Added a new part to UsageLabel for conditions in nodes, and added a new corresponding labelling function for nodes

This commit is contained in:
Neil Brown 2008-06-06 18:32:47 +00:00
parent fe1238d379
commit cbe460f306
4 changed files with 20 additions and 14 deletions

View File

@ -257,8 +257,8 @@ checkParAssignUsage = mapM_ checkParAssign . listify isParAssign
checkArrayUsage (m, fmap ((,) []) mockedupParItems) -- TODO add BK properly checkArrayUsage (m, fmap ((,) []) mockedupParItems) -- TODO add BK properly
where where
mockedupParItems :: ParItems UsageLabel mockedupParItems :: ParItems UsageLabel
mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing $ processVarW v mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing Nothing
Nothing] | v <- vs] $ processVarW v Nothing] | v <- vs]
checkProcCallArgsUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t) => t -> m () 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 :: A.Process -> m ()
checkArgs p@(A.ProcCall m _ _) checkArgs p@(A.ProcCall m _ _)
= do vars <- getVarProcCall p = do vars <- getVarProcCall p
let mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing v] let mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing Nothing v]
| v <- vars] | v <- vars]
checkPlainVarUsage (m, mockedupParItems) checkPlainVarUsage (m, mockedupParItems)
checkArrayUsage (m, fmap ((,) []) mockedupParItems) checkArrayUsage (m, fmap ((,) []) mockedupParItems)

View File

@ -72,7 +72,9 @@ data ParItems a
data UsageLabel = Usage data UsageLabel = Usage
{ nodeRep :: Maybe (A.Name, A.Replicator) { nodeRep :: Maybe (A.Name, A.Replicator)
, nodeDecl :: Maybe Decl , nodeDecl :: Maybe Decl
,nodeVars :: Vars} , nodeCond :: Maybe A.Expression
, nodeVars :: Vars
}
instance Show UsageLabel where instance Show UsageLabel where
show = const "" show = const ""
@ -229,22 +231,24 @@ labelUsageFunctions :: forall m. (Die m, CSMR m) => GraphLabelFuncs m UsageLabel
labelUsageFunctions = GLF labelUsageFunctions = GLF
{ {
labelExpression = single getVarExp labelExpression = single getVarExp
,labelConditionalExpression
= \e -> return $ Usage Nothing Nothing (Just e) (getVarExp e)
,labelExpressionList = single getVarExpList ,labelExpressionList = single getVarExpList
,labelDummy = const (return $ Usage Nothing Nothing emptyVars) ,labelDummy = const (return $ Usage Nothing Nothing Nothing emptyVars)
,labelProcess = singleM getVarProc ,labelProcess = singleM getVarProc
,labelAlternative = single getVarAlternative ,labelAlternative = single getVarAlternative
,labelStartNode = single (uncurry getVarFormals) ,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) --don't forget about the variables used as initialisers in declarations (hence getVarSpec)
,labelScopeIn = pair (getDecl $ ScopeIn False) getVarSpec ,labelScopeIn = pair (getDecl $ ScopeIn False) getVarSpec
,labelScopeOut = pair (getDecl ScopeOut) (const emptyVars) ,labelScopeOut = pair (getDecl ScopeOut) (const emptyVars)
} }
where where
single :: (a -> Vars) -> (a -> m UsageLabel) 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 :: (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 :: (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)

View File

@ -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) testGraph' testName nodes roots edges str = testGraphF testName nodes roots edges (buildFlowGraph testOps str)
testOps :: GraphLabelFuncs (State (Map.Map Meta Int)) Int 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], testGraphF :: Data structType => String -> [(Int, Meta)] -> [Int] -> [(Int, Int, EdgeLabel)] -> State (Map.Map Meta Int) (Either String (FlowGraph' Identity Int structType, [Node],
[Node])) -> Test [Node])) -> Test

View File

@ -108,6 +108,7 @@ data Monad m => GraphLabelFuncs m label = GLF {
,labelProcess :: A.Process -> m label ,labelProcess :: A.Process -> m label
,labelAlternative :: A.Alternative -> m label ,labelAlternative :: A.Alternative -> m label
,labelExpression :: A.Expression -> m label ,labelExpression :: A.Expression -> m label
, labelConditionalExpression :: A.Expression -> m label
,labelExpressionList :: A.ExpressionList -> m label ,labelExpressionList :: A.ExpressionList -> m label
,labelReplicator :: (A.Name, A.Replicator) -> m label ,labelReplicator :: (A.Name, A.Replicator) -> m label
,labelScopeIn :: A.Specification -> m label ,labelScopeIn :: A.Specification -> m label
@ -139,6 +140,7 @@ joinLabelFuncs fx fy = GLF
labelProcess = joinItem labelProcess, labelProcess = joinItem labelProcess,
labelAlternative = joinItem labelAlternative, labelAlternative = joinItem labelAlternative,
labelExpression = joinItem labelExpression, labelExpression = joinItem labelExpression,
labelConditionalExpression = joinItem labelConditionalExpression,
labelExpressionList = joinItem labelExpressionList, labelExpressionList = joinItem labelExpressionList,
labelReplicator = joinItem labelReplicator, labelReplicator = joinItem labelReplicator,
labelScopeIn = joinItem labelScopeIn, labelScopeIn = joinItem labelScopeIn,
@ -154,10 +156,10 @@ joinLabelFuncs fx fy = GLF
return (x0,x1) return (x0,x1)
mkLabelFuncsConst :: Monad m => m label -> GraphLabelFuncs m label 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 :: 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 run :: forall mLabel mAlter label structType b. (Monad mLabel, Monad mAlter) => (GraphLabelFuncs mLabel label -> (b -> mLabel label)) -> b -> GraphMaker mLabel mAlter label structType label