diff --git a/checks/ArrayUsageCheck.hs b/checks/ArrayUsageCheck.hs index c00412b..9f4b721 100644 --- a/checks/ArrayUsageCheck.hs +++ b/checks/ArrayUsageCheck.hs @@ -39,7 +39,7 @@ import Utils -- | A check-pass that checks the given ParItems (usually generated from a control-flow graph) -- for any overlapping array indices. -checkArrayUsage :: forall m. (Die m, CSM m, MonadIO m) => (Meta, ParItems UsageLabel) -> m () +checkArrayUsage :: forall m. (Die m, CSMR m, MonadIO m) => (Meta, ParItems UsageLabel) -> m () checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $ groupArrayIndexes $ transformParItems nodeVars p where diff --git a/checks/Check.hs b/checks/Check.hs index 932b575..d0c18db 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -44,7 +44,7 @@ import UsageCheckAlgorithms import UsageCheckUtils import Utils -usageCheckPass :: Pass +usageCheckPass :: PassR usageCheckPass t = do g' <- buildFlowGraph labelFunctions t (g, roots) <- case g' of Left err -> dieP (findMeta t) err @@ -76,7 +76,7 @@ permuteHelper func (x:xs) = permuteHelper' func [] x xs permuteHelper' func prev cur [] = [func cur prev] permuteHelper' func prev cur (next:rest) = (func cur (prev ++ (next:rest))) : (permuteHelper' func (prev ++ [cur]) next rest) -checkPlainVarUsage :: forall m. (Die m, CSM m) => (Meta, ParItems UsageLabel) -> m () +checkPlainVarUsage :: forall m. (Die m, CSMR m) => (Meta, ParItems UsageLabel) -> m () checkPlainVarUsage (m, p) = check p where getVars :: ParItems UsageLabel -> Vars @@ -136,14 +136,14 @@ difference _ Everything = NormalSet Set.empty difference Everything _ = Everything difference (NormalSet a) (NormalSet b) = NormalSet $ Set.difference a b -showCodeExSet :: (CSM m, Ord a, ShowOccam a, ShowRain a) => ExSet a -> m String +showCodeExSet :: (CSMR m, Ord a, ShowOccam a, ShowRain a) => ExSet a -> m String showCodeExSet Everything = return "" showCodeExSet (NormalSet s) = do ss <- mapM showCode (Set.toList s) return $ "{" ++ concat (intersperse ", " ss) ++ "}" -- | Checks that no variable is used uninitialised. That is, it checks that every variable is written to before it is read. -checkInitVar :: forall m. (Monad m, Die m, CSM m) => Meta -> FlowGraph m UsageLabel -> Node -> m () +checkInitVar :: forall m. (Monad m, Die m, CSMR m) => Meta -> FlowGraph m UsageLabel -> Node -> m () checkInitVar m graph startNode = do startLabel <- checkJust (Just m, "Could not find starting node in the control-flow graph") (lab graph startNode) >>* writeNode @@ -196,7 +196,7 @@ checkInitVar m graph startNode do vars <- showCodeExSet $ filterPlain' v `difference` filterPlain' vs dieP (getMeta n) $ "Variable(s) read from are not written to before-hand: " ++ vars -checkParAssignUsage :: forall m t. (CSM m, Die m, MonadIO m, Data t) => t -> m () +checkParAssignUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t) => t -> m () checkParAssignUsage = mapM_ checkParAssign . listify isParAssign where isParAssign :: A.Process -> Bool @@ -214,7 +214,7 @@ checkParAssignUsage = mapM_ checkParAssign . listify isParAssign mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing $ processVarW v] | v <- vs] -checkProcCallArgsUsage :: forall m t. (CSM m, Die m, MonadIO m, Data t) => t -> m () +checkProcCallArgsUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t) => t -> m () checkProcCallArgsUsage = mapM_ checkArgs . listify isProcCall where isProcCall :: A.Process -> Bool diff --git a/common/Pass.hs b/common/Pass.hs index 745c547..3191385 100644 --- a/common/Pass.hs +++ b/common/Pass.hs @@ -52,10 +52,12 @@ instance Warn PassMR where -- | The type of an AST-mangling pass. type Pass = A.AST -> PassM A.AST +type PassR = A.AST -> PassMR A.AST -runPassR :: PassMR a -> PassM a -runPassR p = do st <- get - (r,w) <- liftIO $ runWriterT $ runReaderT (runErrorT p) st +runPassR :: PassR -> Pass +runPassR p t + = do st <- get + (r,w) <- liftIO $ runWriterT $ runReaderT (runErrorT (p t)) st case r of Left err -> throwError err Right result -> tell w >> return result diff --git a/common/PassList.hs b/common/PassList.hs index 57e2a9a..b857c11 100644 --- a/common/PassList.hs +++ b/common/PassList.hs @@ -36,7 +36,7 @@ commonPasses opts = [ ("Simplify types", simplifyTypes) , ("Simplify expressions", simplifyExprs) ] - ++ (if csUsageChecking opts then [("Usage checks", usageCheckPass)] else []) ++ + ++ (if csUsageChecking opts then [("Usage checks", runPassR usageCheckPass)] else []) ++ [ ("Simplify processes", simplifyProcs) , ("Flatten nested declarations", unnest)