diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs
index 946d70e..6382bda 100644
--- a/backends/BackendPasses.hs
+++ b/backends/BackendPasses.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -30,6 +30,7 @@ import Metadata
 import Pass
 import PrettyShow
 import qualified Properties as Prop
+import Traversal
 import Types
 import Utils
 
@@ -44,19 +45,16 @@ squashArrays = makePassesDep
   where
     prereq = Prop.agg_namesDone ++ Prop.agg_typesDone ++ Prop.agg_functionsGone ++ [Prop.subscriptsPulledUp, Prop.arrayLiteralsExpanded]
 
-transformWaitFor :: Data t => t -> PassM t
-transformWaitFor = doGeneric `extM` doAlt
+transformWaitFor :: PassType
+transformWaitFor = applyDepthM doAlt
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric transformWaitFor
-  
     doAlt :: A.Process -> PassM A.Process
     doAlt a@(A.Alt m pri s)
       = do (s',(specs,code)) <- runStateT (applyToOnly doWaitFor s) ([],[])
            if (null specs && null code)
              then return a
              else return $ A.Seq m $ foldr addSpec (A.Several m (code ++ [A.Only m $ A.Alt m pri s'])) specs
-    doAlt p = doGeneric p
+    doAlt p = return p
     
     addSpec :: Data a => (A.Structured a -> A.Structured a) -> A.Structured a -> A.Structured a
     addSpec spec inner = spec inner
@@ -81,8 +79,8 @@ append_sizes n = n {A.nameName = A.nameName n ++ "_sizes"}
 
 -- | Declares a _sizes array for every array, statically sized or dynamically sized.
 -- For each record type it declares a _sizes array too.
-declareSizesArray :: Data t => t -> PassM t
-declareSizesArray = doGeneric `ext1M` doStructured
+declareSizesArray :: PassType
+declareSizesArray = applyDepthSM doStructured
   where
     defineSizesName :: Meta -> A.Name -> A.SpecType -> PassM ()
     defineSizesName m n spec
@@ -175,10 +173,6 @@ declareSizesArray = doGeneric `ext1M` doStructured
            defineSizesName m n_sizes sizeSpecType
            return $ A.Specification m n_sizes sizeSpecType
 
-
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric declareSizesArray
-
     doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
     doStructured str@(A.Spec m sp@(A.Specification m' n spec) s)
       = do t <- typeOfSpec spec
@@ -207,14 +201,12 @@ declareSizesArray = doGeneric `ext1M` doStructured
                                 sizeSpec = A.Specification m' n_sizes sizeSpecType
                             defineSizesName m' n_sizes sizeSpecType
                             return sizeSpec
-                  s' <- doStructured s
-                  return (A.Spec m sizeSpec $ A.Spec m sp $ s')
+                  return (A.Spec m sizeSpec $ A.Spec m sp $ s)
              (A.RecordType m _ fs, _) ->
-                do s' <- doStructured s
-                   fieldDeclarations <- foldM (declareFieldSizes (A.nameName n) m) s' fs
+                do fieldDeclarations <- foldM (declareFieldSizes (A.nameName n) m) s fs
                    return $ A.Spec m sp fieldDeclarations
-             _ -> doGeneric str
-    doStructured s = doGeneric s
+             _ -> return str
+    doStructured s = return s
 
     makeStaticSizeSpec :: Meta -> A.Name -> [A.Dimension] -> A.SpecType
     makeStaticSizeSpec m n ds = makeDynamicSizeSpec m n es
@@ -238,21 +230,17 @@ declareSizesArray = doGeneric `ext1M` doStructured
 
 -- | A pass for adding _sizes parameters to PROC arguments
 -- TODO in future, only add _sizes for variable-sized parameters
-addSizesFormalParameters :: Data t => t -> PassM t
-addSizesFormalParameters = doGeneric `extM` doSpecification
+addSizesFormalParameters :: PassType
+addSizesFormalParameters = applyDepthM doSpecification
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric addSizesFormalParameters
-    
     doSpecification :: A.Specification -> PassM A.Specification
     doSpecification (A.Specification m n (A.Proc m' sm args body))
       = do (args', newargs) <- transformFormals m args
-           body' <- doGeneric body
-           let newspec = A.Proc m' sm args' body'
+           let newspec = A.Proc m' sm args' body
            modify (\cs -> cs {csNames = Map.adjust (\nd -> nd { A.ndSpecType = newspec }) (A.nameName n) (csNames cs)})
            mapM_ (recordArg m') newargs
            return $ A.Specification m n newspec
-    doSpecification st = doGeneric st
+    doSpecification st = return st
     
     recordArg :: Meta -> A.Formal -> PassM ()
     recordArg m (A.Formal am t n)
@@ -277,15 +265,12 @@ addSizesFormalParameters = doGeneric `extM` doSpecification
                   return (f : rest, new)
 
 -- | A pass for adding _sizes parameters to actuals in PROC calls
-addSizesActualParameters :: Data t => t -> PassM t
-addSizesActualParameters = doGeneric `extM` doProcess
+addSizesActualParameters :: PassType
+addSizesActualParameters = applyDepthM doProcess
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric addSizesActualParameters
-    
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.ProcCall m n params) = concatMapM transformActual params >>* A.ProcCall m n
-    doProcess p = doGeneric p
+    doProcess p = return p
     
     transformActual :: A.Actual -> PassM [A.Actual]
     transformActual a@(A.ActualVariable v)
@@ -306,25 +291,16 @@ addSizesActualParameters = doGeneric `extM` doProcess
     transformActualVariable a _ = return [a]
 
 -- | Transforms all slices into the FromFor form.
-simplifySlices :: Data t => t -> PassM t
-simplifySlices = doGeneric `extM` doVariable
+simplifySlices :: PassType
+simplifySlices = applyDepthM doVariable
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric simplifySlices
-    
-    -- We recurse into the subscripts in case they contain subscripts:    
     doVariable :: A.Variable -> PassM A.Variable
     doVariable (A.SubscriptedVariable m (A.SubscriptFor m' for) v)
-      = do for' <- doGeneric for
-           v' <- doGeneric v
-           return (A.SubscriptedVariable m (A.SubscriptFromFor m' (makeConstant m' 0) for') v')
+      = return (A.SubscriptedVariable m (A.SubscriptFromFor m' (makeConstant m' 0) for) v)
     doVariable (A.SubscriptedVariable m (A.SubscriptFrom m' from) v)
-      = do v' <- doGeneric v
-           A.Array (d:_) _ <- astTypeOf v'
+      = do A.Array (d:_) _ <- astTypeOf v
            limit <- case d of
              A.Dimension n -> return n
-             A.UnknownDimension -> return $ A.SizeVariable m' v'
-           from' <- doGeneric from
-           return (A.SubscriptedVariable m (A.SubscriptFromFor m' from' (A.Dyadic m A.Subtr limit from')) v')
-    -- We must recurse, to handle nested variables, and variables inside subscripts!
-    doVariable v = doGeneric v
+             A.UnknownDimension -> return $ A.SizeVariable m' v
+           return (A.SubscriptedVariable m (A.SubscriptFromFor m' from (A.Dyadic m A.Subtr limit from)) v)
+    doVariable v = return v
diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs
index 1b0e128..8652923 100644
--- a/backends/GenerateCPPCSP.hs
+++ b/backends/GenerateCPPCSP.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -47,6 +47,7 @@ import Pass
 import qualified Properties as Prop
 import ShowCode
 import TLP
+import Traversal
 import Types
 import Utils
 
@@ -93,7 +94,7 @@ genCPPCSPPasses = makePassesDep' ((== BackendCPPCSP) . csBackend)
   [ ("Transform channels to ANY", chansToAny, [Prop.processTypesChecked], [Prop.allChansToAnyOrProtocol])
   ]
 
-chansToAny :: Data t => t -> PassM t
+chansToAny :: PassType
 chansToAny x = do st <- get
                   case csFrontend st of
                     FrontendOccam ->
@@ -104,13 +105,10 @@ chansToAny x = do st <- get
     chansToAny' :: A.Type -> PassM A.Type
     chansToAny' c@(A.Chan _ _ (A.UserProtocol {})) = return c
     chansToAny' (A.Chan a b _) = return $ A.Chan a b A.Any
-    chansToAny' t = doGeneric t
+    chansToAny' t = return t
     
     chansToAnyM :: Data t => t -> PassM t
-    chansToAnyM = doGeneric `extM` chansToAny'
-    
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric chansToAnyM
+    chansToAnyM = applyDepthM chansToAny'
     
     chansToAnyInCompState :: PassM ()
     chansToAnyInCompState = do st <- get
diff --git a/common/Types.hs b/common/Types.hs
index a5d0eb5..85c3d79 100644
--- a/common/Types.hs
+++ b/common/Types.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -48,9 +48,9 @@ import Errors
 import EvalLiterals
 import Intrinsics
 import Metadata
-import Pass
 import PrettyShow
 import ShowCode
+import Traversal
 import TypeSizes
 import Utils
 
@@ -311,22 +311,14 @@ abbrevModeOfSpec s
 
 -- | Resolve a datatype into its underlying type -- i.e. if it's a named data
 -- type, then return the underlying real type. This will recurse.
-
 underlyingType :: forall m. (CSMR m, Die m) => Meta -> A.Type -> m A.Type
-underlyingType m = underlyingType'
+underlyingType m = applyDepthM doType
   where
-    underlyingType' :: Data t => t -> m t
-    underlyingType' = doGeneric `extM` underlyingType''
-    
-    doGeneric :: Data t => t -> m t
-    doGeneric = makeGeneric underlyingType'
-  
-    underlyingType'' :: A.Type -> m A.Type
-    underlyingType'' t@(A.UserDataType _)
-      = resolveUserType m t >>= underlyingType m
-    underlyingType'' (A.Array ds t)
-      = underlyingType m t >>* addDimensions ds
-    underlyingType'' t = doGeneric t
+    doType :: A.Type -> m A.Type
+    -- This is fairly subtle: after resolving a user type, we have to recurse
+    -- on the resulting type.
+    doType t@(A.UserDataType _) = resolveUserType m t >>= underlyingType m
+    doType t = return t
 
 -- | Like underlyingType, but only do the "outer layer": if you give this a
 -- user type that's an array of user types, then you'll get back an array of
diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs
index a28f055..6868515 100644
--- a/frontends/OccamTypes.hs
+++ b/frontends/OccamTypes.hs
@@ -616,25 +616,33 @@ inSubscriptedContext m body
 --{{{  inferTypes
 
 -- | Infer types.
-inferTypes :: Data t => t -> PassM t
-inferTypes = applyX $ baseX
-                      `extX` doExpression
-                      `extX` doDimension
-                      `extX` doSubscript
-                      `extX` doArrayConstr
-                      `extX` doReplicator
-                      `extX` doAlternative
-                      `extX` doInputMode
-                      `extX` doSpecification
-                      `extX` doProcess
-                      `extX` doVariable
+inferTypes :: PassType
+inferTypes = recurse
   where
-    doExpression :: ExplicitTrans A.Expression
-    doExpression descend outer
+    ops :: Ops
+    ops = baseOp
+          `extOp` doExpression
+          `extOp` doDimension
+          `extOp` doSubscript
+          `extOp` doArrayConstr
+          `extOp` doReplicator
+          `extOp` doAlternative
+          `extOp` doInputMode
+          `extOp` doSpecification
+          `extOp` doProcess
+          `extOp` doVariable
+
+    recurse :: Recurse
+    recurse = makeRecurse ops
+    descend :: Descend
+    descend = makeDescend ops
+
+    doExpression :: Transform A.Expression
+    doExpression outer
         = case outer of
             -- Literals are what we're really looking for here.
             A.Literal m t lr ->
-               do t' <- inferTypes t
+               do t' <- recurse t
                   ctx <- getTypeContext
                   let wantT = case (ctx, t') of
                                 -- No type specified on the literal,
@@ -643,7 +651,7 @@ inferTypes = applyX $ baseX
                                 -- Use the explicit type of the literal, or the
                                 -- default.
                                 _ -> t'
-                  (realT, realLR) <- doLiteral descend (wantT, lr)
+                  (realT, realLR) <- doLiteral (wantT, lr)
                   return $ A.Literal m realT realLR
 
             -- Expressions that aren't literals, but that modify the type
@@ -651,14 +659,14 @@ inferTypes = applyX $ baseX
             A.Dyadic m op le re ->
               let -- Both types are the same.
                   bothSame
-                    =  do lt <- inferTypes le >>= astTypeOf
-                          rt <- inferTypes re >>= astTypeOf
+                    =  do lt <- recurse le >>= astTypeOf
+                          rt <- recurse re >>= astTypeOf
                           inTypeContext (Just $ betterType lt rt) $
                             descend outer
                   -- The RHS type is always A.Int.
                   intOnRight
-                    =  do le' <- inferTypes le
-                          re' <- inTypeContext (Just A.Int) $ inferTypes re
+                    =  do le' <- recurse le
+                          re' <- inTypeContext (Just A.Int) $ recurse re
                           return $ A.Dyadic m op le' re'
               in case classifyOp op of
                    ComparisonOp -> noTypeContext $ bothSame
@@ -675,9 +683,9 @@ inferTypes = applyX $ baseX
                   ctx' <- case ctx of
                             Just t -> unsubscriptType s t >>* Just
                             Nothing -> return Nothing
-                  e' <- inTypeContext ctx' $ inferTypes e
+                  e' <- inTypeContext ctx' $ recurse e
                   t <- astTypeOf e'
-                  s' <- inferTypes s >>= fixSubscript t
+                  s' <- recurse s >>= fixSubscript t
                   return $ A.SubscriptedExpr m s' e'
             A.BytesInExpr _ _ -> noTypeContext $ descend outer
             -- FIXME: ExprConstr
@@ -694,19 +702,19 @@ inferTypes = applyX $ baseX
     doActuals :: Data a => Meta -> A.Name -> [A.Formal] -> Transform [a]
     doActuals m n fs as
         =  do checkActualCount m n fs as
-              sequence [inTypeContext (Just t) $ inferTypes a
+              sequence [inTypeContext (Just t) $ recurse a
                         | (A.Formal _ t _, a) <- zip fs as]
 
-    doDimension :: ExplicitTrans A.Dimension
-    doDimension descend dim = inTypeContext (Just A.Int) $ descend dim
+    doDimension :: Transform A.Dimension
+    doDimension dim = inTypeContext (Just A.Int) $ descend dim
 
-    doSubscript :: ExplicitTrans A.Subscript
-    doSubscript descend s = inTypeContext (Just A.Int) $ descend s
+    doSubscript :: Transform A.Subscript
+    doSubscript s = inTypeContext (Just A.Int) $ descend s
 
     -- FIXME: RepConstr shouldn't contain the type -- and this won't fill it in.
     -- (That is, it should just be a kind of literal.)
-    doArrayConstr :: ExplicitTrans A.ArrayConstr
-    doArrayConstr descend ac
+    doArrayConstr :: Transform A.ArrayConstr
+    doArrayConstr ac
         = case ac of
             A.RangeConstr m t _ _ -> inSubscriptedContext m $ descend ac
             A.RepConstr m t _ _ -> inSubscriptedContext m $ descend ac
@@ -718,46 +726,46 @@ inferTypes = applyX $ baseX
                do es' <- doFunctionCall m n es
                   return $ A.FunctionCallList m n es'
             A.ExpressionList m es ->
-               do es' <- sequence [inTypeContext (Just t) $ inferTypes e
+               do es' <- sequence [inTypeContext (Just t) $ recurse e
                                    | (t, e) <- zip ts es]
                   return $ A.ExpressionList m es'
 
-    doReplicator :: ExplicitTrans A.Replicator
-    doReplicator descend rep
+    doReplicator :: Transform A.Replicator
+    doReplicator rep
         = case rep of
             A.For _ _ _ _ -> inTypeContext (Just A.Int) $ descend rep
             A.ForEach _ _ _ -> noTypeContext $ descend rep
 
-    doAlternative :: ExplicitTrans A.Alternative
-    doAlternative descend a = inTypeContext (Just A.Bool) $ descend a
+    doAlternative :: Transform A.Alternative
+    doAlternative a = inTypeContext (Just A.Bool) $ descend a
 
-    doInputMode :: ExplicitTrans A.InputMode
-    doInputMode descend im = inTypeContext (Just A.Int) $ descend im
+    doInputMode :: Transform A.InputMode
+    doInputMode im = inTypeContext (Just A.Int) $ descend im
 
     -- FIXME: This should be shared with foldConstants.
-    doSpecification :: ExplicitTrans A.Specification
-    doSpecification descend s@(A.Specification m n st)
-        =  do st' <- doSpecType descend st
+    doSpecification :: Transform A.Specification
+    doSpecification s@(A.Specification m n st)
+        =  do st' <- doSpecType st
               -- Update the definition of each name after we handle it.
               modifyName n (\nd -> nd { A.ndSpecType = st' })
               return $ A.Specification m n st'
 
-    doSpecType :: ExplicitTrans A.SpecType
-    doSpecType descend st
+    doSpecType :: Transform A.SpecType
+    doSpecType st
         = case st of
             A.Place _ _ -> inTypeContext (Just A.Int) $ descend st
             A.Is m am t v ->
-               do am' <- inferTypes am
-                  t' <- inferTypes t
-                  v' <- inTypeContext (Just t') $ inferTypes v
+               do am' <- recurse am
+                  t' <- recurse t
+                  v' <- inTypeContext (Just t') $ recurse v
                   t'' <- case t' of
                            A.Infer -> astTypeOf v'
                            _ -> return t'
                   return $ A.Is m am' t'' v'
             A.IsExpr m am t e ->
-               do am' <- inferTypes am
-                  t' <- inferTypes t
-                  e' <- inTypeContext (Just t') $ inferTypes e
+               do am' <- recurse am
+                  t' <- recurse t
+                  e' <- inTypeContext (Just t') $ recurse e
                   t'' <- case t' of
                            A.Infer -> astTypeOf e'
                            _ -> return t'
@@ -765,8 +773,8 @@ inferTypes = applyX $ baseX
             A.IsChannelArray m t vs ->
                -- No expressions in this -- but we may need to infer the type
                -- of the variable if it's something like "cs IS [c]:".
-               do t' <- inferTypes t
-                  vs' <- mapM inferTypes vs
+               do t' <- recurse t
+                  vs' <- mapM recurse vs
                   let dim = makeDimension m $ length vs'
                   t'' <- case (t', vs') of
                            (A.Infer, (v:_)) ->
@@ -777,9 +785,9 @@ inferTypes = applyX $ baseX
                            _ -> return $ applyDimension dim t'
                   return $ A.IsChannelArray m t'' vs'
             A.Function m sm ts fs (Left sel) ->
-               do sm' <- inferTypes sm
-                  ts' <- inferTypes ts
-                  fs' <- inferTypes fs
+               do sm' <- recurse sm
+                  ts' <- recurse ts
+                  fs' <- recurse fs
                   sel' <- doFuncDef ts sel
                   return $ A.Function m sm' ts' fs' (Left sel')
             A.RetypesExpr _ _ _ _ -> noTypeContext $ descend st
@@ -791,27 +799,27 @@ inferTypes = applyX $ baseX
         -- form.)
         doFuncDef :: [A.Type] -> Transform (A.Structured A.ExpressionList)
         doFuncDef ts (A.Spec m spec s)
-            =  do spec' <- inferTypes spec
+            =  do spec' <- recurse spec
                   s' <- doFuncDef ts s
                   return $ A.Spec m spec' s'
         doFuncDef ts (A.ProcThen m p s)
-            =  do p' <- inferTypes p
+            =  do p' <- recurse p
                   s' <- doFuncDef ts s
                   return $ A.ProcThen m p' s'
         doFuncDef ts (A.Only m el)
             =  do el' <- doExpressionList ts el
                   return $ A.Only m el'
 
-    doProcess :: ExplicitTrans A.Process
-    doProcess descend p
+    doProcess :: Transform A.Process
+    doProcess p
         = case p of
             A.Assign m vs el ->
-               do vs' <- inferTypes vs
+               do vs' <- recurse vs
                   ts <- mapM astTypeOf vs'
                   el' <- doExpressionList ts el
                   return $ A.Assign m vs' el'
             A.Output m v ois ->
-               do v' <- inferTypes v
+               do v' <- recurse v
                   -- At this point we must resolve the "c ! x" ambiguity:
                   -- we definitely know what c is, and we must know what x is
                   -- before trying to infer its type.
@@ -828,14 +836,14 @@ inferTypes = applyX $ baseX
                     else do ois' <- doOutputItems m v' Nothing ois
                             return $ A.Output m v' ois'
             A.OutputCase m v tag ois ->
-               do v' <- inferTypes v
+               do v' <- recurse v
                   ois' <- doOutputItems m v' (Just tag) ois
                   return $ A.OutputCase m v' tag ois'
             A.If _ _ -> inTypeContext (Just A.Bool) $ descend p
             A.Case m e so ->
-               do e' <- inferTypes e
+               do e' <- recurse e
                   t <- astTypeOf e'
-                  so' <- inTypeContext (Just t) $ inferTypes so
+                  so' <- inTypeContext (Just t) $ recurse so
                   return $ A.Case m e' so'
             A.While _ _ _ -> inTypeContext (Just A.Bool) $ descend p
             A.Processor _ _ _ -> inTypeContext (Just A.Int) $ descend p
@@ -867,19 +875,19 @@ inferTypes = applyX $ baseX
 
         doOutputItem :: A.Type -> Transform A.OutputItem
         doOutputItem (A.Counted ct at) (A.OutCounted m ce ae)
-            =  do ce' <- inTypeContext (Just ct) $ inferTypes ce
-                  ae' <- inTypeContext (Just at) $ inferTypes ae
+            =  do ce' <- inTypeContext (Just ct) $ recurse ce
+                  ae' <- inTypeContext (Just at) $ recurse ae
                   return $ A.OutCounted m ce' ae'
-        doOutputItem A.Any o = noTypeContext $ inferTypes o
-        doOutputItem t o = inTypeContext (Just t) $ inferTypes o
+        doOutputItem A.Any o = noTypeContext $ recurse o
+        doOutputItem t o = inTypeContext (Just t) $ recurse o
 
-    doVariable :: ExplicitTrans A.Variable
-    doVariable descend (A.SubscriptedVariable m s v)
-        =  do v' <- inferTypes v
+    doVariable :: Transform A.Variable
+    doVariable (A.SubscriptedVariable m s v)
+        =  do v' <- recurse v
               t <- astTypeOf v'
-              s' <- inferTypes s >>= fixSubscript t
+              s' <- recurse s >>= fixSubscript t
               return $ A.SubscriptedVariable m s' v'
-    doVariable descend v = descend v
+    doVariable v = descend v
 
     -- | Resolve the @v[s]@ ambiguity: this takes the type that @v@ is, and
     -- returns the correct 'Subscript'.
@@ -901,8 +909,8 @@ inferTypes = applyX $ baseX
 
     -- | Process a 'LiteralRepr', taking the type it's meant to represent or
     -- 'Infer', and returning the type it really is.
-    doLiteral :: ExplicitTrans (A.Type, A.LiteralRepr)
-    doLiteral descend (wantT, lr)
+    doLiteral :: Transform (A.Type, A.LiteralRepr)
+    doLiteral (wantT, lr)
         = case lr of
             A.ArrayLiteral m aes ->
                do (t, A.ArrayElemArray aes') <-
@@ -960,7 +968,7 @@ inferTypes = applyX $ baseX
                       return (bestT, aes')
         -- An expression: descend into it with the right context.
         doArrayElem wantT (A.ArrayElemExpr e)
-            =  do e' <- inTypeContext (Just wantT) $ doExpression descend e
+            =  do e' <- inTypeContext (Just wantT) $ doExpression e
                   t <- astTypeOf e'
                   checkType (findMeta e') wantT t
                   return (t, A.ArrayElemExpr e')
@@ -1005,7 +1013,7 @@ inferTypes = applyX $ baseX
 -- | Check the AST for type consistency.
 -- This is actually a series of smaller passes that check particular types
 -- inside the AST, but it doesn't really make sense to split it up.
-checkTypes :: Data t => t -> PassM t
+checkTypes :: PassType
 checkTypes t =
     checkVariables t >>=
     checkExpressions >>=
@@ -1014,7 +1022,7 @@ checkTypes t =
 
 --{{{  checkVariables
 
-checkVariables :: Data t => t -> PassM t
+checkVariables :: PassType
 checkVariables = checkDepthM doVariable
   where
     doVariable :: Check A.Variable
@@ -1036,7 +1044,7 @@ checkVariables = checkDepthM doVariable
 --}}}
 --{{{  checkExpressions
 
-checkExpressions :: Data t => t -> PassM t
+checkExpressions :: PassType
 checkExpressions = checkDepthM doExpression
   where
     doExpression :: Check A.Expression
@@ -1091,7 +1099,7 @@ checkExpressions = checkDepthM doExpression
 --}}}
 --{{{  checkSpecTypes
 
-checkSpecTypes :: Data t => t -> PassM t
+checkSpecTypes :: PassType
 checkSpecTypes = checkDepthM doSpecType
   where
     doSpecType :: Check A.SpecType
@@ -1170,7 +1178,7 @@ checkSpecTypes = checkDepthM doSpecType
 --}}}
 --{{{  checkProcesses
 
-checkProcesses :: Data t => t -> PassM t
+checkProcesses :: PassType
 checkProcesses = checkDepthM doProcess
   where
     doProcess :: Check A.Process
diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs
index 40dd7a6..160bf48 100644
--- a/frontends/RainPasses.hs
+++ b/frontends/RainPasses.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -32,6 +32,7 @@ import Pass
 import qualified Properties as Prop
 import RainTypes
 import SimplifyTypes
+import Traversal
 import TreeUtils
 import Types
 
@@ -69,8 +70,8 @@ rainPasses = let f = makePassesDep' ((== FrontendRain) . csFrontend) in f
      ]
 
 -- | A pass that transforms all instances of 'A.Int' into 'A.Int64'
-transformInt :: Data t => t -> PassM t
-transformInt = everywhereM (mkM transformInt')
+transformInt :: PassType
+transformInt = applyDepthM transformInt'
   where
     transformInt' :: A.Type -> PassM A.Type
     transformInt' A.Int = return A.Int64
@@ -89,8 +90,8 @@ transformInt = everywhereM (mkM transformInt')
 --
 -- This pass works because everywhereM goes bottom-up, so declarations are
 --resolved from the bottom upwards.
-uniquifyAndResolveVars :: Data t => t -> PassM t
-uniquifyAndResolveVars = everywhereM (mk1M uniquifyAndResolveVars')
+uniquifyAndResolveVars :: PassType
+uniquifyAndResolveVars = applyDepthSM uniquifyAndResolveVars'
   where
     uniquifyAndResolveVars' :: Data a => A.Structured a -> PassM (A.Structured a)
     
@@ -158,13 +159,13 @@ replaceNameName ::
 replaceNameName find replace n = if (A.nameName n) == find then n {A.nameName = replace} else n
 
 -- | A pass that finds and tags the main process, and also mangles its name (to avoid problems in the C\/C++ backends with having a function called main).
-findMain :: Data t => t -> PassM t
+findMain :: PassType
 --Because findMain runs after uniquifyAndResolveVars, the types of all the process will have been recorded
 --Therefore this pass doesn't actually need to walk the tree, it just has to look for a process named "main"
 --in the CompState, and pull it out into csMainLocals
 findMain x = do newMainName <- makeNonce "main_"
                 modify (findMain' newMainName)
-                everywhereM (mkM $ return . (replaceNameName "main" newMainName)) x
+                applyDepthM (return . (replaceNameName "main" newMainName)) x
   where
     --We have to mangle the main name because otherwise it will cause problems on some backends (including C and C++)
     findMain' :: String -> CompState -> CompState 
@@ -183,32 +184,25 @@ checkIntegral (A.ByteLiteral _ s) = Nothing -- TODO support char literals
 checkIntegral _ = Nothing
 
 -- | Transforms seqeach\/pareach loops over things like [0..99] into SEQ i = 0 FOR 100 loops
-transformEachRange :: Data t => t -> PassM t
-transformEachRange = doGeneric `ext1M` doStructured
+transformEachRange :: PassType
+transformEachRange = applyDepthSM doStructured
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric transformEachRange
-    
     doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
     doStructured (A.Rep repMeta (A.ForEach eachMeta loopVar (A.ExprConstr
       _ (A.RangeConstr _ _ begin end))) body)
-        =   do body' <- doStructured body
-               -- Need to change the stored abbreviation mode to original:
+        =   do -- Need to change the stored abbreviation mode to original:
                modifyName loopVar $ \nd -> nd { A.ndAbbrevMode = A.Original }
                return $ A.Rep repMeta (A.For eachMeta loopVar begin
-                 (addOne $ subExprs end begin)) body'
-    doStructured s = doGeneric s
+                 (addOne $ subExprs end begin)) body
+    doStructured s = return s
 
 -- | A pass that changes all the Rain range constructor expressions into the more general array constructor expressions
 --
 -- TODO make sure when the range has a bad order that an empty list is
 -- returned
-transformRangeRep :: Data t => t -> PassM t
-transformRangeRep = doGeneric `extM` doExpression
+transformRangeRep :: PassType
+transformRangeRep = applyDepthM doExpression
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric transformRangeRep
-    
     doExpression :: A.Expression -> PassM A.Expression
     doExpression (A.ExprConstr _ (A.RangeConstr m t begin end))
           =        do A.Specification _ rep _ <- makeNonceVariable "rep_constr" m A.Int A.VariableName A.ValAbbrev
@@ -216,11 +210,11 @@ transformRangeRep = doGeneric `extM` doExpression
                       return $ A.ExprConstr m $ A.RepConstr m t
                         (A.For m rep begin count)
                           (A.ExprVariable m $ A.Variable m rep)
-    doExpression e = doGeneric e
+    doExpression e = return e
 
 -- TODO this is almost certainly better figured out from the CFG
-checkFunction :: Data t => t -> PassM t
-checkFunction = return -- everywhereM (mkM checkFunction')
+checkFunction :: PassType
+checkFunction = return -- applyDepthM checkFunction'
   where
     checkFunction' :: A.Specification -> PassM A.Specification
     checkFunction' spec@(A.Specification _ n (A.Function m _ _ _ (Right body)))
@@ -246,12 +240,9 @@ checkFunction = return -- everywhereM (mkM checkFunction')
 -- backend we need it to be a variable so we can use begin() and end() (in
 -- C++); these will only be valid if exactly the same list is used
 -- throughout the loop.
-pullUpForEach :: Data t => t -> PassM t
-pullUpForEach = doGeneric `ext1M` doStructured
+pullUpForEach :: PassType
+pullUpForEach = applyDepthSM doStructured
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric pullUpForEach
-
     doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
     doStructured (A.Rep m (A.ForEach m' loopVar loopExp) s)
      = do (extra, loopExp') <- case loopExp of
@@ -260,13 +251,12 @@ pullUpForEach = doGeneric `ext1M` doStructured
                     spec@(A.Specification _ n _) <- makeNonceIsExpr
                       "loop_expr" m' t loopExp
                     return (A.Spec m' spec, A.ExprVariable m' (A.Variable m' n))
-          s' <- doStructured s
-          return $ extra $ A.Rep m (A.ForEach m' loopVar loopExp') s'
-    doStructured s = doGeneric s
+          return $ extra $ A.Rep m (A.ForEach m' loopVar loopExp') s
+    doStructured s = return s
       
     
-pullUpParDeclarations :: Data t => t -> PassM t
-pullUpParDeclarations = everywhereM (mkM pullUpParDeclarations')
+pullUpParDeclarations :: PassType
+pullUpParDeclarations = applyDepthM pullUpParDeclarations'
   where
     pullUpParDeclarations' :: A.Process -> PassM A.Process
     pullUpParDeclarations' p@(A.Par m mode inside) 
diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs
index 7fbce1c..d308882 100644
--- a/frontends/RainTypes.hs
+++ b/frontends/RainTypes.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -86,7 +86,7 @@ markUnify x y
        modify $ \st -> st {csUnifyPairs = (tex,tey) : csUnifyPairs st}
 
 
-performTypeUnification :: Data t => t -> PassM t
+performTypeUnification :: PassType
 performTypeUnification x
   = do -- First, we copy the known types into the unify map:
        st <- get
@@ -122,7 +122,7 @@ performTypeUnification x
             name = A.Name {A.nameName = rawName, A.nameMeta = A.ndMeta d, A.nameType
               = A.ndNameType d}
 
-substituteUnknownTypes :: Data t => Map.Map UnifyIndex A.Type -> t -> PassM t
+substituteUnknownTypes :: Map.Map UnifyIndex A.Type -> PassType
 substituteUnknownTypes mt = applyDepthM sub
   where
     sub :: A.Type -> PassM A.Type
@@ -137,8 +137,8 @@ substituteUnknownTypes mt = applyDepthM sub
       Nothing -> dieP m "Could not deduce type"
 
 -- | A pass that records inferred types.  Currently the only place where types are inferred is in seqeach\/pareach loops.
-recordInfNameTypes :: Data t => t -> PassM t
-recordInfNameTypes = everywhereM (mkM recordInfNameTypes')
+recordInfNameTypes :: PassType
+recordInfNameTypes = applyDepthM recordInfNameTypes'
   where
     recordInfNameTypes' :: A.Replicator -> PassM A.Replicator
     recordInfNameTypes' input@(A.ForEach m n e)
@@ -149,7 +149,7 @@ recordInfNameTypes = everywhereM (mkM recordInfNameTypes')
            return input
     recordInfNameTypes' r = return r
 
-markReplicators :: Data t => t -> PassM t
+markReplicators :: PassType
 markReplicators = checkDepthM mark
   where
     mark :: Check A.Replicator
@@ -157,7 +157,7 @@ markReplicators = checkDepthM mark
       = astTypeOf n >>= \t -> markUnify (A.List t) e
 
 -- | Folds all constants.
-constantFoldPass :: Data t => t -> PassM t
+constantFoldPass :: PassType
 constantFoldPass = applyDepthM doExpression
   where
     doExpression :: A.Expression -> PassM A.Expression
@@ -166,7 +166,7 @@ constantFoldPass = applyDepthM doExpression
 -- | A pass that finds all the 'A.ProcCall' and 'A.FunctionCall' in the
 -- AST, and checks that the actual parameters are valid inputs, given
 -- the 'A.Formal' parameters in the process's type
-markParamPass :: Data t => t -> PassM t
+markParamPass :: PassType
 markParamPass = checkDepthM2 matchParamPassProc matchParamPassFunc
   where
     --Picks out the parameters of a process call, checks the number is correct, and maps doParam over them
@@ -197,7 +197,7 @@ markParamPass = checkDepthM2 matchParamPassProc matchParamPassFunc
     matchParamPassFunc _ = return ()
 
 -- | Checks the types in expressions
-markExpressionTypes :: Data t => t -> PassM t
+markExpressionTypes :: PassType
 markExpressionTypes = checkDepthM checkExpression
   where
     -- TODO also check in a later pass that the op is valid
@@ -217,7 +217,7 @@ markExpressionTypes = checkDepthM checkExpression
     checkExpression _ = return ()
 
 -- | Checks the types in assignments
-markAssignmentTypes :: Data t => t -> PassM t
+markAssignmentTypes :: PassType
 markAssignmentTypes = checkDepthM checkAssignment
   where
     checkAssignment :: Check A.Process
@@ -238,7 +238,7 @@ markAssignmentTypes = checkDepthM checkAssignment
     checkAssignment st = return ()
 
 -- | Checks the types in if and while conditionals
-markConditionalTypes :: Data t => t -> PassM t
+markConditionalTypes :: PassType
 markConditionalTypes = checkDepthM2 checkWhile checkIf
   where
     checkWhile :: Check A.Process
@@ -251,7 +251,7 @@ markConditionalTypes = checkDepthM2 checkWhile checkIf
       = markUnify exp A.Bool
 
 -- | Checks the types in inputs and outputs, including inputs in alts
-markCommTypes :: Data t => t -> PassM t
+markCommTypes :: PassType
 markCommTypes = checkDepthM2 checkInputOutput checkAltInput
   where
     checkInput :: A.Variable -> A.Variable -> Meta -> a -> PassM ()
diff --git a/pass/Pass.hs b/pass/Pass.hs
index 79f35f3..b21818c 100644
--- a/pass/Pass.hs
+++ b/pass/Pass.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -31,7 +31,6 @@ import System.IO
 import qualified AST as A
 import CompState
 import Errors
-import Metadata
 import PrettyShow
 import TreeUtils
 import Utils
@@ -52,7 +51,13 @@ instance Warn PassM where
 instance Warn PassMR where
   warnReport w = lift $ lift $ modify (++ [w])
 
--- | The type of an AST-mangling pass.
+-- | The type of a pass function.
+-- This is as generic as possible. Passes are used on 'A.AST' in normal use,
+-- but for explicit descent and testing it's useful to be able to run them
+-- against AST fragments of other types as well.
+type PassType = (forall s. Data s => s -> PassM s)
+
+-- | A description of an AST-mangling pass.
 data Monad m => Pass_ m = Pass {
   passCode :: A.AST -> m A.AST
  ,passName :: String 
@@ -67,10 +72,10 @@ instance Monad m => Eq (Pass_ m) where
 instance Monad m => Ord (Pass_ m) where
   compare x y = compare (passName x) (passName y)
 
-
 type Pass = Pass_ PassM
 type PassR = Pass_ PassMR
 
+-- | A property that can be asserted and tested against the AST.
 data Property = Property {
   propName :: String
  ,propCheck :: A.AST -> PassMR ()
@@ -157,19 +162,8 @@ applyToOnly f (A.ProcThen m p s) = applyToOnly f s >>* A.ProcThen m p
 applyToOnly f (A.Several m ss) = mapM (applyToOnly f) ss >>* A.Several m
 applyToOnly f (A.Only m o) = f o >>* A.Only m
 
--- | Make a generic rule for a pass.
-makeGeneric :: forall m t. (Data t, Monad m) => (forall s. Data s => s -> m s) -> t -> m t
-makeGeneric top
-    = (gmapM top)
-        `extM` (return :: String -> m String)
-        `extM` (return :: Meta -> m Meta)
-
 excludeConstr :: (Data a, CSMR m) => [Constr] -> a -> m a
 excludeConstr cons x 
   = if null items then return x else dieInternal (Nothing, "Excluded item still remains in source tree: " ++ (show $ head items) ++ " tree is: " ++ pshow x)
       where
         items = checkTreeForConstr cons x
-
-mk1M :: (Monad m, Data a, Typeable1 t) => (forall d . Data d => t d -> m (t d)) -> a -> m a
-mk1M = ext1M return
-
diff --git a/pass/Traversal.hs b/pass/Traversal.hs
index e94833e..92a2020 100644
--- a/pass/Traversal.hs
+++ b/pass/Traversal.hs
@@ -18,98 +18,183 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 -- | Traversal strategies over the AST and other data types.
 module Traversal (
-    ExplicitTrans, Transform, Check
-  , transformToExplicitDepth, checkToTransform
-  , baseX, extX, extD, extC, applyX
-  , applyDepthM, applyDepthM2
+    OpsM, Ops
+  , TransformM, Transform
+  , CheckM, Check
+  , baseOp, extOp, extOpS
+  , makeDepth, extOpD, extOpSD
+  , makeCheck, extOpC
+  , RecurseM, Recurse, makeRecurse
+  , DescendM, Descend, makeDescend
+  , applyDepthM, applyDepthSM, applyDepthM2
   , checkDepthM, checkDepthM2
   ) where
 
 import Data.Generics
 
+import qualified AST as A
 import GenericUtils
-import NavAST
 import Pass
 
--- | A transformation for a single 'Data' type with explicit descent.
--- The first argument passed is a function that can be called to explicitly
--- descend into a generic value.
-type ExplicitTrans t = (forall s. Data s => s -> PassM s) -> t -> PassM t
+-- | A set of generic operations.
+type OpsM m = ([TypeKey], DescendM m -> RecurseM m)
 
--- | A transformation for a single 'Data' type with implicit descent.
--- This can be applied recursively throughout a data structure.
-type Transform t = t -> PassM t
+-- | As 'OpsM', but specialised for 'PassM'.
+type Ops = OpsM PassM
 
--- | A check for a single 'Data' type with implicit descent.
+-- | A transformation for a single 'Data' type.
+type TransformM m t = t -> m t
+
+-- | As 'TransformM', but specialised for 'PassM'.
+type Transform t = TransformM PassM t
+
+-- | A check for a single 'Data' type.
 -- This is like 'Transform', but it doesn't change the value; it may fail or
 -- modify the state, though.
-type Check t = t -> PassM ()
+type CheckM m t = t -> m ()
 
--- | Make an 'ExplicitTrans' that applies a 'Transform', recursing depth-first.
-transformToExplicitDepth :: Data t => Transform t -> ExplicitTrans t
-transformToExplicitDepth f descend x = descend x >>= f
+-- | As 'CheckM', but specialised for 'PassM'.
+type Check t = CheckM PassM t
 
--- | Make a 'Transform' that applies a 'Check'.
-checkToTransform :: Data t => Check t -> Transform t
-checkToTransform f x = f x >> return x
+-- | An empty set of operations.
+baseOp :: forall m. Monad m => OpsM m
+baseOp = ([], id)
 
--- | A set of generic transformations.
-type InfoX = ([TypeKey],
-              (forall dgt. Data dgt => dgt -> PassM dgt)
-              -> (forall t1. Data t1 => t1 -> PassM t1)
-              -> (forall t2. Data t2 => t2 -> PassM t2))
+-- | Add a 'TransformM' to a set, to be applied with explicit descent
+-- (that is, the transform will be responsible for recursing into child
+-- elements itself).
+extOp :: forall m t. (Monad m, Data t) => OpsM m -> TransformM m t -> OpsM m
+extOp (tks, g) f = ((typeKey (undefined :: t)) : tks,
+                    (\descend -> g descend `extM` f))
 
--- | An empty set of transformations.
-baseX :: InfoX
-baseX = ([], (\doGeneric t -> t))
+-- | As 'extOp', but for transformations that work on all 'A.Structured' types.
+extOpS :: forall m. Monad m =>
+          OpsM m
+          -> (forall t. Data t => TransformM m (A.Structured t))
+          -> OpsM m
+extOpS ops f
+    = ops
+      `extOp` (f :: TransformM m (A.Structured A.Variant))
+      `extOp` (f :: TransformM m (A.Structured A.Process))
+      `extOp` (f :: TransformM m (A.Structured A.Option))
+      `extOp` (f :: TransformM m (A.Structured A.ExpressionList))
+      `extOp` (f :: TransformM m (A.Structured A.Choice))
+      `extOp` (f :: TransformM m (A.Structured A.Alternative))
+      `extOp` (f :: TransformM m (A.Structured ()))
 
--- | Add an 'ExplicitTrans' to a set.
-extX :: forall t. Data t => InfoX -> ExplicitTrans t -> InfoX
-extX (tks, g) f = ((typeKey (undefined :: t)) : tks,
-                   (\doGeneric t -> (g doGeneric t) `extM` (f doGeneric)))
+-- | Generate an operation that applies a 'TransformM' with automatic
+-- depth-first descent.
+makeDepth :: (Monad m, Data t) => OpsM m -> TransformM m t -> TransformM m t
+makeDepth ops f v = descend v >>= f
+  where
+    descend = makeDescend ops
 
--- | Add a 'Transform' to a set, to be applied depth-first.
-extD :: forall t. Data t => InfoX -> Transform t -> InfoX
-extD info f = extX info (transformToExplicitDepth f)
+-- | Add a 'TransformM' to a set, to be applied with automatic depth-first
+-- descent.
+extOpD :: forall m t. (Monad m, Data t) => OpsM m -> OpsM m -> TransformM m t -> OpsM m
+extOpD ops ops0 f = ops `extOp` (makeDepth ops0 f)
 
--- | Add a 'Check' to a set, to be applied depth-first.
-extC :: forall t. Data t => InfoX -> Check t -> InfoX
-extC info f = extD info (checkToTransform f)
+-- | As 'extOpD', but for transformations that work on all 'A.Structured' types.
+extOpSD :: forall m. Monad m =>
+           OpsM m
+           -> OpsM m
+           -> (forall t. Data t => TransformM m (A.Structured t))
+           -> OpsM m
+extOpSD ops ops0 f = ops `extOpS` (makeDepth ops0 f)
 
--- | Apply a set of transformations.
-applyX :: Data s => InfoX -> s -> PassM s
-applyX info@(tks, maker) = trans
+-- | Generate an operation that applies a 'CheckM' with automatic
+-- depth-first descent.
+makeCheck :: (Monad m, Data t) => OpsM m -> CheckM m t -> TransformM m t
+makeCheck ops f v = descend v >> f v >> return v
+  where
+    descend = makeDescend ops
+
+-- | Add a 'CheckM' to a set, to be applied with automatic depth-first descent.
+extOpC :: forall m t. (Monad m, Data t) => OpsM m -> OpsM m -> CheckM m t -> OpsM m
+extOpC ops ops0 f = ops `extOp` (makeCheck ops0 f)
+
+-- | A function that applies a generic operation.
+-- This applies the operations in the set to the provided value.
+--
+-- This is the type of function that you want to use to apply a generic
+-- operation; a pass in Tock is usually the application of a 'RecurseM' to the
+-- AST. It's also what you should use when you're writing a pass that uses
+-- explicit descent, and you want to explicitly recurse into one of the
+-- children of a value that one of your transformations has been applied to.
+type RecurseM m = (forall t. Data t => t -> m t)
+
+-- | As 'RecurseM', but specialised for 'PassM'.
+type Recurse = RecurseM PassM
+
+-- | Build a 'RecurseM' function from a set of operations.
+makeRecurse :: forall m. Monad m => OpsM m -> RecurseM m
+makeRecurse ops@(_, f) = f descend
+  where
+    descend :: DescendM m
+    descend = makeDescend ops
+
+-- | A function that applies a generic operation.
+-- This applies the operations in the set to the immediate children of the
+-- provided value, but not to the value itself.
+--
+-- You should use this type of operation when you're writing a traversal with
+-- explicit descent, and you want to descend into all the children of a value
+-- that one of your transformations has been applied to.
+type DescendM m = (forall t. Data t => t -> m t)
+
+-- | As 'DescendM', but specialised for 'PassM'.
+type Descend = DescendM PassM
+
+-- | Build a 'DescendM' function from a set of operations.
+makeDescend :: forall m. Monad m => OpsM m -> DescendM m
+makeDescend ops@(tks, _) = gmapMFor ts recurse
   where
     ts :: TypeSet
     ts = makeTypeSet tks
 
-    trans :: Data s => s -> PassM s
-    trans = maker doGeneric doGeneric
-
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = gmapMFor ts trans
+    recurse :: RecurseM m
+    recurse = makeRecurse ops
 
 -- | Apply a transformation, recursing depth-first.
-applyDepthM :: forall t1 s. (Data t1, Data s) =>
-               Transform t1 -> s -> PassM s
-applyDepthM f1
-    = applyX $ baseX `extD` f1
+applyDepthM :: forall m t1 s. (Monad m, Data t1, Data s) =>
+               TransformM m t1 -> s -> m s
+applyDepthM f1 = makeRecurse ops
+  where
+    ops :: OpsM m
+    ops = baseOp `extOp` makeDepth ops f1
+
+-- | As 'applyDepthM', but for transformations that work on all 'A.Structured'
+-- types.
+applyDepthSM :: forall m s. (Monad m, Data s) =>
+                (forall t. Data t => TransformM m (A.Structured t)) -> s -> m s
+applyDepthSM f1 = makeRecurse ops
+  where
+    ops :: OpsM m
+    ops = extOpSD baseOp ops f1
 
 -- | Apply two transformations, recursing depth-first.
-applyDepthM2 :: forall t1 t2 s. (Data t1, Data t2, Data s) =>
-                Transform t1 -> Transform t2 -> s -> PassM s
-applyDepthM2 f1 f2
-    = applyX $ baseX `extD` f1 `extD` f2
+applyDepthM2 :: forall m t1 t2 s. (Monad m, Data t1, Data t2, Data s) =>
+                TransformM m t1 -> TransformM m t2 -> s -> m s
+applyDepthM2 f1 f2 = makeRecurse ops
+  where
+    ops :: OpsM m
+    ops = baseOp `extOp` makeDepth ops f1
+                 `extOp` makeDepth ops f2
 
 -- | Apply a check, recursing depth-first.
-checkDepthM :: forall t1 s. (Data t1, Data s) =>
-               Check t1 -> s -> PassM s
-checkDepthM f1
-    = applyX $ baseX `extC` f1
+checkDepthM :: forall m t1 s. (Monad m, Data t1, Data s) =>
+               CheckM m t1 -> s -> m s
+checkDepthM f1 = makeRecurse ops
+  where
+    ops :: OpsM m
+    ops = baseOp `extOp` makeCheck ops f1
 
 -- | Apply two checks, recursing depth-first.
-checkDepthM2 :: forall t1 t2 s. (Data t1, Data t2, Data s) =>
-               Check t1 -> Check t2 -> s -> PassM s
-checkDepthM2 f1 f2
-    = applyX $ baseX `extC` f1 `extC` f2
+checkDepthM2 :: forall m t1 t2 s. (Monad m, Data t1, Data t2, Data s) =>
+               CheckM m t1 -> CheckM m t2 -> s -> m s
+checkDepthM2 f1 f2 = makeRecurse ops
+  where
+    ops :: OpsM m
+    ops = baseOp `extOp` makeCheck ops f1
+                 `extOp` makeCheck ops f2
 
diff --git a/transformations/SimplifyComms.hs b/transformations/SimplifyComms.hs
index 849ba17..9fab435 100644
--- a/transformations/SimplifyComms.hs
+++ b/transformations/SimplifyComms.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -20,7 +20,6 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module SimplifyComms where
 
 import Control.Monad.State
-import Data.Generics
 import Data.List
 
 import qualified AST as A
@@ -28,6 +27,7 @@ import CompState
 import Metadata
 import Pass
 import qualified Properties as Prop
+import Traversal
 import Types
 import Utils
 
@@ -38,12 +38,9 @@ simplifyComms = makePassesDep
        ,("Flatten sequential protocol inputs into multiple inputs", transformProtocolInput, Prop.agg_namesDone ++ Prop.agg_typesDone ++ [Prop.inputCaseRemoved], [Prop.seqInputsFlattened])
       ]
 
-outExprs :: Data t => t -> PassM t
-outExprs = doGeneric `extM` doProcess
+outExprs :: PassType
+outExprs = applyDepthM doProcess
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric outExprs
-
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Output m c ois)
         =  do (ois', specs) <- mapAndUnzipM changeItem ois
@@ -53,7 +50,7 @@ outExprs = doGeneric `extM` doProcess
         =  do (ois', specs) <- mapAndUnzipM changeItem ois
               let foldedSpec = foldFuncs specs
               return $ A.Seq m (foldedSpec $ A.Only m $ A.OutputCase m c tag ois')
-    doProcess p = doGeneric p
+    doProcess p = return p
   
     changeItem :: A.OutputItem -> PassM (A.OutputItem, A.Structured A.Process -> A.Structured A.Process)
     changeItem (A.OutExpression m e) = do (e', spec) <- transExpr m e
@@ -133,12 +130,9 @@ ALT
          -- process D
 -}
 
-transformInputCase :: Data t => t -> PassM t
-transformInputCase = doGeneric `extM` doProcess
+transformInputCase :: PassType
+transformInputCase = applyDepthM doProcess
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric transformInputCase
-
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Input m v (A.InputCase m' s))
       = do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
@@ -149,15 +143,14 @@ transformInputCase = doGeneric `extM` doProcess
     doProcess (A.Alt m pri s)
       = do s' <- doStructuredA s
            return (A.Alt m pri s')
-    doProcess p = doGeneric p
+    doProcess p = return p
 
     -- Can't easily use generics here as we're switching from one type of Structured to another
     doStructuredV :: A.Variable -> A.Structured A.Variant -> PassM (A.Structured A.Option)
     -- These entries all just burrow deeper into the structured:
     doStructuredV v (A.ProcThen m p s)
       = do s' <- doStructuredV v s
-           p' <- doProcess p
-           return (A.ProcThen m p' s')
+           return (A.ProcThen m p s')
     doStructuredV v (A.Spec m sp st)
       = do st' <- doStructuredV v st
            return (A.Spec m sp st')
@@ -171,20 +164,18 @@ transformInputCase = doGeneric `extM` doProcess
     doStructuredV chanVar (A.Only m (A.Variant m' n iis p))
       = do (Right items) <- protocolItems chanVar
            let (Just idx) = elemIndex n (fst $ unzip items)
-           p' <- doProcess p
            return $ A.Only m $ A.Option m' [makeConstant m' idx] $
              if (length iis == 0)
-               then p'
+               then p
                else A.Seq m' $ A.Several m'
-                      [A.Only m' $ A.Input m' chanVar (A.InputSimple m' iis)
-                      ,A.Only (findMeta p') p'] 
+                      [A.Only m' $ A.Input m' chanVar (A.InputSimple m' iis),
+                       A.Only (findMeta p) p]
  
     doStructuredA :: A.Structured A.Alternative -> PassM (A.Structured A.Alternative)
-    -- TODO use generics instead of this boilerplate, but don't omit the doProcess call in ProcThen!
+    -- TODO use generics instead of this boilerplate
     doStructuredA (A.ProcThen m p s)
       = do s' <- doStructuredA s
-           p' <- doProcess p
-           return (A.ProcThen m p' s')
+           return (A.ProcThen m p s')
     doStructuredA (A.Spec m sp st)
       = do st' <- doStructuredA st
            return (A.Spec m sp st')
@@ -206,22 +197,18 @@ transformInputCase = doGeneric `extM` doProcess
     -- Leave other guards (and parts of Structured) untouched:
     doStructuredA s = return s
     
-transformProtocolInput :: Data t => t -> PassM t
-transformProtocolInput = doGeneric `extM` doProcess `extM` doAlternative
+transformProtocolInput :: PassType
+transformProtocolInput = applyDepthM2 doProcess doAlternative
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric transformProtocolInput
-    
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Input m v (A.InputSimple m' iis@(_:_:_)))
       = return $ A.Seq m $ A.Several m $
           map (A.Only m . A.Input m v . A.InputSimple m' . singleton) iis
-    doProcess p = doGeneric p
+    doProcess p = return p
 
     doAlternative :: A.Alternative -> PassM A.Alternative
     doAlternative (A.Alternative m cond v (A.InputSimple m' (firstII:(otherIIS@(_:_)))) body)
-      = do body' <- doProcess body
-           return $ A.Alternative m cond v (A.InputSimple m' [firstII]) $ A.Seq m' $ A.Several m' $
+      = return $ A.Alternative m cond v (A.InputSimple m' [firstII]) $ A.Seq m' $ A.Several m' $
              map (A.Only m' . A.Input m' v . A.InputSimple m' . singleton) otherIIS
-             ++ [A.Only m' body']
-    doAlternative s = doGeneric s
+             ++ [A.Only m' body]
+    doAlternative s = return s
diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs
index 3d77a0c..030fbe8 100644
--- a/transformations/SimplifyExprs.hs
+++ b/transformations/SimplifyExprs.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -31,6 +31,7 @@ import Metadata
 import Pass
 import qualified Properties as Prop
 import ShowCode
+import Traversal
 import Types
 import Utils
 
@@ -48,12 +49,9 @@ simplifyExprs = makePassesDep
 --      ++ makePassesDep' ((== BackendCPPCSP) . csBackend) [("Pull up definitions (C++)", pullUp True, Prop.agg_namesDone ++ [Prop.expressionTypesChecked, Prop.functionsRemoved, Prop.processTypesChecked,Prop.seqInputsFlattened], [Prop.functionCallsRemoved, Prop.subscriptsPulledUp])]
 
 -- | Convert FUNCTION declarations to PROCs.
-functionsToProcs :: Data t => t -> PassM t
-functionsToProcs = doGeneric `extM` doSpecification
+functionsToProcs :: PassType
+functionsToProcs = applyDepthM doSpecification
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric functionsToProcs
-
     doSpecification :: A.Specification -> PassM A.Specification
     doSpecification (A.Specification m n (A.Function mf sm rts fs evp))
         = do -- Create new names for the return values.
@@ -76,8 +74,8 @@ functionsToProcs = doGeneric `extM` doSpecification
                         A.ndPlacement = A.Unplaced
                       }
              defineName n nd
-             doGeneric spec
-    doSpecification s = doGeneric s
+             return spec
+    doSpecification s = return s
 
     vpToSeq :: Meta -> A.Name -> Either (A.Structured A.ExpressionList) A.Process -> [A.Variable] -> A.Process
     vpToSeq m n (Left el) vs = A.Seq m $ vpToSeq' el vs
@@ -101,40 +99,32 @@ functionsToProcs = doGeneric `extM` doSpecification
 
 -- | Convert AFTER expressions to the equivalent using MINUS (which is how the
 -- occam 3 manual defines AFTER).
-removeAfter :: Data t => t -> PassM t
-removeAfter = doGeneric `extM` doExpression
+removeAfter :: PassType
+removeAfter = applyDepthM doExpression
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric removeAfter
-
     doExpression :: A.Expression -> PassM A.Expression
     doExpression (A.Dyadic m A.After a b)
-        =  do a' <- removeAfter a
-              b' <- removeAfter b
-              t <- astTypeOf a'
+        =  do t <- astTypeOf a
               case t of
                 A.Byte -> do let one = A.Literal m t $ A.IntLiteral m "1"
                                  oneTwoSeven = A.Literal m t $ A.IntLiteral m "127"
-                             return $ A.Dyadic m A.Less (A.Dyadic m A.Minus (A.Dyadic m A.Minus a' b') one) oneTwoSeven
+                             return $ A.Dyadic m A.Less (A.Dyadic m A.Minus (A.Dyadic m A.Minus a b) one) oneTwoSeven
                 _ -> do let zero = A.Literal m t $ A.IntLiteral m "0"
-                        return $ A.Dyadic m A.More (A.Dyadic m A.Minus a' b') zero
-    doExpression e = doGeneric e
+                        return $ A.Dyadic m A.More (A.Dyadic m A.Minus a b) zero
+    doExpression e = return e
 
--- | For array literals that include other arrays, burst them into their elements.
-expandArrayLiterals :: Data t => t -> PassM t
-expandArrayLiterals = doGeneric `extM` doArrayElem
+-- | For array literals that include other arrays, burst them into their
+-- elements.
+expandArrayLiterals :: PassType
+expandArrayLiterals = applyDepthM doArrayElem
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric expandArrayLiterals
-
     doArrayElem :: A.ArrayElem -> PassM A.ArrayElem
     doArrayElem ae@(A.ArrayElemExpr e)
-        =  do e' <- expandArrayLiterals e
-              t <- astTypeOf e'
+        =  do t <- astTypeOf e
               case t of
                 A.Array ds _ -> expand ds e
-                _ -> doGeneric ae
-    doArrayElem ae = doGeneric ae
+                _ -> return ae
+    doArrayElem ae = return ae
 
     expand :: [A.Dimension] -> A.Expression -> PassM A.ArrayElem
     expand [] e = return $ A.ArrayElemExpr e
@@ -159,26 +149,21 @@ expandArrayLiterals = doGeneric `extM` doArrayElem
 -- Therefore, we only need to pull up the counts for sequential replicators
 --
 -- TODO for simplification, we could avoid pulling up replication counts that are known to be constants
-pullRepCounts :: Data t => t -> PassM t
-pullRepCounts = doGeneric `extM` doProcess
+pullRepCounts :: PassType
+pullRepCounts = applyDepthM doProcess
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric pullRepCounts
-    
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Seq m s) = pullRepCountSeq s >>* A.Seq m
-    doProcess p = doGeneric p
+    doProcess p = return p
     
     pullRepCountSeq :: A.Structured A.Process -> PassM (A.Structured A.Process)
-    pullRepCountSeq (A.Only m p) = doProcess p >>* A.Only m
+    pullRepCountSeq s@(A.Only _ _) = return s
     pullRepCountSeq (A.Spec m sp str)
-      = do sp' <- pullRepCounts sp
-           str' <- pullRepCountSeq str
-           return $ A.Spec m sp' str'
+      = do str' <- pullRepCountSeq str
+           return $ A.Spec m sp str'
     pullRepCountSeq (A.ProcThen m p s)
-      = do p' <- doProcess p
-           s' <- pullRepCountSeq s
-           return $ A.ProcThen m p' s'
+      = do s' <- pullRepCountSeq s
+           return $ A.ProcThen m p s'
     pullRepCountSeq (A.Several m ss) = mapM pullRepCountSeq ss >>* A.Several m
     pullRepCountSeq (A.Rep m (A.For m' n from for) s)
       = do t <- astTypeOf for
@@ -190,12 +175,9 @@ pullRepCounts = doGeneric `extM` doProcess
       = do s' <- pullRepCountSeq s
            return $ A.Rep m rep s'
 
-transformConstr :: Data t => t -> PassM t
-transformConstr = doGeneric `ext1M` doStructured
+transformConstr :: PassType
+transformConstr = applyDepthSM doStructured
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric transformConstr
-
     -- For arrays, this takes a constructor expression:
     --   VAL type name IS [i = rep | expr]:
     --   ...
@@ -218,8 +200,7 @@ transformConstr = doGeneric `ext1M` doStructured
     --     name += [expr]
     doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
     doStructured (A.Spec m (A.Specification m' n (A.IsExpr _ _ _ expr@(A.ExprConstr m'' (A.RepConstr _ t rep exp)))) scope)
-      = do scope' <- transformConstr scope
-           case t of
+      = do case t of
              A.Array {} ->
                do indexVarSpec@(A.Specification _ indexName _) <- makeNonceVariable "array_constr_index" m'' A.Int A.VariableName A.Original
                   let indexVar = A.Variable m'' indexName
@@ -232,11 +213,11 @@ transformConstr = doGeneric `ext1M` doStructured
                             [ assignItem indexVar
                             , incrementIndex indexVar ]
                     ])
-                    scope'
+                    scope
              A.List {} ->
                return $ declDest $ A.ProcThen m''
                  (A.Seq m'' $ A.Rep m'' rep $ appendItem)
-                 scope'
+                 scope
              _ -> diePC m $ formatCode "Unsupported type for array constructor: %" t
       where
         declDest :: Data a => A.Structured a -> A.Structured a
@@ -261,26 +242,26 @@ transformConstr = doGeneric `ext1M` doStructured
             (A.ExprVariable m'' $ A.Variable m'' n)
             (A.Literal m'' t $ A.ListLiteral m'' [exp])]
 
-    doStructured s = doGeneric s
+    doStructured s = return s
 
 -- | Find things that need to be moved up to their enclosing Structured, and do
 -- so.
-pullUp :: Data t => Bool -> t -> PassM t
-pullUp pullUpArraysInsideRecords
-       = doGeneric
-          `ext1M` doStructured
-          `extM` doProcess
-          `extM` doSpecification
-          `extM` doLiteralRepr
-          `extM` doExpression
-          `extM` doVariable
-          `extM` doExpressionList
+pullUp :: Bool -> PassType
+pullUp pullUpArraysInsideRecords = recurse
   where
-    pullUpRecur :: Data t => t -> PassM t
-    pullUpRecur = pullUp pullUpArraysInsideRecords
-  
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric pullUpRecur
+    ops :: Ops
+    ops = baseOp
+          `extOpS` doStructured
+          `extOp` doProcess
+          `extOp` doSpecification
+          `extOp` doLiteralRepr
+          `extOp` doExpression
+          `extOp` doVariable
+          `extOp` doExpressionList
+    recurse :: Recurse
+    recurse = makeRecurse ops
+    descend :: Descend
+    descend = makeDescend ops
 
     -- | When we encounter a Structured, create a new pulled items state,
     -- recurse over it, then apply whatever pulled items we found to it.
@@ -288,7 +269,7 @@ pullUp pullUpArraysInsideRecords
     doStructured s
         =  do pushPullContext
               -- Recurse over the body, then apply the pulled items to it
-              s' <- doGeneric s >>= applyPulled
+              s' <- descend s >>= applyPulled
               -- ... and restore the original pulled items
               popPullContext
               return s'
@@ -298,7 +279,7 @@ pullUp pullUpArraysInsideRecords
     doProcess :: A.Process -> PassM A.Process
     doProcess p
         =  do pushPullContext
-              p' <- doGeneric p
+              p' <- descend p
               pulled <- havePulled
               p'' <- if pulled
                        then liftM (A.Seq emptyMeta) $ applyPulled (A.Only emptyMeta p')
@@ -310,11 +291,11 @@ pullUp pullUpArraysInsideRecords
     doSpecification :: A.Specification -> PassM A.Specification
     -- Iss might be SubscriptedVars -- which is fine; the backend can deal with that.
     doSpecification (A.Specification m n (A.Is m' am t v))
-        =  do v' <- doGeneric v    -- note doGeneric rather than pullUp
+        =  do v' <- descend v    -- note descend rather than pullUp
               return $ A.Specification m n (A.Is m' am t v')
     -- IsExprs might be SubscriptedExprs, and if so we have to convert them.
     doSpecification (A.Specification m n (A.IsExpr m' am t e))
-        =  do e' <- doExpression' e  -- note doExpression' rather than pullUp
+        =  do e' <- doExpression' e  -- note doExpression' rather than recurse
               return $ A.Specification m n (A.IsExpr m' am t e')
     -- Convert RetypesExpr into Retypes of a variable.
     doSpecification (A.Specification m n (A.RetypesExpr m' am toT e))
@@ -323,7 +304,7 @@ pullUp pullUpArraysInsideRecords
               spec@(A.Specification _ n' _) <- makeNonceIsExpr "retypes_expr" m' fromT e'
               addPulled $ (m', Left spec)
               return $ A.Specification m n (A.Retypes m' am toT (A.Variable m' n'))
-    doSpecification s = doGeneric s
+    doSpecification s = descend s
 
     -- | Filter what can be pulled in LiteralReprs.
     doLiteralRepr :: A.LiteralRepr -> PassM A.LiteralRepr
@@ -331,9 +312,9 @@ pullUp pullUpArraysInsideRecords
     -- for nested array literals.
     -- Don't pull up array expressions that are fields of record literals.
     doLiteralRepr (A.RecordLiteral m es)
-        =  do es' <- mapM (if pullUpArraysInsideRecords then doExpression else doExpression') es    -- note doExpression' rather than pullUp
+        =  do es' <- mapM (if pullUpArraysInsideRecords then doExpression else doExpression') es    -- note doExpression' rather than recurse
               return $ A.RecordLiteral m es'
-    doLiteralRepr lr = doGeneric lr
+    doLiteralRepr lr = descend lr
 
     -- | Pull array expressions that aren't already non-subscripted variables.
     -- Also pull lists that are literals or constructed
@@ -366,7 +347,7 @@ pullUp pullUpArraysInsideRecords
     -- | Pull any variable subscript that results in an array.
     doVariable :: A.Variable -> PassM A.Variable
     doVariable v@(A.SubscriptedVariable m _ _)
-        =  do v' <- doGeneric v
+        =  do v' <- descend v
               t <- astTypeOf v'
               case t of
                 A.Array _ _ ->
@@ -376,12 +357,12 @@ pullUp pullUpArraysInsideRecords
                      addPulled $ (m, Left spec)
                      return $ A.Variable m n
                 _ -> return v'
-    doVariable v = doGeneric v
+    doVariable v = descend v
 
     -- | Convert a FUNCTION call into some variables and a PROC call.
     convertFuncCall :: Meta -> A.Name -> [A.Expression] -> PassM [A.Variable]
     convertFuncCall m n es
-        = do es' <- pullUpRecur es
+        = do es' <- recurse es
              ets <- sequence [astTypeOf e | e <- es']
 
              ps <- get
@@ -403,18 +384,18 @@ pullUp pullUpArraysInsideRecords
              return $ A.ExprVariable m v
     -- Convert SubscriptedExprs into SubscriptedVariables.
     doExpression' (A.SubscriptedExpr m s e)
-        = do e' <- pullUpRecur e
-             s' <- pullUpRecur s
+        = do e' <- recurse e
+             s' <- recurse s
              t <- astTypeOf e'
              spec@(A.Specification _ n _) <- makeNonceIsExpr "subscripted_expr" m t e'
              addPulled $ (m, Left spec)
              return $ A.ExprVariable m (A.SubscriptedVariable m s' (A.Variable m n))
-    doExpression' e = doGeneric e
+    doExpression' e = descend e
 
     doExpressionList :: A.ExpressionList -> PassM A.ExpressionList
     -- Convert multi-valued function calls.
     doExpressionList (A.FunctionCallList m n es)
         = do vs <- convertFuncCall m n es
              return $ A.ExpressionList m [A.ExprVariable m v | v <- vs]
-    doExpressionList el = doGeneric el
+    doExpressionList el = descend el
 
diff --git a/transformations/SimplifyProcs.hs b/transformations/SimplifyProcs.hs
index 084298a..e8249f6 100644
--- a/transformations/SimplifyProcs.hs
+++ b/transformations/SimplifyProcs.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -28,6 +28,7 @@ import CompState
 import Metadata
 import Pass
 import qualified Properties as Prop
+import Traversal
 import Types
 
 simplifyProcs :: [Pass]
@@ -38,47 +39,37 @@ simplifyProcs = makePassesDep
       ]
 
 -- | Wrap the subprocesses of PARs in no-arg PROCs.
-parsToProcs :: Data t => t -> PassM t
-parsToProcs = doGeneric `extM` doProcess
+parsToProcs :: PassType
+parsToProcs = applyDepthM doProcess
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric parsToProcs
-
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Par m pm s)
         =  do s' <- doStructured s
               return $ A.Par m pm s'
-    doProcess p = doGeneric p
+    doProcess p = return p
 
     -- FIXME This should be generic and in Pass.
     doStructured :: A.Structured A.Process -> PassM (A.Structured A.Process)
     doStructured (A.Rep m r s)
-        =  do r' <- parsToProcs r
-              s' <- doStructured s
-              return $ A.Rep m r' s'
+        =  do s' <- doStructured s
+              return $ A.Rep m r s'
     doStructured (A.Spec m spec s)
-        =  do spec' <- parsToProcs spec
-              s' <- doStructured s
-              return $ A.Spec m spec' s'
+        =  do s' <- doStructured s
+              return $ A.Spec m spec s'
     doStructured (A.ProcThen m p s)
-        =  do p' <- parsToProcs p
-              s' <- doStructured s
-              return $ A.ProcThen m p' s'
+        =  do s' <- doStructured s
+              return $ A.ProcThen m p s'
     doStructured (A.Only m p)
-        =  do p' <- parsToProcs p
-              s@(A.Specification _ n _) <- makeNonceProc m p'
+        =  do s@(A.Specification _ n _) <- makeNonceProc m p
               modify (\cs -> cs { csParProcs = Set.insert n (csParProcs cs) })
               return $ A.Spec m s (A.Only m (A.ProcCall m n []))
     doStructured (A.Several m ss)
         = liftM (A.Several m) $ mapM doStructured ss
 
 -- | Turn parallel assignment into multiple single assignments through temporaries.
-removeParAssign :: Data t => t -> PassM t
-removeParAssign = doGeneric `extM` doProcess
+removeParAssign :: PassType
+removeParAssign = applyDepthM doProcess
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric removeParAssign
-
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Assign m vs@(_:_:_) (A.ExpressionList _ es))
         =  do ts <- mapM astTypeOf vs
@@ -87,27 +78,26 @@ removeParAssign = doGeneric `extM` doProcess
               let first = [A.Assign m [v] (A.ExpressionList m [e]) | (v, e) <- zip temps es]
               let second = [A.Assign m [v] (A.ExpressionList m [A.ExprVariable m v']) | (v, v') <- zip vs temps]
               return $ A.Seq m $ foldl (\s spec -> A.Spec m spec s) (A.Several m (map (A.Only m) (first ++ second))) specs
-    doProcess p = doGeneric p
+    doProcess p = return p
 
 -- | Turn assignment of arrays and records into multiple assignments.
-flattenAssign :: Data t => t -> PassM t
-flattenAssign = doGeneric `extM` doProcess `ext1M` doStructured
+flattenAssign :: PassType
+flattenAssign = makeRecurse ops
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric flattenAssign
+    ops :: Ops
+    ops = extOpD (extOpSD baseOp ops doStructured) ops doProcess
 
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Assign m [v] (A.ExpressionList m' [e]))
         =  do t <- astTypeOf v
               assign m t v m' e
-    doProcess p = doGeneric p
-    
+    doProcess p = return p
+
     doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
     doStructured (A.Spec m (A.Specification m' n t@(A.RecordType _ _ fs)) s)
       = do procSpec <- recordCopyProc n m fs
-           s' <- doStructured s
-           return $ A.Spec m (A.Specification m' n t) (procSpec s')
-    doStructured s = doGeneric s
+           return $ A.Spec m (A.Specification m' n t) (procSpec s)
+    doStructured s = return s
 
     assign :: Meta -> A.Type -> A.Variable -> Meta -> A.Expression -> PassM A.Process
     assign m t@(A.Array _ _) v m' e = complexAssign m t v m' e
diff --git a/transformations/SimplifyTypes.hs b/transformations/SimplifyTypes.hs
index c94d9b1..d8c2fe4 100644
--- a/transformations/SimplifyTypes.hs
+++ b/transformations/SimplifyTypes.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -20,13 +20,13 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module SimplifyTypes (simplifyTypes) where
 
 import Control.Monad.State
-import Data.Generics
 import qualified Data.Set as Set
 
 import qualified AST as A
 import Metadata
 import Pass
 import qualified Properties as Prop
+import Traversal
 import Types
 
 simplifyTypes :: [Pass]
@@ -41,12 +41,9 @@ resolveAllNamedTypes = Pass
   ,passEnabled = const True}
 
 -- | Turn named data types into their underlying types.
-resolveNamedTypes :: Data t => t -> PassM t
-resolveNamedTypes = doGeneric `extM` doType
+resolveNamedTypes :: PassType
+resolveNamedTypes = applyDepthM doType
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric resolveNamedTypes
-
     doType :: A.Type -> PassM A.Type
     doType t@(A.UserDataType _) = underlyingType emptyMeta t
-    doType t = doGeneric t
+    doType t = return t
diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs
index 7076545..abf1b36 100644
--- a/transformations/Unnest.hs
+++ b/transformations/Unnest.hs
@@ -1,6 +1,6 @@
 {-
 Tock: a compiler for parallel languages
-Copyright (C) 2007  University of Kent
+Copyright (C) 2007, 2008  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
@@ -19,6 +19,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- | Flatten nested declarations.
 module Unnest (unnest) where
 
+import Control.Monad.Identity
 import Control.Monad.State
 import Data.Generics
 import Data.List
@@ -32,6 +33,7 @@ import EvalConstants
 import Metadata
 import Pass
 import qualified Properties as Prop
+import Traversal
 import Types
 
 unnest :: [Pass]
@@ -86,33 +88,21 @@ freeNamesIn = doGeneric
 
 -- | Replace names.
 replaceNames :: Data t => [(A.Name, A.Name)] -> t -> t
-replaceNames map = doGeneric `extT` doName
+replaceNames map v = runIdentity $ applyDepthM doName v
   where
-    doGeneric :: Data t => t -> t
-    doGeneric = (gmapT (replaceNames map))
-                                   `extT` (id :: String -> String)
-                                   `extT` (id :: Meta -> Meta)  
-    smap = [(A.nameName f, t) | (f, t) <- map]
+    smap = Map.fromList [(A.nameName f, t) | (f, t) <- map]
 
-    doName :: A.Name -> A.Name
-    doName n
-        = case lookup (A.nameName n) smap of
-            Just n' -> n'
-            Nothing -> n
+    doName :: A.Name -> Identity A.Name
+    doName n = return $ Map.findWithDefault n (A.nameName n) smap
 
 -- | Turn free names in PROCs into arguments.
-removeFreeNames :: Data t => t -> PassM t
-removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
+removeFreeNames :: PassType
+removeFreeNames = applyDepthM2 doSpecification doProcess
   where
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric removeFreeNames
-
     doSpecification :: A.Specification -> PassM A.Specification
     doSpecification spec = case spec of
-        A.Specification m n st@(A.Proc _ _ _ _) ->
-          do st'@(A.Proc mp sm fs p) <- removeFreeNames st
-
-             -- If this is the top-level process, we shouldn't add new args --
+        A.Specification m n st@(A.Proc mp sm fs p) ->
+          do -- If this is the top-level process, we shouldn't add new args --
              -- we know it's not going to be moved by removeNesting, so anything
              -- that it had in scope originally will still be in scope.
              ps <- get
@@ -120,7 +110,7 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
              let isTLP = (snd $ head $ csMainLocals ps) == n
 
              -- Figure out the free names.
-             let freeNames' = if isTLP then [] else Map.elems $ freeNamesIn st'
+             let freeNames' = if isTLP then [] else Map.elems $ freeNamesIn st
              let freeNames'' = [n | n <- freeNames',
                                     case A.nameType n of
                                       A.ChannelName -> True
@@ -145,12 +135,12 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
 
              -- Add formals for each of the free names
              let newFs = [A.Formal am t n | (am, t, n) <- zip3 ams types newNames]
-             let st'' = A.Proc mp sm (fs ++ newFs) $ replaceNames (zip freeNames newNames) p
-             let spec' = A.Specification m n st''
+             let st' = A.Proc mp sm (fs ++ newFs) $ replaceNames (zip freeNames newNames) p
+             let spec' = A.Specification m n st'
 
              -- Update the definition of the proc
              nameDef <- lookupName n
-             defineName n (nameDef { A.ndSpecType = st'' })
+             defineName n (nameDef { A.ndSpecType = st' })
 
              -- Note that we should add extra arguments to calls of this proc
              -- when we find them
@@ -163,42 +153,43 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
                modify $ (\ps -> ps { csAdditionalArgs = Map.insert (A.nameName n) newAs (csAdditionalArgs ps) })
 
              return spec'
-        _ -> doGeneric spec
+        _ -> return spec
 
     -- | Add the extra arguments we recorded when we saw the definition.
     doProcess :: A.Process -> PassM A.Process
     doProcess p@(A.ProcCall m n as)
         =  do st <- get
               case Map.lookup (A.nameName n) (csAdditionalArgs st) of
-                Just add -> doGeneric $ A.ProcCall m n (as ++ add)
-                Nothing -> doGeneric p
-    doProcess p = doGeneric p
+                Just add -> return $ A.ProcCall m n (as ++ add)
+                Nothing -> return p
+    doProcess p = return p
 
 -- | Pull nested declarations to the top level.
-removeNesting :: forall a. Data a => A.Structured a -> PassM (A.Structured a)
-removeNesting p
+removeNesting :: Data t => Transform (A.Structured t)
+removeNesting s
     =  do pushPullContext
-          p' <- pullSpecs p
-          s <- applyPulled p'
+          s' <- (makeRecurse ops) s >>= applyPulled
           popPullContext
-          return s
+          return s'
   where
-    pullSpecs :: Data t => t -> PassM t
-    pullSpecs = doGeneric `ext1M` doStructured
+    ops :: Ops
+    ops = baseOp `extOpS` doStructured
 
-    doGeneric :: Data t => t -> PassM t
-    doGeneric = makeGeneric pullSpecs
+    recurse :: Recurse
+    recurse = makeRecurse ops
+    descend :: Descend
+    descend = makeDescend ops
 
-    doStructured :: Data t => A.Structured t -> PassM (A.Structured t)
-    doStructured s@(A.Spec m spec@(A.Specification _ n st) subS)
-        = do isConst <- isConstantName n
+    doStructured :: Data t => Transform (A.Structured t)
+    doStructured s@(A.Spec m spec subS)
+        = do spec'@(A.Specification _ n st) <- recurse spec
+             isConst <- isConstantName n
              if isConst || canPull st then
                  do debug $ "removeNesting: pulling up " ++ show n
-                    spec' <- doGeneric spec
                     addPulled $ (m, Left spec')
                     doStructured subS
-               else doGeneric s
-    doStructured s = doGeneric s
+               else descend s
+    doStructured s = descend s
 
     canPull :: A.SpecType -> Bool
     canPull (A.Proc _ _ _ _) = True