diff --git a/pass/Pass.hs b/pass/Pass.hs
index 7f5d308..d3b93fb 100644
--- a/pass/Pass.hs
+++ b/pass/Pass.hs
@@ -23,6 +23,7 @@ import Control.Monad.Error
 import Control.Monad.State
 import Control.Monad.Writer
 import Data.Generics
+import Data.Generics.Polyplate
 import Data.List
 import Data.Ord
 import qualified Data.Set as Set
@@ -53,21 +54,35 @@ instance Warn PassM where
 -- 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)
+type PassType t = t -> PassM t
+
+type PassOnOps ops
+  = (PolyplateM t ops () PassM, PolyplateM t () ops PassM) => Pass t
+
+type PassASTOnOps ops
+  = (PolyplateM A.AST ops () PassM, PolyplateM A.AST () ops PassM) => Pass A.AST
+
+type PassTypeOnOps ops
+  = (PolyplateM t ops () PassM, PolyplateM t () ops PassM) => PassType t
+
+type PassOn t = PassOnOps (OneOpM PassM t)
+type PassOn2 s t = PassOnOps (TwoOpM PassM s t)
+type PassTypeOn t = PassTypeOnOps (OneOpM PassM t)
+      
 
 -- | A description of an AST-mangling pass.
-data Pass = Pass {
-    passCode :: PassType
+data Pass t = Pass {
+    passCode :: PassType t
   , passName :: String
   , passPre :: Set.Set Property
   , passPost :: Set.Set Property
   , passEnabled :: CompState -> Bool
 }
 
-instance Eq Pass where
+instance Eq (Pass t) where
   x == y = passName x == passName y
 
-instance Ord Pass where
+instance Ord (Pass t) where
   compare = comparing passName
 
 -- | A property that can be asserted and tested against the AST.
@@ -89,30 +104,17 @@ runPassM :: CompState -> PassM a -> IO (Either ErrorReport a, CompState)
 runPassM cs pass
     =  flip runStateT cs $ runErrorT pass
 
-enablePassesWhen :: (CompState -> Bool) -> [Pass] -> [Pass]
+enablePassesWhen :: (CompState -> Bool) -> [Pass A.AST] -> [Pass A.AST]
 enablePassesWhen f
     = map (\p -> p { passEnabled = \c -> f c && (passEnabled p c) })
 
 -- | A helper to run a pass at the top-level, or deliver an error otherwise
-passOnlyOnAST :: forall t. Data t => String -> (A.AST -> PassM A.AST) -> t -> PassM t
-passOnlyOnAST name func x
-    = case cast x :: Maybe A.AST of
-        Nothing -> dieP emptyMeta $ name ++ " only operates at top-level"
-        Just x' ->
-           do y <- func x'
-              case cast y :: Maybe t of
-                Nothing -> dieP emptyMeta $ name ++ " crazy cast error at top-level"
-                Just y' -> return y'
+passOnlyOnAST :: String -> (A.AST -> PassM A.AST) -> (A.AST -> PassM A.AST)
+passOnlyOnAST name = id
 
--- For all functions of this type, do NOT use dollar before the pass.
--- That is, do not write: pass "" [] [] $ some code
--- On GHC 6.6 (without impredicative polymorphism from 6.8.1) this
--- will force the RHS (some code) to become monomorphic, where in fact
--- it needs to remain polymorphic.  So just bracket the code for the
--- pass instead, and everything will be fine
-type PassMaker = String -> [Property] -> [Property] -> PassType -> Pass
+type PassMaker t = String -> [Property] -> [Property] -> PassType t -> Pass t
 
-passMakerHelper :: (CompState -> Bool) -> PassMaker
+passMakerHelper :: (CompState -> Bool) -> PassMaker t
 passMakerHelper f name pre post code
   = Pass { passCode = code
          , passName = name
@@ -121,30 +123,27 @@ passMakerHelper f name pre post code
          , passEnabled = f
          }
 
-rainOnlyPass :: PassMaker
+rainOnlyPass :: PassMaker t
 rainOnlyPass = passMakerHelper $ (== FrontendRain) . csFrontend
 
-occamOnlyPass :: PassMaker
+occamOnlyPass :: PassMaker t
 occamOnlyPass = passMakerHelper $ (== FrontendOccam) . csFrontend
 
 occamAndCOnlyPass :: PassMaker
 occamAndCOnlyPass = passMakerHelper $
   \st -> (csFrontend st == FrontendOccam) && (csBackend st == BackendC)
 
-cOnlyPass :: PassMaker
+cOnlyPass :: PassMaker t
 cOnlyPass = passMakerHelper $ (== BackendC) . csBackend
 
-cppOnlyPass :: PassMaker
+cppOnlyPass :: PassMaker t
 cppOnlyPass = passMakerHelper $ (== BackendCPPCSP) . csBackend
 
-cOrCppOnlyPass :: PassMaker
-cOrCppOnlyPass = passMakerHelper $ (`elem` [BackendC, BackendCPPCSP]) . csBackend
-
 pass :: PassMaker
 pass = passMakerHelper (const True)
 
 -- | Compose a list of passes into a single pass by running them in the order given.
-runPasses :: [Pass] -> (A.AST -> PassM A.AST)
+runPasses :: [Pass A.AST] -> (A.AST -> PassM A.AST)
 runPasses [] ast = return ast
 runPasses (p:ps) ast
     =  do debug $ "{{{ " ++ passName p
diff --git a/pass/Traversal.hs b/pass/Traversal.hs
index 0ef6c7c..06f5040 100644
--- a/pass/Traversal.hs
+++ b/pass/Traversal.hs
@@ -18,32 +18,24 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 -- | Traversal strategies over the AST and other data types.
 module Traversal (
-    OpsM, Ops
-  , TransformM, Transform
+    TransformM, Transform
   , CheckM, Check
-  , baseOp, extOp, extOpS
-  , makeDepth, extOpD, extOpSD
-  , makeCheck, extOpC
-  , RecurseM, Recurse, makeRecurse
-  , DescendM, Descend, makeDescend
-  , applyDepthM, applyDepthSM, applyDepthM2
-  , checkDepthM, checkDepthM2
-  , fastListify
+  , ExtOpMP, ExtOpMS, ExtOpMSP, extOpMS
+  , module Data.Generics.Polyplate
+  , module Data.Generics.Polyplate.Schemes
   ) where
 
 import Control.Monad.State
 import Data.Generics
+import Data.Generics.Polyplate
+import Data.Generics.Polyplate.Schemes
+
 
 import qualified AST as A
 import GenericUtils
+import NavAST
 import Pass
 
--- | A set of generic operations.
-type OpsM m = ([TypeKey], TypeSet, DescendM m -> RecurseM m)
-
--- | As 'OpsM', but specialised for 'PassM'.
-type Ops = OpsM PassM
-
 -- | A transformation for a single 'Data' type.
 type TransformM m t = t -> m t
 
@@ -58,157 +50,48 @@ type CheckM m t = t -> m ()
 -- | As 'CheckM', but specialised for 'PassM'.
 type Check t = CheckM PassM t
 
--- | An empty set of operations.
-baseOp :: forall m. Monad m => OpsM m
-baseOp = ([], makeTypeSet [], id)
+type ExtOpMP opT t = ExtOpM PassM opT t
 
--- | 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
-    = (tks',
-       makeTypeSet tks',
-       (\descend -> g descend `extM` f))
-  where
-    tks' = typeKey (undefined :: t) : tks
+type ExtOpMS m opT =
+          (A.Structured () -> m (A.Structured ()),
+          (A.Structured A.Alternative -> m (A.Structured A.Alternative),
+          (A.Structured A.Choice -> m (A.Structured A.Choice),
+          (A.Structured A.ExpressionList -> m (A.Structured A.ExpressionList),
+          (A.Structured A.Option -> m (A.Structured A.Option),
+          (A.Structured A.Process -> m (A.Structured A.Process),
+          (A.Structured A.Variant -> m (A.Structured A.Variant),
+          opT)))))))
+type ExtOpMSP opT = ExtOpMS PassM opT
 
--- | 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
+extOpMS :: forall m opT op0T.
+          (PolyplateM (A.Structured ()) () op0T m,
+           PolyplateM (A.Structured A.Alternative) () op0T m,
+           PolyplateM (A.Structured A.Choice) () op0T m,
+           PolyplateM (A.Structured A.ExpressionList) () op0T m,
+           PolyplateM (A.Structured A.Option) () op0T m,
+           PolyplateM (A.Structured A.Process) () op0T m,
+           PolyplateM (A.Structured A.Variant) () op0T m,
+           PolyplateM (A.Structured ()) op0T () m,
+           PolyplateM (A.Structured A.Alternative) op0T () m,
+           PolyplateM (A.Structured A.Choice) op0T () m,
+           PolyplateM (A.Structured A.ExpressionList) op0T () m,
+           PolyplateM (A.Structured A.Option) op0T () m,
+           PolyplateM (A.Structured A.Process) op0T () m,
+           PolyplateM (A.Structured A.Variant) op0T () m) =>
+          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
+                            , PolyplateM (A.Structured t) op0T () m) =>
+           A.Structured t -> m (A.Structured t)) ->
+          ExtOpMS m opT
+extOpMS 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 ()))
+      `extOpM` (f :: A.Structured A.Variant -> m (A.Structured A.Variant))
+      `extOpM` (f :: A.Structured A.Process -> m (A.Structured A.Process))
+      `extOpM` (f :: A.Structured A.Option -> m (A.Structured A.Option))
+      `extOpM` (f :: A.Structured A.ExpressionList -> m (A.Structured A.ExpressionList))
+      `extOpM` (f :: A.Structured A.Choice -> m (A.Structured A.Choice))
+      `extOpM` (f :: A.Structured A.Alternative -> m (A.Structured A.Alternative))
+      `extOpM` (f :: A.Structured () -> m (A.Structured ()))
 
