Added the beginnings of support for implicit mobility for Rain (just printing out the decisions for now)

Makefile.am

@@ -151,6 +151,7 @@ tock_SOURCES_hs += pass/Pass.hs
 tock_SOURCES_hs += pass/PassList.hs
 tock_SOURCES_hs += pass/Properties.hs
 tock_SOURCES_hs += pass/Traversal.hs
+tock_SOURCES_hs += transformations/ImplicitMobility.hs
 tock_SOURCES_hs += transformations/SimplifyComms.hs
 tock_SOURCES_hs += transformations/SimplifyExprs.hs
 tock_SOURCES_hs += transformations/SimplifyProcs.hs

frontends/RainPasses.hs

@@ -28,6 +28,7 @@ import Data.Maybe
 import qualified AST as A
 import CompState
 import Errors
+import ImplicitMobility
 import Pass
 import qualified Properties as Prop
 import RainTypes
@@ -67,6 +68,8 @@ rainPasses = let f = makePassesDep' ((== FrontendRain) . csFrontend) in f
        ,("Transform Rain functions into the occam form",checkFunction, Prop.agg_typesDone, [])
          --TODO add an export property.  Maybe check other things too (lack of comms etc -- but that could be combined with occam?)
        ,("Pull up par declarations", pullUpParDeclarations, [], [Prop.rainParDeclarationsPulledUp])
+
+       ,("Implicit mobility pass", implicitMobility, [], [])
      ]
 
 -- | A pass that transforms all instances of 'A.Int' into 'A.Int64'

testcases/move.rain

@@ -0,0 +1,30 @@
+process foo (?[int]: in, ![int]: out)
+{
+	[int]: xs;
+	[int]: ys;
+	int: n;
+    n = 0;
+    while (n <> -1)
+    {
+      in ? xs;
+      in ? ys;
+      out ! xs; 
+      out ! ys; 
+      ys = [];
+      seqeach (i : xs)
+      {
+      	ys = ys ++ [i + 5];
+      }
+      out ! xs;
+      out ! ys; 
+    }
+  out ! xs;
+  ys = xs;
+  out ! ys;
+}
+
+process main (?uint8: in, !uint8: out, !uint8: err)
+{
+	channel [int]: c;
+	foo(?c,!c);
+}

transformations/ImplicitMobility.hs

@@ -0,0 +1,95 @@
+{-
+Tock: a compiler for parallel languages
+Copyright (C) 2007  University of Kent
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation, either version 2 of the License, or (at your
+option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License along
+with this program.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+module ImplicitMobility where
+
+import Control.Monad
+import Control.Monad.Trans
+import Data.Graph.Inductive
+import Data.Graph.Inductive.Query.DFS
+import qualified Data.Map as Map
+import Data.Maybe
+import qualified Data.Set as Set
+
+import qualified AST as A
+import Errors
+import FlowAlgorithms
+import FlowGraph
+import FlowUtils
+import Metadata
+import Pass
+import UsageCheckUtils
+import Utils
+
+calculateUsedAgainAfter :: Monad m => FlowGraph m UsageLabel -> Node -> Either String (Map.Map Node
+ (Set.Set Var))
+calculateUsedAgainAfter g startNode
+  = flowAlgorithm funcs (udfs [startNode] g) (startNode, Set.empty)
+  where
+    funcs :: GraphFuncs Node EdgeLabel (Set.Set Var)
+    funcs = GF     
+      { nodeFunc = iterate
+      -- Backwards data flow:
+      , nodesToProcess = lsuc g
+      , nodesToReAdd = lpre g
+      , defVal = Set.empty
+      , userErrLabel = ("for node at: " ++) . show . fmap getNodeMeta . lab g
+      }
+
+    iterate :: (Node, EdgeLabel) -> Set.Set Var -> Maybe (Set.Set Var) -> Set.Set
+      Var
+    iterate node _ mvs = case lab g (fst node) of
+      Just ul -> let nvars = writtenVars $ nodeVars $ getNodeData ul in
+        maybe nvars (Set.union nvars) mvs
+      Nothing -> error "Node label not found in calculateUsedAgainAfter"
+
+--TODO rememember to take note of declarations/scope, otherwise this:
+-- seqeach (..) {int:x; ... x = 3;}
+-- will look like x is used again on the next loop iteration
+
+-- TODO look at the types, too!
+printMoveCopyDecisions :: Monad m => FlowGraph m UsageLabel -> Node -> PassM ()
+printMoveCopyDecisions gr n
+  = case calculateUsedAgainAfter gr n of
+      Left err -> dieP (getNodeMeta $ fromJust $ lab gr n) err
+      Right mvs -> mapMapWithKeyM f mvs >> return ()
+  where
+    f :: Node -> (Set.Set Var) -> PassM (Set.Set Var)
+    f n vs = case liftM (readVars . nodeVars . getNodeData) $ lab gr n of
+               Nothing -> dieP emptyMeta "Did not find label in pmcd"
+               Just rv -> (mapM_ g $ Set.toList rv) >> return vs
+      where
+        g :: Var -> PassM ()
+        g v | Set.member v vs = liftIO . putStrLn $ show (findMeta v) ++ " COPY"
+            | otherwise = liftIO . putStrLn $ show (findMeta v) ++ " MOVE"
+
+
+implicitMobility :: A.AST -> PassM A.AST
+implicitMobility t
+  = do g' <- buildFlowGraph labelFunctions t
+              :: PassM (Either String (FlowGraph' PassM UsageLabel (), [Node],
+                [Node]))
+       case g' of
+         Left err -> dieP emptyMeta $ "Error building flow graph: " ++ err
+         Right (g, roots, terms) ->
+           -- We go from the terminator nodes, because we are performing backward
+           -- data-flow analysis
+           (liftIO $ putStrLn $ makeFlowGraphInstr g) >>
+           mapM_ (printMoveCopyDecisions g) terms
+       return t
+