--
import "Bits.html"  -- see Bits.html source here.

------------------------------------
-- Strategies

data Rule = X (forall a . SymBit a -> Maybe(SymBit a))

first:: [Rule] -> SymBit a -> Maybe (SymBit a)
first [] x = Nothing
first (X f:fs) x =
case f x of
Just t -> Just t
Nothing -> first fs x

all:: [Rule] -> SymBit a -> [SymBit a]
all [] x = []
all (X f:fs) x =
case f x of
Just y -> y : all fs x
Nothing -> all fs x

topDown:: [Rule] -> SymBit a -> Maybe (SymBit a)
topDown rule x =
case first rule x of
Just t -> Just t
Nothing ->
case x of
And a b -> help rule And a b
Or a b -> help rule Or a b
Xor a b -> help rule Xor a b
Not a -> help rule g a a
where g a b = Not a
_ -> Nothing

help:: [Rule] -> (SymBit a -> SymBit b -> c) -> SymBit a -> SymBit b -> Maybe c
help rule f a b =
case (topDown rule a, topDown rule b) of
(Nothing,Nothing) -> Nothing
(Just m, Just n) -> Just(f m n)
(Nothing,Just n) -> Just(f a n)
(Just m,Nothing) -> Just(f m b)

repeat:: [Rule] -> SymBit a -> SymBit a
repeat rule x =
case first rule x of
Just y -> repeat rule y
Nothing -> x

--------------------------------------
-- rules

rule1 = [X f,X g,X h,X simpXor]
rule2 = [X (topDown rule1)]
simp x = repeat rule2 x

simpXor:: SymBit a -> Maybe(SymBit a)
simpXor (Xor I x) = Just (Not x)
where theorem th = lemmaXor1 (eval x)
simpXor (Xor x I) = Just (Not x)
where theorem th = lemmaXor2 (eval x)
simpXor (Xor O x) = Just x
where theorem th = lemmaXor3 (eval x)
simpXor (Xor x O) = Just x
where theorem th = lemmaXor4 (eval x)
simpXor _ = Nothing

lemmaXor1:: Bit c -> Equal {notB c} {xor 1t c}
lemmaXor1 Zero = Eq
lemmaXor1 One = Eq

lemmaXor2:: Bit c -> Equal {notB c} {xor c 1t}
lemmaXor2 Zero = Eq
lemmaXor2 One = Eq

lemmaXor3:: Bit c -> Equal {xor 0t c} c
lemmaXor3 Zero = Eq
lemmaXor3 One = Eq

lemmaXor4:: Bit c -> Equal {xor c 0t} c
lemmaXor4 Zero = Eq
lemmaXor4 One = Eq

g:: SymBit a -> Maybe(SymBit a)
g (Not O) = Just I
g (Not I) = Just O
g _ = Nothing

f:: SymBit a -> Maybe(SymBit a)
f (Not(And x y)) = Just (Or (Not x) (Not y))
where theorem lemma2
f x = Nothing

h:: SymBit a -> Maybe(SymBit a)
h (Or I x) = Just I
h (Or x I) = Just I
where theorem hh = lemma3 (eval x)
h (Or O x) = Just x
where theorem kk = lemma5 (eval x)
h (Or x O) = Just x
where theorem jj = lemma4 (eval x)
theorem kk = lemma5 (eval x)
h _ = Nothing

lemma3:: Bit i -> Equal {or i (S j)} (S Z)
lemma3 Zero = Eq
lemma3 One = Eq

lemma4:: Bit i -> Equal {or i Z} {or Z i}
lemma4 Zero = Eq
lemma4 One = Eq

lemma5:: Bit c -> Equal {or Z c} c
lemma5 Zero = Eq
lemma5 One = Eq

lemma2 :: Nat' a -> Nat' b -> Equal {notB {and a b}} {or {notB a} {notB b}}
lemma2 Z Z = Eq
lemma2 Z (S _) = Eq
lemma2 (S _) Z = Eq
lemma2 (S _) (S _) = Eq

mapS :: (forall i . t i -> t i) -> Seq t n a -> Seq t n a
mapS f Nil = Nil
mapS f (Cons x xs) = Cons (f x) (mapS f xs)

--