summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/cpranal/should_compile/Cpr001_imp.hs
blob: 5b2586127bc8f0e7e5501f407fec8548ea7a3669 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
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)