blob: a3562d51c08af8de7362990d3ca2fe30f654cfb4 (
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
|
(.module:
[library
[lux "*"
["[0]" macro {"+" [with_identifiers]}]
["[0]" meta]
[abstract
["[0]" monad {"+" [do]}]]
[control
["[0]" maybe]
["[0]" try]
["<>" parser
["</>" code {"+" [Parser]}]]]
[data
["[0]" text ("[1]\[0]" monoid)]
[collection
["[0]" list ("[1]\[0]" functor)]]]
[math
[number
["[0]" nat]
["[0]" int]
["[0]" rev]
["[0]" frac]]]]]
[//
["[0]" code]]
["[0]" / "_"
["[1][0]" export]])
(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'))))
(def: syntax
(Parser [Code [Text (List Code)] Code])
(/export.parser
($_ <>.and
(</>.form ($_ <>.and
</>.local_identifier
(</>.tuple (<>.some </>.any))))
</>.any)))
(macro: .public (syntax: tokens)
(case (</>.result ..syntax tokens)
(#try.Success [export_policy [name args] 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))
({(#.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)))))))))
(#try.Failure error)
(meta.failure (macro.wrong_syntax_error (name_of ..syntax:)))))
|
