{----------------------------------------- Expression interpreter: fancy version (variables, polynomials, asbtract parsing) -----------------------------------------} -------------------- -- Expression trees and their fold data Expr = Lit Int | Var | Opr Op Expr Expr deriving (Eq, Show) fold f g x (Lit n) = f n fold f g x Var = x fold f g x (Opr o l r) = g o (fold f g x l) (fold f g x 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 | IdX deriving (Read,Show) scan [] = [] scan (c:cs) | isSpace c = scan cs | isOpSym c = Sym c : scan cs | (=='x') c = IdX : scan cs | isDigit c = Num n : scan cs' | otherwise = error "bad symbol" where [(n,cs')] = readDec (c:cs) -------------------- -- Parsing into a tree (with abstract constructors) parse f g x cs = case foldl shred [] (scan cs) of [t] -> t s -> error "too few ops" where shred s (Num n) = f n : s shred s IdX = x : s shred (a:b:s) (Sym c) = g (rop c) b a : s shred s _ = error "too few args" ---------------------------------------- -- Various printing, evaluating and parsing combinations prti = fold show inf "x" prtp = fold show pof "x" eval = fold id sem subst = fold Lit Opr defn = fold Lit Opr . Lit trace n = fold ((:[]) . Lit) (comb n) [Lit n, Var] poly = fold (:[]) psem [0,1] parTree = parse Lit Opr Var parVal = parse id sem parPoly = parse (:[]) psem [0,1] parInf = parse show inf "x" parPost = parse show pof "x" -------------------- -- Calculation traces comb n op ls@(l:_) (r:tr) = let (&) = Opr op in Lit (eval n (l&r)) : [x&r | x<-ls] ++ [last ls & y | y<-tr] calc n = putStr . fmtEqns . map prti . reverse . trace n -------------------- -- Print formatting utilities inf o l r = par (unwords [l, syn o, r]) pof o l r = unwords [l, r, syn o] par = ("("++) . (++")") fmtEqns = (" "++) . foldl1 (\x y -> x++"\n => "++y) -------------------- -- Evaluation and semantic operations on polynomials -- (represented as reversed lists of coefficients) -- {theorem: eval == pval . poly } pval cs x = foldr (\c r -> c + x * r) 0 cs ps, pd :: [Int] -> [Int] -> [Int] ps = lzw (+) 0 pd = lzw (-) 0 pm cs ds = foldr (\c r -> ps (map (c *) ds) (0 : r)) [] cs -- polynomial semantics for operators psem Add = ps ; psem Mul = pm ; psem Sub = pd -- Polynomial utility function ("long" zipWith) lzw f u [] [] = [] lzw f u (x:xs) [] = f x u : lzw f u xs [] lzw f u [] (y:ys) = f u y : lzw f u [] ys lzw f u (x:xs) (y:ys) = f x y : lzw f u xs ys -------------------- -- Test data, "generating functions" and notation [(+:), (*:), (-:)] = map Opr [Add, Mul, Sub] t0 = (Var *: Lit 2) *: ((Lit 3 +: Var) -: Lit 4) s0 = "2 3 + 5 x + 4 - *" t1 = (Lit 2 *: Var) +: (Var +: Lit 5) t2 = bump t1 -: t1 t3 = t0 *: t1 bump = fold (Lit . succ) Opr Var mirr = fold Lit (\o l r->Opr o r l) Var ------------------------------------------------------------