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)
|
-- | A check-pass that checks the given ParItems (usually generated from a control-flow graph)
|
||||||
-- for any overlapping array indices.
|
-- 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 $
|
checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $
|
||||||
groupArrayIndexes $ transformParItems nodeVars p
|
groupArrayIndexes $ transformParItems nodeVars p
|
||||||
where
|
where
|
||||||
|
|
|
@ -44,7 +44,7 @@ import UsageCheckAlgorithms
|
||||||
import UsageCheckUtils
|
import UsageCheckUtils
|
||||||
import Utils
|
import Utils
|
||||||
|
|
||||||
usageCheckPass :: Pass
|
usageCheckPass :: PassR
|
||||||
usageCheckPass t = do g' <- buildFlowGraph labelFunctions t
|
usageCheckPass t = do g' <- buildFlowGraph labelFunctions t
|
||||||
(g, roots) <- case g' of
|
(g, roots) <- case g' of
|
||||||
Left err -> dieP (findMeta t) err
|
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 [] = [func cur prev]
|
||||||
permuteHelper' func prev cur (next:rest) = (func cur (prev ++ (next:rest))) : (permuteHelper' func (prev ++ [cur]) next rest)
|
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
|
checkPlainVarUsage (m, p) = check p
|
||||||
where
|
where
|
||||||
getVars :: ParItems UsageLabel -> Vars
|
getVars :: ParItems UsageLabel -> Vars
|
||||||
|
@ -136,14 +136,14 @@ difference _ Everything = NormalSet Set.empty
|
||||||
difference Everything _ = Everything
|
difference Everything _ = Everything
|
||||||
difference (NormalSet a) (NormalSet b) = NormalSet $ Set.difference a b
|
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 Everything = return "<all-vars>"
|
||||||
showCodeExSet (NormalSet s)
|
showCodeExSet (NormalSet s)
|
||||||
= do ss <- mapM showCode (Set.toList s)
|
= do ss <- mapM showCode (Set.toList s)
|
||||||
return $ "{" ++ concat (intersperse ", " ss) ++ "}"
|
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.
|
-- | 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
|
checkInitVar m graph startNode
|
||||||
= do startLabel <- checkJust (Just m, "Could not find starting node in the control-flow graph")
|
= do startLabel <- checkJust (Just m, "Could not find starting node in the control-flow graph")
|
||||||
(lab graph startNode) >>* writeNode
|
(lab graph startNode) >>* writeNode
|
||||||
|
@ -196,7 +196,7 @@ checkInitVar m graph startNode
|
||||||
do vars <- showCodeExSet $ filterPlain' v `difference` filterPlain' vs
|
do vars <- showCodeExSet $ filterPlain' v `difference` filterPlain' vs
|
||||||
dieP (getMeta n) $ "Variable(s) read from are not written to before-hand: " ++ vars
|
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
|
checkParAssignUsage = mapM_ checkParAssign . listify isParAssign
|
||||||
where
|
where
|
||||||
isParAssign :: A.Process -> Bool
|
isParAssign :: A.Process -> Bool
|
||||||
|
@ -214,7 +214,7 @@ checkParAssignUsage = mapM_ checkParAssign . listify isParAssign
|
||||||
mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing $ processVarW v] | v <- vs]
|
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
|
checkProcCallArgsUsage = mapM_ checkArgs . listify isProcCall
|
||||||
where
|
where
|
||||||
isProcCall :: A.Process -> Bool
|
isProcCall :: A.Process -> Bool
|
||||||
|
|
|
@ -52,10 +52,12 @@ instance Warn PassMR where
|
||||||
|
|
||||||
-- | The type of an AST-mangling pass.
|
-- | The type of an AST-mangling pass.
|
||||||
type Pass = A.AST -> PassM A.AST
|
type Pass = A.AST -> PassM A.AST
|
||||||
|
type PassR = A.AST -> PassMR A.AST
|
||||||
|
|
||||||
runPassR :: PassMR a -> PassM a
|
runPassR :: PassR -> Pass
|
||||||
runPassR p = do st <- get
|
runPassR p t
|
||||||
(r,w) <- liftIO $ runWriterT $ runReaderT (runErrorT p) st
|
= do st <- get
|
||||||
|
(r,w) <- liftIO $ runWriterT $ runReaderT (runErrorT (p t)) st
|
||||||
case r of
|
case r of
|
||||||
Left err -> throwError err
|
Left err -> throwError err
|
||||||
Right result -> tell w >> return result
|
Right result -> tell w >> return result
|
||||||
|
|
|
@ -36,7 +36,7 @@ commonPasses opts =
|
||||||
[ ("Simplify types", simplifyTypes)
|
[ ("Simplify types", simplifyTypes)
|
||||||
, ("Simplify expressions", simplifyExprs)
|
, ("Simplify expressions", simplifyExprs)
|
||||||
]
|
]
|
||||||
++ (if csUsageChecking opts then [("Usage checks", usageCheckPass)] else []) ++
|
++ (if csUsageChecking opts then [("Usage checks", runPassR usageCheckPass)] else []) ++
|
||||||
[
|
[
|
||||||
("Simplify processes", simplifyProcs)
|
("Simplify processes", simplifyProcs)
|
||||||
, ("Flatten nested declarations", unnest)
|
, ("Flatten nested declarations", unnest)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user