aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-07-29 11:18:12 -0400
committerEduardo Julian2017-07-29 11:18:12 -0400
commitf7047f1c3966bd1727c1a3729295def3c9913ab8 (patch)
treef35e59ff3589446d22188b250dcfcd5cc7379c3e /stdlib
parente578df2b0b6d4fd751b8656c16efee54363fc121 (diff)
- Added Functor, Applicative and Monad implementations for Lazy.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/data/lazy.lux25
-rw-r--r--stdlib/test/test/lux/data/lazy.lux40
2 files changed, 57 insertions, 8 deletions
diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index 1f4566eee..d2533644a 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -1,7 +1,9 @@
(;module:
lux
(lux [io]
- (control monad)
+ (control functor
+ applicative
+ monad)
(concurrency ["A" atom])
[macro]
(macro ["s" syntax #+ syntax:])
@@ -12,8 +14,7 @@
(def: #hidden (freeze' generator)
(All [a] (-> (-> [] a) (Lazy a)))
- (let [cache (: (A;Atom (Maybe ($ +0)))
- (A;atom #;None))]
+ (let [cache (A;atom (: (Maybe ($ +0)) #;None))]
(@model (function [_]
(case (io;run (A;get cache))
(#;Some value)
@@ -32,3 +33,21 @@
(do @
[g!_ (macro;gensym "_")]
(wrap (list (` (freeze' (function [(~ g!_)] (~ expr))))))))
+
+(struct: #export _ (Functor Lazy)
+ (def: (map f fa)
+ (freeze (f (thaw fa)))))
+
+(struct: #export _ (Applicative Lazy)
+ (def: functor Functor<Lazy>)
+
+ (def: (wrap a)
+ (freeze a))
+
+ (def: (apply ff fa)
+ (freeze ((thaw ff) (thaw fa)))))
+
+(struct: #export _ (Monad Lazy)
+ (def: applicative Applicative<Lazy>)
+
+ (def: join thaw))
diff --git a/stdlib/test/test/lux/data/lazy.lux b/stdlib/test/test/lux/data/lazy.lux
index bf395bcfa..926157a07 100644
--- a/stdlib/test/test/lux/data/lazy.lux
+++ b/stdlib/test/test/lux/data/lazy.lux
@@ -1,14 +1,14 @@
(;module:
lux
(lux [io]
- (control ["M" monad #+ do Monad])
+ (control [monad #+ do Monad])
(data ["&" lazy])
- ["R" math/random])
+ ["r" math/random])
lux/test)
(context: "Lazy."
- [left R;nat
- right R;nat
+ [left r;nat
+ right r;nat
#let [lazy (&;freeze (n.* left right))
expected (n.* left right)]]
($_ seq
@@ -17,7 +17,37 @@
(&;thaw lazy)))
(test "Lazy values only evaluate once."
(and (not (is expected
- (: Nat (&;thaw lazy))))
+ (&;thaw lazy)))
(is (&;thaw lazy)
(&;thaw lazy))))
))
+
+(context: "Functor, Applicative, Monad."
+ [sample r;nat]
+ ($_ seq
+ (test "Functor map."
+ (|> (&;freeze sample)
+ (:: &;Functor<Lazy> map n.inc)
+ &;thaw
+ (n.= (n.inc sample))))
+
+ (test "Applicative wrap."
+ (|> sample
+ (:: &;Applicative<Lazy> wrap)
+ &;thaw
+ (n.= sample)))
+
+ (test "Applicative apply."
+ (let [(^open "&/") &;Applicative<Lazy>]
+ (|> (&/apply (&/wrap n.inc) (&/wrap sample))
+ &;thaw
+ (n.= (n.inc sample)))))
+
+ (test "Monad."
+ (|> (do &;Monad<Lazy>
+ [f (wrap n.inc)
+ a (wrap sample)]
+ (wrap (f a)))
+ &;thaw
+ (n.= (n.inc sample))))
+ ))