rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

bitwise visibilities

Browse source
This commit is contained in:
rhiannon morris 2023-06-24 14:35:59 +02:00
parent 124637c946
commit 30fbb40399
1 changed files with 8 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
lib/Quox/NatExtra.idr
View file

@ -101,7 +101,7 @@ floorHalf k = case half k of
||| |||
||| take all the bits of `subj` that are set in `mask`, and squish them down ||| take all the bits of `subj` that are set in `mask`, and squish them down
||| towards the lsb ||| towards the lsb
export public export
select : (mask, subj : Nat) -> Nat select : (mask, subj : Nat) -> Nat
select mask subj = go 1 (halfRec mask) subj 0 where select mask subj = go 1 (halfRec mask) subj 0 where
go : forall mask. Nat -> HalfRec mask -> Nat -> Nat -> Nat go : forall mask. Nat -> HalfRec mask -> Nat -> Nat -> Nat
@ -115,7 +115,7 @@ select mask subj = go 1 (halfRec mask) subj 0 where
||| and place them where mask's set bits are ||| and place them where mask's set bits are
||| |||
||| left inverse of select if mask .|. subj = mask ||| left inverse of select if mask .|. subj = mask
export public export
spread : (mask, subj : Nat) -> Nat spread : (mask, subj : Nat) -> Nat
spread mask subj = go 1 (halfRec mask) subj 0 where spread mask subj = go 1 (halfRec mask) subj 0 where
go : forall mask. Nat -> HalfRec mask -> Nat -> Nat -> Nat go : forall mask. Nat -> HalfRec mask -> Nat -> Nat -> Nat
@ -153,7 +153,7 @@ bitwiseRec m n = go (halfRec m) (halfRec n) where
go (HalfRecOdd m mr) (HalfRecEven n nr) = Bw10 m n $ go mr nr go (HalfRecOdd m mr) (HalfRecEven n nr) = Bw10 m n $ go mr nr
go (HalfRecOdd m mr) (HalfRecOdd n nr) = Bw11 m n $ go mr nr go (HalfRecOdd m mr) (HalfRecOdd n nr) = Bw11 m n $ go mr nr
export public export
bitwise : (Bool -> Bool -> Bool) -> Nat -> Nat -> Nat bitwise : (Bool -> Bool -> Bool) -> Nat -> Nat -> Nat
bitwise f m n = go 1 (bitwiseRec m n) 0 where bitwise f m n = go 1 (bitwiseRec m n) 0 where
one : Bool -> Bool -> Nat -> Nat -> Nat one : Bool -> Bool -> Nat -> Nat -> Nat
@ -165,7 +165,7 @@ bitwise f m n = go 1 (bitwiseRec m n) 0 where
go bit (Bw10 m n rec) res = go (bit + bit) rec $ one True False bit res go bit (Bw10 m n rec) res = go (bit + bit) rec $ one True False bit res
go bit (Bw11 m n rec) res = go (bit + bit) rec $ one True True bit res go bit (Bw11 m n rec) res = go (bit + bit) rec $ one True True bit res
export public export
(.&.) : Nat -> Nat -> Nat (.&.) : Nat -> Nat -> Nat
(.&.) = bitwise $ \p, q => p && q (.&.) = bitwise $ \p, q => p && q
@ -173,7 +173,7 @@ private %foreign "scheme:blodwen-and"
primAnd : Nat -> Nat -> Nat primAnd : Nat -> Nat -> Nat
%transform "NatExtra.(.&.)" NatExtra.(.&.) m n = primAnd m n %transform "NatExtra.(.&.)" NatExtra.(.&.) m n = primAnd m n
export public export
(.|.) : Nat -> Nat -> Nat (.|.) : Nat -> Nat -> Nat
(.|.) = bitwise $ \p, q => p || q (.|.) = bitwise $ \p, q => p || q
@ -181,7 +181,7 @@ private %foreign "scheme:blodwen-or"
primOr : Nat -> Nat -> Nat primOr : Nat -> Nat -> Nat
%transform "NatExtra.(.|.)" NatExtra.(.|.) m n = primOr m n %transform "NatExtra.(.|.)" NatExtra.(.|.) m n = primOr m n
export public export
xor : Nat -> Nat -> Nat xor : Nat -> Nat -> Nat
xor = bitwise (/=) xor = bitwise (/=)
@ -190,7 +190,7 @@ primXor : Nat -> Nat -> Nat
%transform "NatExtra.xor" NatExtra.xor m n = primXor m n %transform "NatExtra.xor" NatExtra.xor m n = primXor m n
export public export
shiftL : Nat -> Nat -> Nat shiftL : Nat -> Nat -> Nat
shiftL n 0 = n shiftL n 0 = n
shiftL n (S i) = shiftL (n + n) i shiftL n (S i) = shiftL (n + n) i
@ -199,7 +199,7 @@ private %foreign "scheme:blodwen-shl"
primShiftL : Nat -> Nat -> Nat primShiftL : Nat -> Nat -> Nat
%transform "NatExtra.shiftL" NatExtra.shiftL n i = primShiftL n i %transform "NatExtra.shiftL" NatExtra.shiftL n i = primShiftL n i
export public export
shiftR : Nat -> Nat -> Nat shiftR : Nat -> Nat -> Nat
shiftR n 0 = n shiftR n 0 = n
shiftR n (S i) = shiftL (floorHalf n) i shiftR n (S i) = shiftL (floorHalf n) i