blob: a510cb759cb7e6e2f28e1e2576dbc5063e5adde1 (
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
|
(.using
[library
[lux (.except)
["[0]" meta]
[abstract
["[0]" monad (.only do)]]
[control
["[0]" maybe]
["[0]" try]
["<>" parser (.only)
["</>" code (.only Parser)]]]
[data
["[0]" text (.open: "[1]#[0]" monoid)]
[collection
["[0]" list]]]
[math
[number
["[0]" nat]
["[0]" int]
["[0]" rev]
["[0]" frac]]]]]
["[0]" // (.only with_symbols)
["[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 (all 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']} (partial_list x y (un_paired pairs'))))
(def: syntaxP
(Parser [[Text (Maybe Text) (List Code)] Code])
(all <>.and
(</>.form (all <>.and
</>.local
(<>.maybe </>.local)
(</>.tuple (<>.some </>.any))))
</>.any))
(def: .public syntax
(macro (_ tokens)
(case (</>.result ..syntaxP tokens)
{try.#Success [[name g!state args] body]}
(with_symbols [g!tokens g!body g!error]
(do [! meta.monad]
[vars+parsers (case (list.pairs args)
{.#Some args}
(monad.each !
(is (-> [Code Code] (Meta [Code Code]))
(function (_ [var parser])
(with_expansions [<default> (in [var
(` ((~! ..self_documenting) (' (~ var))
(~ parser)))])]
(case var
[_ {.#Symbol ["" _]}]
<default>
[_ {.#Symbol _}]
(in [var parser])
_
<default>))))
args)
_
(meta.failure "Syntax pattern expects pairs of bindings and code-parsers."))
g!state (case g!state
{.#Some g!state}
(in (code.local g!state))
{.#None}
(//.symbol "g!state"))
this_module meta.current_module_name
.let [error_msg (code.text (//.wrong_syntax_error [this_module name]))
g!name (code.symbol ["" name])]]
(in (list (` (.macro ((~ g!name) (~ g!tokens) (~ g!state))
(.case ((~! </>.result)
(is ((~! </>.Parser) (Meta (List Code)))
((~! do) (~! <>.monad)
[(~+ (..un_paired vars+parsers))]
(.at (~! <>.monad) (~' in) (~ body))))
(~ g!tokens))
{try.#Success (~ g!body)}
((~ g!body) (~ g!state))
{try.#Failure (~ g!error)}
{try.#Failure ((~! text.interposed) (~! text.new_line) (list (~ error_msg) (~ g!error)))})))))))
{try.#Failure error}
(meta.failure (//.wrong_syntax_error (symbol ..syntax))))))
|
