--
-- This file declares two version of Bits. We use these
-- defintions in two other examples:
--  1)  adderWork.html
--  2)  TypedRewriting.html

data Bit:: Nat ~> *0 where
  One :: Bit (S Z)
  Zero :: Bit Z

data SymBit:: Nat ~> *0 where
 O:: SymBit Z
 I:: SymBit (S Z)
 And:: SymBit i -> SymBit j -> SymBit {and i j}
 Or:: SymBit i -> SymBit j -> SymBit {or i j}
 Not:: SymBit i -> SymBit {notB i}
 Xor:: SymBit i -> SymBit j -> SymBit {xor i j}
 Var:: String -> SymBit i

data Seq:: (Nat ~> *0) ~> Nat ~> Nat ~> *0 where
   Nil:: Seq bit Z Z
   Cons:: bit v -> Seq bit n u -> Seq bit (S n) {plus {plus u u} v}
  deriving List(b)

-- There are two approaches to semantically interpreting
-- a  (Seq Bit n i)
-- [0,0,1] -- least sig bit first = 4
-- [0,0,1] -- most sig bit first  = 1
-- Seq uses the least significant bit first approach.

--------------------------------------------------
-- addition of Nat

plus :: Nat ~> Nat ~> Nat
{plus Z n} = n
{plus (S x) n} = S {plus x n}

-------------------------------------------------
-- Theroems about addition

plusZ :: Nat' n -> Equal {plus n Z} n
plusZ Z = Eq
plusZ (x@(S m)) = Eq
  where theorem indHyp = plusZ m

plusS :: Nat' n -> Equal {plus n (S m)} (S{plus n m})
plusS Z  = Eq
plusS (S x)  = Eq
  where theorem ih = plusS x

plusCommutes :: Nat' n -> Nat' m -> Equal {plus n m} {plus m n}
plusCommutes Z m = Eq
   where theorem lemma = plusZ m
plusCommutes (S x) m = Eq
   where theorem plusS,
                 indHyp = plusCommutes x m

plusAssoc :: Nat' n -> Equal {plus {plus n b} c} {plus n {plus b c}}
plusAssoc Z = Eq
plusAssoc (S n) = Eq
  where theorem ih = plusAssoc n

plusNorm :: Nat' x -> Equal {plus x {plus y z}} {plus y {plus x z}}
plusNorm Z = Eq
plusNorm (S n) = Eq
  where theorem plusS, ih = plusNorm n

-------------------------------------------------------------
-- Boolean operations when Booleans are encoded as Nat

and:: Nat ~> Nat ~> Nat
{and Z y} = Z
{and (S x) Z} = Z
{and (S x) (S y)} = S Z

or:: Nat ~> Nat ~> Nat
{or Z Z} = Z
{or Z (S y)} = (S Z)
{or (S x) y} = (S Z)

xor:: Nat ~> Nat ~> Nat
{xor Z Z} = Z
{xor Z (S y)} = (S Z)
{xor (S x) Z} = (S Z)
{xor (S x) (S y)} = Z


notB:: Nat ~> Nat
{notB Z} = S Z
{notB (S x)} = Z

andX:: Bit i -> Bit j -> Bit {and i j}
andX Zero Zero = Zero

eval:: SymBit a -> Bit a
eval O = Zero
eval I = One
eval (And x y) = andX (eval x) (eval y)


--