blob: cb535a96bc28aa6e7412e239e7f69d5104900806 (
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
|
(.module:
[lux #*
[control
["." equivalence]
["." monoid]
["." parser]]
[data
["." number
["." i64]]
[format
["." binary]]
[collection
["." list ("#;." functor)]]]
[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 [g!name (' Modifier)
g!combine (' combine)
g!empty (' empty)
g!format (' modifier-format)
typeC (` (abstract.abstract: (~' #export) (~ g!name)
{}
//encoding.U2
(.def: (~' #export) (~' code)
(.-> (~ g!name) //encoding.U2)
(.|>> abstract.:representation))
(.def: (~' #export) ((~ g!combine) (~ g!parameter) (~ g!subject))
(.-> (~ g!name) (~ g!name) (~ g!name))
(abstract.:abstraction (//encoding.to-u2 (i64.and (//encoding.from-u2 (abstract.:representation (~ g!parameter)))
(//encoding.from-u2 (abstract.:representation (~ g!subject)))))))
(.do-template [(~ g!<code>) (~ g!<name>)]
[(.def: (~' #export) (~ g!<name>)
(~ g!name)
(.|> ((~! number.hex) (~ g!<code>)) //encoding.to-u2 abstract.:abstraction))]
["0000" (~ g!empty)]
(~+ (list;map ..code options))
)
(.structure: (~' #export) (~' modifier-equivalence) (equivalence.Equivalence (~ g!name))
(.def: ((~' =) (~' reference) (~' sample))
(.:: //encoding.u2-equivalence (~' =)
(abstract.:representation (~' reference))
(abstract.:representation (~' sample)))))
(.def: (~' #export) (~ g!format)
(binary.Format (~ g!name))
(.let [(.^open "_;.") //encoding.u2-format]
{#binary.reader (|> (~' _;reader)
(:: parser.functor (~' map)
(|>> abstract.:abstraction)))
#binary.writer (|>> abstract.:representation
(~' _;writer))}))))
monoidC (` (.structure: (~' #export) (~' modifier-monoid) (monoid.Monoid (~ g!name))
(.def: (~' identity) (~ g!empty))
(.def: (~' compose) (~ g!combine))))]
(wrap (list typeC monoidC)))))
|
