blob: 4ab065278693128de98979d70c88690cda71419f (
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
|
(.require
[library
[lux (.except local symbol function macro)
[abstract
["[0]" monad (.only do)]]
[data
["[0]" text (.use "[1]#[0]" monoid)]
[collection
["[0]" list (.use "[1]#[0]" monad)]]]
[math
[number
["[0]" nat]]]]]
["[0]" /
["[1][0]" expansion]]
["[0]" // (.only)
["[0]" code]
["[0]" symbol (.use "[1]#[0]" codec)]])
(def .public (symbol prefix)
(-> Text (Meta Code))
(do //.monad
[id //.seed]
(in (|> id
(of nat.decimal encoded)
(all text#composite "__gensym__" prefix)
[""] code.symbol))))
(def (local ast)
(-> Code (Meta Text))
(when ast
[_ {.#Symbol ["" name]}]
(of //.monad in name)
_
(//.failure (text#composite "Code is not a local symbol: " (code.format ast)))))
(def .public wrong_syntax_error
(-> Symbol Text)
(|>> symbol#encoded
(text.prefix (text#composite "Wrong syntax for " text.\''))
(text.suffix (text#composite text.\'' "."))))
(def .public with_symbols
(.macro (_ tokens)
(when tokens
(list [_ {.#Tuple symbols}] body)
(do [! //.monad]
[symbol_names (monad.each ! ..local symbols)
.let [symbol_defs (list#conjoint (list#each (is (-> Text (List Code))
(.function (_ name) (list (code.symbol ["" name]) (` (..symbol (, (code.text name)))))))
symbol_names))]]
(in (list (` (do //.monad
[(,* symbol_defs)]
(, body))))))
_
(//.failure (..wrong_syntax_error (.symbol ..with_symbols))))))
(def .public times
(.macro (_ tokens)
(when tokens
(list.partial [_ {.#Nat times}] terms)
(loop (again [times times
before terms])
(when times
0
(of //.monad in before)
_
(do [! //.monad]
[after (|> before
(monad.each ! /expansion.single)
(of ! each list#conjoint))]
(again (-- times) after))))
_
(//.failure (..wrong_syntax_error (.symbol ..times))))))
(def .public final
(.macro (_ it)
(let [! //.monad]
(|> it
(monad.each ! /expansion.complete)
(of ! each list#conjoint)))))
(def .public function
(-> Macro Macro')
(|>> (as Macro')))
(def .public macro
(-> Macro' Macro)
(|>> (as Macro)))
|