Parser

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

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

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

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

> import Text.ParserCombinators.Parsec
> import Text.ParserCombinators.Parsec.Pos
>
> import Expr           (  Prim(..), Expr(..)  )

> import Ratio

> import Limes        --  (  Extended(..)  )

 > data Extended val     =  MInfty | Proper val | Infty
 >                       deriving (Eq)

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

Parsing primitive functions

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

> prim          =  let  pairParser (s,x) = do { lexs s; return x }
>                   in  lexical . choice . map pairParser $
>                     [ ("sinh",   Sinh),   ("cosh",   Cosh)
>                     , ("tanh",   Tanh),   ("coth",   Coth)
>                     , ("sin",    Sin ),   ("cos",    Cos )
>                     , ("tan",    Tan ),   ("cot",    Cot )
>                     , ("exp",    Exp ),   ("ln",     Ln  )
>                     , ("log",    Log )
>                     , ("arcsin", Arcsin), ("arccos", Arccos)
>                     , ("arctan", Arctan), ("arccot", Arccot)
>                     , ("abs",    Abs) ]

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

Parsing expressions

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

> expr          =    term >>= expr1
> expr1 e1      =    (do { lit '+'; e2 <- term; expr1 (Add e1 e2) })
>               <|>  (do { lit '-'; e2 <- term; expr1 (Sub e1 e2) })
>               <|>  return e1

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

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

> term          =    sfactor >>= term1
> term1 e1      =    (do { lit '*'; e2 <- term; term1 (Mul e1 e2) })
>               <|>  (do { lit '/'; e2 <- term; term1 (Div e1 e2) })
>               <|>  return e1

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

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

> sfactor       =    (do { lit '+'; sfactor })
>               <|>  (do { lit '-'; e <- sfactor; return (Negg e) })
>               <|>  factor

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

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

> factor        =    atom >>= factor1
> factor1 e1    =    (do { lit '^'; e2 <- factor; return (Pow e1 e2) })
>               <|>  return e1

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

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

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

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

Lexical parser

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

> var           =  lexical (do c <- letter
>                              cs <- option "" (many alphaNum)
>                              return (c:cs) )

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

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

> number        =  lexical (many1 digit)

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

Parsing Extended Expressions

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

> ext p         =   (do {lits "-oo"; return MInfty})
>               <|> (do {lits "oo"; return Infty})
>               <|> (do {v <- p; return (Proper v) })

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

Helper parsers

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

> lit c                 = lexical (char c)   <?> "the character '"++[c]++"'"
> lits s                = lexical (lexs s)   <?> "the literal \""++s++"\""
> lexs s                = let lex c = satisfy (==c) in accumulat (map lex s)
> lexical p             = do { v <- p; spaces; return v } <?> "possible spaces afterwards"

> accumulat             :: [CharParser st a] -> CharParser st [a]
> accumulat []          = return []
> accumulat (p:ps)      = try (do { v <- p; vs <- accumulat ps; return (v:vs) })





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

testing

> testParser = expr

> mytest s = parseTest testParser s