Made all the imports of Data.Generics have an import list

This makes sure that we catch all leftover instances of using SYB to do generic operations that we should be using Polyplate for instead.  Most modules should only import Data, and possibly Typeable.

Main.hs

@@ -24,7 +24,7 @@ import Control.Monad.Identity
 import Control.Monad.State
 import Control.Monad.Writer
 import Data.Either
-import Data.Generics
+import Data.Generics (Data)
 import Data.Maybe
 import qualified Data.Set as Set
 import List
@@ -459,6 +459,7 @@ compile mode fn (outHandles@(outHandle, _), headerName)
             ModeLex -> liftIO $ hPutStr outHandle $ pshow lexed
             ModeHTML -> liftIO $ hPutStr outHandle $ showTokens True lexed
             ModeParse -> liftIO $ hPutStr outHandle $ pshow ast1
+{-
             ModeFlowGraph ->
               do procs <- findAllProcesses
                  let fs :: Data t => t -> PassM String
@@ -476,6 +477,7 @@ compile mode fn (outHandles@(outHandle, _), headerName)
                        = map (transformMaybe $ \(x,_,_) -> x) graphs
                  -- TODO: output each process to a separate file, rather than just taking the first:
                  liftIO $ hPutStr outHandle $ head $ map makeFlowGraphInstr (catMaybes graphsTyped)
+-}
             ModeCompile ->
               do progress "Passes:"
 

Makefile.am

@@ -1,5 +1,5 @@
 GHC_OPTS = \
-	-fcontext-stack=200 \
+	-fcontext-stack=400 \
 	-fwarn-deprecations \
 	-fwarn-duplicate-exports \
 	-fwarn-incomplete-record-updates \

backends/AnalyseAsm.hs

@@ -30,7 +30,7 @@ module AnalyseAsm (
 import Control.Arrow
 import Control.Monad.State
 import Data.Char
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe

backends/GenerateC.hs

@@ -41,7 +41,7 @@ module GenerateC
   ) where
 
 import Data.Char
-import Data.Generics
+import Data.Generics (Data)
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe
@@ -63,6 +63,7 @@ import Pass
 import qualified Properties as Prop
 import ShowCode
 import TLP
+import Traversal
 import Types
 import TypeSizes
 import Utils
@@ -181,11 +182,11 @@ cgenTopLevel headerName s
                 = A.nameName n `elem` (csOriginalTopLevelProcs cs)
 
           tellToHeader $ sequence_ $ map (call genForwardDeclaration)
-                                       (listify isTopLevelSpec s)
+                                       (listifyDepth isTopLevelSpec s)
           -- Things like lifted wrapper_procs we still need to forward-declare,
           -- but we do it in the C file, not in the header:
           sequence_ $ map (call genForwardDeclaration)
-                            (listify (not . isTopLevelSpec) s)
+                            (listifyDepth (not . isTopLevelSpec) s)
 
           tell ["#include \"", dropPath headerName, "\"\n"]
 

backends/GenerateCBased.hs

@@ -22,7 +22,7 @@ module GenerateCBased where
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer hiding (tell)
-import Data.Generics
+import Data.Generics (Data)
 import Data.List
 import System.IO
 

backends/GenerateCHP.hs

@@ -42,7 +42,7 @@ module GenerateCHP where
 import Control.Monad.State
 import Control.Monad.Trans
 import Data.Char
-import Data.Generics
+import Data.Generics (Data, showConstr, toConstr)
 import Data.List
 import Data.Maybe
 import System.IO

backends/GenerateCPPCSP.hs

@@ -32,7 +32,7 @@ module GenerateCPPCSP (cppcspPrereq, cppgenOps, generateCPPCSP, genCPPCSPPasses)
 
 import Control.Monad.State
 import Data.Char
-import Data.Generics
+import Data.Generics (Data)
 import Data.List
 import Data.Maybe
 import qualified Data.Set as Set
@@ -144,11 +144,11 @@ cppgenTopLevel headerName s
                 = A.nameName n `elem` (csOriginalTopLevelProcs cs)
 
           tellToHeader $ sequence_ $ map (call genForwardDeclaration)
