blob: 92db5f04586a89d71cb8d0e9cfddeefdad0775db (
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
(.module:
[library
[lux #*
[control
[monad]
["p" parser
["s" code (#+ Parser)]]]
[data
[collection
["." list ("#\." functor fold)]]]
["." macro
[syntax (#+ syntax:)]
["." code]]]])
(interface: #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
(Parser Binding)
(p.and s.any s.any))
(type: Context
(#Let (List Binding))
(#Bind Binding))
(def: context
(Parser 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))
(def: named_monad
(Parser [(Maybe Text) Code])
(p.either (s.record (p.and (\ p.monad map (|>> #.Some)
s.local_identifier)
s.any))
(\ p.monad map (|>> [#.None])
s.any)))
(syntax: #export (do {[?name monad] ..named_monad}
{context (s.tuple (p.some context))}
expression)
(macro.with_gensyms [g!_ g!bind]
(let [body (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))]
(wrap (list (case ?name
(#.Some name)
(let [name (code.local_identifier name)]
(` (let [(~ name) (~ monad)
{#..wrap (~' wrap)
#..bind (~ g!bind)} (~ name)]
(~ body))))
#.None
(` (let [{#..wrap (~' wrap)
#..bind (~ g!bind)} (~ monad)]
(~ body)))))))))
|
