module Numeric.Clifford.Internal (myTrace, trie, untrie, enumerate) where
import Numeric.Natural
import Prelude hiding (head,tail, null)
import Data.MemoTrie
import Data.List.Stream
import Control.Arrow
import Data.Bits
import Test.QuickCheck
import Data.Word
import qualified Debug.Trace as DebugTrace
#ifdef DEBUG
myTrace = DebugTrace.trace
#else
myTrace _ x = x
#endif
instance HasTrie Natural where
newtype Natural :->: a = NaturalTrie ((Bool,[Bool]) :->: a)
trie f = NaturalTrie (trie (f . unbitsZ))
untrie (NaturalTrie t) = untrie t . bitsZ
enumerate (NaturalTrie t) = enum' unbitsZ t
instance Arbitrary Natural where
arbitrary = sized $ \n ->
let n' = abs n in
fmap (toNatural . (\x -> (fromIntegral x)::Word)) (choose (0, n'))
shrink = shrinkIntegral
unbitsZ :: (Prelude.Num n, Bits n) => (Bool,[Bool]) -> n
unbitsZ (headder,bs) = (unbits (headder:bs))
bitsZ :: (Prelude.Num n, Ord n, Bits n) => n -> (Bool,[Bool])
bitsZ i = (h, t ) where
theBits = bits i
(h,t) = if null theBits
then (False,[])
else (head theBits, tail theBits)
bits :: (Prelude.Num t, Bits t) => t -> [Bool]
bits 0 = []
bits x = testBit x 0 : bits (shiftR x 1)
unbits :: (Prelude.Num t, Bits t) => [Bool] -> t
unbits [] = 0
unbits (x:xs) = unbit x .|. shiftL (unbits xs) 1
unbit :: Prelude.Num t => Bool -> t
unbit False = 0
unbit True = 1
enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]
enum' f = (fmap.first) f . enumerate