blob: 72a92507c52a9d6b6c353d5d048bb74aaffd9224 (
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
|
## Copyright (c) Eduardo Julian. All rights reserved.
## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
(;module: [lux #- & | ^])
## [Values]
(do-template [<short-name> <op> <doc> <type>]
[(def: #export (<short-name> param subject)
{#;doc <doc>}
(-> Nat <type> <type>)
(_lux_proc ["bit" <op>] [subject param]))]
[& "and" "Bit and." Nat]
[| "or" "Bit or." Nat]
[^ "xor" "Bit xor." Nat]
[<< "shift-left" "Bit shift-left." Nat]
[>> "shift-right" "Bit shift-right." Int]
[>>> "unsigned-shift-right" "Bit unsigned-shift-right." Nat]
)
(def: #export (count subject)
{#;doc "Count the number of 1s in a bit-map."}
(-> Nat Nat)
(_lux_proc ["bit" "count"] [subject]))
(def: mask Nat (int-to-nat -1))
(def: #export ~
{#;doc "Bit negation."}
(-> Nat Nat)
(^ mask))
(def: #export (clear idx input)
{#;doc "Clear bit at given index."}
(-> Nat Nat Nat)
(& (~ (<< idx +1)) input))
(do-template [<name> <op> <doc>]
[(def: #export (<name> idx input)
{#;doc <doc>}
(-> Nat Nat Nat)
(<op> (<< idx +1) input))]
[set | "Set bit at given index."]
[flip ^ "Flip bit at given index."]
)
(def: #export (set? idx input)
(-> Nat Nat Bool)
(|> input (& (<< idx +1)) (=+ +0) not))
(def: rot-top Nat +64)
(do-template [<name> <main> <comp>]
[(def: #export (<name> distance input)
(-> Nat Nat Nat)
(| (<main> distance input)
(<comp> (-+ (%+ rot-top distance)
rot-top)
input)))]
[rotate-left << >>>]
[rotate-right >>> <<]
)
|