blob: ad160085600e731d8e8c4eec97d01ef7c76c8d58 (
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
|
(.module:
[lux #*
[abstract
["." monad (#+ do)]]
[control
["p" parser ("#@." functor)]]
[data
["." bit ("#@." codec)]
["." text]
[number
["." nat ("#@." decimal)]
["." int ("#@." decimal)]
["." rev ("#@." decimal)]
["." frac ("#@." decimal)]]
[collection
["." list ("#@." monad)]]]]
["." //
["." code]
["s" syntax (#+ Syntax syntax:)]])
(syntax: #export (splice {parts (s.tuple (p.some s.any))})
(wrap parts))
(syntax: #export (with-locals {locals (s.tuple (p.some s.local-identifier))}
body)
(do @
[g!locals (|> (//.gensym "local")
(list.repeat (list.size locals))
(monad.seq @))]
(wrap (list (` (.with-expansions [(~+ (|> (list.zip2 locals g!locals)
(list@map (function (_ [name identifier])
(list (code.local-identifier name) (as-is identifier))))
list@join))]
(~ body)))))))
(def: snippet
(Syntax Text)
($_ p.either
s.text
s.local-identifier
s.local-tag
(p@map bit@encode s.bit)
(p@map nat@encode s.nat)
(p@map int@encode s.int)
(p@map rev@encode s.rev)
(p@map frac@encode s.frac)
))
(def: part
(Syntax (List Text))
(s.tuple (p.many ..snippet)))
(syntax: #export (text {simple ..part})
(wrap (list (|> simple (text.join-with "") code.text))))
(template [<name> <simple> <complex>]
[(syntax: #export (<name> {simple ..part} {complex (p.maybe ..part)})
(case complex
#.None
(wrap (list (|> simple (text.join-with "") <simple>)))
(#.Some complex)
(wrap (list (<complex> [(text.join-with "" simple)
(text.join-with "" complex)])))))]
[identifier code.local-identifier code.identifier]
[tag code.local-tag code.tag]
)
|