{-# LANGUAGE BangPatterns #-}
module Urbit.Ob.Ob (
fein
, fynd
, feis
, tail
, fe
, fen
, capF
, capFe
, capFen
) where
import Data.Bits
import Data.Word (Word32)
import Prelude hiding (tail)
import Urbit.Ob.Muk (muk)
fein :: (Integral a, Bits a) => a -> a
fein = loop where
loop !pyn =
let lo = pyn .&. 0xFFFFFFFF
hi = pyn .&. 0xFFFFFFFF00000000
p32 = fromIntegral pyn :: Word32
in if pyn >= 0x10000 && pyn <= 0xFFFFFFFF
then 0x10000 + fromIntegral (feis (p32 - 0x10000))
else if pyn >= 0x100000000 && pyn <= 0xFFFFFFFFFFFFFFFF
then hi .|. loop lo
else pyn
fynd :: (Integral a, Bits a) => a -> a
fynd = loop where
loop !cry =
let lo = cry .&. 0xFFFFFFFF
hi = cry .&. 0xFFFFFFFF00000000
c32 = fromIntegral cry :: Word32
in if cry >= 0x10000 && cry <= 0xFFFFFFFF
then 0x10000 + fromIntegral (tail (c32 - 0x10000))
else if cry >= 0x100000000 && cry <= 0xFFFFFFFFFFFFFFFF
then hi .|. loop lo
else cry
feis :: Word32 -> Word32
feis = capFe 4 0xFFFF 0x10000 0xFFFFFFFF capF
tail :: Word32 -> Word32
tail = capFen 4 0xFFFF 0x10000 0xFFFFFFFF capF
capF :: Int -> Word32 -> Word32
capF j key = fromIntegral (muk seed key) where
seed = raku !! fromIntegral j
raku = [
0xb76d5eed
, 0xee281300
, 0x85bcae01
, 0x4b387af7
]
capFe
:: Int
-> Word32
-> Word32
-> Word32
-> (Int -> Word32 -> Word32)
-> Word32
-> Word32
capFe r a b k f m
| c < k = c
| otherwise = fe r a b f c
where
c = fe r a b f m
fe
:: Int
-> Word32
-> Word32
-> (Int -> Word32 -> Word32)
-> Word32
-> Word32
fe r a b f m = loop 1 capL capR where
capL = m `mod` a
capR = m `div` a
loop j !ell !arr
| j > r =
if odd r || arr == a
then a * arr + ell
else a * ell + arr
| otherwise =
let eff = f (pred j) arr
tmp = if odd j
then (ell `mod` a + eff `mod` a) `mod` a
else (ell `mod` b + eff `mod` b) `mod` b
in loop (succ j) arr tmp
capFen
:: Int
-> Word32
-> Word32
-> Word32
-> (Int -> Word32 -> Word32)
-> Word32
-> Word32
capFen r a b k f m
| c <= k = c
| otherwise = fen r a b f c
where
c = fen r a b f m
fen
:: Int
-> Word32
-> Word32
-> (Int -> Word32 -> Word32)
-> Word32
-> Word32
fen r a b f m = loop r capL capR where
ahh =
if odd r
then m `div` a
else m `mod` a
ale =
if odd r
then m `mod` a
else m `div` a
capL =
if ale == a
then ahh
else ale
capR =
if ale == a
then ale
else ahh
loop j !ell !arr
| j < 1 = a * arr + ell
| otherwise =
let eff = f (pred j) ell
tmp = if odd j
then (arr + a - (eff `mod` a)) `mod` a
else (arr + b - (eff `mod` b)) `mod` b
in loop (pred j) tmp ell