--- | Generate an operation that applies a 'TransformM' with automatic
--- depth-first descent.
-makeDepth :: forall m t. (Monad m, Data t) =>
-             OpsM m -> TransformM m t -> TransformM m t
-makeDepth ops f v = descend v >>= f
-  where
-    descend :: DescendM m
-    descend = makeDescend ops
-
--- | 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)
-
--- | 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)
-
--- | Generate an operation that applies a 'CheckM' with automatic
--- depth-first descent.
-makeCheck :: forall m t. (Monad m, Data t) =>
-             OpsM m -> CheckM m t -> TransformM m t
-makeCheck ops f v = descend v >> f v >> return v
-  where
-    descend :: DescendM m
-    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@(_, ts, _) = gmapMFor ts recurse
-  where
-    recurse :: RecurseM m
-    recurse = makeRecurse ops
-
--- | Apply a transformation, recursing depth-first.
-applyDepthM :: forall m t1. (Monad m, Data t1) =>
-               TransformM m t1 -> (forall s. Data s => 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 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 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 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
-
--- | Lists all the items (in arbitrary order) that meet the given criteria.  Just
--- like the Data.Generics listify function, only faster
-fastListify :: forall s t. (Data s, Data t) => (t -> Bool) -> s -> [t]
-fastListify f x = execState (applyDepthM f' x) []
-  where
-    f' :: t -> State [t] t
-    f' y = when (f y) (modify (y:)) >> return y