blob: 4b0b7e4d255d5839280c104ed6bb3828456e6270 (
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
|
(.module:
[lux #*
[abstract
["." monad]]
[control
["<>" parser ("#@." monad)
["<c>" code (#+ Parser)]
["<a>" analysis]
["<s>" synthesis]]]
[data
["." product]
[collection
["." list ("#@." functor)]]]
[macro (#+ with-gensyms)
["." code]
[syntax (#+ syntax:)]]
[tool
[compiler
["." phase]]]])
(type: Input
{#variable Text
#parser Code})
(def: (simple default)
(-> Code (Parser Input))
($_ <>.and
<c>.local-identifier
(<>@wrap default)))
(def: complex
(Parser Input)
(<c>.record ($_ <>.and
<c>.local-identifier
<c>.any)))
(def: (input default)
(-> Code (Parser Input))
(<>.either (..simple default)
..complex))
(type: Declaration
{#name Code
#label Text
#phase Text
#inputs (List Input)})
(def: (declaration default)
(-> Code (Parser Declaration))
(<c>.form ($_ <>.and
<c>.any
<c>.local-identifier
<c>.local-identifier
(<>.some (..input default)))))
(template [<any> <end> <and> <run> <extension> <name>]
[(syntax: #export (<name>
{[name extension phase inputs] (..declaration (` <any>))}
body)
(let [g!parser (case (list@map product.right inputs)
#.Nil
(` <end>)
parsers
(` (.$_ <and> (~+ parsers))))
g!name (code.local-identifier extension)
g!phase (code.local-identifier phase)]
(with-gensyms [g!handler g!inputs g!error]
(wrap (list (` (<extension> (~ name)
(.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!inputs))
(.case ((~! <run>) (~ g!parser) (~ g!inputs))
(#.Right [(~+ (list@map (|>> product.left
code.local-identifier)
inputs))])
(~ body)
(#.Left (~ g!error))
((~! phase.fail) (~ g!error)))
))))))))]
[<c>.any <c>.end! <c>.and <c>.run "lux def analysis" analysis:]
[<a>.any <a>.end! <a>.and <a>.run "lux def synthesis" synthesis:]
[<s>.any <s>.end! <s>.and <s>.run "lux def generation" generation:]
[<c>.any <c>.end! <c>.and <c>.run "lux def directive" directive:]
)
|
