blob: 4c467c7fbedffaab75d983968522176ff4a07b0b (
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
|
(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data [product]
["e" error]
[text "text/" Eq<Text>]
text/format)
[macro]
(macro ["s" syntax #+ syntax:])))
(type: #export Eval
(-> Type Code (Meta Any)))
(def: #export (fail message)
(All [a] (-> Text (Meta a)))
(do macro.Monad<Meta>
[[file line col] macro.cursor
#let [location (format file
"," (|> line .int %i)
"," (|> col .int %i))]]
(macro.fail (format message "\n\n"
"@ " location))))
(def: #export (throw exception message)
(All [e a] (-> (ex.Exception e) e (Meta a)))
(fail (ex.construct exception message)))
(syntax: #export (assert exception message test)
(wrap (list (` (if (~ test)
(:: macro.Monad<Meta> (~' wrap) [])
(..throw (~ exception) (~ message)))))))
(def: #export (with-source-code source action)
(All [a] (-> Source (Meta a) (Meta a)))
(function (_ compiler)
(let [old-source (get@ #.source compiler)]
(case (action (set@ #.source source compiler))
(#e.Error error)
(#e.Error error)
(#e.Success [compiler' output])
(#e.Success [(set@ #.source old-source compiler')
output])))))
(def: #export (with-stacked-errors handler action)
(All [a] (-> (-> [] Text) (Meta a) (Meta a)))
(function (_ compiler)
(case (action compiler)
(#e.Success [compiler' output])
(#e.Success [compiler' output])
(#e.Error error)
(#e.Error (if (text/= "" error)
(handler [])
(format (handler []) "\n\n-----------------------------------------\n\n" error))))))
(def: fresh-bindings
(All [k v] (Bindings k v))
{#.counter +0
#.mappings (list)})
(def: fresh-scope
Scope
{#.name (list)
#.inner +0
#.locals fresh-bindings
#.captured fresh-bindings})
(def: #export (with-scope action)
(All [a] (-> (Meta a) (Meta [Scope a])))
(function (_ compiler)
(case (action (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler))
(#e.Success [compiler' output])
(case (get@ #.scopes compiler')
#.Nil
(#e.Error "Impossible error: Drained scopes!")
(#.Cons head tail)
(#e.Success [(set@ #.scopes tail compiler')
[head output]]))
(#e.Error error)
(#e.Error error))))
(def: #export (with-current-module name action)
(All [a] (-> Text (Meta a) (Meta a)))
(function (_ compiler)
(case (action (set@ #.current-module (#.Some name) compiler))
(#e.Success [compiler' output])
(#e.Success [(set@ #.current-module
(get@ #.current-module compiler)
compiler')
output])
(#e.Error error)
(#e.Error error))))
(def: #export (with-cursor cursor action)
(All [a] (-> Cursor (Meta a) (Meta a)))
(if (text/= "" (product.left cursor))
action
(function (_ compiler)
(let [old-cursor (get@ #.cursor compiler)]
(case (action (set@ #.cursor cursor compiler))
(#e.Success [compiler' output])
(#e.Success [(set@ #.cursor old-cursor compiler')
output])
(#e.Error error)
(#e.Error error))))))
|
