-------------------------------------------------------------
-- Type-definition for parsetree

data Expr = Con Int
          | Var String
          | Fun String [Expr]
          | Expr :+: Expr
          | Expr :-: Expr
          | Expr :*: Expr
          | Expr :/: Expr

-------------------------------------------------------------
-- Parser for expressions with two priorities

fact :: Parser Char Expr
fact =  integer <@ Con
        <|> identifier <*> (option (parenthesized (commaList expr)) <?@ (Var,flip Fun))
                 <@ ap'
        <|> parenthesized expr

term :: Parser Char Expr
term  =  chainr fact
               (    symbol '*' <@ const (:*:)
                <|> symbol '/' <@ const (:/:)
               )

expr :: Parser Char Expr
expr  =  chainr term
               (    symbol '+' <@ const (:+:)
                <|> symbol '-' <@ const (:-:)
               )


-------------------------------------------------------------
-- Parser for expressions with aribitrary many priorities

type Op a = (Char, a->a->a)

fact' :: Parser Char Expr
fact' =     integer 
            <@ Con
        <|> identifier 
            <*> (option (parenthesized (commaList expr')) <?@ (Var,flip Fun))
            <@ ap'
        <|> parenthesized expr'

gen  ::  [Op a] -> Parser Char a -> Parser Char a
gen ops p  =  chainr p (choice (map f ops))
       where  f (s,c) = symbol s <@ const c

expr' :: Parser Char Expr
expr'  =  foldr gen fact' [addis, multis]

multis  =  [ ('*',(:*:)), ('/',(:/:)) ]
addis   =  [ ('+',(:+:)), ('-',(:-:)) ]


---------------------------------------------------------------------
-- written by:
-- Jeroen Fokker                                 |  jeroen@cs.ruu.nl
-- dept.of Computer Science, Utrecht University  |  tel.+31-30-2534129
-- PObox 80089, 3508TB Utrecht, the Netherlands  |  fax.+31-30-2513791