blob: 7a04c47f99e27c2d236f9632b95c3f3da0ed0feb (
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
|
(.using
[library
[lux "*"
["[0]" meta]
[abstract
["[0]" monad (.only do)]]
[control
["[0]" try (.only Try)]
["[0]" exception (.only exception:)]]
[data
["[0]" product]
["[0]" text]
[collection
["[0]" list ("[1]#[0]" functor)]
[dictionary
["[0]" plist (.only PList)]]]]]]
["[0]" //
["[1][0]" code]])
(exception: .public (unknown_module [module Text])
(exception.report
"Module" (text.format module)))
(template [<name>]
[(exception: .public (<name> [module Text
definition Text])
(exception.report
"Module" (text.format module)
"Definition" (text.format definition)))]
[cannot_shadow_definition]
[unknown_definition]
)
(def: (with_module name body)
(All (_ a) (-> Text (-> Module (Try [Module a])) (Meta a)))
(function (_ compiler)
(case (|> compiler (the .#modules) (plist.value name))
{.#Some module}
(case (body module)
{try.#Success [module' output]}
{try.#Success [(revised .#modules (plist.has name module') compiler)
output]}
{try.#Failure error}
{try.#Failure error})
{.#None}
(exception.except ..unknown_module [name]))))
(def: (push_one [name macro])
(-> [Symbol Macro] (Meta Any))
(do meta.monad
[[module_name definition_name] (meta.normal name)
.let [definition (is Global {.#Definition [false .Macro macro]})
add_macro! (is (-> (PList Global) (PList Global))
(plist.has definition_name definition))]]
(..with_module module_name
(function (_ module)
(case (|> module (the .#definitions) (plist.value definition_name))
{.#None}
{try.#Success [(revised .#definitions add_macro! module)
[]]}
{.#Some _}
(exception.except ..cannot_shadow_definition [module_name definition_name]))))))
(def: (pop_one name)
(-> Symbol (Meta Any))
(do meta.monad
[[module_name definition_name] (meta.normal name)
.let [lacks_macro! (is (-> (PList Global) (PList Global))
(plist.lacks definition_name))]]
(..with_module module_name
(function (_ module)
(case (|> module (the .#definitions) (plist.value definition_name))
{.#Some _}
{try.#Success [(revised .#definitions lacks_macro! module)
[]]}
{.#None}
(exception.except ..unknown_definition [module_name definition_name]))))))
(def: (pop_all macros self)
(-> (List Symbol) Symbol Macro)
("lux macro"
(function (_ _)
(do [! meta.monad]
[_ (monad.each ! ..pop_one macros)
_ (..pop_one self)
compiler meta.compiler_state]
(in (case (the .#expected compiler)
{.#Some _}
(list (' []))
{.#None}
(list)))))))
(def: .public (push macros)
(-> (List [Symbol Macro]) (Meta Code))
(do meta.monad
[_ (monad.each meta.monad ..push_one macros)
seed meta.seed
g!pop (//.symbol "pop")
_ (let [g!pop (is Symbol
["" (//code.format g!pop)])]
(..push_one [g!pop (..pop_all (list#each product.left macros) g!pop)]))]
(in (` ((~ g!pop))))))
|
