module Zustand where newtype Anweisung st r = Z (st -> (st,r)) instance Functor (Anweisung st) where fmap = abb instance Applicative (Anweisung st) where pure a = Z (\st -> (st,a)) (Z gf) <*> (Z ga) = Z (\s -> let (s1,f) = gf s (s2,a) = ga s1 in (s2,f a)) instance Monad (Anweisung st) where (>>) = undDann (>>=) = binde return = pure bsp1 = abb (maybe 0 id) ((setvar "x" 42) `undDann` (setvar "y" 17) `undDann` (getvar "x")) `binde` (setvar "z") bsp2 = fmap (maybe 0 id) ((setvar "x" 42) >> (setvar "y" 17) >> (getvar "x")) >>= (setvar "z") bsp3 = do setvar "x" 42 setvar "y" 17 x <- getvar "x" y <- getvar "y" let z = (maybe 0 id x)+(maybe 0 id y) setvar "z" z return (200+z) bsp4 = do print "geben sie eine Zahl ein" i <- (readLn::IO Integer) print "das Quadrat ist" print (i*i) xs <- readFile "Zustand.hs" writeFile "newZust.hs" xs bsp5 = do x <- [1,2,3,4] y <- [5,6,7,8] return (x,y) bsp6 = do x <- lookup "x" [("y",42),("x",17)] y <- lookup "y" [("y",42),("x",17)] z <- lookup "z" [("y",42),("x",17)] return (x+y) undDann:: (Anweisung st r1) -> (Anweisung st r2) -> (Anweisung st r2) (Z st1) `undDann` (Z st2) = Z (\s -> let (s1,r1) = st1 s (s2,r2) = st2 s1 in (s2,r2) ) binde:: (Anweisung st r1) -> (r1 -> Anweisung st r2) -> (Anweisung st r2) (Z st1) `binde` fs = Z (\s -> let (s1,r1) = st1 s (Z anw2) = fs r1 in anw2 s1) setvar :: String -> Integer -> Anweisung [(String,Integer)] Integer setvar x v = Z (\env -> ((x,v):env,v)) getvar x = Z (\env -> (env,lookup x env)) run (Z stm) = stm [] abb :: (a->b) -> Anweisung st a -> Anweisung st b abb f (Z st) = Z (\s -> let (s1,r1) = st s in (s1,f r1))