diff --git a/coalton.asd b/coalton.asd index 4b08dcb80..4745d30da 100644 --- 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 index fa129613c..b3a8eac17 100644 --- 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 index 0c7321950..c98fdc96a 100644 --- 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 index b84f66904..13a6c2fbb 100644 --- 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 index d9175e684..607397e2c 100644 --- 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 index 1b1069338..3f32e2bc3 100644 --- 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 index 448ddf5de..ccd40bbf4 100644 --- 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 index b39dabff6..9ec28641b 100644 --- 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." diff --git a/tests/list-tests.lisp b/tests/list-tests.lisp index cee060229..3718a9b2b 100644 --- a/tests/list-tests.lisp +++ b/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) diff --git a/tests/split-tests.lisp b/tests/split-tests.lisp index e3f408f77..d69f8637f 100644 --- a/tests/split-tests.lisp +++ b/tests/split-tests.lisp @@ -1,38 +1,56 @@ (cl:in-package #:coalton-native-tests) (coalton-toplevel - (define *path* "wow/ok/dir/file.txt") + (define *split-path* "wow/ok/dir/file.txt") - (define *path-undotted* (make-list + (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 *path-unslashed* (make-list + (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))) + (make-list #\f #\i #\l #\e #\. #\t #\x #\t)))) - (declare list->vec (List :a -> Vector :a)) - (define (list->vec x) - (into x))) +;;; +;;; splitting lists +;;; (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 #\. (iter:collect! (string:chars *split-path*)))) *split-path-undotted*)) + (is (== (iter:collect! (split:split #\/ (iter:collect! (string:chars *split-path*)))) *split-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))))) + (make-list 5)))) + (is (== (iter:collect! (split:split #\A (iter:collect! (string:chars "BANANA")))) + (make-list (make-list #\B) + (make-list #\N) + (make-list #\N))))) ;;; ;;; 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*)))) + (is (== (iter:collect! (split:split #\. (list->vec (iter:collect! (string:chars *split-path*))))) + (map list->vec *split-path-undotted*))) + (is (== (iter:collect! (split: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! (split: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)))))))) diff --git a/tests/string-tests.lisp b/tests/string-tests.lisp index 6b9e2a7c5..1f52d1ce4 100644 --- a/tests/string-tests.lisp +++ b/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 () @@ -78,8 +78,11 @@ (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: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")))) + (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"))))