Adds splittable class, split method for sequences and eq types

coalton-lang · Apr 5, 2024 · 6916fd3 · 6916fd3
1 parent 709b34c
commit 6916fd3
Show file tree

Hide file tree

Showing 11 changed files with 131 additions and 223 deletions.
diff --git a/coalton.asd b/coalton.asd
@@ -165,6 +165,7 @@
                (:file "randomaccess")
                (:file "cell")
                (:file "iterator")
+               (:file "split")
                (:file "optional")
                (:file "result")
                (:file "tuple")

diff --git a/examples/small-coalton-programs/src/brainfold.lisp b/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)
                         (">"

diff --git a/library/list.lisp b/library/list.lisp
@@ -10,7 +10,8 @@
   (:local-nicknames
    (#:cell #:coalton-library/cell)
    (#:iter #:coalton-library/iterator)
-   (#:arith #:coalton-library/math/arith))
+   (#:arith #:coalton-library/math/arith)
+   (#:split #:coalton-library/split))
   (:export
    #:head
    #:tail
@@ -241,11 +242,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 +605,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."
@@ -762,7 +756,32 @@ This function is equivalent to all size-N elements of `(COMBS L)`."
         ((Some a) (Cons a Nil)))))
 
   (define-instance (Default (List :a))
-    (define (default) Nil)))
+    (define (default) Nil))
+
+  (define-instance (split:Splittable List)
+    (define (split: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)))))))
+
+
 
 #+sb-package-locks
 (sb-ext:lock-package "COALTON-LIBRARY/LIST")
