blob: 1060eeb8e6952515368fb1bd51a51a1072bad490 (
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
|
(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data [maybe]
[product]
["e" error]
[text "text/" Eq<Text>]
text/format
(coll [list]))
[macro]
(macro ["s" syntax #+ syntax:])
(lang (type ["tc" check])))
(luxc (lang ["la" analysis])))
(type: #export Eval
(-> Type Code (Meta Top)))
(def: #export (pl-get key table)
(All [a] (-> Text (List [Text a]) (Maybe a)))
(case table
#.Nil
#.None
(#.Cons [k' v'] table')
(if (text/= key k')
(#.Some v')
(pl-get key table'))))
(def: #export (pl-contains? key table)
(All [a] (-> Text (List [Text a]) Bool))
(case (pl-get key table)
(#.Some _)
true
#.None
false))
(def: #export (pl-put key val table)
(All [a] (-> Text a (List [Text a]) (List [Text a])))
(case table
#.Nil
(list [key val])
(#.Cons [k' v'] table')
(if (text/= key k')
(#.Cons [key val]
table')
(#.Cons [k' v']
(pl-put key val table')))))
(def: #export (pl-update key f table)
(All [a] (-> Text (-> a a) (List [Text a]) (List [Text a])))
(case table
#.Nil
#.Nil
(#.Cons [k' v'] table')
(if (text/= key k')
(#.Cons [k' (f v')] table')
(#.Cons [k' v'] (pl-update key f table')))))
(def: (normalize-char char)
(-> Nat Text)
(case char
(^ (char "*")) "_ASTER_"
(^ (char "+")) "_PLUS_"
(^ (char "-")) "_DASH_"
(^ (char "/")) "_SLASH_"
(^ (char "\\")) "_BSLASH_"
(^ (char "_")) "_UNDERS_"
(^ (char "%")) "_PERCENT_"
(^ (char "$")) "_DOLLAR_"
(^ (char "'")) "_QUOTE_"
(^ (char "`")) "_BQUOTE_"
(^ (char "@")) "_AT_"
(^ (char "^")) "_CARET_"
(^ (char "&")) "_AMPERS_"
(^ (char "=")) "_EQ_"
(^ (char "!")) "_BANG_"
(^ (char "?")) "_QM_"
(^ (char ":")) "_COLON_"
(^ (char ".")) "_PERIOD_"
(^ (char ",")) "_COMMA_"
(^ (char "<")) "_LT_"
(^ (char ">")) "_GT_"
(^ (char "~")) "_TILDE_"
(^ (char "|")) "_PIPE_"
_
(text.from-code char)))
(def: underflow Nat (n/dec +0))
(def: #export (normalize-name name)
(-> Text Text)
(loop [idx (n/dec (text.size name))
output ""]
(if (n/= underflow idx)
output
(recur (n/dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output)))))
(exception: #export (Error {message Text})
message)
(def: #export (with-error-tracking action)
(All [a] (-> (Meta a) (Meta a)))
(function (_ compiler)
(case (action compiler)
(#e.Error error)
((throw Error error) compiler)
output
output)))
|
