{-# OPTIONS -XTemplateHaskell -XMultiParamTypeClasses #-}
import UpdatableViewStub 

data Bin = Z | O deriving Eq -- Zero or One 

incr' [] = [O]
incr' (O:x) = Z:incr' x 
incr' (Z:x) = O:x 

decr' []  = []
decr' [O] = []
decr' (Z:x) = (O:decr' x)
decr' (O:x) = Z:x


spec MSB = MSB [Bin] deriving Eq where
    zero :: MSB 
    zero = MSB []
            
    incr :: MSB -> MSB 
    --    incr (MSB x) = MSB $ reverse $ incr' (reverse x))
    
    decr :: MSB -> MSB
    --    decr (LSB x) = LSB $ reverse $ decr' $ reverse x 
    isZero :: MSB -> Bool 
    
    binFromInteger :: Integer -> MSB

impl LSB = LSB [Bin] deriving Eq where
    zero :: LSB
    zero = LSB []

    incr :: LSB -> LSB 
    incr (LSB x) = LSB $ incr' x 
    
    decr :: LSB -> LSB
    decr (LSB x) = LSB $ decr' x 
    
    isZero :: LSB -> Bool 
    isZero (LSB [])    = True 
    isZero (LSB (Z:x)) = isZero (LSB x)
    isZero _           = False

    binFromInteger :: Integer -> LSB 
    binFromInteger n = LSB $ f n 
      where 
        f 0 = []
        f n = if n `mod` 2 == 0 then Z:f (n `div` 2)
              else                 O:f (n `div` 2)

abstractedBy 
    view = $(foldT ''LSB) (reverseB) >>>> $(toC 'MSB)

instance Show MSB where 
    show n = show (f n)
        where f n | isZero n  = 0 
                  | otherwise = 1 + f (decr n)


instance Num MSB where
    (+) = add 
    (*) = mul 
    fromInteger = binFromInteger 
    abs = id 
    signum n | isZero n  = 0 
             | otherwise = 1 
    



normal :: MSB -> MSB 
normal (MSB x) = MSB (normal' x)
    where 
      normal' []     = []
      normal' (O:x)  = O:x 
      normal' (Z:x)  = normal' x 



add :: MSB -> MSB -> MSB 
add x y | isZero x  = y 
        | otherwise = add (decr x) (incr y)


mul :: MSB -> MSB -> MSB 
mul x y | isZero x  = zero
        | otherwise = add y (mul (decr x) y)