aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/data/coll/seq.lux280
-rw-r--r--stdlib/source/lux/macro/poly/eq.lux2
2 files changed, 0 insertions, 282 deletions
diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux
deleted file mode 100644
index 2b464adf8..000000000
--- a/stdlib/source/lux/data/coll/seq.lux
+++ /dev/null
@@ -1,280 +0,0 @@
-(;module:
- lux
- (lux (control ["F" functor]
- ["A" applicative]
- [monad #+ do Monad]
- [eq #+ Eq]
- fold
- ["p" parser])
- (data (coll ["L" list "L/" Monoid<List> Fold<List>]
- (tree ["f" finger]))
- [number]
- [maybe])
- [macro]
- (macro [code]
- ["s" syntax #+ syntax: Syntax])))
-
-(type: #export (Seq a)
- (Maybe (f;Fingers Nat a)))
-
-(def: default-size Nat +1)
-
-(def: (new value)
- (All [a] (-> a (f;Fingers Nat a)))
- {#f;monoid number;Add@Monoid<Nat>
- #f;tree (#f;Leaf default-size value)})
-
-(do-template [<name> <side>]
- [(def: #export (<name> seq)
- (All [a] (-> (Seq a) (Maybe a)))
- (do maybe;Monad<Maybe>
- [fingers seq]
- (wrap (loop [node (get@ #f;tree fingers)]
- (case node
- (#f;Leaf tag value)
- value
-
- (#f;Branch tag left right)
- (recur <side>))))))]
-
- [first left]
- [last right]
- )
-
-(def: #export (prepend prefix subject)
- (All [a] (-> a (Seq a) (Seq a)))
- (case subject
- #;None
- (#;Some (new prefix))
-
- (#;Some fingers)
- (#;Some (f;branch (new prefix) fingers))))
-
-(def: #export (compose suffix subject)
- (All [a] (-> a (Seq a) (Seq a)))
- (case subject
- #;None
- (#;Some (new suffix))
-
- (#;Some fingers)
- (#;Some (f;branch fingers (new suffix)))))
-
-(def: #export (concat left right)
- (All [a] (-> (Seq a) (Seq a) (Seq a)))
- (case [left right]
- [_ #;None]
- left
-
- [#;None _]
- right
-
- [(#;Some left') (#;Some right')]
- (#;Some (f;branch left' right'))))
-
-(def: #export (nth idx seq)
- (All [a] (-> Nat (Seq a) (Maybe a)))
- (do maybe;Monad<Maybe>
- [fingers seq]
- (f;search (n.> idx) fingers)))
-
-(def: #export (size seq)
- (All [a] (-> (Seq a) Nat))
- (case seq
- #;None
- +0
-
- (#;Some fingers)
- (case (get@ #f;tree fingers)
- (^or (#f;Leaf tag value) (#f;Branch tag left right))
- tag)))
-
-(def: #export (to-list seq)
- (All [a] (-> (Seq a) (List a)))
- (case seq
- #;None
- (list)
-
- (#;Some fingers)
- (loop [node (get@ #f;tree fingers)]
- (case node
- (#f;Leaf tag value)
- (list value)
-
- (#f;Branch tag left right)
- (L/compose (recur left) (recur right))))))
-
-(def: #export (from-list xs)
- (All [a] (-> (List a) (Seq a)))
- (loop [xs xs]
- (do maybe;Monad<Maybe>
- [[_ tree] (loop [xs xs]
- (case xs
- #;Nil
- #;None
-
- (#;Cons x #;Nil)
- (wrap [default-size
- (#f;Leaf default-size x)])
-
- (#;Cons x xs')
- (do @
- [[sub-size right] (recur xs')
- #let [branch-size (n.+ default-size sub-size)]]
- (wrap [branch-size
- (#f;Branch branch-size
- (#f;Leaf default-size x)
- right)]))
- ))]
- (wrap {#f;monoid number;Add@Monoid<Nat>
- #f;tree tree}))))
-
-(def: #export (reverse seq)
- (All [a] (-> (Seq a) (Seq a)))
- (do maybe;Monad<Maybe>
- [fingers seq
- #let [node' (loop [node (get@ #f;tree fingers)]
- (case node
- (#f;Leaf tag value)
- node
-
- (#f;Branch tag left right)
- (#f;Branch tag (recur right) (recur left))))]]
- (wrap (set@ #f;tree node' fingers))))
-
-(def: #export (member? Eq<a> xs x)
- (All [a] (-> (Eq a) (Seq a) a Bool))
- (case xs
- #;None
- false
-
- (#;Some fingers)
- (loop [xs (get@ #f;tree fingers)]
- (case xs
- (#f;Leaf tag reference)
- (:: Eq<a> = reference x)
-
- (#f;Branch tag left right)
- (or (recur left)
- (recur right))))))
-
-(do-template [<name> <op> <default>]
- [(def: #export (<name> pred seq)
- (All [a] (-> (-> a Bool) (Seq a) Bool))
- (case seq
- #;None
- <default>
-
- (#;Some fingers)
- (loop [seq (get@ #f;tree fingers)]
- (case seq
- (#f;Leaf tag reference)
- (pred reference)
-
- (#f;Branch tag left right)
- (<op> (recur left)
- (recur right))))))]
-
- [every? and true]
- [any? or false]
- )
-
-(def: #export (sort < seq)
- (All [a] (-> (-> a a Bool) (Seq a) (Seq a)))
- (|> seq to-list (L;sort <) from-list))
-
-(def: #export (find pred seq)
- {#;doc "Returns the first value in the sequence for which the predicate is true."}
- (All [a]
- (-> (-> a Bool) (Seq a) (Maybe a)))
- (do maybe;Monad<Maybe>
- [fingers seq]
- (loop [seq (get@ #f;tree fingers)]
- (case seq
- (#f;Leaf tag value)
- (if (pred value)
- (#;Some value)
- #;None)
-
- (#f;Branch tag left right)
-
- (case (recur left)
- #;None
- (recur right)
-
- output
- output)))))
-
-(struct: #export _ (Fold Seq)
- (def: (fold f init seq)
- (case seq
- #;None
- init
-
- (#;Some fingers)
- (loop [init init
- node (get@ #f;tree fingers)]
- (case node
- (#f;Leaf tag value)
- (f value init)
-
- (#f;Branch tag left right)
- (recur (recur init left)
- right)
- )))))
-
-(struct: #export (Eq<Seq> Eq<a>)
- (All [a] (-> (Eq a) (Eq (Seq a))))
- (def: (= xs ys)
- (:: (L;Eq<List> Eq<a>) =
- (to-list xs)
- (to-list ys))))
-
-(struct: #export _ (F;Functor Seq)
- (def: (map f ma)
- (do maybe;Monad<Maybe>
- [fingers ma]
- (wrap {#f;monoid number;Add@Monoid<Nat>
- #f;tree (loop [tree (get@ #f;tree fingers)]
- (case tree
- (#f;Leaf tag value)
- (#f;Leaf tag (f value))
-
- (#f;Branch tag left right)
- (#f;Branch tag (recur left) (recur right))))}))))
-
-(struct: #export _ (A;Applicative Seq)
- (def: functor Functor<Seq>)
-
- (def: wrap (|>. new #;Some))
-
- (def: (apply ff fa)
- (do maybe;Monad<Maybe>
- [ff' ff]
- (case (get@ #f;tree ff')
- (#f;Leaf tag f)
- (:: Functor<Seq> map f fa)
-
- (#f;Branch tag lfs rfs)
- (do @
- [lefts (apply (#;Some (set@ #f;tree lfs ff')) fa)
- rights (apply (#;Some (set@ #f;tree rfs ff')) fa)]
- (wrap (f;branch lefts rights)))))))
-
-(struct: #export _ (Monad Seq)
- (def: applicative Applicative<Seq>)
-
- (def: (join ffa)
- (do maybe;Monad<Maybe>
- [ffa' ffa]
- (case (get@ #f;tree ffa')
- (#f;Leaf tag fa)
- fa
-
- (#f;Branch tag left right)
- (do @
- [left' (join (#;Some (set@ #f;tree left ffa')))
- right' (join (#;Some (set@ #f;tree right ffa')))]
- (wrap (f;branch left' right')))))))
-
-(syntax: #export (seq [elems (p;some s;any)])
- (wrap (list (` (;;from-list (list (~@ elems)))))))
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index b0b9fbce7..13af05adc 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -10,7 +10,6 @@
[array]
[queue]
[set]
- [seq]
[dict #+ Dict]
(tree [rose]))
[number "nat/" Codec<Text,Nat>]
@@ -69,7 +68,6 @@
[;Array array;Eq<Array>]
[queue;Queue queue;Eq<Queue>]
[set;Set set;Eq<Set>]
- [seq;Seq seq;Eq<Seq>]
[rose;Tree rose;Eq<Tree>]
)]
(do @
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:23:56 +0000