Parser

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

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

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

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

> import Data.Char
> import Ratio

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

> isAlphanum x = isAlpha x || isDigit x || x == '_'

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

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 (Negg 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

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