Adds split functions for sequence types including lists, vectors, seqs and strings

examples/small-coalton-programs/src/brainfold.lisp

@@ -187,7 +187,7 @@
     (let cmds = (vec:new))
     (let vecs = (vec:new))
     (let ((parser (fn (input-string v)
-                    (let ((head-tail (str:split 1 input-string)))
+                    (let ((head-tail (str:bisect 1 input-string)))
                       (match (fst head-tail)
                         ("" cmds)
                         (">"

library/list.lisp

@@ -241,11 +241,11 @@
   (define (nth-cdr n l)
     "Returns the nth-cdr of a list."
     (cond ((null? l)
-	   Nil)
-	  ((arith:zero? n)
-	   l)
-	  (True
-	   (nth-cdr (arith:1- n) (cdr l)))))
+           Nil)
+          ((arith:zero? n)
+           l)
+          (True
+           (nth-cdr (arith:1- n) (cdr l)))))
 
   (declare elemIndex (Eq :a => :a -> List :a -> Optional UFix))
   (define (elemIndex x xs)
@@ -604,13 +604,6 @@
            (any f xs)))
       ((Nil) False)))
 
-  (declare split (Char -> String -> (List String)))
-  (define (split c str)
-    (lisp (List String) (c str)
-      (cl:let ((split-chars (cl:list c)))
-        (cl:declare (cl:dynamic-extent split-chars))
-        (uiop:split-string str :separator split-chars))))
-
   (declare perms (List :a -> (List (List :a))))
   (define (perms l)
     "Produce all permutations of the list L."
@@ -643,6 +636,29 @@ This function is equivalent to all size-N elements of `(COMBS L)`."
                                 (map (Cons x) (combsOf (- n 1) xs)) ; combs with X
                                 (combsOf n xs))))))) ; and without x
 
+  (declare split ((Eq :a) => :a -> (List :a) -> (iter:Iterator (List :a))))
+  (define (split delim xs)
+    (let ((blocks (cell:new Nil))
+          (current-block (cell:new Nil))
+          (iter (iter:into-iter xs)))
+
+      (iter:for-each! (fn (x)
+                        (cond
+                          ((== x delim)
+                           (cell:push! blocks (reverse (cell:read current-block)))
+                           (cell:write! current-block nil)
+                           Unit)
+                          (True
+                           (cell:push! current-block x)
+                           Unit)))
+                      iter)
+
+      (unless (null? (cell:read current-block))
+        (cell:push! blocks (reverse (cell:read current-block)))
+        Unit)
+
+      (iter:into-iter (reverse (cell:read blocks)))))
+
   ;;
   ;; Instances
   ;;
@@ -764,5 +780,7 @@ This function is equivalent to all size-N elements of `(COMBS L)`."
   (define-instance (Default (List :a))
     (define (default) Nil)))
 
+
+
 #+sb-package-locks
 (sb-ext:lock-package "COALTON-LIBRARY/LIST")

library/seq.lisp

@@ -10,7 +10,8 @@
    (#:optional #:coalton-library/optional)
    (#:cell #:coalton-library/cell)
    (#:vector #:coalton-library/vector)
-   (#:iter #:coalton-library/iterator))
+   (#:iter #:coalton-library/iterator)
+   (#:list #:coalton-library/list))
   (:export
    #:Seq
    #:new
@@ -21,6 +22,7 @@
    #:put
    #:empty?
    #:conc
+   #:split
    #:make))
 
 (in-package #:coalton-library/seq)
@@ -60,7 +62,7 @@
      UFix                               ; height
      UFix                               ; cached full subtree size
      (vector:Vector UFix)               ; cumulative size table
-     (vector:Vector (Seq :a)))         ; subtrees
+     (vector:Vector (Seq :a)))          ; subtrees
     (LeafArray (vector:Vector :a)))
 
   (declare new (types:RuntimeRepr :a => Unit -> Seq :a))
@@ -139,14 +141,14 @@ a new `Seq` instance."
        (do
         ((Tuple leaf newsub) <- (pop (vector:last-unsafe sts)))
         (let newsts = (vector:copy sts))
-        (let newcst = (vector:copy cst))
-        (let last-idx = (- (vector:length cst) 1))
-        (let seq-size = (size seq))
+         (let newcst = (vector:copy cst))
+         (let last-idx = (- (vector:length cst) 1))
+         (let seq-size = (size seq))
          (pure
           (cond
             ;; this was the only thing left in seq
             ((== 1 seq-size)
-             (Tuple leaf newsub))     ; newsub is empty
+             (Tuple leaf newsub))       ; newsub is empty
 
             ;; the seq was exactly one larger than the subtree size
             ;; for the current height, this means we can reduce the tree height
@@ -164,7 +166,7 @@ a new `Seq` instance."
              (vector:set! last-idx newsub newsts)
              (Tuple leaf (RelaxedNode h fss newcst newsts)))))))))
 
