blob: 591c24813913f4c93e55c0cfbd7e95e0968f9f74 (
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
55
56
57
58
59
60
61
|
(.module:
lux
(lux (control [monad]
["p" parser])
(data (coll [list "list/" Functor<List> Fold<List>]))
[macro]
(macro ["s" syntax #+ Syntax syntax:])))
(sig: #export (IxMonad m)
(: (All [p a]
(-> a (m p p a)))
wrap)
(: (All [ii it io vi vo]
(-> (-> vi (m it io vo))
(m ii it vi)
(m ii io vo)))
bind))
(type: Binding [Code Code])
(def: binding
(Syntax Binding)
(p.seq s.any s.any))
(type: Context
(#Let (List Binding))
(#Bind Binding))
(def: context
(Syntax Context)
(p.alt (p.after (s.this (' #let))
(s.tuple (p.some binding)))
binding))
(def: (pair-list [binding value])
(All [a] (-> [a a] (List a)))
(list binding value))
(syntax: #export (do monad
{context (s.tuple (p.some context))}
expression)
(macro.with-gensyms [g!_ g!bind]
(wrap (list (` (let [(~' @) (~ monad)
{#..wrap (~' wrap)
#..bind (~ g!bind)} (~' @)]
(~ (list/fold (function (_ context next)
(case context
(#Let bindings)
(` (let [(~+ (|> bindings
(list/map pair-list)
list.concat))]
(~ next)))
(#Bind [binding value])
(` ((~ g!bind)
(.function ((~ g!_) (~ binding))
(~ next))
(~ value)))))
expression
(list.reverse context)))))))))
|