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

Main.hs

@@ -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 $ cAsmCommand cFile sFile (csCompilerFlags $ csOpts cs)
-                 exec $ cCommand sFile oFile (csCompilerFlags 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"

backends/GenerateC.hs

@@ -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]

backends/GenerateCPPCSP.hs

@@ -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",

common/OccamEDSL.hs

@@ -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

common/ShowCode.hs

@@ -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)

common/TestHarness.hs

@@ -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)]

common/TestUtils.hs

@@ -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 = 

common/Types.hs

@@ -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

data/CompState.hs

@@ -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.
+-- | Options for the compiler.
-data CompState = CompState {
+--
-    -- This structure needs to be printable with pshow.
+-- CompOpts should contain things are adjustable from the command-line.  They may
-    -- There are explicit rules for the Maps and Sets used here
+-- also change during compilation; for example, the preprocessor definitions will
-    -- in PrettyShow.hs; if you add any new ones here then remember
+-- be affected by the preprocessor, and other options may be affected by pragmas
-    -- to add matching rules there.
+-- in future.
-
+data CompOpts = CompOpts {
-    -- Set by Main (from command-line options)
     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
+emptyOpts :: CompOpts
-emptyState = CompState {
+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)

frontends/OccamPasses.hs

@@ -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)

frontends/ParseOccam.hs

@@ -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

frontends/PreprocessOccam.hs

@@ -51,11 +51,11 @@ preprocessFile m implicitMods filename
                           then Set.insert (dropTockInc realFilename)
                                  . Set.delete (dropTockInc filename)
                           else id
-          modify (\cs -> cs { csCurrentFile = realFilename
+          modifyCompState (\cs -> cs { csCurrentFile = realFilename
-                            , csUsedFiles = modFunc $ csUsedFiles cs })
+                                     , 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 $ "}}}"

pass/Pass.hs

@@ -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.

pass/PassList.hs

@@ -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

transformations/SimplifyProcs.hs

@@ -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