Added a function to GraphLabelFuncs for labelling replicators

Main.hs

@@ -261,7 +261,7 @@ compile mode fn outHandle
               do procs <- findAllProcesses
                  let fs :: Data t => t -> PassM String
                      fs = ((liftM $ (take 20) . (filter ((/=) '\"'))) . pshowCode)
-                 let labelFuncs = GLF fs fs fs fs fs fs fs
+                 let labelFuncs = mkLabelFuncsGeneric fs
                  graphs <- mapM
                       ((liftM $ either (const Nothing) Just) . (buildFlowGraph labelFuncs) )
                       (map (A.OnlyP emptyMeta) (snd $ unzip $ procs))

checks/UsageCheckUtils.hs

@@ -191,6 +191,7 @@ labelFunctions = GLF
   ,labelDummy = const (return (Nothing, emptyVars))
   ,labelProcess = pair (const Nothing) getVarProc
   ,labelStartNode = pair (const Nothing) (uncurry getVarFormals)
+  ,labelReplicator = const (return (Nothing, emptyVars))
   --don't forget about the variables used as initialisers in declarations (hence getVarSpec)
   ,labelScopeIn = pair (getDecl ScopeIn) getVarSpec
   ,labelScopeOut = pair (getDecl ScopeOut) (const emptyVars)

common/FlowGraph.hs

@@ -41,7 +41,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- * If statements, on the other hand, have to be chained together.  Each expression is connected
 -- to its body, but also to the next expression.  There is no link between the last expression
 -- and the end of the if; if statements behave like STOP if nothing is matched.
-module FlowGraph (AlterAST(..), EdgeLabel(..), FNode(..), FlowGraph, GraphLabelFuncs(..), buildFlowGraph, joinLabelFuncs, makeFlowGraphInstr) where
+module FlowGraph (AlterAST(..), EdgeLabel(..), FNode(..), FlowGraph, GraphLabelFuncs(..), buildFlowGraph, joinLabelFuncs, makeFlowGraphInstr, mkLabelFuncsConst, mkLabelFuncsGeneric) where
 
 import Control.Monad.Error
 import Control.Monad.State
@@ -80,6 +80,7 @@ data AlterAST m =
  |AlterArguments (ASTModifier m [A.Formal])
  |AlterExpression (ASTModifier m A.Expression)
  |AlterExpressionList (ASTModifier m A.ExpressionList)
+ |AlterReplicator (ASTModifier m A.Replicator)
  |AlterSpec (ASTModifier m A.Specification)
  |AlterNothing
 
@@ -121,6 +122,7 @@ data Monad m => GraphLabelFuncs m label = GLF {
     ,labelProcess :: A.Process -> m label
     ,labelExpression :: A.Expression -> m label
     ,labelExpressionList :: A.ExpressionList -> m label
+    ,labelReplicator :: A.Replicator -> m label
     ,labelScopeIn :: A.Specification -> m label
     ,labelScopeOut :: A.Specification -> m label
   }
@@ -138,6 +140,7 @@ joinLabelFuncs fx fy = GLF
   labelProcess = joinItem labelProcess,
   labelExpression = joinItem labelExpression,
   labelExpressionList = joinItem labelExpressionList,
+  labelReplicator = joinItem labelReplicator,
   labelScopeIn = joinItem labelScopeIn,
   labelScopeOut = joinItem labelScopeOut
  }
@@ -150,6 +153,12 @@ joinLabelFuncs fx fy = GLF
                          x1 <- f1 x
                          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)
+
+mkLabelFuncsGeneric :: Monad m => (forall t. Data t => t -> m label) -> GraphLabelFuncs m label
+mkLabelFuncsGeneric f = GLF f f f f f f f f
+
 -- | Builds a control-flow-graph.  The mAlter monad is the monad in which
 -- AST alterations would take place.  Note that mAlter does not feature in
 -- the parameters, only in the result.  The mLabel monad is the monad in

common/FlowGraphTest.hs

@@ -122,7 +122,7 @@ testGraph' testName nodes roots edges code
     deNode (Node (x,y,_)) = (x,y)
     
     testOps :: GraphLabelFuncs (State (Map.Map Meta Int)) Int
-    testOps = GLF nextId nextId nextId nextId nextId (nextId' 100) (nextId' 100)
+    testOps = GLF nextId nextId nextId nextId nextId nextId (nextId' 100) (nextId' 100)
     
     checkGraphEquality :: (Graph g, Show b, Ord b, Monad m) => ([(Int, Meta)], [Int], [(Int, Int, b)]) -> (g (FNode m Int) b, [Int]) -> Assertion
     checkGraphEquality (nodes, roots, edges) (g, actRoots)
@@ -549,9 +549,7 @@ genProcess n = nextIdT >>* makeMeta' >>= \m -> (flip oneofLS) n
 genGraph :: A.Structured -> FlowGraph Identity ()
 genGraph s = either (\e -> error $ "QuickCheck graph did not build properly: " ++ e ++ ", from: " ++ pshow s) fst $ runIdentity $ buildFlowGraph funcs s
   where
-    empty :: a -> Identity ()
+    funcs = mkLabelFuncsConst (return ()) 
-    empty = const (return ())
-    funcs = GLF empty empty empty empty empty empty empty
 
 -- | Given a flow-graph, it returns a list of all the identity alteration functions,
 -- for each node.  Applying any, many or all of these functions to the source AST