Integrationstabelle

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

----------------------------------------------------------------------
> import IOSupport
>
> import CPSParser      renaming (zero to dontknow)
> 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  )
----------------------------------------------------------------------

Einlesen der Integrationstabelle

----------------------------------------------------------------------
> type Table            =  [(Function, Function)]
----------------------------------------------------------------------

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

Parsen der Integrationstabelle

----------------------------------------------------------------------
> table                 =  sepBy 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
----------------------------------------------------------------------

Go to the first, previous, next, last section, table of contents.