aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/host/jvm/modifier.lux
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)))))