blob: 212b190f4046f2db90039820a091b8316a5fc721 (
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
85
86
87
88
89
90
91
92
93
|
(.using
[library
[lux (.except global)
[control
["<>" parser (.only)
["<[0]>" code (.only Parser)]]]
[data
[collection
["[0]" list (.open: "[1]#[0]" functor mix)]]]
["[0]" macro (.only)
[syntax (.only syntax:)]
["[0]" code]]]]
["[0]" //])
(type: .public (IxMonad m)
(Interface
(is (All (_ p a)
(-> a (m p p a)))
in)
(is (All (_ ii it io vi vo)
(-> (-> vi (m it io vo))
(m ii it vi)
(m ii io vo)))
then)))
(type: Binding
[Code Code])
(def: binding
(Parser Binding)
(<>.and <code>.any <code>.any))
(type: Context
(Variant
{#Macro Symbol Code}
{#Binding Binding}))
(def: global
(Parser Symbol)
(//.do <>.monad
[[module short] <code>.symbol
_ (<>.assertion "" (case module "" false _ true))]
(in [module short])))
(def: context
(Parser Context)
(<>.or (<>.and ..global
<code>.any)
binding))
(def: (pair_list [binding value])
(All (_ a) (-> [a a] (List a)))
(list binding value))
(def: named_monad
(Parser [(Maybe Text) Code])
(<>.either (<code>.tuple (<>.and (at <>.monad each (|>> {.#Some})
<code>.local)
<code>.any))
(at <>.monad each (|>> [{.#None}])
<code>.any)))
(syntax: .public (do [[?name monad] ..named_monad
context (<code>.tuple (<>.some context))
expression <code>.any])
(macro.with_symbols [g!_ g!then]
(let [body (list#mix (function (_ context next)
(case context
{#Macro macro parameter}
(` ((~ (code.symbol macro))
(~ parameter)
(~ next)))
{#Binding [binding value]}
(` ((~ g!then)
(.function ((~ g!_) (~ binding))
(~ next))
(~ value)))))
expression
(list.reversed context))]
(in (list (case ?name
{.#Some name}
(let [name (code.local name)]
(` (let [(~ name) (~ monad)
[..in (~' in)
..then (~ g!then)] (~ name)]
(~ body))))
{.#None}
(` (let [[..in (~' in)
..then (~ g!then)] (~ monad)]
(~ body)))))))))
|