--
-- 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)
--