diff --git a/Makefile.am b/Makefile.am index ea77e4f..1794f82 100644 --- a/Makefile.am +++ b/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 diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index 160bf48..317390e 100644 --- a/frontends/RainPasses.hs +++ b/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' diff --git a/testcases/move.rain b/testcases/move.rain new file mode 100644 index 0000000..cbb1a3b --- /dev/null +++ b/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); +} diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs new file mode 100644 index 0000000..2f3371f --- /dev/null +++ b/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 . +-} + +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 +