diff options
Diffstat (limited to 'testsuite/tests/cpranal/should_compile/Cpr001_imp.hs')
-rw-r--r-- | testsuite/tests/cpranal/should_compile/Cpr001_imp.hs | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs b/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs new file mode 100644 index 0000000000..5b2586127b --- /dev/null +++ b/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs @@ -0,0 +1,55 @@ +-- $Id: Cpr001_imp.hs,v 1.1 2001/08/22 12:21:15 simonmar Exp $ + +module Cpr001_imp where + +data MS = MS { instr :: String + , pc :: Int + , mem :: String + , stack :: String + , frames :: [String] + , status :: Maybe String + } + + +newtype StateTrans s a = ST ( s -> (s, Maybe a)) + +-- state monad with error handling +-- in case of an error, the state remains +-- as it is and Nothing is returned as value +-- else execution continues + +instance Monad (StateTrans s) where + (ST p) >>= k + = ST (\s0 -> let + (s1, r0) = p s0 + in + case r0 of + Just v -> let + (ST q) = k v + in + q s1 + Nothing -> (s1, Nothing) + ) + return v + = ST (\s -> (s, Just v)) + + +-- machine state transitions + +type MachineStateTrans = StateTrans MS + +type MST = MachineStateTrans + +{-# NOINLINE setMTerminated #-} +setMTerminated + = ST (\ms -> (ms { status = Just "Terminated" }, Just ())) + +setMSvc call + = ST (\ms -> (ms { status = Just "Service" }, Just ())) + +-- ------------------------------------------------------------------- + +data Instr + = LoadI Int -- load int const + | SysCall String -- system call (svc) + |