{-----------------------------------------
  Expression interpreter: simple version
  (constr parsing, tracing, print options)
 -----------------------------------------}

--------------------
-- Expression trees and their fold

data Expr = Lit Int | Opr Op Expr Expr  deriving (Eq, Show)

fold f g (Lit n)     = f n
fold f g (Opr o l r) = g o (fold f g l) (fold f g r)


--------------------
-- Operators and conversions

data Op = Add | Mul | Sub  deriving (Eq, Show)

isOpSym = (`elem` "+*-")

rop '+' = Add ;  rop '*' = Mul ;  rop '-' = Sub
syn Add = "+" ;  syn Mul = "*" ;  syn Sub = "-"
sem Add = (+) ;  sem Mul = (*) ;  sem Sub = (-)


--------------------
-- Tokens and scanning

data Token = Num Int | Sym Char  deriving (Read,Show)

scan [] = []
scan (c:cs) | isSpace c =         scan cs
            | isOpSym c = Sym c : scan cs
            | isDigit c = Num n : scan cs'
            | otherwise = error "bad symbol"
                          where [(n,cs')] = readDec (c:cs)


--------------------
-- Parsing a list of tokens into a tree (using a stack)

parse cs = case foldl shred [] (scan cs) of
             [t] -> t
             s   -> error "too few ops"
             
           where shred      s  (Num n) = Lit      n      : s
                 shred (a:b:s) (Sym c) = Opr (rop c) b a : s
                 shred      s   _      = error "too few args"


--------------------
-- Evaluation and pretty-printing

eval  = fold id sem

trace = fold ((:[]).Lit) comb

prti  = fold show inf
prtp  = fold show pof

inf o l r = par (unwords [l, syn o, r])
pof o l r =      unwords [l, r, syn o]

par = ("("++) . (++")")


--------------------
-- Tracing a calculation

comb op ls@(l:_) (r:tr) = let (&) = Opr op in
  Lit (eval (l&r)) : [x&r | x<-ls] ++ [last ls & y | y<-tr]

calc = putStr . fmtEqns . map prti . reverse . trace

fmtEqns = ("      "++) . foldl1 (\x y -> x++"\n  =>  "++y)


--------------------
-- Some test data


[(+:), (*:), (-:)] = map Opr [Add, Mul, Sub]

t0 = (Lit 2 +: Lit 3) *: ((Lit 5 +: Lit 6) -: Lit 4)
s0 = "2 3 + 5 6 + 4 - *"

t1 = (Lit 2 *: Lit 3) +:  (Lit 4 *: Lit 5)
t2 = fold (Lit . succ) Opr t1 -: t1


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