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