aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/target/jvm/modifier.lux
blob: d573f0aeb91a0a172e19dc8f0e55715acc28a191 (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
(.using
 [library
  [lux "*"
   [abstract
    ["[0]" equivalence {"+" Equivalence}]
    ["[0]" monoid {"+" Monoid}]]
   [control
    ["[0]" try]
    ["<>" parser
     ["<[0]>" code]]]
   [data
    [format
     ["[0]F" binary {"+" Writer}]]]
   [macro {"+" with_symbols}
    [syntax {"+" syntax:}]
    ["[0]" code]]
   [math
    ["[0]" number {"+" hex}
     ["[0]" i64]]]
   [type
    [primitive "*"]]]]
 ["[0]" // "_"
  [encoding
   ["[1][0]" unsigned]]])

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

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

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

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

  (template: (!unwrap 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)
          (# i64.equivalence = sub))))

  (implementation: .public monoid
    (All (_ of) (Monoid (Modifier of)))

    (def: identity
      (!wrap (hex "0000")))
    
    (def: (composite left right)
      (!wrap (i64.or (!unwrap left) (!unwrap right)))))

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

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

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

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