-                                       (listify isTopLevelSpec s)
+                                       (listifyDepth isTopLevelSpec s)
           -- Things like lifted wrapper_procs we still need to forward-declare,
           -- but we do it in the C file, not in the header:
           sequence_ $ map (call genForwardDeclaration)
-                            (listify (\sp@(A.Specification _ n _)
+                            (listifyDepth (\sp@(A.Specification _ n _)
                               -> not (isTopLevelSpec sp)
                                  && A.nameName n `notElem` map fst (csExternals cs)) s)
 

backends/TLP.hs

@@ -20,7 +20,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module TLP where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import Data.List
 import Data.Maybe
 

checks/Check.hs

@@ -25,7 +25,7 @@ module Check (checkInitVarPass, usageCheckPass, checkUnusedVar) where
 import Control.Monad.Identity
 import Control.Monad.State
 import Control.Monad.Trans
-import Data.Generics
+import Data.Generics (Data)
 import Data.Graph.Inductive hiding (mapSnd)
 import Data.List hiding (union)
 import qualified Data.Map as Map
@@ -104,8 +104,15 @@ followBK = map followBK'
                           (concat $ mapMaybe (flip Map.lookup m) (Set.toList $
                             next `Set.difference` prev))
           where
-            next = Set.fromList $ map Var $ listify (const True :: A.Variable -> Bool) bk
+            next = Set.fromList $ map Var $ concatMap allVarsInBK bk
 
+allVarsInBK :: BackgroundKnowledge -> [A.Variable]
+allVarsInBK (Equal a b) = listifyDepth (const True) a
+                            ++ listifyDepth (const True) b
+allVarsInBK (LessThanOrEqual a b) = listifyDepth (const True) a
+                                      ++ listifyDepth (const True) b
+allVarsInBK (RepBoundsIncl v a b) = v : (listifyDepth (const True) a
+                                           ++ listifyDepth (const True) b)
 
 data And a = And [a]
 data Or a = Or [a]
@@ -268,7 +275,7 @@ addBK mp mp2 g nid n
         
         makeMap :: And BackgroundKnowledge -> Map.Map Var (And BackgroundKnowledge)
         makeMap (And bks) = Map.fromListWith mappend $ concat
-          [zip (map Var $ listify (const True) bk) (repeat $ noAnd bk) | bk <- bks]
+          [zip (map Var $ allVarsInBK bk) (repeat $ noAnd bk) | bk <- bks]
         
         convValues :: Or (Map.Map Var (And BackgroundKnowledge))
         convValues = Or $ map (Map.fromListWith mappend) $

checks/CheckFramework.hs

@@ -26,7 +26,7 @@ module CheckFramework (CheckOptM, CheckOptASTM, forAnyASTTopDown, forAnyASTStruc
 
 import Control.Monad.Reader
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import Data.Graph.Inductive hiding (apply)
 import Data.List
 import qualified Data.Map as Map
@@ -486,7 +486,7 @@ runChecks (CheckOptM m) x = execStateT m (CheckOptData {ast = x, parItems = Noth
   nextVarsTouched = Map.empty, flowGraphRootsTerms = Nothing, lastValidMeta = emptyMeta}) >>* ast
 
 runChecksPass :: CheckOptM () -> Pass A.AST
-runChecksPass c = pass "<Check>" [] [] (mkM (runChecks c))
+runChecksPass c = pass "<Check>" [] [] (runChecks c)
 
 --getParItems :: CheckOptM (ParItems ())
 --getParItems = CheckOptM (\d -> Right (d, fromMaybe (generateParItems $ ast d) (parItems d)))

checks/UsageCheckAlgorithms.hs

@@ -19,7 +19,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module UsageCheckAlgorithms (checkPar, findConstraints, findReachDef, joinCheckParFunctions) where
 
 import Control.Monad
-import Data.Generics
+import Data.Generics (Data)
 import Data.Graph.Inductive
 import Data.List
 import qualified Data.Map as Map
@@ -30,6 +30,7 @@ import qualified AST as A
 import FlowAlgorithms
 import FlowGraph
 import Metadata
+import Traversal
 import Types
 import UsageCheckUtils
 import Utils
@@ -203,7 +204,7 @@ findConstraints graph startNode
     processNode (n, e) nodeVal curAgg = case fmap getNodeData $ lab graph n of
       Just u ->
         let overlapsWithWritten e = not $ null $ intersect
-              (listify (const True) e)
+              (listifyDepth (const True) $ snd e)
               [v | Var v <- Map.keys $ writtenVars $ nodeVars u]
             valFilt = filter (not . overlapsWithWritten) $
                 nub $ nodeVal ++ (case e of

common/Errors.hs

@@ -23,7 +23,7 @@ module Errors (checkJust, Die(..),
 
 import Control.Monad.Error
 import Control.Monad.Trans
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import Data.List
 import System.IO
 import System.IO.Error

common/EvalLiterals.hs

@@ -23,7 +23,7 @@ import Control.Monad.Error
 import Control.Monad.Identity
 import Control.Monad.State
 import Data.Char
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import Data.Int
 import Data.Maybe
 import Data.Word

common/PrettyShow.hs

@@ -29,7 +29,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- (via the 'extCode' function) to print out data, otherwise it acts
 -- like pshow.  Note that because pshowCode chooses the appropriate
 -- language based on the 'csFrontend' in 'CompState', it is inside the CSM monad.
-module PrettyShow (pshow, pshowCode) where
+module PrettyShow (pshow) where
 
 import Control.Monad.State
 import Data.Generics
@@ -154,6 +154,7 @@ doAny extFunc = extFunc (
 pshow :: Data a => a -> String
 pshow x = render $ doAny id x
 
+{-
 pshowCode :: (Data a, CSMR m) => a -> m String
 pshowCode c = do st <- getCompState
                  case csFrontend st of
@@ -164,3 +165,4 @@ pshowCode c = do st <- getCompState
     extOccam f = extCode f showOccam
     extRain :: forall a. (Data a, Typeable a) => (a -> Doc) -> (a -> Doc)
     extRain f = extCode f showRain
+-}

common/ShowCode.hs

@@ -33,11 +33,11 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- My plan for testing was to take each of the cgtests, and parse it in to AST_A.  Then print AST_A using this
 -- module, and feed it back in to the parser to get AST_B.  Then check if AST_A and AST_B are equal.
 
-module ShowCode (showCode, ShowOccam(..), showOccam, ShowRain(..), showRain, formatCode, extCode) where 
+module ShowCode (showCode, ShowOccam(..), showOccam, ShowRain(..), showRain, formatCode) where 
 
 import Control.Monad.State
 import Control.Monad.Writer
-import Data.Generics
+import Data.Generics (Data, gshow)
 import Data.List
 import qualified Data.Map as Map
 import Text.PrettyPrint.HughesPJ hiding (space, colon, semi)
@@ -711,6 +711,7 @@ instance ShowRain a => ShowRain [a] where
 -- ShowOccam\/ShowRain implementation.  But since to add a type to the ShowOccam\/ShowRain 
 -- classes you have to provide a specific instance above anyway, I don't think that adding 
 -- one more line while you're at it is too bad.
+{-
 extCode :: (Data b, Typeable b) => (b -> Doc) -> (forall a. (ShowOccam a, ShowRain a) => a -> String) -> (b -> Doc)
 extCode q f = q 
                 `extQ` (text . (f :: A.Expression -> String))
@@ -723,4 +724,4 @@ extCode q f = q
                 `extQ` (text . (f :: A.Variable -> String))
 --TODO
 --                `ext1Q` (text . (f :: (Data c, ShowOccam c) => A.Structured c -> String))
-
+-}

common/Types.hs

@@ -41,7 +41,7 @@ module Types
 
 import Control.Monad.State
 import Data.Char
-import Data.Generics
+import Data.Generics (Data)
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.List

data/CompState.hs

@@ -23,7 +23,7 @@ import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe

data/Metadata.hs

@@ -21,7 +21,7 @@ module Metadata where
 
 {-! global : Haskell2Xml !-}
 
-import Data.Generics
+import Data.Generics (Data, Typeable, listify)
 import Data.List
 import Numeric
 import Text.Printf

flow/FlowGraph.hs

@@ -46,7 +46,7 @@ module FlowGraph (AlterAST(..), EdgeLabel(..), FNode, FlowGraph, FlowGraph', Gra
 import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import Data.Graph.Inductive hiding (run)
 import Data.Maybe
 

flow/FlowUtils.hs

@@ -21,7 +21,7 @@ module FlowUtils where
 import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import Data.Graph.Inductive hiding (run)
 
 import qualified AST as A

frontends/LexOccam.x

@@ -21,7 +21,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module LexOccam where
 
 import Control.Monad.Error
-import Data.Generics
+import Data.Generics (Data, Typeable)
 
 import Errors
 import Metadata

frontends/LexRain.x

@@ -20,7 +20,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- | Lexically analyse Rain code.
 module LexRain where
 
-import Data.Generics
+import Data.Generics (Data, Typeable)
 
 import Metadata
 }

frontends/OccamPasses.hs

@@ -20,7 +20,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module OccamPasses (occamPasses, foldConstants, checkConstants) where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import Data.List
 import qualified Data.Sequence as Seq
 import qualified Data.Foldable as F

frontends/OccamTypes.hs

@@ -23,7 +23,7 @@ import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Function (on)
-import Data.Generics
+import Data.Generics (Data)
 import Data.IORef
 import Data.List
 import qualified Data.Map as Map

frontends/ParseRain.hs

@@ -21,7 +21,7 @@ module ParseRain where
 
 import Control.Monad (liftM)
 import Control.Monad.State (MonadState, liftIO, get, put)
-import Data.Generics
+import Data.Generics (Data)
 import Data.List
 import Data.Maybe
 import qualified IO

frontends/RainPasses.hs

@@ -20,7 +20,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module RainPasses where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics -- TODO change this module to use Polyplate
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe

frontends/RainTypes.hs

@@ -19,7 +19,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module RainTypes (constantFoldPass, performTypeUnification) where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data, showConstr, toConstr)
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe

frontends/TypeUnification.hs

@@ -21,7 +21,7 @@ module TypeUnification where
 import Control.Monad
 import Control.Monad.State
 import Control.Monad.Trans
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.IORef

frontends/UnifyType.hs

@@ -18,7 +18,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 module UnifyType where
 
-import Data.Generics
+import Data.Generics (Data, Typeable)
 import Data.IORef
 
 import qualified AST as A

pass/Pass.hs

@@ -22,7 +22,7 @@ module Pass where
 import Control.Monad.Error
 import Control.Monad.State
 import Control.Monad.Writer
-import Data.Generics
+import Data.Generics (Constr, Data)
 import Data.Generics.Polyplate
 import Data.List
 import Data.Ord

pass/Properties.hs

@@ -69,7 +69,7 @@ module Properties
   where
 
 import Control.Monad.Writer
-import Data.Generics
+import Data.Generics -- TODO stop this module using SYB
 import Data.Int
 import Data.List
 import qualified Data.Map as Map

pass/Traversal.hs

@@ -22,13 +22,14 @@ module Traversal (
     TransformM, Transform, TransformStructured, TransformStructured'
   , CheckM, Check
   , ExtOpMP, ExtOpMS, ExtOpMSP, extOpMS, PassOnStruct, PassASTOnStruct
-  , applyBottomUpMS
+  , ExtOpQS, extOpQS
+  , applyBottomUpMS, ASTStructured
   , module Data.Generics.Polyplate
   , module Data.Generics.Polyplate.Schemes
   ) where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import Data.Generics.Polyplate
 import Data.Generics.Polyplate.Schemes
 
@@ -68,6 +69,57 @@ type ExtOpMSP opT = ExtOpMS PassM opT
 type PassOnStruct = PassOnOps (ExtOpMSP BaseOp)
 type PassASTOnStruct = PassASTOnOps (ExtOpMSP BaseOp)
 
+class (PolyplateM (A.Structured a) () opsM m
+      ,PolyplateM (A.Structured a) opsM () m
+      ,PolyplateSpine (A.Structured a) opsQ () r
+      ,PolyplateSpine (A.Structured a) () opsQ r
+      ,Data a
+      ,Monad m
+      ) => ASTStructured a opsM m opsQ r
+
+instance (PolyplateM (A.Structured ()) () opsM m
+         ,PolyplateM (A.Structured ()) opsM () m
+         ,PolyplateSpine (A.Structured ()) opsQ () r
+         ,PolyplateSpine (A.Structured ()) () opsQ r
+         ,Monad m) => ASTStructured () opsM m opsQ r
+
+instance (PolyplateM (A.Structured A.Alternative) () opsM m
+         ,PolyplateM (A.Structured A.Alternative) opsM () m
+         ,PolyplateSpine (A.Structured A.Alternative) opsQ () r
+         ,PolyplateSpine (A.Structured A.Alternative) () opsQ r
+         ,Monad m) => ASTStructured A.Alternative opsM m opsQ r
+
+instance (PolyplateM (A.Structured A.Choice) () opsM m
+         ,PolyplateM (A.Structured A.Choice) opsM () m
+         ,PolyplateSpine (A.Structured A.Choice) opsQ () r
+         ,PolyplateSpine (A.Structured A.Choice) () opsQ r
+         ,Monad m) => ASTStructured A.Choice opsM m opsQ r
+
+instance (PolyplateM (A.Structured A.ExpressionList) () opsM m
+         ,PolyplateM (A.Structured A.ExpressionList) opsM () m
+         ,PolyplateSpine (A.Structured A.ExpressionList) opsQ () r
+         ,PolyplateSpine (A.Structured A.ExpressionList) () opsQ r
+         ,Monad m) => ASTStructured A.ExpressionList opsM m opsQ r
+
+instance (PolyplateM (A.Structured A.Option) () opsM m
+         ,PolyplateM (A.Structured A.Option) opsM () m
+         ,PolyplateSpine (A.Structured A.Option) opsQ () r
+         ,PolyplateSpine (A.Structured A.Option) () opsQ r
+         ,Monad m) => ASTStructured A.Option opsM m opsQ r
+
+instance (PolyplateM (A.Structured A.Process) () opsM m
+         ,PolyplateM (A.Structured A.Process) opsM () m
+         ,PolyplateSpine (A.Structured A.Process) opsQ () r
+         ,PolyplateSpine (A.Structured A.Process) () opsQ r
+         ,Monad m) => ASTStructured A.Process opsM m opsQ r
+
+instance (PolyplateM (A.Structured A.Variant) () opsM m
+         ,PolyplateM (A.Structured A.Variant) opsM () m
+         ,PolyplateSpine (A.Structured A.Variant) opsQ () r
+         ,PolyplateSpine (A.Structured A.Variant) () opsQ r
+         ,Monad m) => ASTStructured A.Variant opsM m opsQ r
+
+
 extOpMS :: forall m opT op0T.
           (PolyplateM (A.Structured ()) () op0T m,
            PolyplateM (A.Structured A.Alternative) () op0T m,
@@ -86,9 +138,7 @@ extOpMS :: forall m opT op0T.
           opT ->
           -- Pairing the next two arguments allows us to apply this function infix:
           (op0T, -- just a type witness
-           forall t. (Data t, PolyplateM (A.Structured t) () op0T m
+           forall t. ASTStructured t op0T m () () => A.Structured t -> m (A.Structured t)) ->
-                            , PolyplateM (A.Structured t) op0T () m) =>
-           A.Structured t -> m (A.Structured t)) ->
           ExtOpMS m opT
 extOpMS ops (_, f)
     = ops
@@ -100,6 +150,47 @@ extOpMS ops (_, f)
       `extOpM` (f :: A.Structured A.Alternative -> m (A.Structured A.Alternative))
       `extOpM` (f :: A.Structured () -> m (A.Structured ()))
 
+type ExtOpQS r opT =
+          (A.Structured () -> r,
+          (A.Structured A.Alternative -> r,
+          (A.Structured A.Choice -> r,
+          (A.Structured A.ExpressionList -> r,
+          (A.Structured A.Option -> r,
+          (A.Structured A.Process -> r,
+          (A.Structured A.Variant -> r,
+          opT)))))))
+
+extOpQS :: forall m opT op0T r.
+          (PolyplateSpine (A.Structured ()) () op0T r,
+           PolyplateSpine (A.Structured A.Alternative) () op0T r,
+           PolyplateSpine (A.Structured A.Choice) () op0T r,
+           PolyplateSpine (A.Structured A.ExpressionList) () op0T r,
+           PolyplateSpine (A.Structured A.Option) () op0T r,
+           PolyplateSpine (A.Structured A.Process) () op0T r,
+           PolyplateSpine (A.Structured A.Variant) () op0T r,
+           PolyplateSpine (A.Structured ()) op0T () r,
+           PolyplateSpine (A.Structured A.Alternative) op0T () r,
+           PolyplateSpine (A.Structured A.Choice) op0T () r,
+           PolyplateSpine (A.Structured A.ExpressionList) op0T () r,
+           PolyplateSpine (A.Structured A.Option) op0T () r,
+           PolyplateSpine (A.Structured A.Process) op0T () r,
+           PolyplateSpine (A.Structured A.Variant) op0T () r) =>
+          opT ->
+          -- Pairing the next two arguments allows us to apply this function infix:
+          (op0T, -- just a type witness
+           forall t. ASTStructured t () PassM op0T r => A.Structured t -> r) ->
+          ExtOpQS r opT
+extOpQS ops (_, f)
+    = ops
+      `extOpQ` (f :: A.Structured A.Variant -> r)
+      `extOpQ` (f :: A.Structured A.Process -> r)
+      `extOpQ` (f :: A.Structured A.Option -> r)
+      `extOpQ` (f :: A.Structured A.ExpressionList -> r)
+      `extOpQ` (f :: A.Structured A.Choice -> r)
+      `extOpQ` (f :: A.Structured A.Alternative -> r)
+      `extOpQ` (f :: A.Structured () -> r)
+
+
 applyBottomUpMS :: (PolyplateM t (ExtOpMSP BaseOp) () PassM) =>
   (forall a. (Data a, PolyplateM (A.Structured a) () (ExtOpMSP BaseOp) PassM) =>
      (A.Structured a -> PassM (A.Structured a)))

transformations/ImplicitMobility.hs

@@ -20,7 +20,7 @@ module ImplicitMobility (implicitMobility, mobiliseArrays, inferDeref) where
 
 import Control.Monad
 import Control.Monad.Trans
-import Data.Generics
+import Data.Generics (Data)
 import Data.Graph.Inductive
 import Data.Graph.Inductive.Query.DFS
 import qualified Data.Map as Map

transformations/SimplifyAbbrevs.hs

@@ -25,7 +25,7 @@ module SimplifyAbbrevs (
   ) where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 

transformations/SimplifyExprs.hs

@@ -20,7 +20,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module SimplifyExprs where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import qualified Data.Map as Map
 
 import qualified AST as A
@@ -86,17 +86,11 @@ functionsToProcs = pass "Convert FUNCTIONs to PROCs"
 
     vpToSeq :: Meta -> A.Name -> [A.Variable] -> Either (A.Structured A.ExpressionList) A.Process -> A.Process
     vpToSeq m n vs (Left el) = A.Seq m $ vpToSeq' el vs
-    vpToSeq _ n vs (Right p) = subst p
+    vpToSeq _ n vs (Right p) = applyBottomUp doAssignSubst p
       where
-        subst :: Data t => t -> t
-        subst = doGenericSubst `extT` doAssignSubst
-        
-        doGenericSubst :: Data t => t -> t
-        doGenericSubst = gmapT subst `extT` (id :: String -> String) `extT` (id :: Meta -> Meta)
-        
         doAssignSubst :: A.Process -> A.Process
         doAssignSubst ass@(A.Assign m [A.Variable _ dest] el) = if (A.nameName dest == A.nameName n) then (A.Assign m vs el) else ass
-        doAssignSubst p = doGenericSubst p
+        doAssignSubst p = p
         
 
     vpToSeq' :: A.Structured A.ExpressionList -> [A.Variable] -> A.Structured A.Process

transformations/SimplifyProcs.hs

@@ -20,7 +20,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module SimplifyProcs (simplifyProcs, fixLowReplicators) where
 
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import qualified Data.Set as Set
 
 import qualified AST as A

transformations/Unnest.hs

@@ -21,10 +21,11 @@ module Unnest (unnest, removeNesting) where
 
 import Control.Monad.Identity
 import Control.Monad.State
-import Data.Generics
+import Data.Generics (Data)
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe
+import Data.Tree
 
 import qualified AST as A
 import CompState
@@ -44,16 +45,22 @@ unnest =
       ]
 
 type NameMap = Map.Map String A.Name
+type FreeNameOps = ExtOpQ NameMap (ExtOpQ NameMap (ExtOpQS NameMap BaseOp) A.Name) A.SpecType
 
 -- | Get the set of free names within a block of code.
-freeNamesIn :: Data t => t -> NameMap
+freeNamesIn :: PolyplateSpine t FreeNameOps () NameMap  => t -> NameMap
-freeNamesIn = doGeneric
+freeNamesIn = flattenTree . recurse
-                `extQ` (ignore :: String -> NameMap)
-                `extQ` (ignore :: Meta -> NameMap)
-                `extQ` doName `ext1Q` doStructured `extQ` doSpecType
   where
-    doGeneric :: Data t => t -> NameMap
+    flattenTree :: Tree (Maybe NameMap) -> NameMap
-    doGeneric n = Map.unions $ gmapQ freeNamesIn n
+    flattenTree = foldl Map.union Map.empty . catMaybes . flatten
+    
+    ops :: FreeNameOps
+    ops = baseOp `extOpQS` (ops, doStructured) `extOpQ` doName `extOpQ` doSpecType
+
+    recurse :: PolyplateSpine t FreeNameOps () NameMap => t -> Tree (Maybe NameMap)
+    recurse = transformSpine ops ()
+    descend :: PolyplateSpine t () FreeNameOps NameMap => t -> Tree (Maybe NameMap)
+    descend = transformSpine () ops
     
     ignore :: t -> NameMap
     ignore s = Map.empty
@@ -61,11 +68,14 @@ freeNamesIn = doGeneric
     doName :: A.Name -> NameMap
     doName n = Map.singleton (A.nameName n) n
 
-    doStructured :: Data a => A.Structured a -> NameMap
+    doStructured :: (Data a, PolyplateSpine (A.Structured a) () FreeNameOps NameMap
+                           , PolyplateSpine (A.Structured a) FreeNameOps () NameMap)
+      => A.Structured a -> NameMap
     doStructured (A.Spec _ spec s) = doSpec spec s
-    doStructured s = doGeneric s
+    doStructured s = flattenTree $ descend s
 
-    doSpec :: Data t => A.Specification -> t -> NameMap
+    doSpec :: (PolyplateSpine t () FreeNameOps NameMap
+              ,PolyplateSpine t FreeNameOps () NameMap) => A.Specification -> t -> NameMap
     doSpec (A.Specification _ n st) child
         = Map.union fns $ Map.delete (A.nameName n) $ freeNamesIn child
       where
@@ -74,7 +84,7 @@ freeNamesIn = doGeneric
     doSpecType :: A.SpecType -> NameMap
     doSpecType (A.Proc _ _ fs p) = Map.difference (freeNamesIn p) (freeNamesIn fs)
     doSpecType (A.Function _ _ _ fs vp) = Map.difference (freeNamesIn vp) (freeNamesIn fs)
-    doSpecType st = doGeneric st
+    doSpecType st = flattenTree $ descend st
 
 -- | Replace names.
 --