blob: 5c9280164eabec1382f4b7ecc945cb2d37968e78 (
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
|
(.module:
[lux #*
[control
["." monoid]
["." parser]]
[data
["." number
["." i64]]
[format
["." binary]]
[collection
[list ("list/." Functor<List>)]]]
[type
["." abstract]]
[macro (#+ with-gensyms)
["." code]
["s" syntax (#+ Syntax syntax:)]]]
[//
["//." encoding]])
(type: Modifier
{#code Text
#name Text})
(def: modifier
(Syntax Modifier)
(s.tuple (parser.and s.text
s.local-identifier)))
(def: (code modifier)
(-> Modifier Code)
(code.tuple (list (code.text (get@ #code modifier))
(code.local-identifier (get@ #name modifier)))))
(syntax: #export (modifiers: {options (parser.many ..modifier)})
(with-gensyms [g!parameter g!subject g!<name> g!<code>]
(let [nameC (' Modifier)
combineC (' combine)
emptyC (' empty)
typeC (` (abstract.abstract: (~' #export) (~ nameC)
{}
//encoding.U2
(.def: (~' #export) (~' code)
(.-> (~ nameC) //encoding.U2)
(.|>> (~' :representation)))
(.def: (~' #export) ((~ combineC) (~ g!parameter) (~ g!subject))
(.-> (~ nameC) (~ nameC) (~ nameC))
((~' :abstraction) (//encoding.to-u2 (i64.and (//encoding.from-u2 ((~' :representation) (~ g!parameter)))
(//encoding.from-u2 ((~' :representation) (~ g!subject)))))))
(.do-template [(~ g!<code>) (~ g!<name>)]
[(.def: (~' #export) (~ g!<name>)
(~ nameC)
(.|> (number.hex (~ g!<code>)) //encoding.to-u2 (~' :abstraction)))]
["0000" (~ emptyC)]
(~+ (list/map ..code options))
)
(.def: (~' #export) (~' format)
(binary.Format (~ nameC))
(.let [(.^open "_/.") //encoding.u2-format]
{#binary.reader (|> (~' _/reader)
(:: parser.Functor<Parser> (~' map)
(|>> (~' :abstraction))))
#binary.writer (|>> (~' :representation)
(~' _/writer))}))))
monoidC (` (.structure: (~' #export) (~' _) (monoid.Monoid (~ nameC))
(.def: (~' identity) (~ emptyC))
(.def: (~' compose) (~ combineC))))]
(wrap (list typeC monoidC)))))
|