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
|
(.require
[library
[lux (.except)
[abstract
["[0]" monad (.only do)]]
[control
["<>" parser]
["[0]" try]]
[data
["[0]" text (.use "[1]#[0]" monoid)]
[collection
["[0]" list]]]
["[0]" meta (.only)
["[0]" code (.only)
["</>" \\parser (.only Parser)]]]]]
["[0]" // (.only with_symbols)])
(def .public (self_documenting binding parser)
(All (_ a) (-> Code (Parser a) (Parser a)))
(function (_ tokens)
(when (parser tokens)
{try.#Failure error}
{try.#Failure (all text#composite
"Failed to parse: " (code.format binding) text.new_line
error)}
success
success)))
(def (un_paired pairs)
(All (_ a) (-> (List [a a]) (List a)))
(when pairs
{.#Item [x y] pairs'}
(list.partial x y (un_paired pairs'))
{.#End}
{.#End}))
(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)
(when (</>.result ..syntaxP tokens)
{try.#Success [[name g!state args] body]}
(with_symbols [g!tokens g!body g!error]
(do [! meta.monad]
[vars+parsers (when (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)))])]
(when var
[_ {.#Symbol ["" _]}]
<default>
[_ {.#Symbol _}]
(in [var parser])
_
<default>))))
args)
_
(meta.failure "Syntax pattern expects pairs of bindings and code-parsers."))
g!state (when g!state
{.#Some g!state}
(in (code.local g!state))
{.#None}
(//.symbol "g!state"))
this_module meta.current_module_name
.let [g!name (code.symbol ["" name])]]
(in (list (` (.macro ((, g!name) (, g!tokens) (, g!state))
(.when (</>.result
(is (</>.Parser (Meta (List Code)))
(do <>.monad
[(,* (..un_paired vars+parsers))]
(.of <>.monad (,' in)
(is (Meta (List Code))
(, body)))))
(, g!tokens))
{try.#Success (, g!body)}
((, g!body) (, g!state))
{try.#Failure (, g!error)}
{try.#Failure (text.interposed text.new_line (list "Invalid syntax:" (, g!error)))})))))))
{try.#Failure error}
(meta.failure (//.wrong_syntax_error (symbol ..syntax))))))
|
