Kapitel 6: Programmiertechniken

hugs Eval
ghc -c Eval.lhs

> module Eval
> where

> data Term                     =  Con Integer
>                               |  Bin Term Op Term
>                                  deriving (Eq, Show)

> data Op                       =  Add | Sub | Mul | Div
>                                  deriving (Eq, Show)

> aterm				:: Term
> aterm				=  Bin (Bin (Con 11) Add (Con 23)) Mul (Con 47)

> sys				:: Op -> (Integer -> Integer -> Integer)
> sys Add                       =  (+)
> sys Sub                       =  (-)
> sys Mul                       =  (*)
> sys Div                       =  div

Der Ausgangspunkt.

> eval                          :: Term -> Integer
> eval (Con n)                  =  n
> eval (Bin t op u)             =  sys op (eval t) (eval u)

eval aterm

Erweiterung 1: Fehlerbehandlung.

> data Exception a              =  Raise  String
>                               |  Return a
>				   deriving (Show)

> eval1                         :: Term -> Exception Integer
> eval1 (Con n)                 =  Return n
> eval1 (Bin t op u)            =  case eval1 t of
>                                    Raise  s -> Raise s
>                                    Return v -> case eval1 u of
>                                      Raise  s -> Raise s
>                                      Return w ->
>                                        if (op == Div && w == 0) then
>                                          Raise "div by zero"
>                                        else
>                                          Return (sys op v w)

eval1 aterm

Erweiterung 2: Zähler.

> type Count a                  =  Int -> (a, Int)

> eval2                         :: Term -> Count Integer
> eval2 (Con n)                 =  \i -> (n, i)
> eval2 (Bin t op u)            =  \i -> let (v, j) = eval2 t i
>                                            (w, k) = eval2 u j
>                                        in  (sys op v w, k + 1)

eval2 aterm 0

Erweiterung 3: Protokoll der durchgeführten Operationen.

> type Trace a                  =  (a, String)

> eval3                         :: Term -> Trace Integer
> eval3 e@(Con n)               =  (n, trace e n)
> eval3 e@(Bin t op u)          =  let (v, x) = eval3 t
>                                      (w, y) = eval3 u
>                                      r      = sys op v w
>                                  in  (r, x ++ y ++ trace e r)

> trace				:: Term -> Integer -> String
> trace t n                     =  "eval (" ++ show t ++ ") = "
>                               ++ show n ++ "\n"

eval3 aterm

Erweiterung 4: Ausgabe der Reduktionen.

> eval4                         :: Term -> IO Integer
> eval4 e@(Con n)               =  putStr (trace e n)           >>
>                                  return n
> eval4 e@(Bin t op u)          =  eval4 t                      >>= \ v ->
>                                  eval4 u                      >>= \ w ->
>                                  let r = sys op v w           in
>                                  putStr (trace e r)          >>
>                                  return r

eval4 aterm