aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/bit.lux
blob: 90f98f245bea57ba11ed3924741cfe8dedf49924 (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
(.module: [lux #- and or not])

(def: #export width Nat +64)

## [Values]
(do-template [<short-name> <op> <doc> <type>]
  [(def: #export (<short-name> param subject)
     {#.doc <doc>}
     (-> Nat <type> <type>)
     (<op> subject param))]

  [and "lux bit and" "Bitwise and." Nat]
  [or "lux bit or" "Bitwise or." Nat]
  [xor "lux bit xor" "Bitwise xor." Nat]
  [left-shift "lux bit left-shift" "Bitwise left-shift." Nat]
  [logical-right-shift "lux bit logical-right-shift" "Unsigned bitwise logical-right-shift." Nat]
  [arithmetic-right-shift "lux bit arithmetic-right-shift" "Signed bitwise arithmetic-right-shift." Int]
  )

(def: #export (count subject)
  {#.doc "Count the number of 1s in a bit-map."}
  (-> Nat Nat)
  ("lux bit count" subject))

(def: #export not
  {#.doc "Bitwise negation."}
  (-> Nat Nat)
  (let [mask (int-to-nat -1)]
    (xor mask)))

(def: #export (clear idx input)
  {#.doc "Clear bit at given index."}
  (-> Nat Nat Nat)
  (..and (..not (left-shift idx +1))
         input))

(do-template [<name> <op> <doc>]
  [(def: #export (<name> idx input)
     {#.doc <doc>}
     (-> Nat Nat Nat)
     (<op> (left-shift idx +1) input))]

  [set  ..or  "Set bit at given index."]
  [flip ..xor "Flip bit at given index."]
  )

(def: #export (set? idx input)
  (-> Nat Nat Bool)
  (|> input (..and (left-shift idx +1)) (n/= +0) .not))

(do-template [<name> <main> <comp>]
  [(def: #export (<name> distance input)
     (-> Nat Nat Nat)
     (..or (<main> distance input)
           (<comp> (n/- (n/% width distance)
                        width)
                   input)))]

  [rotate-left  left-shift          logical-right-shift]
  [rotate-right logical-right-shift left-shift]
  )

(def: #export (region-mask size offset)
  (-> Nat Nat Nat)
  (let [pattern (|> +1 (left-shift size) n/dec)]
    (left-shift offset pattern)))