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)