diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/coll/seq.lux | 280 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly/eq.lux | 2 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/coll/seq.lux | 129 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 1 |
4 files changed, 0 insertions, 412 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 @ diff --git a/stdlib/test/test/lux/data/coll/seq.lux b/stdlib/test/test/lux/data/coll/seq.lux deleted file mode 100644 index 801c5c2f1..000000000 --- a/stdlib/test/test/lux/data/coll/seq.lux +++ /dev/null @@ -1,129 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do Monad] - pipe) - (data (coll ["&" seq] - ["F" tree/finger] - ["L" list]) - [text "Text/" Monoid<Text>] - [number] - [bool] - [product] - maybe) - ["r" math/random]) - lux/test) - -(def: bounded-size - (r;Random Nat) - (|> r;nat - (:: r;Monad<Random> map (|>. (n.% +100) (n.+ +10) (n.max +1))))) - -(context: "Seqs: Part 1" - [size bounded-size - idx (:: @ map (n.% size) r;nat) - sample (|> (r;list size r;nat) - (:: @ map &;from-list)) - extra r;nat - #let [(^open "&/") (&;Eq<Seq> number;Eq<Nat>)]] - ($_ seq - (test "Can convert to/from list." - (|> sample - &;to-list &;from-list - (&/= sample))) - - (test "The size function should correctly portray the size of the seq." - (n.= size (&;size sample))) - - (test "Reversing a seq does not change it's size." - (n.= (&;size sample) - (&;size (&;reverse sample)))) - - (test "Reversing a seq twice results in the original seq." - (&/= sample - (&;reverse (&;reverse sample)))) - - (test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." - (if (&;every? n.even? sample) - (not (&;any? (bool;complement n.even?) sample)) - (&;any? (bool;complement n.even?) sample))) - - (test "Any element of the list can be considered its member." - (and (&;member? number;Eq<Nat> - (&;prepend extra sample) - extra) - (&;member? number;Eq<Nat> - (&;compose extra sample) - extra))) - - (test "Can do random access to seq elements." - (and (|> (&;prepend extra sample) - (&;nth +0) - (case> (#;Some reference) - (n.= reference extra) - - _ - false)) - (|> (&;compose extra sample) - (&;nth size) - (case> (#;Some reference) - (n.= reference extra) - - _ - false)))) - )) - -(context: "Seqs: Part 2" - [size bounded-size - sample (|> (r;list size r;nat) - (:: @ map &;from-list)) - #let [(^open "&/") (&;Eq<Seq> number;Eq<Nat>) - (^open "&/") &;Functor<Seq>]] - ($_ seq - (test "Functor should go over every element of the seq." - (let [there (&/map n.inc sample) - back-again (&/map n.dec there)] - (and (not (&/= sample there)) - (&/= sample back-again)))) - - (test "Sorting a seq shouldn't change it's size." - (n.= (&;size sample) - (&;size (&;sort n.< sample)))) - - (test "Sorting a seq with one order should yield the reverse of sorting it with the opposite order." - (&/= (&;sort n.< sample) - (&;reverse (&;sort n.> sample)))) - )) - -(context: "Seqs: Part 3" - [size bounded-size - idx (:: @ map (n.% size) r;nat) - sample (|> (r;list size r;nat) - (:: @ map &;from-list)) - other-size bounded-size - other-sample (|> (r;list other-size r;nat) - (:: @ map &;from-list)) - elem r;nat - #let [(^open "&/") (&;Eq<Seq> number;Eq<Nat>) - (^open "&/") &;Monad<Seq>]] - ($_ seq - (test "Applicative allows you to create singleton seqs, and apply seqs of functions to seqs of values." - (and (&/= (&;seq elem) (&/wrap elem)) - (&/= (&/map n.inc sample) - (&/apply (&/wrap n.inc) sample)))) - - (test "Seq concatenation is a monad." - (&/= (&;concat sample other-sample) - (&/join (&;seq sample other-sample)))) - - (test "You can find any value that satisfies some criterium, if such values exist in the seq." - (case (&;find n.even? sample) - (#;Some found) - (and (n.even? found) - (&;any? n.even? sample) - (not (&;every? (bool;complement n.even?) sample))) - - #;None - (and (not (&;any? n.even? sample)) - (&;every? (bool;complement n.even?) sample)))) - )) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 085275e62..b7f097fa2 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -49,7 +49,6 @@ ["_;" set] ["_;" stack] ["_;" vector] - ["_;" seq] ["_;" priority-queue] ["_;" stream] (tree ["tree_;" rose] |