blob: 1830ff44f5c2fc55dcab2f2999dc0be03d6984c6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
## Copyright (c) Eduardo Julian. All rights reserved.
## The use and distribution terms for this software are covered by the
## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
## which can be found in the file epl-v10.html at the root of this distribution.
## By using this software in any fashion, you are agreeing to be bound by
## the terms of this license.
## You must not remove this notice, or any other, from this software.
(;import lux
(../functor #as F)
lux/data/list
lux/meta/macro)
## Signatures
(defsig #export (CoMonad w)
(: (F;Functor w)
_functor)
(: (All [a]
(-> (w a) a))
unwrap)
(: (All [a]
(-> (w a) (w (w a))))
split))
## Functions
(def #export (extend w f ma)
(All [w a b]
(-> (CoMonad w) (-> (w a) b) (w a) (w b)))
(using w
(using ;;_functor
(F;map f (;;split ma)))))
## Syntax
(defmacro #export (be tokens state)
(case tokens
(\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
(let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
(lambda [body' binding]
(let [[var value] binding]
(case var
(#;Meta [_ (#;TagS ["" "let"])])
(` (;let (~ value) (~ body')))
_
(` (extend (;lambda [(~ var)] (~ body'))
(~ value)))))))
body
(reverse (as-pairs bindings)))]
(#;Right [state (list (` (;case (~ monad)
{#;return ;return #;bind ;bind}
(~ body'))))]))
_
(#;Left "Wrong syntax for be")))
|
