Added a new part to UsageLabel for conditions in nodes, and added a new corresponding labelling function for nodes
This commit is contained in:
parent
fe1238d379
commit
cbe460f306
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user