module Algebra where import Parsing2 -------------------- -- Abstract syntax, concrete syntax and semantics for arithmetic -- operators and terms, parsing to terms or directly to meanings -------------------- -- Arithmetic operators data Opr = Add | Mul deriving Show fopr f g Add = f; fopr f g Mul = g syn = fopr "+" "*" sem = fopr (+) (*) -------------------- -- Arithmetic terms data Expr a b = Lit a | Bop b (Expr a b) (Expr a b) deriving Show fold f g (Lit n) = f n fold f g (Bop o l r) = g o (fold f g l) (fold f g r) infx exp = fold show (inpar . syn) exp where inpar o l r = concat ["(",l,o,r,")"] evalg t = fold id sem t -------------------- -- Parsing: infix operators (with precedence), literals and parentheses popr g (s,c) i o = do { x <- i; do { symbol s; y <- o; return (g c x y) } +++ return x } layer g = foldr (\a b -> fix (popr g a b)) par f a e = do { symbol "("; x <- e; symbol ")"; return x } +++ (a >>= return . f) algebra f g ops a = let (x,y) = (flip (layer g) ops y, par f a x) in x -------------------- -- Final parsing and evaluation ptree = run (algebra Lit Bop [("+", Add), ("*", Mul)] natural) peval = run (algebra id id [("+", (+)), ("*", (*))] natural) ptval = evalg . ptree test = " 2+ 4 *(1+3) " -------------------- -- Utility: fixed-point operator fix f = f (fix f)