Changed all the usage check passes to use CSMR, and thus changed usageCheckPass to be a PassR rather than Pass
This commit is contained in:
parent
cc29010103
commit
64d7b35cfe
|
@ -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
|
||||
|
|
|
@ -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 "<all-vars>"
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user