From f54e6e22e5044a0cdf28e5ee01e90e1866b29dfc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Oct 2017 19:37:58 -0400 Subject: - Removed the useless Seq type. --- stdlib/source/lux/data/coll/seq.lux | 280 ------------------------------------ stdlib/source/lux/macro/poly/eq.lux | 2 - 2 files changed, 282 deletions(-) delete mode 100644 stdlib/source/lux/data/coll/seq.lux (limited to 'stdlib/source') 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 Fold] - (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 - #f;tree (#f;Leaf default-size value)}) - -(do-template [ ] - [(def: #export ( seq) - (All [a] (-> (Seq a) (Maybe a))) - (do maybe;Monad - [fingers seq] - (wrap (loop [node (get@ #f;tree fingers)] - (case node - (#f;Leaf tag value) - value - - (#f;Branch tag left right) - (recur ))))))] - - [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 - [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 - [[_ 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 - #f;tree tree})))) - -(def: #export (reverse seq) - (All [a] (-> (Seq a) (Seq a))) - (do maybe;Monad - [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 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 = reference x) - - (#f;Branch tag left right) - (or (recur left) - (recur right)))))) - -(do-template [ ] - [(def: #export ( pred seq) - (All [a] (-> (-> a Bool) (Seq a) Bool)) - (case seq - #;None - - - (#;Some fingers) - (loop [seq (get@ #f;tree fingers)] - (case seq - (#f;Leaf tag reference) - (pred reference) - - (#f;Branch tag left right) - ( (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 - [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 Eq) - (All [a] (-> (Eq a) (Eq (Seq a)))) - (def: (= xs ys) - (:: (L;Eq Eq) = - (to-list xs) - (to-list ys)))) - -(struct: #export _ (F;Functor Seq) - (def: (map f ma) - (do maybe;Monad - [fingers ma] - (wrap {#f;monoid number;Add@Monoid - #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) - - (def: wrap (|>. new #;Some)) - - (def: (apply ff fa) - (do maybe;Monad - [ff' ff] - (case (get@ #f;tree ff') - (#f;Leaf tag f) - (:: Functor 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) - - (def: (join ffa) - (do maybe;Monad - [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] @@ -69,7 +68,6 @@ [;Array array;Eq] [queue;Queue queue;Eq] [set;Set set;Eq] - [seq;Seq seq;Eq] [rose;Tree rose;Eq] )] (do @ -- cgit v1.2.3