suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Split out a chunk of CompState into a CompOpts type for things that can be set on the command-line

Browse Source
This commit is contained in:
Neil Brown 2009-04-17 21:10:14 +00:00
parent af3be945a4
commit 57ffc7bfa4
15 changed files with 106 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
Main.hs
View File

@ -58,7 +58,7 @@ import ShowCode
import Utils
-- Either gives back options, or an exact string to print out:
type OptFunc = CompState -> ErrorT String IO CompState
type OptFunc = CompOpts -> ErrorT String IO CompOpts
printString :: String -> ErrorT String IO a
printString = throwError
@ -188,7 +188,7 @@ optPrintHelp _ = printString $ usageInfo "Usage: tock [OPTION...] SOURCEFILE" op
optPrintWarningHelp :: OptFunc
optPrintWarningHelp _ = printString $ usageInfo "Usage: tock [OPTION...] SOURCEFILE" optionsWarnings
optOnOff :: (String, Bool -> CompState -> CompState) -> String -> OptFunc
optOnOff :: (String, Bool -> CompOpts -> CompOpts) -> String -> OptFunc
optOnOff (n, f) s ps
= do mode <- case s of
"on" -> return True
@ -240,7 +240,7 @@ main = do
Just $ take (length fn - length ".rain") fn)
else (id, Nothing)
res <- runErrorT $ foldl (>>=) (return $ frontendGuess emptyState) opts
res <- runErrorT $ foldl (>>=) (return $ frontendGuess emptyOpts) opts
case res of
Left str -> putStrLn str
Right initState -> do
@ -250,7 +250,7 @@ main = do
mode -> useOutputOptions (compile mode fn)
-- Run the compiler.
v <- runPassM initState operation
v <- runPassM (emptyState { csOpts = initState}) operation
case v of
(Left e, cs) -> showWarnings (csWarnings cs) >> dieIO e
(Right r, cs) -> showWarnings (csWarnings cs)
@ -279,14 +279,14 @@ instance Die FilesPassM where
-- If removing the files fails, we don't want to die with that
-- error; we want the user to see the original error, so ignore
-- errors arising from removing the files:
optsPS <- getCompState
optsPS <- getCompOpts
when (not $ csKeepTemporaries optsPS) $
liftIO $ removeFiles files
FilesPassM $ dieReport err
compileFull :: String -> Maybe String -> FilesPassM ()
compileFull inputFile moutputFile
= do optsPS <- getCompState
= do optsPS <- getCompOpts
outputFile <- case (csOutputFile optsPS, moutputFile) of
-- If the user hasn't given an output file, we guess by
-- using a stem (input file minus known extension).
@ -307,7 +307,7 @@ compileFull inputFile moutputFile
let cFile = outputFile ++ cExtension
hFile = outputFile ++ hExtension
iFile = outputFile ++ ".tock.inc"
modifyCompState $ \cs -> cs { csOutputIncFile = Just iFile }
modifyCompOpts $ \cs -> cs { csOutputIncFile = Just iFile }
withOutputFile cFile $ \hb ->
withOutputFile hFile $ \hh ->
FilesPassM $ lift $ compile ModeCompile inputFile ((hb, hh), hFile)
@ -316,7 +316,7 @@ compileFull inputFile moutputFile
exec $ "indent " ++ cFile
cs <- getCompState
case csBackend cs of
case csBackend (csOpts cs) of
BackendC ->
let sFile = outputFile ++ ".tock.s"
oFile = outputFile ++ ".tock.o"
@ -325,52 +325,55 @@ compileFull inputFile moutputFile
postOFile = outputFile ++ ".tock_post.o"
in
do sequence_ $ map noteFile $ [sFile, postCFile, postOFile]
++ if csHasMain cs then [oFile] else []
++ if csHasMain (csOpts cs) then [oFile] else []
-- The object file is a temporary to-be-removed
-- iff we are also linking the end product
-- Compile the C into assembly, and assembly into an object file
exec $ cAsmCommand cFile sFile (csCompilerFlags cs)
exec $ cCommand sFile oFile (csCompilerFlags cs)
exec $ cAsmCommand cFile sFile (csCompilerFlags $ csOpts cs)
exec $ cCommand sFile oFile (csCompilerFlags $ csOpts cs)
-- Analyse the assembly for stack sizes, and output a
-- "post" H file
sizes <- withOutputFile sizesFile $ \h -> FilesPassM $ lift $
postCAnalyse sFile ((h,intErr),intErr)
when (csHasMain cs) $ do
when (csHasMain $ csOpts cs) $ do
withOutputFile postCFile $ \h ->
computeFinalStackSizes searchReadFile (csUnknownStackSize cs)
computeFinalStackSizes searchReadFile (csUnknownStackSize $ csOpts cs)
(Meta (Just sizesFile) 1 1) sizes >>= (liftIO . hPutStr h)
-- Compile this new "post" C file into an object file
exec $ cCommand postCFile postOFile (csCompilerFlags cs)
exec $ cCommand postCFile postOFile (csCompilerFlags $ csOpts cs)
let otherOFiles = [usedFile ++ ".tock.o"
| usedFile <- Set.toList $ csUsedFiles cs]
-- Link the object files into a binary
exec $ cLinkCommand (oFile : postOFile : otherOFiles) outputFile (csCompilerLinkFlags cs)
exec $ cLinkCommand (oFile : postOFile : otherOFiles) outputFile
(csCompilerLinkFlags $ csOpts cs)
-- For C++, just compile the source file directly into a binary
BackendCPPCSP ->
do cs <- getCompState
if csHasMain cs
if csHasMain $ csOpts cs
then let otherOFiles = [usedFile ++ ".tock.o"
| usedFile <- Set.toList $ csUsedFiles cs]
in exec $ cxxCommand cFile outputFile
(concat (intersperse " " otherOFiles) ++ " " ++ csCompilerFlags cs ++ " " ++ csCompilerLinkFlags cs)
(concat (intersperse " " otherOFiles) ++ " "
++ csCompilerFlags (csOpts cs) ++ " "
++ csCompilerLinkFlags (csOpts cs))
else exec $ cxxCommand cFile (outputFile ++ ".tock.o")
("-c " ++ csCompilerFlags cs)
("-c " ++ csCompilerFlags (csOpts cs))
BackendCHP ->
exec $ hCommand cFile outputFile
_ -> dieReport (Nothing, "Cannot use specified backend: "
++ show (csBackend cs)
++ show (csBackend $ csOpts cs)
++ " with full-compile mode")
-- Finally, remove the temporary files:
tempFiles <- FilesPassM get
when (not $ csKeepTemporaries cs) $
when (not $ csKeepTemporaries $ csOpts cs) $
liftIO $ removeFiles tempFiles
where
@ -404,7 +407,7 @@ compileFull inputFile moutputFile
-- | Picks out the handle from the options and passes it to the function:
useOutputOptions :: (((Handle, Handle), String) -> PassM a) -> PassM a
useOutputOptions func
= do optsPS <- get
= do optsPS <- getCompOpts
withHandleFor (csOutputFile optsPS) $ \hb ->
withHandleFor (csOutputHeaderFile optsPS) $ \hh ->
func ((hb, hh), csOutputHeaderFile optsPS)
@ -459,7 +462,7 @@ showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0
-- because then it's very easy to pass the state around.
compile :: CompMode -> String -> ((Handle, Handle), String) -> PassM ()
compile mode fn (outHandles@(outHandle, _), headerName)
= do optsPS <- get
= do optsPS <- getCompOpts
debug "{{{ Parse"
progress "Parse"

