data Expr a b = Lit a | Bop b (Expr a b) (Expr a b)

fold f g (Lit a) = f a
fold f g (Bop b l r) = g b (fold f g l) (fold f g r)


data Opr = Add | Mul | Sub | And | Or | Equ | Gtr


type BorN = Either Bool Int

blit = Lit . Left
nlit = Lit . Right

bopr f (Left  x) (Left  y) = Left  (f x y)
bopr f _ _ = error "non-boolean argument(s)"

nopr g (Right x) (Right y) = Right (g x y)
nopr g _ _ = error "non-numeric argument(s)"

ropr h (Right x) (Right y) = Left (h x y)
ropr h _ _ = error "non-numeric argument(s)"


sem And = bopr (&&)
sem Or  = bopr (||)
sem Add = nopr (+)
sem Mul = nopr (*)
sem Sub = nopr (-)
sem Equ = ropr (==)
sem Gtr = ropr (>)


--------------------


eval = fold id sem

good = Bop Add (Bop Mul (nlit 5) (nlit 6))
               (Bop Sub (nlit 7) (nlit 2))

bad  = Bop Add (Bop Mul (nlit 5) (nlit 6))
               (Bop Sub (nlit 7) (blit True))

reln = Bop Equ (Bop Add (nlit 5) (nlit 6))
               (Bop Sub (nlit 7) (nlit 2))


--------------------

chi b = if b then 1 else 0

cvt (Left b)  = chi b
cvt (Right n) = n

sem' And = (*)
sem' Or  = max
sem' Add = (+)
sem' Mul = (*)
sem' Sub = (-)
sem' Equ = (\n m -> chi (n==m))
sem' Gtr = (\n m -> chi (n>m))

sort And = ((B,B),B)
sort Or  = ((B,B),B)
sort Add = ((N,N),N)
sort Mul = ((N,N),N)
sort Sub = ((N,N),N)
sort Equ = ((N,N),B)
sort Gtr = ((N,N),B)

eval' = fold cvt sem'

data Sort = B | N  deriving (Eq,Show)

-- Maybe Sort would be more a more felicitous result type

check (Lit (Left _))  = B
check (Lit (Right _)) = N
check (Bop b l r) = if (check l, check r) == arg then res
                    else error "bad operator/operand sorts"
                    where (arg,res) = sort b