blob: 57a18c109ace386c965a23c81338af5a149f4e69 (
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
62
63
64
|
(.module:
[lux #*
[control
[monad]
["p" parser]]
[data
[collection
["." list ("#;." functor fold)]]]
["." macro
["s" syntax (#+ Syntax syntax:)]]])
(signature: #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.and s.any s.any))
(type: Context
(#Let (List Binding))
(#Bind Binding))
(def: context
(Syntax Context)
(p.or (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)))))))))
|
