Adding splittable class, split for sequence types

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

Hide file tree

Showing 5 changed files with 251 additions and 28 deletions.
diff --git a/library/split.lisp b/library/split.lisp
@@ -0,0 +1,180 @@
+(coalton-library/utils:defstdlib-package #:coalton-library/split
+  (:use
+   #: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))
+  (: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))
+
+
+(in-package #:coalton-library/split)
+
+(named-readtables:in-readtable coalton:coalton)
+
+
+;;;
+;;; Split
+;;;
+
+(coalton-toplevel
+
+  (define-class (Splittable :seq)
+    "Sequence types that can be split by 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))))))
+
+  )
diff --git a/library/string.lisp b/library/string.lisp
@@ -12,7 +12,8 @@
   (:local-nicknames
    (#:cell #:coalton-library/cell)
    (#:iter #:coalton-library/iterator)
-   (#:list #:coalton-library/list))
+   (#:list #:coalton-library/list)
+   (#:split #:coalton-library/split))
   (:export
    #:concat
    #:reverse
@@ -67,9 +68,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))))
 
@@ -137,31 +138,33 @@ does not have that suffix."
     "Returns an iterator over the characters in `str`."
     (iter:into-iter str))
 
-  (declare delim-split (Char -> String -> (List String)))
-  (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)))
+  (declare split (Char -> String -> (iter:Iterator (List Char))))
+  (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)
+              (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)
+              (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))))
+              (list:reverse (cell:read strs))))
 
   ;;
   ;; Instances

diff --git a/tests/package.lisp b/tests/package.lisp
@@ -32,7 +32,8 @@
    (#:red-black/tree #:coalton-library/ord-tree)
    (#:red-black/map #:coalton-library/ord-map)
    (#:result #:coalton-library/result)
-   (#:seq #:coalton-library/seq)))
+   (#:seq #:coalton-library/seq)
+   (#:split #:coalton-library/split)))
 
 (in-package #:coalton-native-tests)
 

diff --git a/tests/split-tests.lisp b/tests/split-tests.lisp
@@ -0,0 +1,38 @@
+(cl:in-package #:coalton-native-tests)
+
+(coalton-toplevel
+  (define *path* "wow/ok/dir/file.txt")
+
+  (define *path-undotted* (make-list
+                             (make-list #\w #\o #\w #\/ #\o #\k #\/ #\d #\i #\r #\/ #\f #\i #\l #\e)
+                             (make-list #\t #\x #\t)))
+
+  (define *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)))
+
+  (declare list->vec (List :a -> Vector :a))
+  (define (list->vec x)
+    (into x)))
+
+(define-test split-list ()
+  (is (== (iter:collect! (split:split #\. (iter:collect! (string:chars *path*)))) *path-undotted*))
+  (is (== (iter:collect! (split:split #\/ (iter:collect! (string:chars *path*)))) *path-unslashed*))
+  (is (== (iter:collect! (split:split 2 (make-list 1 2 3 4 2 5 2))) (make-list (make-list 1)
+                                                                               (make-list 3 4)
+                                                                               (make-list 5)))))
+
+;;;
+;;; splitting vectors
+;;;
+
+(coalton-toplevel
+
+  )
+(define-test split-vector ()
+  (is (== (iter:collect! (split:split #\. (list->vec (iter:collect! (string:chars *path*)))))
+          (map list->vec *path-undotted*)))
+  (is (== (iter:collect! (split:split #\/ (list->vec (iter:collect! (string:chars *path*)))))
+          (map list->vec *path-unslashed*))))
diff --git a/tests/string-tests.lisp b/tests/string-tests.lisp
@@ -77,8 +77,9 @@
   (is (has-empty? ""))
   (is (has-empty? "foo")))
 
-(define-test string-delim-split ()
+(define-test string-split ()
   (let path = "wow/ok/dir/file.txt")
   (is (== (string:delim-split #\. path) (make-list "wow/ok/dir/file" "txt")))
   (is (== (string:delim-split #\/ path) (make-list "wow" "ok" "dir" "file.txt")))
   (is (== (string:delim-split #\d "thisddddddworks") (make-list "this" "works"))))
+