blob: 106048f90a34e976188d44ebac5854338db2aae8 (
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
109
110
|
(.module:
[library
[lux #*
["." macro (#+ with_identifiers)]
["." meta]
[abstract
["." monad (#+ do)]]
[control
["." maybe]
["." try]
["<>" parser
["</>" code (#+ Parser)]]]
[data
["." text ("#\." monoid)]
[collection
["." list ("#\." functor)]]]
[math
[number
["." nat]
["." int]
["." rev]
["." frac]]]]]
[//
["." code]])
(def: (self_documenting binding parser)
(All (_ a) (-> Code (Parser a) (Parser a)))
(function (_ tokens)
(case (parser tokens)
(#try.Success [tokens output])
(#try.Success [tokens output])
(#try.Failure error)
(#try.Failure ($_ text\composite
"Failed to parse: " (code.format binding) text.new_line
error)))))
(def: (un_paired pairs)
(All (_ a) (-> (List [a a]) (List a)))
(case pairs
#.End #.End
(#.Item [[x y] pairs']) (list& x y (un_paired pairs'))))
(macro: .public (syntax: tokens)
(let [?parts (: (Maybe [Code Text (List Code) Code Code])
(case tokens
(^ (list export_policy
[_ (#.Form (list [_ (#.Identifier ["" name])] [_ (#.Tuple args)]))]
body))
(#.Some [export_policy name args (` {}) body])
(^ (list export_policy
[_ (#.Form (list [_ (#.Identifier ["" name])] [_ (#.Tuple args)]))]
meta_data
body))
(#.Some [export_policy name args meta_data body])
(^ (list [_ (#.Form (list [_ (#.Identifier ["" name])] [_ (#.Tuple args)]))]
body))
(#.Some [(` .private) name args (` {}) body])
(^ (list [_ (#.Form (list [_ (#.Identifier ["" name])] [_ (#.Tuple args)]))]
meta_data
body))
(#.Some [(` .private) name args meta_data body])
_
#.None))]
(case ?parts
(#.Some [export_policy name args meta body])
(with_identifiers [g!tokens g!body g!error]
(do {! meta.monad}
[_ (if (|> args list.size nat.even?)
(in [])
(meta.failure "Syntax pattern expects pairs of bindings and code-parsers."))
vars+parsers (monad.each !
(: (-> [Code Code] (Meta [Code Code]))
(function (_ [var parser])
(with_expansions [<default> (in [var
(` ((~! ..self_documenting) (' (~ var))
(~ parser)))])]
(case var
[_ (#.Identifier ["" _])]
<default>
[_ (#.Identifier _)]
(in [var parser])
_
<default>))))
(list.pairs args))
this_module meta.current_module_name
.let [g!state (code.identifier ["" "*lux*"])
error_msg (code.text (macro.wrong_syntax_error [this_module name]))]]
(in (list (` (macro: (~ export_policy) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state))
(~ meta)
({(#.Right (~ g!body))
((~ g!body) (~ g!state))
(#.Left (~ g!error))
(#.Left ((~! text.interposed) (~! text.new_line) (list (~ error_msg) (~ g!error))))}
((~! </>.result)
(: ((~! </>.Parser) (Meta (List Code)))
((~! do) (~! <>.monad)
[(~+ (..un_paired vars+parsers))]
((~' in) (~ body))))
(~ g!tokens)))))))))
_
(meta.failure (macro.wrong_syntax_error (name_of ..syntax:))))))
|
