ghc/tests/cpranal/should_compile/Cpr001_imp.hs

   1 -- $Id: Cpr001_imp.hs,v 1.1 2001/03/28 05:07:34 kglynn Exp $
   2
   3 module Cpr001_imp where
   4
   5 data MS         = MS { instr    :: String
   6                      , pc       :: Int
   7                      , mem      :: String
   8                      , stack    :: String
   9                      , frames   :: [String]
  10                      , status   :: Maybe String
  11                      }
  12
  13
  14 newtype StateTrans s a = ST ( s -> (s, Maybe a))
  15
  16 -- state monad with error handling
  17 -- in case of an error, the state remains
  18 -- as it is and Nothing is returned as value
  19 -- else execution continues
  20
  21 instance Monad (StateTrans s) where
  22     (ST p) >>= k
  23         = ST (\s0 -> let
  24                      (s1, r0)   = p s0
  25                      in
  26                      case r0 of
  27                      Just v -> let
  28                                (ST q) = k v
  29                                in
  30                                q s1
  31                      Nothing -> (s1, Nothing)
  32              )
  33     return v
  34         = ST (\s -> (s, Just v))
  35
  36
  37 -- machine state transitions
  38
  39 type MachineStateTrans  = StateTrans MS
  40
  41 type MST = MachineStateTrans
  42
  43 {-# NOINLINE setMTerminated #-}
  44 setMTerminated
  45     = ST (\ms -> (ms { status = Just "Terminated" }, Just ()))
  46
  47 setMSvc call
  48     = ST (\ms -> (ms { status = Just "Service" }, Just ()))
  49
  50 -- -------------------------------------------------------------------
  51
  52 data Instr
  53     = LoadI             Int             -- load int const
  54     | SysCall           String          -- system call (svc)
  55