aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-04-05 17:56:26 -0400
committerEduardo Julian2017-04-05 17:56:26 -0400
commit6f87d469fa427dbaaaa13c0ef22626801f3f03e9 (patch)
tree86bf7162d378f28bac12bb9eb24b8896b9b5260b
parentd6ce01f22aa14386758adf2b7b9e7b2e47bd4e2b (diff)
- Implemented a few comonads.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/env.lux24
-rw-r--r--stdlib/source/lux/data/store.lux42
-rw-r--r--stdlib/source/lux/data/trace.lux33
3 files changed, 99 insertions, 0 deletions
diff --git a/stdlib/source/lux/data/env.lux b/stdlib/source/lux/data/env.lux
new file mode 100644
index 000000000..7c29f5833
--- /dev/null
+++ b/stdlib/source/lux/data/env.lux
@@ -0,0 +1,24 @@
+(;module:
+ lux
+ (lux (control functor
+ comonad)))
+
+(type: #export (Env e a)
+ {#env e
+ #value a})
+
+(struct: #export Functor<Env> (All [e] (Functor (Env e)))
+ (def: (map f fa)
+ (update@ #value f fa)))
+
+(struct: #export CoMonad<Env> (All [e] (CoMonad (Env e)))
+ (def: functor Functor<Env>)
+
+ (def: unwrap (get@ #value))
+
+ (def: (split wa)
+ (set@ #value wa wa)))
+
+(def: #export (local change env)
+ (All [e a] (-> (-> e e) (Env e a) (Env e a)))
+ (update@ #env change env))
diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux
new file mode 100644
index 000000000..4badfb382
--- /dev/null
+++ b/stdlib/source/lux/data/store.lux
@@ -0,0 +1,42 @@
+(;module:
+ lux
+ (lux (control functor
+ comonad)
+ (type auto)))
+
+(type: #export (Store s a)
+ {#cursor s
+ #peek (-> s a)})
+
+(def: (extend f wa)
+ (All [s a b] (-> (-> (Store s a) b) (Store s a) (Store s b)))
+ {#cursor (get@ #cursor wa)
+ #peek (lambda [s] (f (set@ #cursor s wa)))})
+
+(struct: #export Functor<Store> (All [s] (Functor (Store s)))
+ (def: (map f fa)
+ (extend (lambda [store] (f (:: store peek (:: store cursor))))
+ fa)))
+
+(struct: #export CoMonad<Store> (All [s] (CoMonad (Store s)))
+ (def: functor Functor<Store>)
+
+ (def: (unwrap wa) (::: peek (::: cursor)))
+
+ (def: split (extend id)))
+
+(def: #export (peeks trans store)
+ (All [s a] (-> (-> s s) (Store s a) a))
+ (|> (::: cursor) trans (::: peek)))
+
+(def: #export (seek cursor store)
+ (All [s a] (-> s (Store s a) (Store s a)))
+ (:: (::: split store) peek cursor))
+
+(def: #export (seeks change store)
+ (All [s a] (-> (-> s s) (Store s a) (Store s a)))
+ (|> store (::: split) (peeks change)))
+
+(def: #export (experiment Functor<f> change store)
+ (All [f s a] (-> (Functor f) (-> s (f s)) (Store s a) (f a)))
+ (:: Functor<f> map (::: peek) (change (::: cursor))))
diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux
new file mode 100644
index 000000000..f8094565b
--- /dev/null
+++ b/stdlib/source/lux/data/trace.lux
@@ -0,0 +1,33 @@
+(;module:
+ lux
+ (lux (control ["m" monoid]
+ functor
+ comonad)
+ [macro]))
+
+(type: #export (Trace t a)
+ {#monoid (m;Monoid t)
+ #trace (-> t a)})
+
+(struct: #export Functor<Trace> (All [t] (Functor (Trace t)))
+ (def: (map f fa)
+ (update@ #trace (. f) fa)))
+
+(struct: #export CoMonad<Trace> (All [t] (CoMonad (Trace t)))
+ (def: functor Functor<Trace>)
+
+ (def: (unwrap wa)
+ ((get@ #trace wa)
+ (get@ [#monoid #m;unit] wa)))
+
+ (def: (split wa)
+ (let [monoid (get@ #monoid wa)]
+ {#monoid monoid
+ #trace (lambda [t1]
+ {#monoid monoid
+ #trace (lambda [t2] ((get@ #trace wa)
+ (:: monoid append t1 t2)))})})))
+
+(def: #export (run context tracer)
+ (All [t a] (-> t (Trace t a) a))
+ (:: tracer trace context))