Parser

----------------------------------------------------------------------

> module Parse          (  expr, var, number, ext, lit, lits
>                       )
> where

----------------------------------------------------------------------

----------------------------------------------------------------------

> import CPSParser
>
> import Expr           (  Prim(..), Expr(..)  )
> import Limes          (  Extended(..)  )

----------------------------------------------------------------------

Parsing primitive functions

----------------------------------------------------------------------

> prim          =  lexical (
>                  lexs "sinh"   >> unit Sinh    <|>  lexs "cosh"   >> unit Cosh
>               <|>  lexs "tanh"   >> unit Tanh    <|>  lexs "coth"   >> unit Coth
>               <|>  lexs "sin"    >> unit Sin     <|>  lexs "cos"    >> unit Cos
>               <|>  lexs "tan"    >> unit Tan     <|>  lexs "cot"    >> unit Cot
>               <|>  lexs "exp"    >> unit Exp     <|>  lexs "ln"     >> unit Ln
>               <|>  lexs "log"    >> unit Log
>               <|>  lexs "arcsin" >> unit Arcsin  <|>  lexs "arccos" >> unit Arccos
>               <|>  lexs "arctan" >> unit Arctan  <|>  lexs "arccot" >> unit Arccot
>               <|>  lexs "abs"    >> unit Abs
>               )

----------------------------------------------------------------------

Parsing expressions

----------------------------------------------------------------------

> expr          =  term >>= expr1
> expr1 e1      =  (lit '+' >> term >>= \e2 -> expr1 (Add e1 e2))
>               <|>  (lit '-' >> term >>= \e2 -> expr1 (Sub e1 e2))
>               <|>  unit e1

----------------------------------------------------------------------

----------------------------------------------------------------------

> term          =  sfactor >>= term1
> term1 e1      =  (lit '*' >> sfactor >>= \e2 -> term1 (Mul e1 e2))
>               <|>  (lit '/' >> sfactor >>= \e2 -> term1 (Div e1 e2))
>               <|>  unit e1

----------------------------------------------------------------------

----------------------------------------------------------------------

> sfactor       =  (lit '+' >> sfactor)
>               <|>  (lit '-' >> sfactor >>= \e -> unit (Neg e))
>               <|>  factor

----------------------------------------------------------------------

----------------------------------------------------------------------

> factor        =  atom >>= factor1
> factor1 e1    =  (lit '^' >> factor >>= \e2 -> unit (Pow e1 e2))
>               <|>  unit e1

----------------------------------------------------------------------

----------------------------------------------------------------------

> atom          =  (prim >>= \f -> many (lit '\'') >>= \d -> atom >>= \e ->
>                   unit (AppPrim f (length d) e))
>               <|>  (var >>= \f -> many (lit '\'') >>= \d -> atom >>= \e ->
>                   unit (AppFun f (length d) e))
>               <|>  (var >>= \x -> unit (Var x))
>               <|>  (number >>= \n -> unit (Lit (read n % 1)))
>               <|>  (lit '(' >> expr >>= \e -> lit ')' >> unit e)

----------------------------------------------------------------------

Lexical parser

----------------------------------------------------------------------

> var           =  lexical (alpha >>= \c -> many alphanum >>= \cs -> unit (c:cs))

----------------------------------------------------------------------

----------------------------------------------------------------------

> number        =  lexical (many1 digit)

----------------------------------------------------------------------

Parsing Extended Expressions

----------------------------------------------------------------------

> ext p         =  (lits "-oo" >> unit MInfty)
>               <|>  (lits "oo"  >> unit Infty)
>               <|>  (p >>= \v -> unit (Proper v))

----------------------------------------------------------------------

Helper parsers

----------------------------------------------------------------------

> lit c         =  lexical (item |> (==c))
> lits s        =  lexical (lexs s)

----------------------------------------------------------------------

----------------------------------------------------------------------

> space         =  item |> isSpace
> digit         =  item |> isDigit
> alpha         =  item |> isAlpha
> alphanum      =  item |> isAlphanum

----------------------------------------------------------------------

----------------------------------------------------------------------

> lexs s        =  let lex c = item |> (==c) in accumulat (map lex s)

----------------------------------------------------------------------

----------------------------------------------------------------------

> lexical p     =  p >>= \v -> many space >> unit v

----------------------------------------------------------------------