-    (define (conc left right)
+  (define (conc left right)
     "Concatenate two `Seq`s"
     (cond
       ((empty? left) right)
@@ -207,6 +209,30 @@ a new `Seq` instance."
                    (rebalance-branches
                     (fold <> (butlast lsubts) (make-list nsubts (butfirst rsubts))))))))))))
 
+  (declare split ((Eq :a) (types:RuntimeRepr :a) => :a -> (Seq :a) -> (iter:Iterator (Seq :a))))
+  (define (split delim xs)
+    (let ((blocks (cell:new Nil))
+          (current-block (cell:new (new)))
+          (iter (iter:into-iter xs)))
+
+      (iter:for-each!
+       (fn (x)
+         (cond
+           ((== x delim)
+            (cell:push! blocks (cell:read current-block))
+            (cell:write! current-block (new))
+            Unit)
+           (True
+            (cell:write! current-block (push (cell:read current-block) x))
+            Unit)))
+       iter)
+
+      (unless (empty? (cell:read current-block))
+        (cell:push! blocks (cell:read current-block))
+        Unit)
+
+      (iter:into-iter (list:reverse (cell:read blocks)))))
+
   ;;
   ;; Instances
   ;; 
@@ -253,6 +279,8 @@ a new `Seq` instance."
                             (iter:zip! (iter:into-iter a)
                                        (iter:into-iter b)))))))
 
+
+
   ;;
   ;; Helpers
   ;; 

library/string.lisp

