module Expr where
import Numl
import Nat

data Expr1 = Lit1 Int | Add1 Expr1 Expr1 | Mul1 Expr1 Expr1

eval1 (Lit1 k) = k
eval1 (Add1 s t) = eval1 s + eval1 t
eval1 (Mul1 s t) = eval1 s * eval1 t

t1 = Add1  (Lit1  2) (Mul1  (Lit1  3) (Lit1  5))

-----

data Expr2 = Lit2 Int | Bop2 AOp Expr2 Expr2
data AOp = Add | Mul

eval2 (Lit2 k) = k
eval2 (Bop2 Add s t) = eval2 s + eval2 t
eval2 (Bop2 Mul s t) = eval2 s * eval2 t

t2 = Bop2 Add (Lit2 2) (Bop2 Mul (Lit2 3) (Lit2 5))

t2' = Lit2 2 + (Lit2 3 * Lit2 5)   where (+) = Bop2 Add ;  (*) = Bop2 Mul

-----

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

eval3 (Lit k) = k
eval3 (Bop Add s t) = eval3 s + eval3 t
eval3 (Bop Mul s t) = eval3 s * eval3 t

type AExp = Expr3 Int  AOp
type BExp = Expr3 Bool BOp

data BOp = And | Or | Xor | Nand | Nor

-----

eval4 = fold id sem

eval :: Num a => Expr3 a AOp -> a
eval  = fold id (opr (+) (*))

sem Add = (+) ;  sem Mul = (*)

opr a m Add = a ; opr a m Mul = m

fold f g (Lit k) = f k
fold f g (Bop o l r) = g o (fold f g l) (fold f g r)

mapt f g = fold (Lit . f) (Bop . g)

t3 = Lit 2 +: (Lit 3 *: Lit 5)
(+:) = Bop Add
(*:) = Bop Mul

nat = fold (iton . toInt) (opr add mul)
sev = mapt (% 7) id			--  == fold (Lit . (% 7)) Bop

mark = fold (pri [] ('|':)) (opr (++) mul)
       where mul x y = concat (map (const x) y)

grow t = fold (const t) Bop t
mirr   = fold Lit (flip . Bop)

-- ??  mirr . mirr == id           ??
-- ??  mirr . grow == grow . mirr  ??
-- ??  ntoi . nat  == eval         ??  { no, since eval works on negs }

-----

instance Show a => Show (Expr3 a AOp) where
  show = prt inf sym

prt syn ops = fold show (syn . ops)
bin syn ops = fold (str 2) (syn . ops)

wrd = opr "plus" "times"
sym = opr "+" "*"

mth o l r = o ++ par (concat [l, ", ", r])
sch o l r = par (unwords [o, l, r])
inf o l r = par (unwords [l, o, r])
pre o l r =      unwords [o, l, r] 
pos o l r =      unwords [l, r, o] 

par s = "(" ++ s ++ ")"

-----

-- analyze for even/odd: True == odd
-- what is Mul? And; What is Add? XOR

a # b = (a || b) && not (a && b)

oddity = fold odd (opr (#) (&&))

-----

combo f xs = [f x y | x<-xs, y<-xs]

doc f x y = show x ++ " " ++ show y ++ " -> " ++ show (f x y)

dump f = putStr . unlines . combo (doc f)