Subato

Resource Files

State in Haskell

.


> module Zustand where > import Control.Monad.Trans.Maybe > import Control.Monad.Trans.Class > import Control.Monad > import Control.Monad.IO.Class > newtype Anweisung st r = Z (st -> (st,r)) > setvar :: String -> Integer -> Anweisung [(String,Integer)] Integer > setvar x v = Z (\env -> ((x,v):env,v)) > getvar :: String -> Anweisung [(String,Integer)] (Maybe Integer) > getvar x = Z (\env -> (env,lookup x env)) > ex1 = > let > Z anw1 = setvar "x" 17 > Z anw2 = setvar "y" 4 > Z anw3 = setvar "z" 2 > Z anw4 = getvar "x" > Z anw5 = getvar "y" > Z anw6 = getvar "z" > (st1,_) = anw1 [] > (st2,_) = anw2 st1 > (st3,_) = anw3 st2 > (st4,Just x) = anw4 st3 > (st5,Just y) = anw5 st4 > (st6,Just z) = anw6 st5 > in (st6,(x+y)*z) > undDann:: (Anweisung st r1) -> (Anweisung st r2) -> (Anweisung st r2) > (Z anw1) `undDann` (Z anw2) > = Z (\s -> let (s1,r1) = anw1 s > (s2,r2) = anw2 s1 > in (s2,r2) ) > ex2 = > let > Z anw123 = > setvar "x" 17 `undDann` > setvar "y" 4 `undDann` > setvar "z" 2 > Z anw4 = getvar "x" > Z anw5 = getvar "y" > Z anw6 = getvar "z" > (st3,_) = anw123 [] > (st4,Just x) = anw4 st3 > (st5,Just y) = anw5 st4 > (st6,Just z) = anw6 st5 > in (st6,(x+y)*z) > undMit::(Anweisung st r1)-> (r1 -> Anweisung st r2) -> (Anweisung st r2) > (Z st1) `undMit` fs > = Z (\s -> let (s1,r1) = st1 s > (Z anw2) = fs r1 > in anw2 s1) > ergebnis :: r -> Anweisung st r > ergebnis r = Z (\st -> (st,r)) > ex3 = > let > Z anws = > setvar "x" 17 `undDann` > setvar "y" 4 `undDann` > setvar "z" 2 `undDann` > getvar "x" `undMit` \(Just x) -> > getvar "y" `undMit` \(Just y) -> > getvar "z" `undMit` \(Just z) -> > ergebnis ((x+y)*z) > in anws [] > infixl 1 --> > infixl 1 ->- > (-->) = undDann > (->-) = undMit > ex4 = let > Z anws = > setvar "x" 17 --> > setvar "y" 4 --> > setvar "z" 2 --> > getvar "x" ->- \(Just x) -> > getvar "y" ->- \(Just y) -> > getvar "z" ->- \(Just z) -> > ergebnis ((x+y)*z) > in anws [] > (=:) = setvar > x !() = getvar x > ex5 = let > Z anws = > "x" =: 17 --> > "y" =: 4 --> > "z" =: 2 --> > "x"!() ->- \(Just x) -> > "y"!() ->- \(Just y) -> > "z"!() ->- \(Just z) -> > ergebnis ((x+y)*z) > in anws [] > run (Z stm) = stm [] > ex6 = > "x" =: 17 --> > "y" =: 4 --> > "z" =: 2 --> > "x"!() ->- \(Just x) -> > "y"!() ->- \(Just y) -> > "z"!() ->- \(Just z) -> > ergebnis ((x+y)*z) > instance Monad (Anweisung st) where > (>>) = undDann > (>>=) = undMit > return = ergebnis > instance Functor (Anweisung st) where > fmap f (Z st) = Z (\s -> let (s1,r1) = st s in (s1,f r1)) > instance Applicative (Anweisung st) where > pure = ergebnis > (Z gf) <*> (Z ga) > = Z (\s -> let (s1,f) = gf s > (s2,a) = ga s1 > in (s2,f a)) > ex7 = > "x" =: 17 >> > "y" =: 4 >> > "z" =: 2 >> > "x"!() >>= \(Just x)-> > "y"!() >>= \(Just y)-> > "z"!() >>= \(Just z)-> > return ((x+y)*z) > ex8 = do > "x" =: 17 > "y" =: 4 > "z" =: 2 > mx <- "x"!() > let (Just x) = mx > my <- "y"!() > let (Just y) = my > mz <- "z"!() > let (Just z) = mz > return ((x+y)*z) > eval1 env = do > x <- lookup "x" env > y <- lookup "y" env > z <- lookup "z" env > return ((x+y)*z) > bsp1 = 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) > ex9 = do > "x" =: 17 > "y" =: 4 > "z" =: 2 > mx <- "x"!() > my <- "y"!() > mz <- "z"!() > return $do > x<-mx > y<-my > z<-mz > return ((x+y)*z) > ex10 :: MaybeT (Anweisung [(String,Integer)]) Integer > ex10 = do > MaybeT$fmap Just ("x" =: 17) > MaybeT$fmap Just ("y" =: 4) > MaybeT$fmap Just ("z" =: 2) > xm <- MaybeT ("x"!()) > ym <- MaybeT ("y"!()) > zm <- MaybeT ("z"!()) > return ((xm+ym)*zm) > ex11 :: MaybeT (Anweisung [(String,Integer)]) Integer > ex11 = do > lift ("x" =: 17) > lift ("y" =: 4) > lift ("z" =: 2) > xm <- MaybeT ("x"!()) > ym <- MaybeT ("y"!()) > zm <- MaybeT ("z"!()) > return ((xm+ym)*zm) > bsp2 = do > print "geben sie eine Zahl ein" > i <- (readLn::IO Integer) > print "das Quadrat ist" > print (i*i) > xs <- readFile "Zustand.lhs" > writeFile "newZust.hs" xs > bsp3 = do > x <- [1,2,3,4] > y <- [5,6,7] > return (x,y) > bsp4 = do > x <- [1,2,3,4] > y <- [5,6,7] > guard (x`mod`2==0) > return (x,y) > data Imperator = > Lese String > |Drucke Imperator > |Zuweisung String Imperator > |Literal Integer > |Var String > |Arith Imperator (Integer->Integer->Integer) Imperator > |While Imperator Imperator > |Sequenz [Imperator] > factorial = Sequenz > [Lese "x" > ,Zuweisung "r" (Literal 1) > ,While > (Var "x") > (Sequenz > [Zuweisung "r" (Arith (Var "r")(*)(Var "x")) > ,Zuweisung "x" (Arith (Var "x")(-)(Literal 1)) > ] > ) > ,Drucke (Var "r") > ] > newtype AnweisungT st m r > = AnweisungT {runAnweisungT::(st -> m (st, r))} > instance Monad m => Functor (AnweisungT st m) where > fmap f (AnweisungT anw) = AnweisungT (\x-> fmap (\(s',a)->(s', f a)) (anw x)) > instance Monad m => Monad (AnweisungT st m) where > return a = AnweisungT (\st -> return (st,a)) > (AnweisungT anw1) >>= k = AnweisungT $ \ s -> do > ~(s',a) <- anw1 s > let (AnweisungT anw2) = (k a) > anw2 s' > instance (Functor m, Monad m) => Applicative (AnweisungT st m) where > pure a = AnweisungT $ \ s -> return (s, a) > > AnweisungT mf <*> AnweisungT mx = AnweisungT $ \ s -> do > ~(s', f) <- mf s > ~(s'', x) <- mx s' > return (s'', f x) > m *> k = m >>= \_ -> k > instance MonadTrans (AnweisungT st) where > lift m = AnweisungT $ \ st -> do > a <- m > return (st, a) > instance (MonadIO m) => MonadIO (AnweisungT st m) where > liftIO io = lift (liftIO io) > liftAnweisung (Z f) = AnweisungT (\st -> return (f st)) > execute :: Imperator > -> MaybeT (AnweisungT [(String, Integer)] IO) Integer > execute (Literal n) = return 0 -- ToDo > execute (Var v) = do > return 0 -- ToDo > execute (Drucke imp) = do > return 0 -- ToDo > execute (Zuweisung v imp) = do > return 0 -- ToDo > execute (Lese v) = do > return 0 -- ToDo > execute (Arith l op r) = do > return 0 -- ToDo > execute w@(While cond body) = do > return 0 -- ToDo > execute (Sequenz [i]) = return 0 -- ToDo > execute (Sequenz (i:is)) = do > return 0 -- ToDo > execute (Sequenz []) = return 0
lhs