Integrationstabelle

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

> module Table          (  Table, readTable, retrieve
>                       )
> where

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

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

 > import IOSupport

 > import Text.ParserCombinators.Parsec

> import System.IO.Error

> import CPS
> import CPSParser
> import OrdAssList
>
> import Prim           (  Ident, Prim(..)  )
> import Expr           (  Expr(..)  )
> import Function       (  Function(..), constant,
>                          csplit, summands, factors, summ, prod  )

> import Convert        (  abstract  )
> import Parse          (  expr, var, lit  )
> import Simplify       (  standard1  )

> dontknow = zzero

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

Einlesen der Integrationstabelle

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

> type Table            =  [(Function, Function)]

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

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

> readTable             :: String -> IO Table
> readTable fid         =  try (readFile fid) >>=
>                          either
>                          (\err -> print err >>
>                                   return [])
>                          (\str -> case runParserCPS table str of
>                              Left (t, _) -> --sequence [ print e | e<-t ] >>
>                                             return t
>                              Right _     -> putStrLn "syntax error" >>
>                                             return [])

----------------------------------------------------------------------
Parsen der Integrationstabelle
----------------------------------------------------------------------

> table                 =  sepByCPS equ (lit ';') &= \t ->
>                          opt (lit ';') ';' & unit t

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

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

> equ                   =  lit '|' & var &= \x -> expr &= \e1 ->
>                          lit '=' & expr &= \e2 ->
>                          unit (convert x e1, convert x e2)

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

> convert x e           =  standard1 (abstract x e)

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

Substitution

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

> type Env                      =  FM Ident Function

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

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

> subst                         :: Env -> Function -> Function
> subst env f@(Const c)         =  lookupWithDefault env f c
> subst env (Derive n f)        =  Derive n (subst env f)
> subst env (f :.: g)           =  subst env f :.: subst env g
> subst env (Summ fs)           =  Summ [ subst env f | f<-fs ]
> subst env (Prod fs)           =  Prod [ subst env f | f<-fs ]
> subst env (f :^: g)           =  subst env f :^: subst env g
> subst env f                   =  f

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

Mustervergleich

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

> match (Ratio m) (Ratio m')
>     | m == m'         =  unit empty
> match (Const c) f     =  unit (singleton (c, f))
> match (Prim f) (Prim f')
>     | f == f'         =  unit empty
> match Id Id           =  unit empty
> match (f :.: g) h'    =  match f f'                           &= \env1 ->
>                          match g g'                           &= \env2 ->
>                          unit (env1 `union` env2)
>     where
>     (f', g')          =  csplit h'
> match (Summ fs) h'
>     | length cs <= 1  =  match (summ cs) (summ cs')           &= \env1 ->
>                          matchs hs hs'                        &= \env2 ->
>                          unit (env1 `union` env2)
>     where
>     (cs,  hs)         =  span constant fs
>     (cs', hs')        =  span constant (summands h')
> match (Prod fs) h'
>     | length cs <= 1  =  match (prod cs) (prod cs')           &= \env1 ->
>                          matchs hs hs'                        &= \env2 ->
>                          unit (env1 `union` env2)
>     where
>     (cs,  hs)         =  span constant fs
>     (cs', hs')        =  span constant (factors h')
> match (f :^: g) (f' :^: g')
>                       =  match f f'                           &= \env1 ->
>                          match g g'                           &= \env2 ->
>                          unit (env1 `union` env2)
> match _ _             =  dontknow                             -- catch all

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

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

> matchs [] []                  =  unit empty
> matchs (f:fs) (f':fs')        =  match f f'                   &= \env1 ->
>                                  matchs fs fs'                &= \env2 ->
>                                  unit (env1 `union` env2)
> matchs _ _                    =  dontknow                     -- catch all

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

Nachschlagen in der Integrationstabelle

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

> --retrieve                    :: Table -> Function -> CPSChoice Function
> retrieve [] _                 =  dontknow
> retrieve ((f, ff):t) g        =  (match f g                   &= \env ->
>                                   unit (subst env ff))
>                               ?  retrieve t g

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