diff --git a/checks/Check.hs b/checks/Check.hs index 9179fb9..a479558 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -257,8 +257,8 @@ checkParAssignUsage = mapM_ checkParAssign . listify isParAssign checkArrayUsage (m, fmap ((,) []) mockedupParItems) -- TODO add BK properly where mockedupParItems :: ParItems UsageLabel - mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing $ processVarW v - Nothing] | v <- vs] + mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing Nothing + $ processVarW v Nothing] | v <- vs] checkProcCallArgsUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t) => t -> m () @@ -273,7 +273,7 @@ checkProcCallArgsUsage = mapM_ checkArgs . listify isProcCall checkArgs :: A.Process -> m () checkArgs p@(A.ProcCall m _ _) = do vars <- getVarProcCall p - let mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing v] + let mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing Nothing v] | v <- vars] checkPlainVarUsage (m, mockedupParItems) checkArrayUsage (m, fmap ((,) []) mockedupParItems) diff --git a/checks/UsageCheckUtils.hs b/checks/UsageCheckUtils.hs index 998595d..7bbe469 100644 --- a/checks/UsageCheckUtils.hs +++ b/checks/UsageCheckUtils.hs @@ -70,9 +70,11 @@ data ParItems a deriving (Show) data UsageLabel = Usage - {nodeRep :: Maybe (A.Name, A.Replicator) - ,nodeDecl :: Maybe Decl - ,nodeVars :: Vars} + { nodeRep :: Maybe (A.Name, A.Replicator) + , nodeDecl :: Maybe Decl + , nodeCond :: Maybe A.Expression + , nodeVars :: Vars + } instance Show UsageLabel where show = const "" @@ -229,22 +231,24 @@ labelUsageFunctions :: forall m. (Die m, CSMR m) => GraphLabelFuncs m UsageLabel labelUsageFunctions = GLF { labelExpression = single getVarExp + ,labelConditionalExpression + = \e -> return $ Usage Nothing Nothing (Just e) (getVarExp e) ,labelExpressionList = single getVarExpList - ,labelDummy = const (return $ Usage Nothing Nothing emptyVars) + ,labelDummy = const (return $ Usage Nothing Nothing Nothing emptyVars) ,labelProcess = singleM getVarProc ,labelAlternative = single getVarAlternative ,labelStartNode = single (uncurry getVarFormals) - ,labelReplicator = \x -> return (Usage (Just x) Nothing (getVarRepExp $ snd x)) + ,labelReplicator = \x -> return (Usage (Just x) Nothing Nothing (getVarRepExp $ snd x)) --don't forget about the variables used as initialisers in declarations (hence getVarSpec) ,labelScopeIn = pair (getDecl $ ScopeIn False) getVarSpec ,labelScopeOut = pair (getDecl ScopeOut) (const emptyVars) } where single :: (a -> Vars) -> (a -> m UsageLabel) - single f x = return $ Usage Nothing Nothing (f x) + single f x = return $ Usage Nothing Nothing Nothing (f x) singleM :: (a -> m Vars) -> (a -> m UsageLabel) - singleM f x = f x >>* Usage Nothing Nothing + singleM f x = f x >>* Usage Nothing Nothing Nothing pair :: (a -> Maybe Decl) -> (a -> Vars) -> (a -> m UsageLabel) - pair f0 f1 x = return $ Usage Nothing (f0 x) (f1 x) + pair f0 f1 x = return $ Usage Nothing (f0 x) Nothing (f1 x) diff --git a/flow/FlowGraphTest.hs b/flow/FlowGraphTest.hs index f97a81a..13cacae 100644 --- a/flow/FlowGraphTest.hs +++ b/flow/FlowGraphTest.hs @@ -118,7 +118,7 @@ testGraph' :: String -> [(Int, Meta)] -> [Int] -> [(Int, Int, EdgeLabel)] -> A.A testGraph' testName nodes roots edges str = testGraphF testName nodes roots edges (buildFlowGraph testOps str) testOps :: GraphLabelFuncs (State (Map.Map Meta Int)) Int -testOps = GLF nextId nextId nextId nextId nextId nextId (nextId . snd) (nextId' 100) (nextId' 100) +testOps = GLF nextId nextId nextId nextId nextId nextId nextId (nextId . snd) (nextId' 100) (nextId' 100) testGraphF :: Data structType => String -> [(Int, Meta)] -> [Int] -> [(Int, Int, EdgeLabel)] -> State (Map.Map Meta Int) (Either String (FlowGraph' Identity Int structType, [Node], [Node])) -> Test diff --git a/flow/FlowUtils.hs b/flow/FlowUtils.hs index 1223829..5a7510f 100644 --- a/flow/FlowUtils.hs +++ b/flow/FlowUtils.hs @@ -108,6 +108,7 @@ data Monad m => GraphLabelFuncs m label = GLF { ,labelProcess :: A.Process -> m label ,labelAlternative :: A.Alternative -> m label ,labelExpression :: A.Expression -> m label + , labelConditionalExpression :: A.Expression -> m label ,labelExpressionList :: A.ExpressionList -> m label ,labelReplicator :: (A.Name, A.Replicator) -> m label ,labelScopeIn :: A.Specification -> m label @@ -139,6 +140,7 @@ joinLabelFuncs fx fy = GLF labelProcess = joinItem labelProcess, labelAlternative = joinItem labelAlternative, labelExpression = joinItem labelExpression, + labelConditionalExpression = joinItem labelConditionalExpression, labelExpressionList = joinItem labelExpressionList, labelReplicator = joinItem labelReplicator, labelScopeIn = joinItem labelScopeIn, @@ -154,10 +156,10 @@ joinLabelFuncs fx fy = GLF return (x0,x1) mkLabelFuncsConst :: Monad m => m label -> GraphLabelFuncs m label -mkLabelFuncsConst v = GLF (const v) (const v) (const v) (const v) (const v) (const v) (const v) (const v) (const v) +mkLabelFuncsConst v = GLF (const v) (const v) (const v) (const v) (const v) (const v) (const v) (const v) (const v) (const v) mkLabelFuncsGeneric :: Monad m => (forall t. Data t => t -> m label) -> GraphLabelFuncs m label -mkLabelFuncsGeneric f = GLF f f f f f f f f f +mkLabelFuncsGeneric f = GLF f f f f f f f f f f run :: forall mLabel mAlter label structType b. (Monad mLabel, Monad mAlter) => (GraphLabelFuncs mLabel label -> (b -> mLabel label)) -> b -> GraphMaker mLabel mAlter label structType label