blob: a0f8e18a73957ed003c09feea5e8cec1237e3c3e (
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
|
(.module: [lux #- and or not])
(def: #export width Nat +64)
## [Values]
(do-template [<name> <op> <doc>]
[(def: #export (<name> param subject)
{#.doc <doc>}
(All [s] (-> (I64 s) (I64 s) (I64 s)))
(<op> param subject))]
[and "lux i64 and" "Bitwise and."]
[or "lux i64 or" "Bitwise or."]
[xor "lux i64 xor" "Bitwise xor."]
)
(do-template [<name> <op> <doc>]
[(def: #export (<name> param subject)
{#.doc <doc>}
(All [s] (-> Nat (I64 s) (I64 s)))
(<op> param subject))]
[left-shift "lux i64 left-shift" "Bitwise left-shift."]
[logical-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logical-right-shift."]
[arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."]
)
(alias: right-shift logical-right-shift)
(def: (add-shift shift value)
(-> Nat Nat Nat)
(|> value (right-shift shift) (n/+ value)))
(def: #export (count subject)
{#.doc "Count the number of 1s in a bit-map."}
(-> (I64 Any) Nat)
(let [count' (n/- (|> subject (right-shift +1) (and +6148914691236517205) i64)
(i64 subject))]
(|> count'
(right-shift +2) (and +3689348814741910323) (n/+ (and +3689348814741910323 count'))
(add-shift +4) (and +1085102592571150095)
(add-shift +8)
(add-shift +16)
(add-shift +32)
(and +127))))
(def: #export not
{#.doc "Bitwise negation."}
(All [s] (-> (I64 s) (I64 s)))
(xor (:! I64 -1)))
(def: (flag idx)
(-> Nat I64)
(|> +1 (:! I64) (left-shift idx)))
(def: #export (clear idx input)
{#.doc "Clear bit at given index."}
(All [s] (-> Nat (I64 s) (I64 s)))
(|> idx flag ..not (..and input)))
(do-template [<name> <op> <doc>]
[(def: #export (<name> idx input)
{#.doc <doc>}
(All [s] (-> Nat (I64 s) (I64 s)))
(|> idx flag (<op> input)))]
[set ..or "Set bit at given index."]
[flip ..xor "Flip bit at given index."]
)
(def: #export (set? idx input)
(-> Nat (I64 Any) Bool)
(|> input (:! I64) (..and (flag idx)) (n/= +0) .not))
(do-template [<name> <main> <comp>]
[(def: #export (<name> distance input)
(All [s] (-> Nat (I64 s) (I64 s)))
(let [backwards-distance (n/- (n/% width distance) width)]
(|> input
(<comp> backwards-distance)
(..or (<main> distance input)))))]
[rotate-left left-shift right-shift]
[rotate-right right-shift left-shift]
)
(def: #export (region size offset)
(-> Nat Nat I64)
(|> +1 (:! I64) (left-shift size) dec (left-shift offset)))
|