@@ -11,21 +11,23 @@
    #:Vector)
   (:local-nicknames
    (#:cell #:coalton-library/cell)
-   (#:iter #:coalton-library/iterator))
+   (#:iter #:coalton-library/iterator)
+   (#:list #:coalton-library/list))
   (:export
    #:concat
    #:reverse
    #:length
    #:substring
-   #:split
+   #:bisect
    #:strip-prefix
    #:strip-suffix
    #:parse-int
    #:ref
    #:ref-unchecked
    #:substring-index
    #:substring?
-   #:chars))
+   #:chars
+   #:split))
 
 
 (in-package #:coalton-library/string)
@@ -65,9 +67,9 @@
       (lisp String (real-start real-end str)
         (cl:subseq str real-start real-end))))
 
-  (declare split (UFix -> String -> (Tuple String String)))
-  (define (split n str)
-    "Splits a string into a head and tail at the nth index."
+  (declare bisect (UFix -> String -> (Tuple String String)))
+  (define (bisect n str)
+    "Bisects a string into a head and tail at the nth index."
     (Tuple (substring str 0 n)
            (substring str n (length str))))
 
@@ -134,6 +136,12 @@ does not have that suffix."
   (define (chars str)
     "Returns an iterator over the characters in `str`."
     (iter:into-iter str))
+
+  (declare split (Char -> String -> (List String)))
+  (define (split ch str)
+    "Splits a string with a specified single-character delimeter."
+    (map (fn (x) (the String (into x)))
+         (iter:collect! (list:split ch (the (List Char) (into str))))))
 
   ;;
   ;; Instances

library/vector.lisp

@@ -32,6 +32,7 @@
    #:last
    #:last-unsafe
    #:extend!
+   #:split
    #:find-elem
    #:append
    #:swap-remove!
@@ -247,6 +248,24 @@
      iter)
     Unit)
 
+  (declare split ((Eq :a) => :a -> (Vector :a) -> (iter:Iterator (Vector :a))))
+  (define (split delim v)
+    "Splits a vector according to a delimiter. Returns an iterator of vectors."
+    (let fragments = (new))
+    (let current-fragment = (new))
+    (for i in (iter:up-to (length v))
+         (let ((elt (index-unsafe i v)))
+           (cond ((== elt delim)
+                  (push! (copy current-fragment) fragments)
+                  (clear! current-fragment))
+                 (True
+                  (push! elt current-fragment)
+                  Unit))))
+    (while (not (empty? current-fragment))
+      (push! (copy current-fragment) fragments)
+      (clear! current-fragment))
+    (iter:into-iter fragments))
+
   ;;
   ;; Instances
   ;;

tests/list-tests.lisp

@@ -209,9 +209,6 @@
   Unit)
 
 (define-test test-combinatorics ()
-  (is (== (list:split #\, "one,two,three") (make-list "one" "two" "three")))
-  (is (== (list:split #\, "one,,three") (make-list "one" "" "three")))
-
   (is (set== (list:perms x)
              (make-list
               (make-list 1 2 3)

tests/split-tests.lisp

@@ -0,0 +1,56 @@
+(cl:in-package #:coalton-native-tests)
+
+(coalton-toplevel
+  (define *split-path* "wow/ok/dir/file.txt")
+
+  (define *split-path-undotted* (make-list
+                             (make-list #\w #\o #\w #\/ #\o #\k #\/ #\d #\i #\r #\/ #\f #\i #\l #\e)
+                             (make-list #\t #\x #\t)))
+
+  (define *split-path-unslashed* (make-list
+                              (make-list #\w #\o #\w)
+                              (make-list #\o #\k)
+                              (make-list #\d #\i #\r)
+                              (make-list #\f #\i #\l #\e #\. #\t #\x #\t))))
+
+;;;
+;;; splitting lists
+;;;
+
+(define-test split-list ()
+  (is (== (iter:collect! (list:split #\. (iter:collect! (string:chars *split-path*)))) *split-path-undotted*))
+  (is (== (iter:collect! (list:split #\/ (iter:collect! (string:chars *split-path*)))) *split-path-unslashed*))
+  (is (== (iter:collect! (list:split 2 (make-list 1 2 3 4 2 5 2))) (make-list (make-list 1)
+                                                                               (make-list 3 4)
+                                                                               (make-list 5))))
+  (is (== (iter:collect! (list:split #\A (iter:collect! (string:chars "BANANA"))))
+          (make-list (make-list #\B)
+                     (make-list #\N)
+                     (make-list #\N)))))
+
+;;;
+;;; splitting vectors
+;;;
+
+
+(define-test split-vector ()
+  (is (== (iter:collect! (vector:split #\. (list->vec (iter:collect! (string:chars *split-path*)))))
+          (map list->vec *split-path-undotted*)))
+  (is (== (iter:collect! (vector:split #\/ (list->vec (iter:collect! (string:chars *split-path*)))))
+          (map list->vec *split-path-unslashed*))))
+
+;;;
+;;; splitting vector
+;;;
+
+
+(coalton-toplevel
+
+  (define (seq-num-list)
+    (the (seq:Seq Integer) (iter:collect! (iter:up-to 10)))))
+
+(define-test split-seq ()
+  (is (== (the (List (seq:Seq Integer))
+               (iter:collect! (seq:split 5 (seq-num-list))))
+          (make-list (the (seq:Seq Integer) (iter:collect! (iter:up-to 5)))
+                     (the (seq:Seq Integer) (iter:collect! (map (fn (x) (+ x 6)) (iter:up-to 4))))))))

tests/string-tests.lisp

@@ -19,11 +19,11 @@
   (is (== (substring "foobar" 3 6)
           "bar")))
 
-(define-test string-split ()
+(define-test bisect-string ()
   (let str = "teststring")
-  (is (== (string:split 1 str)
+  (is (== (string:bisect 1 str)
           (Tuple "t" "eststring")))
-  (is (== (string:split 4 str)
+  (is (== (string:bisect 4 str)
           (Tuple "test" "string"))))
 
 (define-test strip-fixes ()
@@ -76,3 +76,13 @@
   (let has-empty? = (string:substring? ""))
   (is (has-empty? ""))
   (is (has-empty? "foo")))
+
+(define-test string-split ()
+  (is (== (string:split #\, "one,two,three") (make-list "one" "two" "three")))
+  (is (== (string:split #\, "one,,three") (make-list "one" "" "three")))
+
+  (let path = "wow/ok/dir/file.txt")
+  (is (== (string:split #\. path) (make-list "wow/ok/dir/file" "txt")))
+  (is (== (string:split #\/ path) (make-list "wow" "ok" "dir" "file.txt")))
+  (is (== (string:split #\d "thisddddworks") (make-list "this" "" "" "" "works"))))
+