diff --git a/library/prelude.lisp b/library/prelude.lisp
@@ -256,5 +256,6 @@
    (#:hashtable #:coalton-library/hashtable)
    (#:st #:coalton-library/monad/state)
    (#:iter #:coalton-library/iterator)
+   (#:split #:coalton-library/split)
    (#:sys #:coalton-library/system)))
 
diff --git a/library/seq.lisp b/library/seq.lisp
@@ -10,7 +10,9 @@
    (#:optional #:coalton-library/optional)
    (#:cell #:coalton-library/cell)
    (#:vector #:coalton-library/vector)
-   (#:iter #:coalton-library/iterator))
+   (#:iter #:coalton-library/iterator)
+   (#:list #:coalton-library/list)
+   (#:split #:coalton-library/split))
   (:export
    #:Seq
    #:new
@@ -253,6 +255,29 @@ a new `Seq` instance."
                             (iter:zip! (iter:into-iter a)
                                        (iter:into-iter b)))))))
 
+  (define-instance (split:Splittable Seq)
+    (define (split: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))))))
+
   ;;
   ;; Helpers
   ;; 

diff --git a/library/split.lisp b/library/split.lisp
@@ -3,38 +3,12 @@
    #:coalton
    #:coalton-library/builtin
    #:coalton-library/classes)
-  #+ignore(:import-from
-   #:coalton-library/hash
-   #:define-sxhash-hasher)
-  #+ignore(:import-from
-   #:coalton-library/vector
-   #:Vector)
   (:local-nicknames
-   (#:cell #:coalton-library/cell)
    (#:iter #:coalton-library/iterator)
-   (#:list #:coalton-library/list)
-   (#:vec #:coalton-library/vector)
-   (#:seq #:coalton-library/seq)
-   (#:types #:coalton-library/types)
-   (#:slice #:coalton-library/slice))
+   (#:types #:coalton-library/types))
   (:export
    #:splittable
-   #:split)
-  #+ignore(:export
-           #:concat
-           #:reverse
-           #:length
-           #:substring
-           #:split
-           #:strip-prefix
-           #:strip-suffix
-           #:parse-int
-           #:ref
-           #:ref-unchecked
-           #:substring-index
-           #:substring?
-           #:chars
-           #:delim-split))
+   #:split))
 
 
 (in-package #:coalton-library/split)
@@ -49,132 +23,10 @@
 (coalton-toplevel
 
   (define-class (Splittable :seq)
-    "Sequence types that can be split by equality."
+    "Sequence types that can be split by element equality."
     (split ((Eq :a) (types:runtimerepr :a) => :a -> (:seq :a) -> (iter:iterator (:seq :a))))))
 
-;;;
-;;; Instances
-;;;
-
-(coalton-toplevel
-
-  (define-instance (Splittable List)
-    (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)
-                             (unless (list:null? (cell:read current-block))
-                               (cell:push! blocks (list:reverse (cell:read current-block)))
-                               (cell:write! current-block nil)
-                               Unit))
-                            (True
-                             (cell:push! current-block x)
-                             Unit)))
-                        iter)
-
-        (unless (list:null? (cell:read current-block))
-          (cell:push! blocks (list:reverse (cell:read current-block)))
-          Unit)
-
-        (iter:into-iter (list:reverse (cell:read blocks))))))
-
-  (define-instance (Splittable vec:Vector)
-    (define (split delim v)
-      (let ((blocks (cell:new Nil))
-            (current-block (vec:new))
-            (iter (iter:into-iter v)))
-
-        (iter:for-each! (fn (x)
-                          (cond
-                            ((== x delim)
-                             (unless (vec:empty? current-block)
-                               (cell:push! blocks current-block)
-                               (vec:clear! current-block)
-                               Unit))
-                            (True
-                             (vec:push! x current-block)
-                             Unit)))
-                        iter)
-
-        (unless (vec:empty? current-block)
-          (cell:push! blocks current-block)
-          Unit)
-
-        (iter:into-iter (list:reverse (cell:read blocks))))))
-
-  (define-instance (Splittable seq:Seq)
-    (define (split delim xs)
-      (let ((blocks (cell:new Nil))
-            (current-block (cell:new (seq:new)))
-            (iter (iter:into-iter xs)))
-
-        (iter:for-each! (fn (x)
-                          (cond
-                            ((== x delim)
-                             (unless (seq:empty? (cell:read current-block))
-                               (cell:push! blocks (cell:read current-block))
-                               (cell:write! current-block (seq:new))
-                               Unit))
-                            (True
-                             (cell:write! current-block (seq:push (cell:read current-block) x))
-                             Unit)))
-                        iter)
-
-        (unless (seq:empty? (cell:read current-block))
-          (cell:push! blocks (cell:read current-block))
-          Unit)
-
-        (iter:into-iter (list:reverse (cell:read blocks))))))
-
-  (define-instance (Splittable iter:Iterator)
-    (define (split delim it)
-      (let ((blocks (cell:new Nil))
-            (current-block (cell:new Nil)))
-
-        (iter:for-each! (fn (x)
-                          (cond
-                            ((== x delim)
-                             (unless (list:null? (cell:read current-block))
-                               (cell:push! blocks (iter:into-iter (list:reverse (cell:read current-block))))
-                               (cell:write! current-block nil)
-                               Unit))
-                            (True
-                             (cell:push! current-block x)
-                             Unit)))
-                        it)
-
-        (unless (list:null? (cell:read current-block))
-          (cell:push! blocks (iter:into-iter (list:reverse (cell:read current-block))))
-          Unit)
-
-        (iter:into-iter (list:reverse (cell:read blocks))))))
 
-  (define-instance (Splittable slice:Slice)
-    (define (split delim xs)
-      (let ((blocks (cell:new Nil))
-            (current-block (cell:new Nil))
-            (iter:into-iter xs))
-
-        (iter:for-each! (fn (x)
-                          (cond
-                            ((== x delim)
-                             (unless (list:null? (cell:read current-block))
-                               (cell:push! blocks (iter:into-iter (list:reverse (cell:read current-block))))
-                               (cell:write! current-block nil)
-                               Unit))
-                            (True
-                             (cell:push! current-block x)
-                             Unit)))
-                        it)
-
-        (unless (list:null? (cell:read current-block))
-          (cell:push! blocks (iter:into-iter (list:reverse (cell:read current-block))))
-          Unit)
-
-        (iter:into-iter (list:reverse (cell:read blocks))))))
 
-  )
+;; TODO (Maybe):
+;; Add instance for Slice
diff --git a/library/string.lisp b/library/string.lisp
@@ -19,6 +19,7 @@
    #:reverse
    #:length
    #:substring
+   #:bisect
    #:split
    #:strip-prefix
    #:strip-suffix
@@ -138,33 +139,11 @@ does not have that suffix."
     "Returns an iterator over the characters in `str`."
     (iter:into-iter str))
 
-  (declare split (Char -> String -> (iter:Iterator (List Char))))
+  (declare split (Char -> String -> (List String)))
   (define (split ch str)
-    (split:split ch (iter:collect! (chars str))))
-  #+ignore(define (delim-split delim str)
-            "Splits the string according to a single-char delimiter."
-            (let ((strs (cell:new Nil))
-                  (current-str (the (cell:Cell (List Char)) (cell:new Nil)))
-                  (chrs (chars str)))
-
-              (iter:for-each! (fn (x)
-                                (cond
-                                  ((== x delim)
-                                   (unless (list:null? (cell:read current-str))
-                                     (cell:push! strs (the String (into (list:reverse (cell:read current-str)))))
-                                     (cell:write! current-str nil)
-                                     Unit))
-                                  (True
-                                   (cell:push! current-str x)
-                                   Unit
-                                   )))
-                              chrs)
-
-              (unless (list:null? (cell:read current-str))
-                (cell:push! strs (the String (into (list:reverse (cell:read current-str)))))
-                Unit)
-
-              (list:reverse (cell:read strs))))
+    "Splits a string with a specified single-character delimeter."
+    (map (fn (x) (the String (into x)))
+         (iter:collect! (split:split ch (the (List Char) (into str))))))
 
   ;;
   ;; Instances

diff --git a/library/vector.lisp b/library/vector.lisp
@@ -9,7 +9,8 @@
    (#:list #:coalton-library/list)
    (#:cell #:coalton-library/cell)
    (#:iter #:coalton-library/iterator)
-   (#:ram #:coalton-library/randomaccess))
+   (#:ram #:coalton-library/randomaccess)
+   (#:split #:coalton-library/split))
   (:export
    #:Vector
    #:new
@@ -348,7 +349,19 @@
       vec))
 
   (define-instance (Default (Vector :a))
-    (define default new)))
+    (define default new))
+
+  (declare list->vec (List :a -> Vector :a))
+  (define (list->vec x)
+    (into x))
+
+  (declare vec->list (Vector :a -> List :a))
+  (define (vec->list x)
+    (into x))
+
+  (define-instance (split:Splittable Vector)
+    (define (split:split delim v)
+      (map list->vec (split:split delim (vec->list v))))))
 
 (cl:defmacro make (cl:&rest elements)
   "Construct a `Vector' containing the ELEMENTS, in the order listed."