Skip to content

Commit

Permalink
Defines a split function for strings, lists, vecs, seqs
Browse files Browse the repository at this point in the history
  • Loading branch information
@Izaakwltn
Izaakwltn committed Apr 8, 2024
1 parent 18a627a commit 3b7c6ca
Show file tree
Hide file tree
Showing 9 changed files with 109 additions and 144 deletions.
1 change: 0 additions & 1 deletion coalton.asd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -165,7 +165,6 @@
(:file "randomaccess")
(:file "cell")
(:file "iterator")
(:file "split")
(:file "optional")
(:file "result")
(:file "tuple")
Expand Down
75 changes: 37 additions & 38 deletions library/list.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,7 @@
(:local-nicknames
(#:cell #:coalton-library/cell)
(#:iter #:coalton-library/iterator)
(#:arith #:coalton-library/math/arith)
(#:split #:coalton-library/split))
(#:arith #:coalton-library/math/arith))
(:export
#:head
#:tail
Expand Down Expand Up @@ -637,23 +636,46 @@ 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
;;

(define-instance (Eq :a => Eq (List :a))
(define (== a b)
(match a
((Cons x xs)
(match b
((Cons y ys)
(and (== x y)
(== xs ys)))
(_ False)))
((Nil)
(match b
((Nil) True)
(_ False))))))
(define (== a b)
(match a
((Cons x xs)
(match b
((Cons y ys)
(and (== x y)
(== xs ys)))
(_ False)))
((Nil)
(match b
((Nil) True)
(_ False))))))

;; <=> on lists uses lexographic order, like strings.
;; Nil is the smallest list, and is LT any non-nil list.
Expand Down Expand Up @@ -756,30 +778,7 @@ 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-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)))))))
(define (default) Nil)))



Expand Down
1 change: 0 additions & 1 deletion library/prelude.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -256,6 +256,5 @@
(#:hashtable #:coalton-library/hashtable)
(#:st #:coalton-library/monad/state)
(#:iter #:coalton-library/iterator)
(#:split #:coalton-library/split)
(#:sys #:coalton-library/system)))

81 changes: 42 additions & 39 deletions library/seq.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,8 +11,7 @@
(#:cell #:coalton-library/cell)
(#:vector #:coalton-library/vector)
(#:iter #:coalton-library/iterator)
(#:list #:coalton-library/list)
(#:split #:coalton-library/split))
(#:list #:coalton-library/list))
(:export
#:Seq
#:new
Expand All @@ -23,6 +22,7 @@
#:put
#:empty?
#:conc
#:split
#:make))

(in-package #:coalton-library/seq)
Expand Down Expand Up @@ -62,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))
Expand Down Expand Up @@ -141,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
Expand All @@ -166,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)
Expand Down Expand Up @@ -195,19 +195,43 @@ a new `Seq` instance."
((Tuple (RelaxedNode lht _lfss _lcst lsubts) (RelaxedNode rht _rfss _rcst rsubts))
(cond ((< lht rht)
(match1 (RelaxedNode _nht _nfss _ncst nsubts)
(conc left (vector:head-unsafe rsubts))
(rebalance-branches
(vector:append nsubts (butfirst rsubts)))))
(conc left (vector:head-unsafe rsubts))
(rebalance-branches
(vector:append nsubts (butfirst rsubts)))))
((> lht rht)
(match1 (RelaxedNode _nht _nfss _ncst nsubts)
(conc (vector:last-unsafe lsubts) right)
(rebalance-branches
(vector:append (butlast lsubts) nsubts))))
(conc (vector:last-unsafe lsubts) right)
(rebalance-branches
(vector:append (butlast lsubts) nsubts))))
(True
(match1 (RelaxedNode _nht _nfss _ncst nsubts)
(conc (vector:last-unsafe lsubts) (vector:head-unsafe rsubts))
(rebalance-branches
(fold <> (butlast lsubts) (make-list nsubts (butfirst rsubts))))))))))))
(conc (vector:last-unsafe lsubts) (vector:head-unsafe rsubts))
(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
Expand Down Expand Up @@ -255,28 +279,7 @@ 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
Expand Down
32 changes: 0 additions & 32 deletions library/split.lisp
View file

This file was deleted.

8 changes: 3 additions & 5 deletions library/string.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,15 +12,13 @@
(:local-nicknames
(#:cell #:coalton-library/cell)
(#:iter #:coalton-library/iterator)
(#:list #:coalton-library/list)
(#:split #:coalton-library/split))
(#:list #:coalton-library/list))
(:export
#:concat
#:reverse
#:length
#:substring
#:bisect
#:split
#:strip-prefix
#:strip-suffix
#:parse-int
Expand All @@ -29,7 +27,7 @@
#:substring-index
#:substring?
#:chars
#:delim-split))
#:split))


(in-package #:coalton-library/string)
Expand Down Expand Up @@ -143,7 +141,7 @@ does not have that suffix."
(define (split ch str)
"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))))))
(iter:collect! (list:split ch (the (List Char) (into str))))))

;;
;; Instances
Expand Down
38 changes: 19 additions & 19 deletions library/vector.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,7 @@
(#:list #:coalton-library/list)
(#:cell #:coalton-library/cell)
(#:iter #:coalton-library/iterator)
(#:ram #:coalton-library/randomaccess)
(#:split #:coalton-library/split))
(#:ram #:coalton-library/randomaccess))
(:export
#:Vector
#:new
Expand All @@ -33,6 +32,7 @@
#:last
#:last-unsafe
#:extend!
#:split
#:find-elem
#:append
#:swap-remove!
Expand Down Expand Up @@ -248,15 +248,27 @@
iter)
Unit)

(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))

(declare split ((Eq :a) => :a -> (Vector :a) -> (iter:Iterator (Vector :a))))
(define (split delim v)
(map list->vec (list:split delim (vec->list v))))

;;
;; Instances
;;

(define-instance (Eq :a => Eq (Vector :a))
(define (== v1 v2)
(if (/= (length v1) (length v2))
False
(iter:every! id (iter:zip-with! == (iter:into-iter v1) (iter:into-iter v2))))))
(define (== v1 v2)
(if (/= (length v1) (length v2))
False
(iter:every! id (iter:zip-with! == (iter:into-iter v1) (iter:into-iter v2))))))

(define-instance (Semigroup (Vector :a))
(define <> append))
Expand Down Expand Up @@ -349,19 +361,7 @@
vec))

(define-instance (Default (Vector :a))
(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))))))
(define default new)))

(cl:defmacro make (cl:&rest elements)
"Construct a `Vector' containing the ELEMENTS, in the order listed."
Expand Down
Loading

0 comments on commit 3b7c6ca

Please sign in to comment.