Main program

> module Main   --        (  main  )
> where

 > import Text.ParserCombinators.Parsec

> import System.Console.Readline
> import Data.Char

> import Pretty
> import CPS
> import CPSParser
> import Expr
> import Limes
> import Print
> import Parse
> import Function       hiding (  zero  )
> import Derive
> import Convert
> import Simplify       hiding (  summ, prod  )
> import Replace
> import Table
> import Integrate

----------------------------------------------------------------------
Command-line interpreter
----------------------------------------------------------------------

> data Theme              =  Theme { prompt, helpString, leavingMessage :: String }

> type MyState            =  (Expr, Table)

> g # f = f . g

> isQuit ("exit")    = True
> isQuit (':':'q':_) = True
> isQuit _           = False

> isHelp (':':'h':_) = True
> isHelp ("?")       = True
> isHelp _           = False

> version = "0.4.0"
> startMessage   = "Abacas "++version++"\n"++
>                  "exit or :q or ^D to quit" ++"\n"++
>                  "? or :h or :help for help"

> main = do
>    tab <- readTable "integrals"
>    putStrLn startMessage
>    loop (Theme {prompt=">>> ", leavingMessage="Leaving Abacas", helpString=help}) evaluate (Var "x", tab)

> loop :: Theme -> (st -> String -> IO st) -> st -> IO ()
> loop theme f st = do
>    s <- readline (prompt theme)
>    case s of
>       Nothing -> putStrLn $ "\n" ++ (leavingMessage theme)
>       Just str -> do
>        if isHelp str
>          then do putStr (helpString theme)
>                  loop theme f st
>          else do
>            if isQuit str
>              then putStrLn (leavingMessage theme)
>              else do
>                myAddHistory str
>                st' <- f st str
>                loop theme f st'
> myAddHistory x = if x == "" then return () else addHistory x
> myPutStrLn x = if x == "" then return () else putStrLn x

> evaluate              :: MyState -> String -> IO MyState
> evaluate s x          =  case runParserCPS (expression s) x of
>                          Left (Nothing, _) -> 
>                              putStrLn "sorry, does not compute" >> return s
>                          Left (Just (t, s'), _) ->
>                              putStrLn (pretty 78 t) >> return s'
>                          Right _     ->
>                              putStrLn "syntax error" >> return s

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

Abarbeitung von Ausdr"ucken
Execution for printing or printer

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

> expression (e, t)     =  ((lit '\'' & var &= \x -> opt expr e &= \e ->
>                            unit (wrap x (Just . derive) e))
>                       ?   (lit '|' & var &= \x -> opt expr e &= \e ->
>                            unit (wrap x (integrate t) e))
>                       ?   (lit '[' & expr &= \e1 -> lit '/' & expr &= \e2 ->
>                            lit ']' & opt expr e &= \e ->
>                            unit (wrap "" (Just . replace (abstract "" e1,
>                                                           abstract "" e2)) e))
>                       ?   (lits "lim" & var &= \x -> lits "->" &
>                            ext expr &= \a -> opt expr e &= \e ->
>                            unit (wrap' x (limes (mapE (abstract "") a)) e))
>                       ?   (lits "st2" &
>                            unit (wrap "" (Just . standard2) e))
>                       ?   (lits "st3" & number &= \n ->
>                            unit (wrap "" (Just . standard3 (read n)) e))
>                       ?   (expr &= \e ->
>                            unit (wrap "" Just e)))
>                       &= \r -> end & unit r
>     where
>     wrap x f          =  abstract x # standard1 # f 
>                       #  mapMaybe (standard1 # rapply x # \e' -> (pp e', (e', t)))
>     wrap' x f         =  abstract x # standard1 # f 
>                       #  mapMaybe (mapE (standard1 # rapply "") # \v -> (pp v, (e, t)))

> mystr = "sin(arcsin(x))"
> runit ex = case runParserCPS expr ex of
>               Left (result, _) ->
>                   result
>               Right _     ->
>                   error "syntax error"
> testexpr = abstract "" (runit mystr)

> rapply x f            =  apply f (Var x)

> mapMaybe f Nothing        =  Nothing
> mapMaybe f (Just a)       =  Just (f a)

> help = unlines [
>     "<exp>                         enter expression",
>     "'<var> <exp>                  differentiate <exp> (or last entered expression)",
>     "|<var> <exp>                  integrate <exp> (or last entered expression)",
>     "[<exp1>/<exp2>] <exp>         replace <exp1> by <exp2> in <exp> (or last)",
>     "lim ...                       <not implemented yet>",
>     "st2                           standard form 2",
>     "st3 <nat>                     standard form 3 of ordern [n]",
>     "? or :help or :h              display this command summary",
>     "exit or :quit or :q or ^D     exit the system"]

> singleton a   =  [a]

> getNatArg             :: [String] -> IO (Integer, [String])
> getNatArg []          =  error "argument expected"
> getNatArg (arg:args)
>     | all isDigit arg =  return (read arg, args)
>     | otherwise       =  error "number expected"