aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/target/jvm/modifier.lux
blob: 0db6fec0c2ae38c1fc11e3ccb8bd6f839ab67e62 (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
83
84
85
86
87
88
89
90
91
92
(.using
 [library
  [lux (.except)
   [abstract
    ["[0]" equivalence (.only Equivalence)]
    ["[0]" monoid (.only Monoid)]]
   [control
    ["[0]" try]
    ["<>" parser (.only)
     ["<[0]>" code]]]
   [data
    [format
     ["[0]F" binary (.only Writer)]]]
   [macro (.only with_symbols)
    [syntax (.only syntax)]
    ["[0]" code]]
   [math
    ["[0]" number (.only hex)
     ["[0]" i64]]]
   [type
    [primitive (.except)]]]]
 ["[0]" //
  [encoding
   ["[1][0]" unsigned]]])

(primitive: .public (Modifier of)
  //unsigned.U2

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

  (def: .public equivalence
    (All (_ of) (Equivalence (Modifier of)))
    (implementation
     (def: (= reference sample)
       (at //unsigned.equivalence =
           (representation reference)
           (representation sample)))))

  (def: !wrap
    (template (_ value)
      [(|> value
           //unsigned.u2
           try.trusted
           abstraction)]))

  (def: !unwrap
    (template (_ value)
      [(|> value
           representation
           //unsigned.value)]))

  (def: .public (has? sub super)
    (All (_ of) (-> (Modifier of) (Modifier of) Bit))
    (let [sub (!unwrap sub)]
      (|> (!unwrap super)
          (i64.and sub)
          (at i64.equivalence = sub))))

  (def: .public monoid
    (All (_ of) (Monoid (Modifier of)))
    (implementation
     (def: identity
       (!wrap (hex "0000")))
     
     (def: (composite left right)
       (!wrap (i64.or (!unwrap left) (!unwrap right))))))

  (def: .public empty
    Modifier
    (at ..monoid identity))

  (def: .public writer
    (All (_ of) (Writer (Modifier of)))
    (|>> representation //unsigned.writer/2))

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

(def: .public modifiers:
  (syntax (_ [ofT <code>.any
              options (<>.many <code>.any)])
    (with_symbols [g!modifier g!code]
      (in (list (` (with_template [(~ g!code) (~ g!modifier)]
                     [(def: (~' .public) (~ g!modifier)
                        (..Modifier (~ ofT))
                        ((~! ..modifier) ((~! number.hex) (~ g!code))))]
                     
                     (~+ options))))))))