diff options
Diffstat (limited to 'stdlib/source/library/lux/data/collection/sequence.lux')
-rw-r--r-- | stdlib/source/library/lux/data/collection/sequence.lux | 151 |
1 files changed, 151 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux new file mode 100644 index 000000000..a7fa5cb75 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -0,0 +1,151 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [comonad (#+ CoMonad)]] + [control + ["//" continuation (#+ Cont)] + ["<>" parser + ["<.>" code (#+ Parser)]]] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]] + [data + ["." bit] + [collection + ["." list ("#\." monad)]]] + [math + [number + ["n" nat]]]]]) + +(type: #export (Sequence a) + {#.doc "An infinite sequence of values."} + (Cont [a (Sequence a)])) + +(def: #export (iterate f x) + {#.doc "Create a sequence by applying a function to a value, and to its result, on and on..."} + (All [a] + (-> (-> a a) a (Sequence a))) + (//.pending [x (iterate f (f x))])) + +(def: #export (repeat x) + {#.doc "Repeat a value forever."} + (All [a] + (-> a (Sequence a))) + (//.pending [x (repeat x)])) + +(def: #export (cycle [start next]) + {#.doc (doc "Go over the elements of a list forever." + "The list should not be empty.")} + (All [a] + (-> [a (List a)] (Sequence a))) + (loop [head start + tail next] + (//.pending [head (case tail + #.Nil + (recur start next) + + (#.Cons head' tail') + (recur head' tail'))]))) + +(template [<name> <return>] + [(def: #export (<name> sequence) + (All [a] (-> (Sequence a) <return>)) + (let [[head tail] (//.run sequence)] + <name>))] + + [head a] + [tail (Sequence a)] + ) + +(def: #export (nth idx sequence) + (All [a] (-> Nat (Sequence a) a)) + (let [[head tail] (//.run sequence)] + (case idx + 0 head + _ (nth (dec idx) tail)))) + +(template [<taker> <dropper> <splitter> <pred_type> <pred_test> <pred_step>] + [(def: #export (<taker> pred xs) + (All [a] + (-> <pred_type> (Sequence a) (List a))) + (let [[x xs'] (//.run xs)] + (if <pred_test> + (list& x (<taker> <pred_step> xs')) + (list)))) + + (def: #export (<dropper> pred xs) + (All [a] + (-> <pred_type> (Sequence a) (Sequence a))) + (let [[x xs'] (//.run xs)] + (if <pred_test> + (<dropper> <pred_step> xs') + xs))) + + (def: #export (<splitter> pred xs) + (All [a] + (-> <pred_type> (Sequence a) [(List a) (Sequence a)])) + (let [[x xs'] (//.run xs)] + (if <pred_test> + (let [[tail next] (<splitter> <pred_step> xs')] + [(#.Cons [x tail]) next]) + [(list) xs])))] + + [take_while drop_while split_while (-> a Bit) (pred x) pred] + [take drop split Nat (n.> 0 pred) (dec pred)] + ) + +(def: #export (unfold step init) + {#.doc "A stateful way of infinitely calculating the values of a sequence."} + (All [a b] + (-> (-> a [a b]) a (Sequence b))) + (let [[next x] (step init)] + (//.pending [x (unfold step next)]))) + +(def: #export (filter predicate sequence) + (All [a] (-> (-> a Bit) (Sequence a) (Sequence a))) + (let [[head tail] (//.run sequence)] + (if (predicate head) + (//.pending [head (filter predicate tail)]) + (filter predicate tail)))) + +(def: #export (partition left? xs) + {#.doc (doc "Split a sequence in two based on a predicate." + "The left side contains all entries for which the predicate is #1." + "The right side contains all entries for which the predicate is #0.")} + (All [a] (-> (-> a Bit) (Sequence a) [(Sequence a) (Sequence a)])) + [(filter left? xs) (filter (bit.complement left?) xs)]) + +(implementation: #export functor + (Functor Sequence) + + (def: (map f fa) + (let [[head tail] (//.run fa)] + (//.pending [(f head) (map f tail)])))) + +(implementation: #export comonad + (CoMonad Sequence) + + (def: &functor ..functor) + + (def: unwrap head) + + (def: (split wa) + (let [[head tail] (//.run wa)] + (//.pending [wa (split tail)])))) + +(syntax: #export (^sequence& {patterns (<code>.form (<>.many <code>.any))} + body + {branches (<>.some <code>.any)}) + {#.doc (doc "Allows destructuring of sequences in pattern-matching expressions." + "Caveat emptor: Only use it for destructuring, and not for testing values within the sequences." + (let [(^sequence& x y z _tail) (some_sequence_func +1 +2 +3)] + (func x y z)))} + (with_gensyms [g!sequence] + (let [body+ (` (let [(~+ (list\join (list\map (function (_ pattern) + (list (` [(~ pattern) (~ g!sequence)]) + (` ((~! //.run) (~ g!sequence))))) + patterns)))] + (~ body)))] + (wrap (list& g!sequence body+ branches))))) |