Commit 1ff078e3 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-08-22 12:21:15 by simonmar]

Add cpranal tests.
parent ee157e65
module Cpr001
(intpInstr) where
import Cpr001_imp
-- -------------------------------------------------------------------
intpInstr :: Instr -> MST ()
intpInstr (SysCall "exit")
= setMTerminated
intpInstr (SysCall call)
= setMSvc call
-- -------------------------------------------------------------------
-- $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)
TOP=../../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
include ($confdir ++ "/../vanilla-test.T")
-- Args to vtc are: extra compile flags
test "Cpr001_imp" { vtc("-O") }
test "Cpr001" { vtc("-O") }
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment