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

some bitwise ops corresponding to OPE ops

Browse source
This commit is contained in:
rhiannon morris 2023-06-05 16:41:40 +02:00
parent 9e702dd03d
commit b61ace9c7d
1 changed files with 36 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
lib/Quox/NatExtra.idr
View file

@ -82,5 +82,40 @@ doubleInj (S m) (S n) prf =
export
0 halfDouble : (n : Nat) -> half (n + n) = HalfEven n
halfDouble n with (half (n + n)) | (n + n) proof nn
_ | HalfOdd k | S (k + k) = void $ notEvenOdd n k nn
_ | HalfOdd k | S (k + k) = void $ notEvenOdd n k nn
_ | HalfEven k | k + k = rewrite doubleInj n k nn in Refl
export
floorHalf : Nat -> Nat
floorHalf k = case half k of
HalfOdd n => n
HalfEven n => n
||| like in intercal ☺
|||
||| take all the bits of `subj` that are set in `mask`, and squish them down
||| towards the lsb
export
select : (mask, subj : Nat) -> Nat
select mask subj = go 1 (halfRec mask) subj 0 where
go : forall mask. Nat -> HalfRec mask -> Nat -> Nat -> Nat
go bit HalfRecZ subj res = res
go bit (HalfRecEven _ rec) subj res = go bit rec (floorHalf subj) res
go bit (HalfRecOdd _ rec) subj res = case half subj of
HalfOdd subj => go (bit + bit) rec subj (res + bit)
HalfEven subj => go (bit + bit) rec subj res
||| take the i least significant bits of subj (where i = popCount mask),
||| and place them where mask's set bits are
|||
||| left inverse of select if mask .|. subj = mask
export
spread : (mask, subj : Nat) -> Nat
spread mask subj = go 1 (halfRec mask) subj 0 where
go : forall mask. Nat -> HalfRec mask -> Nat -> Nat -> Nat
go bit HalfRecZ subj res = res
go bit (HalfRecEven _ rec) subj res = go (bit + bit) rec subj res
go bit (HalfRecOdd _ rec) subj res = case half subj of
HalfOdd subj => go (bit + bit) rec subj (res + bit)
HalfEven subj => go (bit + bit) rec subj res