4
backends/GenerateC.hs
View File

@ -203,7 +203,7 @@ cgenTopLevel headerName s
sequence_ [tell ["extern int "] >> genName n >> tell ["_stack_size;\n"]
| n <- nss]
when (csHasMain cs) $ do
when (csHasMain $ csOpts cs) $ do
(tlpName, tlpChans) <- tlpInterface
tell ["extern int "]
genName tlpName
@ -215,7 +215,7 @@ cgenTopLevel headerName s
call genStructured TopLevel s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
when (csHasMain cs) $ do
when (csHasMain $ csOpts cs) $ do
(tlpName, tlpChans) <- tlpInterface
chans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel" | _ <- tlpChans]
killChans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel_kill" | _ <- tlpChans]

8
backends/GenerateCPPCSP.hs
View File

@ -100,7 +100,7 @@ chansToAny :: PassOn A.Type
chansToAny = cppOnlyPass "Transform channels to ANY"
[Prop.processTypesChecked]
[Prop.allChansToAnyOrProtocol]
$ \x -> do st <- get
$ \x -> do st <- getCompOpts
case csFrontend st of
FrontendOccam ->
do chansToAnyInCompState
@ -118,7 +118,7 @@ chansToAny = cppOnlyPass "Transform channels to ANY"
chansToAnyM = applyBottomUpM chansToAny'
chansToAnyInCompState :: PassM ()
chansToAnyInCompState = do st <- get
chansToAnyInCompState = do st <- getCompState
csn <- chansToAnyM (csNames st)
put $ st {csNames = csn}
return ()
@ -160,12 +160,12 @@ cppgenTopLevel headerName s
call genStructured TopLevel s (\m _ -> tell ["\n#error Invalid top-level item: ",show m])
when (csHasMain cs) $ do
when (csHasMain $ csOpts cs) $ do
(name, chans) <- tlpInterface
tell ["int main (int argc, char** argv) { csp::Start_CPPCSP();"]
(chanTypeRead, chanTypeWrite, writer, reader) <-
do st <- getCompState
case csFrontend st of
case csFrontend $ csOpts st of
FrontendOccam -> return ("tockSendableArrayOfBytes",
"tockSendableArrayOfBytes",
"StreamWriterByteArray",

2
common/OccamEDSL.hs
View File

@ -396,7 +396,7 @@ testOccamPassWarn str check code pass
(put $ inpS {csWarnings = []}) -- Blank the warnings for the new pass
(assertEqual str (csNames expS) . csNames)
where
emptyStateWithWarnings = emptyState { csEnabledWarnings = Set.fromList [minBound..maxBound] }
emptyStateWithWarnings = emptyState { csOpts = emptyOpts {csEnabledWarnings = Set.fromList [minBound..maxBound]} }
-- | Like testOccamPass, but applies a transformation to the patterns (such as
-- using stopCaringPattern) before pattern-matching

2
common/ShowCode.hs
View File

@ -179,7 +179,7 @@ instance ShowRain () where
showCode :: (CSMR m, ShowOccam a, ShowRain a) => a -> m String
showCode o
= do st <- getCompState
case csFrontend st of
case csFrontend $ csOpts st of
FrontendOccam -> return $ concat $ snd $ runWriter $ evalStateT (showOccamM o)
(initialShowCodeState $ transformNames $ csNames st)
FrontendRain -> return $ concat $ snd $ runWriter $ evalStateT (showRainM o)

9
common/TestHarness.hs
View File

@ -70,8 +70,11 @@ data AutoTest = AutoTest
automaticTest :: CompFrontend -> Int -> FilePath -> IO Test
automaticTest fr verb fileName = readFile fileName >>* performTest fr verb fileName
defaultOpts :: CompFrontend -> Int -> CompOpts
defaultOpts fr v = emptyOpts {csVerboseLevel = v, csFrontend = fr}
defaultState :: CompFrontend -> Int -> CompState
defaultState fr v = emptyState {csVerboseLevel = v, csFrontend = fr}
defaultState fr v = emptyState { csOpts = defaultOpts fr v }
-- | Tests if compiling the given source gives any errors.
-- If there are errors, they are returned. Upon success, Nothing is returned
@ -83,7 +86,7 @@ testOccam v source = do (result,_) <- runPassM (defaultState FrontendOccam v) co
where
compilation = preprocessOccamSource source
>>= parseOccamProgram
>>= runPasses (getPassList $ defaultState FrontendOccam v)
>>= runPasses (getPassList $ defaultOpts FrontendOccam v)
testRain :: Int -> String -> IO (Maybe (Maybe Meta, String))
testRain v source = do (result,_) <- runPassM (defaultState FrontendRain v) compilation
@ -92,7 +95,7 @@ testRain v source = do (result,_) <- runPassM (defaultState FrontendRain v) comp
Right _ -> Nothing
where
compilation = parseRainProgram "<test>" source
>>= runPasses (getPassList $ defaultState FrontendRain v)
>>= runPasses (getPassList $ defaultOpts FrontendRain v)
-- | Substitutes each substitution into the prologue
substitute :: AutoTest -> Either String [(Bool, String, String)]

2
common/TestUtils.hs
View File

@ -630,7 +630,7 @@ testPassShouldFail' testName actualPass startStateTrans =
--{{{ miscellaneous utilities
markRainTest :: State CompState ()
markRainTest = modify (\cs -> cs { csFrontend = FrontendRain })
markRainTest = modifyCompOpts (\cs -> cs { csFrontend = FrontendRain })
castOrFail :: (Typeable b) => String -> String -> Items -> IO b
castOrFail testName key items =

4
common/Types.hs
View File

@ -330,7 +330,7 @@ returnTypesOfFunction n
returnTypesOfIntrinsic :: (CSMR m, Die m) => Meta -> String -> m [A.Type]
returnTypesOfIntrinsic m s
= do frontend <- getCompState >>* csFrontend
= do frontend <- getCompOpts >>* csFrontend
let intrinsicList = case frontend of
FrontendOccam -> intrinsicFunctions
FrontendRain -> rainIntrinsicFunctions
@ -623,7 +623,7 @@ justSize n = return $ BIJust $ makeConstant emptyMeta n
-- backend. If the backend is not recognised, the C sizes are used.
justSizeBackends :: CSMR m => Int -> Int -> m BytesInResult
justSizeBackends c cxx
= do backend <- getCompState >>* csBackend
= do backend <- getCompOpts >>* csBackend
case backend of
BackendCPPCSP -> justSize c
_ -> justSize cxx

58
data/CompState.hs
View File

@ -97,14 +97,13 @@ data NameAttr = NameShared | NameAliasesPermitted deriving (Typeable, Data, Eq,
data ExternalType = ExternalOldStyle | ExternalOccam
deriving (Typeable, Data, Eq, Show, Ord)
-- | State necessary for compilation.
data CompState = CompState {
-- This structure needs to be printable with pshow.
-- There are explicit rules for the Maps and Sets used here
-- in PrettyShow.hs; if you add any new ones here then remember
-- to add matching rules there.
-- Set by Main (from command-line options)
-- | Options for the compiler.
--
-- CompOpts should contain things are adjustable from the command-line. They may
-- also change during compilation; for example, the preprocessor definitions will
-- be affected by the preprocessor, and other options may be affected by pragmas
-- in future.
data CompOpts = CompOpts {
csMode :: CompMode,
csBackend :: CompBackend,
csFrontend :: CompFrontend,
@ -124,6 +123,21 @@ data CompState = CompState {
csUnknownStackSize :: Integer,
csSearchPath :: [String],
csImplicitModules :: [String],
csDefinitions :: Map String PreprocDef
}
deriving (Data, Typeable, Show)
-- | State necessary for compilation.
data CompState = CompState {
-- This structure needs to be printable with pshow.
-- There are explicit rules for the Maps and Sets used here
-- in PrettyShow.hs; if you add any new ones here then remember
-- to add matching rules there.
-- Set by Main (from command-line options)
csOpts :: CompOpts,
-- Extra sizes files to look up. These are stored without the tock suffix
csExtraSizes :: [String],
-- Extra include files, stored without the .tock.h suffix.
@ -133,7 +147,6 @@ data CompState = CompState {
csCurrentFile :: String, -- Also used by some later passes!
-- #USEd files. These are stored with any (known) extensions removed:
csUsedFiles :: Set String,
csDefinitions :: Map String PreprocDef,
-- Set by Parse
csMainLocals :: [(String, (A.Name, NameType))],
@ -159,8 +172,8 @@ data CompState = CompState {
}
deriving (Data, Typeable, Show)
emptyState :: CompState
emptyState = CompState {
emptyOpts :: CompOpts
emptyOpts = CompOpts {
csMode = ModeFull,
csBackend = BackendC,
csFrontend = FrontendOccam,
@ -185,16 +198,22 @@ emptyState = CompState {
csUnknownStackSize = 512,
csSearchPath = [".", tockIncludeDir],
csImplicitModules = [],
csDefinitions = Map.fromList [("COMPILER.TOCK", PreprocNothing)
,("TARGET.BITS.PER.WORD", PreprocInt $ show $ cIntSize * 8)
,("TARGET.BYTES.PER.WORD", PreprocInt $ show cIntSize)
-- ,("TARGET.HAS.FPU", PreprocNothing)
]
}
emptyState :: CompState
emptyState = CompState {
csOpts = emptyOpts,
csExtraSizes = [],
csExtraIncludes = [],
csCurrentFile = "none",
csUsedFiles = Set.empty,
csDefinitions = Map.fromList [("COMPILER.TOCK", PreprocNothing)
,("TARGET.BITS.PER.WORD", PreprocInt $ show $ cIntSize * 8)
,("TARGET.BYTES.PER.WORD", PreprocInt $ show cIntSize)
-- ,("TARGET.HAS.FPU", PreprocNothing)
],
csMainLocals = [],
csNames = Map.empty,
@ -229,6 +248,9 @@ class (Monad m, CSMR m) => CSM m where
modifyCompState :: (CompState -> CompState) -> m ()
modifyCompState f = (getCompState >>* f) >>= putCompState
modifyCompOpts :: CSM m => (CompOpts -> CompOpts) -> m ()
modifyCompOpts f = modifyCompState $ \cs -> cs { csOpts = f (csOpts cs) }
-- If it's State CompState, I doubt they will want any other instance than this
-- one:
instance CSM (State CompState) where
@ -268,6 +290,8 @@ instance (CSMR m, Error e) => CSMR (ErrorT e m) where
instance (CSMR m, Monoid w) => CSMR (WriterT w m) where
getCompState = lift getCompState
getCompOpts :: CSMR m => m CompOpts
getCompOpts = getCompState >>* csOpts
--instance (MonadWriter [WarningReport] m) => Warn m where
-- warnReport r = tell [r]
@ -475,7 +499,7 @@ searchFile m filename
= do cs <- getCompState
let currentFile = csCurrentFile cs
let possibilities = joinPath currentFile filename
: [dir ++ "/" ++ filename | dir <- csSearchPath cs]
: [dir ++ "/" ++ filename | dir <- (csSearchPath . csOpts) cs]
openOneOf possibilities possibilities
where
openOneOf :: [String] -> [String] -> m (Handle, String)

2
frontends/OccamPasses.hs
View File

@ -61,7 +61,7 @@ occamPasses =
writeIncFile :: Pass A.AST
writeIncFile = occamOnlyPass "Write .inc file" [] []
(passOnlyOnAST "writeIncFile" (\t ->
do out <- getCompState >>* csOutputIncFile
do out <- getCompOpts >>* csOutputIncFile
case out of
Just fn -> do f <- liftIO $ openFile fn WriteMode
contents <- emitProcsAsExternal t >>* (unlines . F.toList)

4
frontends/ParseOccam.hs
View File

@ -65,7 +65,7 @@ addLocalName n = do st <- getState
instance Warn (GenParser tok OccParserState) where
warnReport w@(_,t,_) = modifyCompState $
\cs -> cs { csWarnings =
if t `Set.member` csEnabledWarnings cs
if t `Set.member` csEnabledWarnings (csOpts cs)
then csWarnings cs ++ [w]
else csWarnings cs }
@ -1536,7 +1536,7 @@ pragma = do m <- getPosition >>* sourcePosToMeta
modifyCompState $ \cs -> cs { csExtraIncludes = (f' ++ pragStr) : csExtraIncludes cs }
return Nothing
handleNativeLink m [pragStr]
= do modifyCompState $ \cs -> cs { csCompilerLinkFlags = csCompilerLinkFlags cs ++ " " ++ pragStr}
= do modifyCompOpts $ \cs -> cs { csCompilerLinkFlags = csCompilerLinkFlags cs ++ " " ++ pragStr}
return Nothing
handleExternal isCExternal m

20
frontends/PreprocessOccam.hs
View File

@ -51,11 +51,11 @@ preprocessFile m implicitMods filename
then Set.insert (dropTockInc realFilename)
. Set.delete (dropTockInc filename)
else id
modify (\cs -> cs { csCurrentFile = realFilename
, csUsedFiles = modFunc $ csUsedFiles cs })
modifyCompState (\cs -> cs { csCurrentFile = realFilename
, csUsedFiles = modFunc $ csUsedFiles cs })
s <- liftIO $ hGetContents handle
toks <- preprocessSource m implicitMods realFilename s
modify (\cs -> cs { csCurrentFile = csCurrentFile origCS })
modifyCompState (\cs -> cs { csCurrentFile = csCurrentFile origCS })
return toks
where
-- drops ".tock.inc" from the end if it's there:
@ -146,7 +146,7 @@ preprocessOccam (Token m (TokPreprocessor s) : ts)
stripPrefix _ = error "bad TokPreprocessor prefix"
preprocessOccam (Token _ (TokReserved "##") : Token m (TokIdentifier var) : ts)
= do st <- get
case Map.lookup var (csDefinitions st) of
case Map.lookup var (csDefinitions $ csOpts st) of
Just (PreprocInt num) -> toToken $ TokIntLiteral num
Just (PreprocString str) -> toToken $ TokStringLiteral str
Just (PreprocNothing) -> dieP m $ var ++ " is defined, but has no value"
@ -243,16 +243,16 @@ handleUse m (modName:_)
handleDefine :: DirectiveFunc
handleDefine m [definition]
= do (var, value) <- runPreprocParser m defineDirective definition
st <- get
st <- getCompState >>* csOpts
when (Map.member var $ csDefinitions st) $
dieP m $ "Preprocessor symbol is already defined: " ++ var
put $ st { csDefinitions = Map.insert var value $ csDefinitions st }
modifyCompOpts $ \st -> st { csDefinitions = Map.insert var value $ csDefinitions st }
return return
-- | Handle the @#UNDEF@ directive.
handleUndef :: DirectiveFunc
handleUndef m [var]
= do modify $ \st -> st { csDefinitions = Map.delete var $ csDefinitions st }
= do modifyCompOpts $ \st -> st { csDefinitions = Map.delete var $ csDefinitions st }
return return
-- | Handle the @#IF@ directive.
@ -408,7 +408,7 @@ expression
-- | Match a 'PreprocParser' production.
runPreprocParser :: Meta -> PreprocParser a -> String -> PassM a
runPreprocParser m prod s
= do st <- get
= do st <- getCompState >>* csOpts
case runParser wrappedProd (csDefinitions st) (show m) s of
Left err -> dieP m $ "Error parsing preprocessor instruction: " ++ show err
Right b -> return b
@ -423,10 +423,10 @@ runPreprocParser m prod s
-- | Load and preprocess an occam program.
preprocessOccamProgram :: String -> PassM [Token]
preprocessOccamProgram filename
= do mods <- getCompState >>* csImplicitModules
= do mods <- getCompState >>* (csImplicitModules . csOpts)
toks <- preprocessFile emptyMeta mods filename
-- Leave the main file name in the csCurrentFile slot:
modify $ \cs -> cs { csCurrentFile = filename }
modifyCompState $ \cs -> cs { csCurrentFile = filename }
veryDebug $ "{{{ tokenised source"
veryDebug $ pshow toks
veryDebug $ "}}}"

10
pass/Pass.hs
View File

@ -46,7 +46,7 @@ instance Die PassM where
instance Warn PassM where
warnReport w@(_,t,_) = lift $ modify $
\cs -> cs { csWarnings =
if t `Set.member` csEnabledWarnings cs
if t `Set.member` csEnabledWarnings (csOpts cs)
then csWarnings cs ++ [w]
else csWarnings cs }
@ -102,7 +102,7 @@ data Pass t = Pass {
, passName :: String
, passPre :: Set.Set Property
, passPost :: Set.Set Property
, passEnabled :: CompState -> Bool
, passEnabled :: CompOpts -> Bool
}
instance Eq (Pass t) where
@ -130,7 +130,7 @@ runPassM :: CompState -> PassM a -> IO (Either ErrorReport a, CompState)
runPassM cs pass
= flip runStateT cs $ runErrorT pass
enablePassesWhen :: (CompState -> Bool) -> [Pass A.AST] -> [Pass A.AST]
enablePassesWhen :: (CompOpts -> Bool) -> [Pass A.AST] -> [Pass A.AST]
enablePassesWhen f
= map (\p -> p { passEnabled = \c -> f c && (passEnabled p c) })
@ -140,7 +140,7 @@ passOnlyOnAST name = id
type PassMaker t = String -> [Property] -> [Property] -> PassType t -> Pass t
passMakerHelper :: (CompState -> Bool) -> PassMaker t
passMakerHelper :: (CompOpts -> Bool) -> PassMaker t
passMakerHelper f name pre post code
= Pass { passCode = code
, passName = name
@ -186,7 +186,7 @@ runPasses (p:ps) ast
verboseMessage :: (CSMR m, MonadIO m) => Int -> String -> m ()
verboseMessage n s
= do ps <- getCompState
when (csVerboseLevel ps >= n) $
when (csVerboseLevel (csOpts ps) >= n) $
liftIO $ hPutStrLn stderr s
-- | Print a progress message.

8
pass/PassList.hs
View File

@ -47,7 +47,7 @@ import SimplifyTypes
import Unnest
import Utils
commonPasses :: CompState -> [Pass A.AST]
commonPasses :: CompOpts -> [Pass A.AST]
commonPasses opts = concat $
-- Rain does simplifyTypes separately:
[ enablePassesWhen ((== FrontendOccam) . csFrontend) simplifyTypes
@ -72,7 +72,7 @@ commonPasses opts = concat $
-- (passOnlyOnAST "checkUnusedVar" (runChecks checkUnusedVar))]
]
filterPasses :: CompState -> [Pass t] -> [Pass t]
filterPasses :: CompOpts -> [Pass t] -> [Pass t]
filterPasses opts = filter (\p -> passEnabled p opts)
-- This pass is so small that we may as well just give it here:
@ -94,7 +94,7 @@ nullStateBodies = Pass
nullProcFuncDefs x = x
getPassList :: CompState -> [Pass A.AST]
getPassList :: CompOpts -> [Pass A.AST]
getPassList optsPS = checkList $ filterPasses optsPS $ concat
[ [nullStateBodies]
, enablePassesWhen ((== FrontendOccam) . csFrontend)
@ -108,7 +108,7 @@ getPassList optsPS = checkList $ filterPasses optsPS $ concat
calculatePassList :: CSMR m => m [Pass A.AST]
calculatePassList
= do optsPS <- getCompState
= do optsPS <- getCompOpts
let passes = getPassList optsPS
return $ if csSanityCheck optsPS
then addChecks passes

2
transformations/SimplifyProcs.hs
View File

@ -82,7 +82,7 @@ addForkNames = occamOnlyPass "Add FORK labels" [] []
return $ A.Spec m spec scope'
doStructured (A.Spec m (A.Specification m' n spec@(A.Proc m'' smrm fs mbody)) scope)
= do cs <- lift getCompState
if csHasMain cs && Just n == listToMaybe (map (fst . snd) (csMainLocals cs))
if csHasMain (csOpts cs) && Just n == listToMaybe (map (fst . snd) (csMainLocals cs))
then do scope' <- recurse scope
mbody' <- case mbody of
Nothing -> return Nothing