blob: aae26ada75ef4a110e4f8d966d73b5bd954e8f2c (
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
|
(.module:
[lux #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
["." text
format]
[collection
[array (#+ Array)]
["." list ("#/." functor)]]]
["." 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: #long java/lang/reflect/Method
(invoke [java/lang/Object (Array java/lang/Object)] #try java/lang/Object))
(import: #long (java/lang/Class c)
(getMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] #try java/lang/reflect/Method))
(import: #long java/lang/Object
(getClass [] (java/lang/Class java/lang/Object)))
(def: _object-class
(java/lang/Class java/lang/Object)
(host.class-for java/lang/Object))
(def: _apply-args
(Array (java/lang/Class java/lang/Object))
(|> (host.array (java/lang/Class java/lang/Object) 2)
(host.array-write 0 _object-class)
(host.array-write 1 _object-class)))
(type: #export Expander
(-> Macro (List Code) Lux (Error (Error [Lux (List Code)]))))
(def: #export (jvm macro inputs lux)
Expander
(do error.monad
[apply-method (|> macro
(:coerce java/lang/Object)
(java/lang/Object::getClass)
(java/lang/Class::getMethod "apply" _apply-args))]
(:coerce (Error (Error [Lux (List Code)]))
(java/lang/reflect/Method::invoke
(:coerce java/lang/Object macro)
(|> (host.array java/lang/Object 2)
(host.array-write 0 (:coerce java/lang/Object inputs))
(host.array-write 1 (:coerce java/lang/Object lux)))
apply-method))))
(def: #export (expand expander name macro inputs)
(-> Expander Name Macro (List Code) (Meta (List Code)))
(function (_ state)
(do error.monad
[output (expander macro inputs state)]
(case output
(#error.Success output)
(#error.Success output)
(#error.Failure error)
((///.throw expansion-failed [name inputs error]) state)))))
(def: #export (expand-one expander name macro inputs)
(-> Expander Name Macro (List Code) (Meta Code))
(do macro.monad
[expansion (expand expander name macro inputs)]
(case expansion
(^ (list single))
(wrap single)
_
(///.throw must-have-single-expansion [name inputs]))))
|
