- Some bug fixes.

- More additions to the standard library.

1 files changed, 115 insertions, 45 deletions

diff --git a/input/lux/codata/stream.lux b/input/lux/codata/stream.lux
index 1bfd19292..1d6dd1b50 100644
--- a/input/lux/codata/stream.lux
+++ b/input/lux/codata/stream.lux
@@ -7,57 +7,127 @@
 ##   You must not remove this notice, or any other, from this software.
 
 (;import lux
-         (lux (control (lazy #as L #refer #all))))
+         (lux (control (lazy #as L #refer #all)
+                       (functor #as F #refer #all)
+                       (monad #as M #refer #all)
+                       (comonad #as CM #refer #all))
+              (meta lux
+                    macro
+                    syntax)
+              (data (list #as l #refer (#only list list& List/Monad)))))
 
-## Types
+## [Types]
 (deftype #export (Stream a)
   (Lazy (, a (Stream a))))
 
-## Functions
+## [Utils]
+(def (cycle' x xs init full)
+  (All [a]
+    (-> a (List a) a (List a) (Stream a)))
+  (case xs
+    #;Nil            (cycle' init full init full)
+    (#;Cons [y xs']) (... [x (cycle' y xs' init full)])))
+
+## [Functions]
 (def #export (iterate f x)
   (All [a]
     (-> (-> a a) a (Stream a)))
   (... [x (iterate f (f x))]))
 
-## (def #export (take n xs)
-##   (All [a]
-##     (-> Int (Stream a) (List a)))
-##   (if (int:> n 0)
-##     (let [[x xs'] (! xs)]
-##       (list& x (take (dec n) xs')))
-##     (list)))
-
-## (def #export (drop n xs)
-##   (All [a]
-##     (-> Int (Stream a) (Stream a)))
-##   (if (int:> n 0)
-##     (drop (dec n) (get@ 1 (! xs)))
-##     xs))
-
-## Pattern-matching
-## (defmacro #export (\stream tokens)
-##   (case tokens
-##     (\ (list& body patterns'))
-##     (do Lux:Monad
-##       [patterns (map% Lux:Monad M;macro-expand-1 patterns')
-##        g!s (M;gensym "s")
-##        #let [patterns+ (do List:Monad
-##                          [pattern (reverse patterns)]
-##                          (list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))]]
-##       (wrap (list g!s
-##                   (` (;let [(~@ patterns+)]
-##                            (~ body))))))
-
-##     _
-##     "Wrong syntax for \stream"))
-
-## (defsyntax #export (\stream body [patterns' (+$ id$)])
-##   (do Lux:Monad
-##     [patterns (map% Lux:Monad M;macro-expand-1 patterns')
-##      g!s (M;gensym "s")
-##      #let [patterns+ (do List:Monad
-##                        [pattern (reverse patterns)]
-##                        (list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))]]
-##     (wrap (list g!s
-##                 (` (;let [(~@ patterns+)]
-##                          (~ body)))))))
+(def #export (repeat x)
+  (All [a]
+    (-> a (Stream a)))
+  (... [x (repeat x)]))
+
+(def #export (cycle xs)
+  (All [a]
+    (-> (List a) (Maybe (Stream a))))
+  (case xs
+    #;Nil            #;None
+    (#;Cons [x xs']) (#;Some (cycle' x xs' x xs'))))
+
+(do-template [<name> <return> <part>]
+  [(def #export (<name> s)
+     (All [a] (-> (Stream a) <return>))
+     (let [[h t] (! s)]
+       <part>))]
+
+  [head a          h]
+  [tail (Stream a) t])
+
+(def #export (@ idx s)
+  (All [a] (-> Int (Stream a) a))
+  (let [[h t] (! s)]
+    (if (i> idx 0)
+      (@ (dec idx) t)
+      h)))
+
+(do-template [<taker> <dropper> <splitter> <det-type> <det-test> <det-step>]
+  [(def #export (<taker> det xs)
+     (All [a]
+       (-> <det-type> (Stream a) (List a)))
+     (let [[x xs'] (! xs)]
+       (if <det-test>
+         (list& x (<taker> <det-step> xs'))
+         (list))))
+
+   (def #export (<dropper> det xs)
+     (All [a]
+       (-> <det-type> (Stream a) (Stream a)))
+     (let [[x xs'] (! xs)]
+       (if <det-test>
+         (<dropper> <det-step> xs')
+         xs)))
+
+   (def #export (<splitter> det xs)
+     (All [a]
+       (-> <det-type> (Stream a) (, (List a) (Stream a))))
+     (let [[x xs'] (! xs)]
+       (if <det-test>
+         (let [[tail next] (<splitter> <det-step> xs')]
+           [(#;Cons [x tail]) next])
+         [(list) xs])))]
+  
+  [take-while drop-while split-with (-> a Bool) (det x)    det]
+  [take       drop       split      Int         (i> det 0) (dec det)]
+  )
+
+(def #export (unfold step init)
+  (All [a b]
+    (-> (-> a (, a b)) a (Stream b)))
+  (let [[next x] (step init)]
+    (... [x (unfold step next)])))
+
+(def #export (filter p xs)
+  (All [a] (-> (-> a Bool) (Stream a) (Stream a)))
+  (let [[x xs'] (! xs)]
+    (if (p x)
+      (... [x (filter p xs')])
+      (filter p xs'))))
+
+(def #export (partition p xs)
+  (All [a] (-> (-> a Bool) (Stream a) (, (Stream a) (Stream a))))
+  [(filter p xs) (filter (complement p) xs)])
+
+## [Structures]
+(defstruct #export Stream/Functor (Functor Stream)
+  (def (F;map f fa)
+    (let [[h t] (! fa)]
+      (... [(f h) (F;map f t)]))))
+
+(defstruct #export Stream/CoMonad (CoMonad Stream)
+  (def CM;_functor Stream/Functor)
+  (def CM;unwrap head)
+  (def (CM;split wa)
+    (:: Stream/Functor (F;map repeat wa))))
+
+## [Pattern-matching]
+(defsyntax #export (\stream body [patterns' (+^ id^)])
+  (do Lux/Monad
+    [patterns (map% Lux/Monad macro-expand-1 patterns')
+     g!s (gensym "s")
+     #let [patterns+ (: (List Syntax)
+                        (do List/Monad
+                          [pattern (l;reverse patterns)]
+                          (list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s))))))]]
+    (M;wrap (list g!s (` (;let [(~@ patterns+)] (~ body)))))))