From 1d500b46ae36a96776297d49c83f66b3c97b428a Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Mon, 15 Dec 2008 10:36:48 +0000 Subject: [PATCH] Moved the SYB-based route stuff back into FlowUtils, and trimmed down the export list of GenericUtils --- common/GenericUtils.hs | 8 +---- flow/FlowGraphTest.hs | 1 - flow/FlowUtils.hs | 54 +++++++++++++++++++++++++++++ transformations/ImplicitMobility.hs | 1 - 4 files changed, 55 insertions(+), 9 deletions(-) diff --git a/common/GenericUtils.hs b/common/GenericUtils.hs index edf8760..21148e9 100644 --- a/common/GenericUtils.hs +++ b/common/GenericUtils.hs @@ -29,7 +29,7 @@ module GenericUtils ( , gmapMFor , gmapMForRoute , routeModify, routeGet, routeSet, Route(..), (@->), routeIdentity, routeId, routeList - , route11, route22, route23, route33, route34, route44, route45, route55 + , route22, route23, route33, route34, route44, route45, route55 ) where import Control.Monad.Identity @@ -191,9 +191,6 @@ gmapMWithRoute f = gmapFuncs [GM {unGM = f' n} | n <- [0..]] makeRoute' :: (Data s, Data t) => Int -> Route s t makeRoute' target = makeRoute [target] (\f -> gmapFuncs [mkM' (if n == target then f else return) | n <- [0..]]) -decomp11 :: (Monad m, Data a, Typeable a0) => (a0 -> a) -> (a0 -> m a0) -> (a -> m a) -decomp11 con f1 = decomp1 con f1 - decomp22 :: (Monad m, Data a, Typeable a0, Typeable a1) => (a0 -> a1 -> a) -> (a1 -> m a1) -> (a -> m a) decomp22 con f1 = decomp2 con return f1 @@ -219,9 +216,6 @@ decomp55 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3 (a0 -> a1 -> a2 -> a3 -> a4 -> a) -> (a4 -> m a4) -> (a -> m a) decomp55 con f4 = decomp5 con return return return return f4 -route11 :: (Data a, Typeable a0) => Route a b -> (a0 -> a) -> Route a0 b -route11 route con = route @-> Route [0] (decomp11 con) - route22 :: (Data a, Typeable a0, Typeable a1) => Route a b -> (a0 -> a1 -> a) -> Route a1 b route22 route con = route @-> makeRoute [1] (decomp22 con) diff --git a/flow/FlowGraphTest.hs b/flow/FlowGraphTest.hs index 331709b..5e2a2d1 100644 --- a/flow/FlowGraphTest.hs +++ b/flow/FlowGraphTest.hs @@ -34,7 +34,6 @@ import Test.HUnit hiding (Node, State, Testable) import Test.QuickCheck import qualified AST as A -import CompState import FlowGraph import GenericUtils import Metadata diff --git a/flow/FlowUtils.hs b/flow/FlowUtils.hs index efb1c86..65420d5 100644 --- a/flow/FlowUtils.hs +++ b/flow/FlowUtils.hs @@ -25,6 +25,7 @@ import Data.Generics import Data.Graph.Inductive hiding (run) import qualified AST as A +import Data.Generics.Polyplate.Route import GenericUtils import Metadata import TreeUtils @@ -303,3 +304,56 @@ joinPairs m mod nodes = do sequence_ $ mapPairs (\(_,s) (e,_) -> addEdge (ESeq Nothing) s e) nodes return (fst (head nodes), snd (last nodes)) + +decomp22 :: (Monad m, Data a, Typeable a0, Typeable a1) => (a0 -> a1 -> a) -> (a1 -> m a1) -> (a -> m a) +decomp22 con f1 = decomp2 con return f1 + +decomp23 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2) => (a0 -> a1 -> a2 -> a) -> (a1 -> m a1) -> (a -> m a) +decomp23 con f1 = decomp3 con return f1 return + +decomp33 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2) => (a0 -> a1 -> a2 -> a) -> (a2 -> m a2) -> (a -> m a) +decomp33 con f2 = decomp3 con return return f2 + +decomp34 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3) => + (a0 -> a1 -> a2 -> a3 -> a) -> (a2 -> m a2) -> (a -> m a) +decomp34 con f2 = decomp4 con return return f2 return + +decomp44 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3) => + (a0 -> a1 -> a2 -> a3 -> a) -> (a3 -> m a3) -> (a -> m a) +decomp44 con f3 = decomp4 con return return return f3 + +decomp45 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3, Typeable a4) => + (a0 -> a1 -> a2 -> a3 -> a4 -> a) -> (a3 -> m a3) -> (a -> m a) +decomp45 con f3 = decomp5 con return return return f3 return + +decomp55 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3, Typeable a4) => + (a0 -> a1 -> a2 -> a3 -> a4 -> a) -> (a4 -> m a4) -> (a -> m a) +decomp55 con f4 = decomp5 con return return return return f4 + +route22 :: (Data a, Typeable a0, Typeable a1) => Route a b -> (a0 -> a1 -> a) -> Route a1 b +route22 route con = route @-> makeRoute [1] (decomp22 con) + +route23 :: (Data a, Typeable a0, Typeable a1, Typeable a2) => Route a b -> (a0 -> a1 -> a2 -> a) -> Route a1 b +route23 route con = route @-> makeRoute [1] (decomp23 con) + +route33 :: (Data a, Typeable a0, Typeable a1, Typeable a2) => Route a b -> (a0 -> a1 -> a2 -> a) -> Route a2 b +route33 route con = route @-> makeRoute [2] (decomp33 con) + +route34 :: (Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3) => + Route a b -> (a0 -> a1 -> a2 -> a3 -> a) -> Route a2 b +route34 route con = route @-> makeRoute [2] (decomp34 con) + +route44 :: (Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3) => + Route a b -> (a0 -> a1 -> a2 -> a3 -> a) -> Route a3 b +route44 route con = route @-> makeRoute [3] (decomp44 con) + +route45 :: (Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3, Typeable a4) => + Route a b -> (a0 -> a1 -> a2 -> a3 -> a4 -> a) -> Route a3 b +route45 route con = route @-> makeRoute [3] (decomp45 con) + +route55 :: (Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3, Typeable a4) => + Route a b -> (a0 -> a1 -> a2 -> a3 -> a4 -> a) -> Route a4 b +route55 route con = route @-> makeRoute [4] (decomp55 con) + +-- TODO we should be able to provide versions of these that do not need to know +-- the constructor or the arity diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs index 6c83f37..77f9e3d 100644 --- a/transformations/ImplicitMobility.hs +++ b/transformations/ImplicitMobility.hs @@ -29,7 +29,6 @@ import qualified Data.Set as Set import qualified Data.Traversable as T import qualified AST as A -import CompState import Errors import FlowAlgorithms import FlowGraph