aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/data/collection/sequence.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux/data/collection/sequence.lux')
-rw-r--r--stdlib/source/library/lux/data/collection/sequence.lux151
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)))))