blob: 64dabaf43e86438edd83660372b86c8b42f89cf6 (
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
|
(.module:
[lux #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
["." text
format]
[collection
[array (#+ Array)]
[list ("list/." Functor<List>)]]]
["." macro]
["." host (#+ import:)]]
["." ///])
(exception: #export (expansion-failed {macro Name} {inputs (List Code)} {error Text})
(ex.report ["Macro" (%name macro)]
["Inputs" (|> inputs
(list/map (|>> %code (format text.new-line text.tab)))
(text.join-with ""))]
["Error" error]))
(exception: #export (must-have-single-expansion {macro Name} {inputs (List Code)})
(ex.report ["Macro" (%name macro)]
["Inputs" (|> inputs
(list/map (|>> %code (format text.new-line text.tab)))
(text.join-with ""))]))
(import: java/lang/reflect/Method
(invoke [Object (Array Object)] #try Object))
(import: (java/lang/Class c)
(getMethod [String (Array (Class Object))] #try Method))
(import: java/lang/Object
(getClass [] (Class Object)))
(def: _object-class
(Class Object)
(host.class-for Object))
(def: _apply-args
(Array (Class Object))
(|> (host.array (Class Object) 2)
(host.array-write 0 _object-class)
(host.array-write 1 _object-class)))
(def: #export (expand name macro inputs)
(-> Name Macro (List Code) (Meta (List Code)))
(function (_ state)
(do error.Monad<Error>
[apply-method (|> macro
(:coerce Object)
(Object::getClass)
(Class::getMethod "apply" _apply-args))
output (Method::invoke (:coerce Object macro)
(|> (host.array Object 2)
(host.array-write 0 (:coerce Object inputs))
(host.array-write 1 (:coerce Object state)))
apply-method)]
(case (:coerce (Error [Lux (List Code)])
output)
(#error.Success output)
(#error.Success output)
(#error.Failure error)
((///.throw expansion-failed [name inputs error]) state)))))
(def: #export (expand-one name macro inputs)
(-> Name Macro (List Code) (Meta Code))
(do macro.Monad<Meta>
[expansion (expand name macro inputs)]
(case expansion
(^ (list single))
(wrap single)
_
(///.throw must-have-single-expansion [name inputs]))))
|
