blob: 077076d2f7666a12f31dadac627bcd13328eabef (
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
(.module:
[lux #*
[control
["ex" exception (#+ exception:)]
[monad (#+ do)]]
[data
[maybe ("maybe/" Functor<Maybe>)]
[error (#+ Error)]
["." text
format]
[collection
[row (#+ Row)]
["dict" dictionary (#+ Dictionary)]]]
[function]
[world [file (#+ File)]]]
["." //
[extension]]
[//synthesis (#+ Synthesis)])
(do-template [<name>]
[(exception: #export (<name>)
"")]
[no-active-buffer]
[no-anchor]
)
(exception: #export (cannot-interpret {message Text})
message)
(type: #export Context
{#scope-name Text
#inner-functions Nat})
(signature: #export (Host code)
(: (-> code (Error Any))
execute!)
(: (-> code (Error Any))
evaluate!))
(type: #export (Buffer code) (Row [Ident code]))
(type: #export (Artifacts code) (Dictionary File (Buffer code)))
(type: #export (State anchor code)
{#context Context
#anchor (Maybe anchor)
#host (Host code)
#buffer (Maybe (Buffer code))
#artifacts (Artifacts code)})
(type: #export (Operation anchor code)
(extension.Operation (State anchor code) Synthesis code))
(type: #export (Compiler anchor code)
(extension.Compiler (State anchor code) Synthesis code))
(def: #export (init host)
(All [anchor code] (-> (Host code) (..State anchor code)))
{#context {#scope-name ""
#inner-functions +0}
#anchor #.None
#host host
#buffer #.None
#artifacts (dict.new text.Hash<Text>)})
(def: #export (with-context expr)
(All [anchor code output]
(-> (Operation anchor code output)
(Operation anchor code [Text output])))
(function (_ [bundle state])
(let [[old-scope old-inner] (get@ #context state)
new-scope (format old-scope "c___" (%i (.int old-inner)))]
(case (expr [bundle (set@ #context [new-scope +0] state)])
(#error.Success [[bundle' state'] output])
(#error.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')]
[new-scope output]])
(#error.Error error)
(#error.Error error)))))
(def: #export context
(All [anchor code] (Operation anchor code Text))
(extension.read (|>> (get@ #context)
(get@ #scope-name))))
(do-template [<tag>
<with-declaration> <with-type> <with-value>
<get> <get-type> <exception>]
[(def: #export <with-declaration>
(All [anchor code output] <with-type>)
(function (_ body)
(function (_ [bundle state])
(case (body [bundle (set@ <tag> (#.Some <with-value>) state)])
(#error.Success [[bundle' state'] output])
(#error.Success [[bundle' (set@ <tag> (get@ <tag> state) state')]
output])
(#error.Error error)
(#error.Error error)))))
(def: #export <get>
(All [anchor code] (Operation anchor code <get-type>))
(function (_ (^@ stateE [bundle state]))
(case (get@ <tag> state)
(#.Some output)
(#error.Success [stateE output])
#.None
(ex.throw <exception> []))))]
[#anchor
(with-anchor anchor)
(-> anchor (Operation anchor code output)
(Operation anchor code output))
anchor
anchor anchor no-anchor]
[#buffer
with-buffer
(-> (Operation anchor code output)
(Operation anchor code output))
row.empty
buffer (Buffer code) no-active-buffer]
)
(def: #export artifacts
(All [anchor code]
(Operation anchor code (Artifacts code)))
(extension.read (get@ #artifacts)))
(do-template [<name>]
[(def: #export (<name> code)
(All [anchor code]
(-> code (Operation anchor code Any)))
(function (_ (^@ stateE [bundle state]))
(case (:: (get@ #host state) <name> code)
(#error.Error error)
(ex.throw cannot-interpret error)
(#error.Success output)
(#error.Success [stateE output]))))]
[execute!]
[evaluate!]
)
(def: #export (save! name code)
(All [anchor code]
(-> Ident code (Operation anchor code Any)))
(do //.Monad<Operation>
[_ (execute! code)]
(extension.update (update@ #buffer (maybe/map (row.add [name code]))))))
(def: #export (save-buffer! target)
(All [anchor code]
(-> File (Operation anchor code Any)))
(do //.Monad<Operation>
[buffer ..buffer]
(extension.update (update@ #artifacts (dict.put target buffer)))))
|
