aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/target/jvm/modifier.lux
blob: 0e354d7305e7b6042f7d40bb86d846206ee5093e (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
(.module:
  [lux #*
   [abstract
    ["." equivalence (#+ Equivalence)]
    ["." monoid (#+ Monoid)]]
   [control
    ["<>" parser
     ["<c>" code (#+ Parser)]]]
   [data
    ["." number (#+ hex)
     ["." i64]]
    [format
     [".F" binary (#+ Format)]]
    [collection
     ["." list ("#@." functor)]]]
   [type
    abstract]
   [macro (#+ with-gensyms)
    [syntax (#+ syntax:)]
    ["." code]]]
  ["." // #_
   [encoding
    ["#." unsigned]]])

(abstract: #export (Modifier of)
  {}
  //unsigned.U2

  (template: (!wrap value)
    (|> value
        //unsigned.u2
        :abstraction))

  (template: (!unwrap value)
    (|> value
        :representation
        //unsigned.nat))

  (def: #export code
    (-> (Modifier Any) //unsigned.U2)
    (|>> :representation))

  (def: modifier
    (-> Nat Modifier)
    (|>> !wrap))

  (structure: #export equivalence
    (All [of] (Equivalence (Modifier of)))
    (def: (= reference sample)
      (:: //unsigned.equivalence =
          (:representation reference)
          (:representation sample))))

  (structure: #export monoid
    (All [of] (Monoid (Modifier of)))

    (def: identity
      (!wrap (hex "0000")))
    
    (def: (compose left right)
      (!wrap (i64.and (!unwrap left) (!unwrap right)))))

  (def: #export empty
    Modifier
    (:: ..monoid identity))

  (def: #export format
    (All [of] (Format (Modifier of)))
    (let [(^open "_@.") //unsigned.u2-format]
      {#binaryF.reader (:: <>.functor map (|>> :abstraction) _@reader)
       #binaryF.writer (|>> :representation _@writer)}))
  )

(syntax: #export (modifiers: ofT {options (<>.many <c>.any)})
  (with-gensyms [g!modifier g!code]
    (wrap (list (` (template [(~ g!code) (~ g!modifier)]
                     [(def: (~' #export) (~ g!modifier)
                        (..Modifier (~ ofT))
                        ((~! ..modifier) ((~! number.hex) (~ g!code))))]
                     
                     (~+ options)))))))