From 44eabe4baa7756a1a76feccf29d42833c065bb35 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Wed, 6 May 2009 11:32:19 +0000
Subject: [PATCH] Reworked Polyplate to have a simpler way of expressing
 opsets, and also simplified PolyplateM and PolyplateMRoute

---
 backends/BackendPasses.hs                     |  16 +--
 checks/Check.hs                               |  13 +--
 checks/CheckFramework.hs                      |  97 ++++++++-------
 frontends/OccamCheckTypes.hs                  |  16 +--
 frontends/OccamInferTypes.hs                  |  30 ++---
 frontends/OccamPasses.hs                      |   6 +-
 frontends/OccamPassesTest.hs                  |  12 +-
 frontends/OccamTypesTest.hs                   |  32 ++---
 frontends/RainTypes.hs                        |  20 ++--
 pass/Pass.hs                                  |  18 +--
 pass/Traversal.hs                             | 110 +++++++++---------
 polyplate/Data/Generics/Polyplate.hs          |  20 ++--
 .../Data/Generics/Polyplate/GenInstances.hs   |  20 ++--
 polyplate/Data/Generics/Polyplate/Schemes.hs  |  54 +++++----
 transformations/ImplicitMobility.hs           |  16 +--
 transformations/SimplifyAbbrevs.hs            |  28 ++---
 transformations/SimplifyAbbrevsTest.hs        |   6 +-
 transformations/SimplifyExprs.hs              |   8 +-
 transformations/SimplifyProcs.hs              |  14 +--
 transformations/SimplifyTypesTest.hs          |   4 +-
 transformations/Unnest.hs                     |  46 ++++----
 21 files changed, 292 insertions(+), 294 deletions(-)

diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs
index be95fd6..e0d493f 100644
--- a/backends/BackendPasses.hs
+++ b/backends/BackendPasses.hs
@@ -99,7 +99,7 @@ removeUnneededDirections
               _ -> diePC m $ formatCode "Direction applied to non-channel type: %" t
     doVariable v = return v
 
-type AllocMobileOps = ExtOpMSP BaseOp `ExtOpMP` A.Process
+type AllocMobileOps = ExtOpMS BaseOpM `ExtOpMP` A.Process
 
 -- | Pulls up any initialisers for mobile allocations.  I think, after all the
 -- other passes have run, the only place these initialisers should be left is in
@@ -107,8 +107,8 @@ type AllocMobileOps = ExtOpMSP BaseOp `ExtOpMP` A.Process
 pullAllocMobile :: PassOnOps AllocMobileOps
 pullAllocMobile = cOnlyPass "Pull up mobile initialisers" [] [] recurse
   where
-    ops :: AllocMobileOps
-    ops = baseOp `extOpMS` (ops, doStructured) `extOpM` doProcess
+    ops :: AllocMobileOps PassM
+    ops = baseOpM `extOpMS` (ops, doStructured) `extOpM` doProcess
 
     recurse :: RecurseM PassM AllocMobileOps
     recurse = makeRecurseM ops
@@ -318,7 +318,7 @@ findVarSizes skip (A.VariableSizes m v)
        mn <- getSizes m (A.VariableSizes m v) es
        return $ Just (mn, fmap (A.Variable m) mn, es)
 
-type DeclSizeOps = ExtOpM SizesM (ExtOpMS SizesM BaseOp) A.Process
+type DeclSizeOps = A.Process :-* ExtOpMS BaseOpM
 
 -- | Declares a _sizes array for every array, statically sized or dynamically sized.
 -- For each record type it declares a _sizes array too.
@@ -333,8 +333,8 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
             return t'
             ))
   where
-    ops :: DeclSizeOps
-    ops = baseOp `extOpMS` (ops, doStructured) `extOpM` doProcess
+    ops :: DeclSizeOps SizesM
+    ops = baseOpM `extOpMS` (ops, doStructured) `extOpM` doProcess
 
     recurse :: RecurseM SizesM DeclSizeOps
     recurse = makeRecurseM ops
@@ -424,8 +424,8 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
         lit = A.ArrayListLiteral m $ A.Several m $ map (A.Only m) es
         t = A.Array [A.Dimension $ makeConstant m (length es)] A.Int
 
-    doStructured :: (Data a, PolyplateM (A.Structured a) DeclSizeOps () SizesM
-                           , PolyplateM (A.Structured a) () DeclSizeOps SizesM)
+    doStructured :: (Data a, PolyplateM (A.Structured a) DeclSizeOps BaseOpM
+                           , PolyplateM (A.Structured a) BaseOpM DeclSizeOps)
                     => (A.Structured a) -> SizesM (A.Structured a)
     doStructured str@(A.Spec m sp@(A.Specification m' n spec) s)
       = do t <- typeOfSpec spec
diff --git a/checks/Check.hs b/checks/Check.hs
index 073de3b..7ccc750 100644
--- a/checks/Check.hs
+++ b/checks/Check.hs
@@ -515,9 +515,7 @@ checkInitVar = forAnyFlowNode
                 warnP m WarnUninitialisedVariable $ "Variable(s) read from are not written to before-hand: " ++ vars
 
 findAllProcess :: forall t m a. (Data t, Monad m,
-  PolyplateMRoute (A.Structured t) (OneOpMRoute (State [(A.Process, Route A.Process (A.Structured t))]) A.Process
-                                      (A.Structured t))
-                  () (State [(A.Process, Route A.Process (A.Structured t))]) (A.Structured t))
+  PolyplateMRoute (A.Structured t) (OneOpMRoute A.Process) BaseOpMRoute)
    => (A.Process -> Bool) -> FlowGraph' m a t -> A.Structured t -> [(A.Process, a)]
 findAllProcess f g t = Map.elems $ Map.intersectionWith (,) astMap nodeMap
   where
@@ -533,9 +531,7 @@ findAllProcess f g t = Map.elems $ Map.intersectionWith (,) astMap nodeMap
       _ -> Nothing
 
 checkParAssignUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t,
-  PolyplateMRoute (A.Structured t) (OneOpMRoute (State [(A.Process, Route A.Process (A.Structured t))]) A.Process
-                                      (A.Structured t))
-                  () (State [(A.Process, Route A.Process (A.Structured t))]) (A.Structured t)
+  PolyplateMRoute (A.Structured t) (OneOpMRoute A.Process) BaseOpMRoute
   ) => FlowGraph' m (BK, UsageLabel) t -> A.Structured t -> m ()
 checkParAssignUsage g = mapM_ checkParAssign . findAllProcess isParAssign g
   where
@@ -556,9 +552,8 @@ checkParAssignUsage g = mapM_ checkParAssign . findAllProcess isParAssign g
           $ processVarW v Nothing] | v <- vs]
 
 checkProcCallArgsUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t,
-  PolyplateMRoute (A.Structured t) (OneOpMRoute (State [(A.Process, Route A.Process (A.Structured t))]) A.Process
-                                      (A.Structured t))
-                  () (State [(A.Process, Route A.Process (A.Structured t))]) (A.Structured t)
+  PolyplateMRoute (A.Structured t) (OneOpMRoute A.Process)
+                  BaseOpMRoute
   ) =>
   FlowGraph' m (BK, UsageLabel) t -> A.Structured t -> m ()
 checkProcCallArgsUsage g = mapM_ checkArgs . findAllProcess isProcCall g
diff --git a/checks/CheckFramework.hs b/checks/CheckFramework.hs
index 539e2e4..f511a3d 100644
--- a/checks/CheckFramework.hs
+++ b/checks/CheckFramework.hs
@@ -260,15 +260,15 @@ forAnyParItems = undefined
 
 -- | This function currently only supports one type
 forAnyASTTopDown :: forall a.
-  (PolyplateMRoute A.AST ((a, Route a A.AST) -> RestartT CheckOptM a, ()) () (RestartT CheckOptM) A.AST
-  ,PolyplateMRoute a () ((a, Route a A.AST) -> RestartT CheckOptM a, ()) (RestartT CheckOptM) A.AST
+  (PolyplateMRoute A.AST (a :-@ BaseOpMRoute) BaseOpMRoute
+  ,PolyplateMRoute a BaseOpMRoute (a :-@ BaseOpMRoute)
   ) =>
     (a -> CheckOptASTM a ()) -> CheckOptM ()
 forAnyASTTopDown origF = CheckOptM $ do
    tr <- get >>* ast
    doTree ops transformMRoute tr
      where
-       ops = baseOp `extOpMRoute` (makeTopDownMRoute ops $ keepApplying $ deCheckOptASTM origF)
+       ops = baseOpMRoute `extOpMRoute` (makeTopDownMRoute ops $ keepApplying $ deCheckOptASTM origF)
 
 forAnyASTStructTopDown :: (forall a. Data a => (A.Structured a -> CheckOptASTM (A.Structured
   a) ())) -> CheckOptM ()
@@ -277,7 +277,7 @@ forAnyASTStructTopDown origF = CheckOptM $ do
    doTree ops transformMRoute tr
   where
     ops
-      = baseOp
+      = baseOpMRoute
         `extOpMRoute` (makeTopDownMRoute ops $ keepApplying $ deCheckOptASTM (origF :: A.Structured A.Variant -> CheckOptASTM (A.Structured A.Variant) ()))
         `extOpMRoute` (makeTopDownMRoute ops $ keepApplying $ deCheckOptASTM (origF :: A.Structured A.Process -> CheckOptASTM (A.Structured A.Process) ()))
         `extOpMRoute` (makeTopDownMRoute ops $ keepApplying $ deCheckOptASTM (origF :: A.Structured A.Option -> CheckOptASTM (A.Structured A.Option) ()))
@@ -286,23 +286,21 @@ forAnyASTStructTopDown origF = CheckOptM $ do
         `extOpMRoute` (makeTopDownMRoute ops $ keepApplying $ deCheckOptASTM (origF :: A.Structured A.Alternative -> CheckOptASTM (A.Structured A.Alternative) ()))
         `extOpMRoute` (makeTopDownMRoute ops $ keepApplying $ deCheckOptASTM (origF :: A.Structured () -> CheckOptASTM (A.Structured ()) ()))
 
-type AccumOp b a = (A.Structured a, Route (A.Structured a) A.AST) -> StateT (AccumMap b) (RestartT CheckOptM) (A.Structured a)
-
-type ExtAcc a b = (b, a)
+type ExtAcc a b = b :-@ a
 
 type AccumOps b =
-  BaseOp
-  `ExtAcc` AccumOp b A.Variant
-  `ExtAcc` AccumOp b A.Process
-  `ExtAcc` AccumOp b A.Option
-  `ExtAcc` AccumOp b A.ExpressionList
-  `ExtAcc` AccumOp b A.Choice
-  `ExtAcc` AccumOp b A.Alternative
-  `ExtAcc` AccumOp b ()
-  `ExtAcc` ((b, Route b A.AST) -> StateT (AccumMap b) (RestartT CheckOptM) b)
+  BaseOpMRoute
+  `ExtAcc` A.Structured A.Variant
+  `ExtAcc` A.Structured A.Process
+  `ExtAcc` A.Structured A.Option
+  `ExtAcc` A.Structured A.ExpressionList
+  `ExtAcc` A.Structured A.Choice
+  `ExtAcc` A.Structured A.Alternative
+  `ExtAcc` A.Structured ()
+  `ExtAcc` b
 
 type SingleOps b
-  = ((b, Route b A.AST) -> StateT (AccumMap b) (RestartT CheckOptM) b, ())
+  = b :-@ BaseOpMRoute
 
 type AccumMap b = Map.Map [Int] b
 
@@ -316,30 +314,30 @@ filterSub r = Map.filterWithKey (\k _ -> not $ r `isPrefixOf` k)
 -- I know the constraints here look horrendous, but it's really just three groups.
 forAnyASTStructBottomUpAccum :: forall b. (Data b,
   -- Allow us to descend into the AST with our full set of ops:
-  PolyplateMRoute A.AST (AccumOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
+  PolyplateMRoute A.AST (AccumOps b) BaseOpMRoute,
 
   -- Allow us to recurse into each Structured item (and b) with our full set of
   -- ops:
-  PolyplateMRoute (A.Structured A.Variant) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Process) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Option) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.ExpressionList) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Choice) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Alternative) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured ()) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute b () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
+  PolyplateMRoute (A.Structured A.Variant) BaseOpMRoute (AccumOps b),
+  PolyplateMRoute (A.Structured A.Process) BaseOpMRoute (AccumOps b),
+  PolyplateMRoute (A.Structured A.Option) BaseOpMRoute (AccumOps b),
+  PolyplateMRoute (A.Structured A.ExpressionList) BaseOpMRoute (AccumOps b),
+  PolyplateMRoute (A.Structured A.Choice) BaseOpMRoute (AccumOps b),
+  PolyplateMRoute (A.Structured A.Alternative) BaseOpMRoute (AccumOps b),
+  PolyplateMRoute (A.Structured ()) BaseOpMRoute (AccumOps b),
+  PolyplateMRoute b BaseOpMRoute (AccumOps b),
 
   -- Allow us to descend into each Structured item with just our ops for
   -- b, when our accumulated stuff becomes invalidated
-  PolyplateMRoute (A.Structured A.Variant) (SingleOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Process) (SingleOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Option) (SingleOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.ExpressionList) (SingleOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Choice) (SingleOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured A.Alternative) (SingleOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
-  PolyplateMRoute (A.Structured ()) (SingleOps b) () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST,
+  PolyplateMRoute (A.Structured A.Variant) (SingleOps b) BaseOpMRoute,
+  PolyplateMRoute (A.Structured A.Process) (SingleOps b) BaseOpMRoute,
+  PolyplateMRoute (A.Structured A.Option) (SingleOps b) BaseOpMRoute,
+  PolyplateMRoute (A.Structured A.ExpressionList) (SingleOps b) BaseOpMRoute,
+  PolyplateMRoute (A.Structured A.Choice) (SingleOps b) BaseOpMRoute,
+  PolyplateMRoute (A.Structured A.Alternative) (SingleOps b) BaseOpMRoute,
+  PolyplateMRoute (A.Structured ()) (SingleOps b) BaseOpMRoute,
   -- For b, we will recurse, not descend:
-  PolyplateMRoute b () (SingleOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST
+  PolyplateMRoute b BaseOpMRoute (SingleOps b)
 
   ) =>
   (forall a. Data a => (A.Structured a) -> CheckOptASTM' [b] (A.Structured a) ()) -> CheckOptM ()
@@ -347,12 +345,12 @@ forAnyASTStructBottomUpAccum origF = CheckOptM $ do
    tr <- get >>* ast
    doTree ops (\x y z -> flip evalStateT (Map.empty :: AccumMap b) $ transformMRoute x y z) tr
   where
-    ops :: AccumOps b
+    ops :: AccumOps b (StateT (AccumMap b) (RestartT CheckOptM)) A.AST
     ops = applyAccum (undefined::b) allF
 
     keepApplying' ::
-      PolyplateMRoute t ((b, Route b A.AST) -> StateT (AccumMap b) (RestartT CheckOptM) b, ())
-         () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST
+      PolyplateMRoute t (b :-@ BaseOpMRoute)
+         BaseOpMRoute
       => ((t, Route t A.AST) -> StateT (AccumMap b) (RestartT CheckOptM) (Either t t)) ->
          ((t, Route t A.AST) -> StateT (AccumMap b) (RestartT CheckOptM) t)
     keepApplying' f xr = do x' <- f xr
@@ -361,13 +359,12 @@ forAnyASTStructBottomUpAccum origF = CheckOptM $ do
                               Left y -> do -- remove all sub-items from state,
                                            -- and then scan the item anew:
                                            modify $ filterSub (routeId $ snd xr)
-                                           transformMRoute (applyAccum (undefined::b) ()) () (y, snd xr)
+                                           transformMRoute (applyAccum (undefined::b) BaseOpMRoute) BaseOpMRoute (y, snd xr)
                                            keepApplying' f (y, snd xr)
 
     wrap :: forall a. (Data a,
-        PolyplateMRoute (A.Structured a) () (AccumOps b) (StateT (AccumMap b) (RestartT CheckOptM)) A.AST
-        , PolyplateMRoute (A.Structured a) ((b, Route b A.AST) -> StateT (AccumMap b) (RestartT CheckOptM) b, ())
-         () (StateT (AccumMap b) (RestartT CheckOptM)) A.AST
+        PolyplateMRoute (A.Structured a) BaseOpMRoute (AccumOps b)
+        , PolyplateMRoute (A.Structured a) (b :-@ BaseOpMRoute) BaseOpMRoute 
       ) => ((A.Structured a, Route (A.Structured a) A.AST, [b]) -> RestartT
       CheckOptM (Either (A.Structured a) (A.Structured a))) -> (A.Structured a, Route (A.Structured
         a) A.AST) -> StateT (AccumMap b) (RestartT
@@ -376,7 +373,7 @@ forAnyASTStructBottomUpAccum origF = CheckOptM $ do
       (routeId y) z))
 
     allF
-      = baseOp
+      = baseOpMRoute
         `extOpMRoute` (wrap $ deCheckOptASTM' (origF :: (A.Structured A.Variant) ->
                       CheckOptASTM' [b] (A.Structured A.Variant) ()))
         `extOpMRoute` (wrap $ deCheckOptASTM' (origF :: (A.Structured A.Process) ->
@@ -400,11 +397,11 @@ type TransFuncS acc b a = (a, Route a b) -> StateT acc (RestartT CheckOptM) a
 -- location to begin at and an AST, transforms the tree.  Handles any restarts
 -- that are requested.
 doTree :: ops ->
-  (ops -> () -> (A.AST, Route A.AST A.AST) -> RestartT CheckOptM A.AST) -> A.AST -> StateT CheckOptData PassM ()
+  (ops -> BaseOpMRoute m outer -> (A.AST, Route A.AST A.AST) -> RestartT CheckOptM A.AST) -> A.AST -> StateT CheckOptData PassM ()
            -- This line applies "apply" to the first thing of the right type in
            -- the given AST; from there, ops recurses for itself
 doTree ops trans tr
-      = do x <- deCheckOptM (getRestartT (trans ops () (tr, identityRoute) >> return ()))
+      = do x <- deCheckOptM (getRestartT (trans ops BaseOpMRoute (tr, identityRoute) >> return ()))
            case x of
              Left _ -> do -- Restart
                tr' <- get >>* ast
@@ -412,15 +409,15 @@ doTree ops trans tr
              Right _ -> return ()
 
 applyAccum :: forall t ops.
-  PolyplateMRoute t () ((t, Route t A.AST) -> StateT (AccumMap t) (RestartT CheckOptM) t, ops)
-      (StateT (AccumMap t) (RestartT CheckOptM)) A.AST
-  => t -> ops -> ((t, Route t A.AST) -> StateT (AccumMap t) (RestartT CheckOptM) t, ops)
+  PolyplateMRoute t BaseOpMRoute (t :-@ ops)
+  => t -> ops (StateT (AccumMap t) (RestartT CheckOptM)) A.AST -> (t :-@ ops)
+    (StateT (AccumMap t) (RestartT CheckOptM)) A.AST
 applyAccum _ ops = ops'
   where
-    ops' :: ((t, Route t A.AST) -> StateT (AccumMap t) (RestartT CheckOptM) t, ops)
-    ops' = (accum, ops)
+    ops' :: (t :-@ ops) (StateT (AccumMap t) (RestartT CheckOptM)) A.AST
+    ops' = accum :-@ ops
 
-    accum xr = do x' <- transformMRoute () ops' xr
+    accum xr = do x' <- transformMRoute BaseOpMRoute ops' xr
                   modify $ Map.insert (routeId $ snd xr) x'
                   return x'
 
diff --git a/frontends/OccamCheckTypes.hs b/frontends/OccamCheckTypes.hs
index 3bde74a..98a0935 100644
--- a/frontends/OccamCheckTypes.hs
+++ b/frontends/OccamCheckTypes.hs
@@ -49,14 +49,14 @@ ok = return ()
 -- 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 ::
- (PolyplateM t (OneOpM PassM A.Variable) () PassM
- ,PolyplateM t (OneOpM PassM A.Expression) () PassM
- ,PolyplateM t (OneOpM PassM A.SpecType) () PassM
- ,PolyplateM t (OneOpM PassM A.Process) () PassM
- ,PolyplateM t () (OneOpM PassM A.Variable) PassM
- ,PolyplateM t () (OneOpM PassM A.Expression) PassM
- ,PolyplateM t () (OneOpM PassM A.SpecType) PassM
- ,PolyplateM t () (OneOpM PassM A.Process) PassM
+ (PolyplateM t (OneOpM A.Variable) BaseOpM
+ ,PolyplateM t (OneOpM A.Expression) BaseOpM
+ ,PolyplateM t (OneOpM A.SpecType) BaseOpM
+ ,PolyplateM t (OneOpM A.Process) BaseOpM
+ ,PolyplateM t BaseOpM (OneOpM A.Variable)
+ ,PolyplateM t BaseOpM (OneOpM A.Expression)
+ ,PolyplateM t BaseOpM (OneOpM A.SpecType)
+ ,PolyplateM t BaseOpM (OneOpM A.Process)
  ) => Pass t
 checkTypes = occamOnlyPass "Check types"
   [Prop.inferredTypesRecorded, Prop.ambiguitiesResolved]
diff --git a/frontends/OccamInferTypes.hs b/frontends/OccamInferTypes.hs
index b243cc2..a6e9eb3 100644
--- a/frontends/OccamInferTypes.hs
+++ b/frontends/OccamInferTypes.hs
@@ -163,7 +163,7 @@ data InferTypeState = InferTypeState
 
 type InferTypeM = StateT InferTypeState PassM
 
-type ExtOpMI ops t = ExtOpM InferTypeM ops t
+type ExtOpMI ops t = t :-* ops
 
 --{{{  type contexts
 
@@ -193,7 +193,7 @@ getTypeContext
 -- I can't put this in the where clause of inferTypes, so it has to be out
 -- here.  It should be the type of ops inside the inferTypes function below.
 type InferTypeOps
-  = ExtOpMS InferTypeM BaseOp
+  = ExtOpMS BaseOpM
     `ExtOpMI` A.Expression
     `ExtOpMI` A.Dimension
     `ExtOpMI` A.Subscript
@@ -212,8 +212,8 @@ inferTypes = occamOnlyPass "Infer types"
   [Prop.inferredTypesRecorded]
   (flip evalStateT (InferTypeState [] []) . recurse)
   where
-    ops :: InferTypeOps
-    ops = baseOp
+    ops :: InferTypeOps InferTypeM
+    ops = baseOpM
           `extOpMS` (ops, doStructured)
           `extOpM` doExpression
           `extOpM` doDimension
@@ -365,14 +365,14 @@ inferTypes = occamOnlyPass "Infer types"
           = typeEqForOp t t'
         typeEqForOp t t' = t == t'
 
-    doActuals :: (PolyplateM a InferTypeOps () InferTypeM, Data a) => Meta -> A.Name -> [A.Formal] ->
+    doActuals :: (PolyplateM a InferTypeOps BaseOpM, Data a) => Meta -> A.Name -> [A.Formal] ->
       (Meta -> A.Direction -> Infer a, A.Type -> Infer a) -> Infer [a]
     doActuals m n fs applyDir_Deref as
         =  do lift $ checkActualCount m n fs as
               sequence [doActual m applyDir_Deref t a | (A.Formal _ t _, a) <- zip fs as]
 
     -- First function directs, second function dereferences if needed
-    doActual :: (PolyplateM a InferTypeOps () InferTypeM, Data a) =>
+    doActual :: (PolyplateM a InferTypeOps BaseOpM, Data a) =>
       Meta -> (Meta -> A.Direction -> Infer a, A.Type -> Infer a) -> A.Type -> Infer a
     doActual m (applyDir, _) (A.ChanEnd dir _ _) a = recurse a >>= applyDir m dir
     doActual m (_, deref) t a = inTypeContext (Just t) $ recurse a >>= deref t
@@ -458,8 +458,8 @@ inferTypes = occamOnlyPass "Infer types"
                              mp' <- recurse mp
                              return $ A.Variant m n iis' p' mp'
 
-    doStructured :: ( PolyplateM (A.Structured t) InferTypeOps () InferTypeM
-                    , PolyplateM (A.Structured t) () InferTypeOps InferTypeM
+    doStructured :: ( PolyplateM (A.Structured t) InferTypeOps BaseOpM
+                    , PolyplateM (A.Structured t) BaseOpM InferTypeOps
                     , Data t) => Infer (A.Structured t)
 
     doStructured (A.Spec mspec s@(A.Specification m n st) body)
@@ -470,8 +470,8 @@ inferTypes = occamOnlyPass "Infer types"
     doStructured s = descend s
 
     -- The second parameter is a modifier (wrapper) for the descent into the body
-    doSpecType :: ( PolyplateM (A.Structured t) InferTypeOps () InferTypeM
-                  , PolyplateM (A.Structured t) () InferTypeOps InferTypeM
+    doSpecType :: ( PolyplateM (A.Structured t) InferTypeOps BaseOpM
+                  , PolyplateM (A.Structured t) BaseOpM InferTypeOps
                   , Data t) => A.Name -> A.SpecType -> ReaderT (A.Structured t) InferTypeM
       (A.SpecType, InferTypeM (A.Structured a) -> InferTypeM (A.Structured a))
     doSpecType n st
@@ -663,19 +663,19 @@ inferTypes = occamOnlyPass "Infer types"
         -- Also, to fit with the normal ops, we must do so in the PassM monad.
         --  Normally we would do this pass in a StateT monad, but to slip inside
         -- PassM, I've used an IORef instead.
-        findDir :: ( PolyplateM a InferTypeOps () InferTypeM
-                   , PolyplateM a () InferTypeOps InferTypeM
+        findDir :: ( PolyplateM a InferTypeOps BaseOpM
+                   , PolyplateM a BaseOpM InferTypeOps
                    ) => A.Name -> a -> InferTypeM [A.Direction]
         findDir n x
           = do r <- liftIO $ newIORef []
                makeRecurseM (makeOps r) x
                liftIO $ readIORef r
           where
-            makeOps :: IORef [A.Direction] -> InferTypeOps
+            makeOps :: IORef [A.Direction] -> InferTypeOps InferTypeM
             makeOps r = ops
               where
-                ops :: InferTypeOps
-                ops = baseOp
+                ops :: InferTypeOps InferTypeM
+                ops = baseOpM
                     `extOpMS` (ops, descend)
                     `extOpM` descend
                     `extOpM` descend
diff --git a/frontends/OccamPasses.hs b/frontends/OccamPasses.hs
index fdc7586..6083ec3 100644
--- a/frontends/OccamPasses.hs
+++ b/frontends/OccamPasses.hs
@@ -248,7 +248,7 @@ foldConstants = occamOnlyPass "Fold constants"
         =  do modifyName n (\nd -> nd { A.ndSpecType = st })
               return s
 
-type CheckConstantsOps = BaseOp `ExtOpMP` A.Type `ExtOpMP` A.Option
+type CheckConstantsOps = BaseOpM `ExtOpMP` A.Type `ExtOpMP` A.Option
   `ExtOpMP` A.SpecType
 
 -- | Check that things that must be constant are.
@@ -258,8 +258,8 @@ checkConstants = occamOnlyPass "Check mandatory constants"
   [Prop.constantsChecked]
   recurse
   where
-    ops :: CheckConstantsOps
-    ops = baseOp `extOpM` doType `extOpM` doOption `extOpM` doSpecType
+    ops :: CheckConstantsOps PassM
+    ops = baseOpM `extOpM` doType `extOpM` doOption `extOpM` doSpecType
 
     descend :: DescendM PassM CheckConstantsOps
     descend = makeDescendM ops
diff --git a/frontends/OccamPassesTest.hs b/frontends/OccamPassesTest.hs
index cec10bb..24c7112 100644
--- a/frontends/OccamPassesTest.hs
+++ b/frontends/OccamPassesTest.hs
@@ -93,8 +93,8 @@ testFoldConstants = TestList
     , test 48 (add var (add const one)) (add var three)
     ]
   where
-    test :: (PolyplateM a (TwoOpM PassM A.Expression A.Specification) () PassM
-            ,PolyplateM a () (TwoOpM PassM A.Expression A.Specification) PassM
+    test :: (PolyplateM a (TwoOpM A.Expression A.Specification) BaseOpM
+            ,PolyplateM a BaseOpM (TwoOpM A.Expression A.Specification)
             ,Data a) => Int -> a -> a -> Test
     test n orig exp = TestCase $ testPass ("testFoldConstants" ++ show n)
                                           exp OccamPasses.foldConstants orig
@@ -142,15 +142,15 @@ testCheckConstants = TestList
     , testFail 33 (A.Option m [lit10, lit10, lit10, var] skip)
     ]
   where
-    testOK :: (PolyplateM a OccamPasses.CheckConstantsOps () PassM
-              ,PolyplateM a () OccamPasses.CheckConstantsOps PassM
+    testOK :: (PolyplateM a OccamPasses.CheckConstantsOps BaseOpM
+              ,PolyplateM a BaseOpM OccamPasses.CheckConstantsOps
               ,Show a, Data a) => Int -> a -> Test
     testOK n orig
         = TestCase $ testPass ("testCheckConstants" ++ show n)
                               orig OccamPasses.checkConstants orig
                               (return ())
-    testFail :: (PolyplateM a OccamPasses.CheckConstantsOps () PassM
-                ,PolyplateM a () OccamPasses.CheckConstantsOps PassM
+    testFail :: (PolyplateM a OccamPasses.CheckConstantsOps BaseOpM
+                ,PolyplateM a BaseOpM OccamPasses.CheckConstantsOps
                 ,Show a, Data a) => Int -> a -> Test
     testFail n orig
         = TestCase $ testPassShouldFail ("testCheckConstants" ++ show n)
diff --git a/frontends/OccamTypesTest.hs b/frontends/OccamTypesTest.hs
index 6f76286..aa2c7b8 100644
--- a/frontends/OccamTypesTest.hs
+++ b/frontends/OccamTypesTest.hs
@@ -505,28 +505,28 @@ testOccamTypes = TestList
     --}}}
     ]
   where
-    testOK :: (PolyplateM a (OneOpM PassM A.Variable) () PassM
-              ,PolyplateM a (OneOpM PassM A.Expression) () PassM
-              ,PolyplateM a (OneOpM PassM A.SpecType) () PassM
-              ,PolyplateM a (OneOpM PassM A.Process) () PassM
-              ,PolyplateM a () (OneOpM PassM A.Variable) PassM
-              ,PolyplateM a () (OneOpM PassM A.Expression) PassM
-              ,PolyplateM a () (OneOpM PassM A.SpecType) PassM
-              ,PolyplateM a () (OneOpM PassM A.Process) PassM
+    testOK :: (PolyplateM a (OneOpM A.Variable) BaseOpM
+              ,PolyplateM a (OneOpM A.Expression) BaseOpM
+              ,PolyplateM a (OneOpM A.SpecType) BaseOpM
+              ,PolyplateM a (OneOpM A.Process) BaseOpM
+              ,PolyplateM a BaseOpM (OneOpM A.Variable)
+              ,PolyplateM a BaseOpM (OneOpM A.Expression)
+              ,PolyplateM a BaseOpM (OneOpM A.SpecType)
+              ,PolyplateM a BaseOpM (OneOpM A.Process)
               ,Show a, Data a) => Int -> a -> Test
     testOK n orig
         = TestCase $ testPass ("testOccamTypes " ++ show n)
                               orig OccamTypes.checkTypes orig
                               startState
 
-    testFail :: (PolyplateM a (OneOpM PassM A.Variable) () PassM
-                ,PolyplateM a (OneOpM PassM A.Expression) () PassM
-                ,PolyplateM a (OneOpM PassM A.SpecType) () PassM
-                ,PolyplateM a (OneOpM PassM A.Process) () PassM
-                ,PolyplateM a () (OneOpM PassM A.Variable) PassM
-                ,PolyplateM a () (OneOpM PassM A.Expression) PassM
-                ,PolyplateM a () (OneOpM PassM A.SpecType) PassM
-                ,PolyplateM a () (OneOpM PassM A.Process) PassM
+    testFail :: (PolyplateM a (OneOpM A.Variable) BaseOpM
+                ,PolyplateM a (OneOpM A.Expression) BaseOpM
+                ,PolyplateM a (OneOpM A.SpecType) BaseOpM
+                ,PolyplateM a (OneOpM A.Process) BaseOpM
+                ,PolyplateM a BaseOpM (OneOpM A.Variable)
+                ,PolyplateM a BaseOpM (OneOpM A.Expression)
+                ,PolyplateM a BaseOpM (OneOpM A.SpecType)
+                ,PolyplateM a BaseOpM (OneOpM A.Process)
                 ,Show a, Data a) => Int -> a -> Test
     testFail n orig
         = TestCase $ testPassShouldFail ("testOccamTypes " ++ show n)
diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs
index 986f634..8df87b3 100644
--- a/frontends/RainTypes.hs
+++ b/frontends/RainTypes.hs
@@ -61,11 +61,11 @@ type RainTypeM = StateT RainTypeState PassM
 
 type RainTypePassType = forall t. t -> StateT RainTypeState PassM t
 
-type RainTypeCheckOn a = forall t. PolyplateM t (OneOpM RainTypeM a) () RainTypeM
+type RainTypeCheckOn a = forall t. PolyplateM t (OneOpM a) BaseOpM
   => t -> RainTypeM ()
 
 type RainTypeCheckOn2 a b = forall t.
-  (PolyplateM t (TwoOpM RainTypeM a b) () RainTypeM
+  (PolyplateM t (TwoOpM a b) BaseOpM
   ) => t -> RainTypeM ()
 
 
@@ -122,14 +122,14 @@ markUnify x y
 
 performTypeUnification ::
   -- | A shorthand for prerequisites when you need to spell them out:
-  (PolyplateM t (OneOpM RainTypeM A.Specification) () RainTypeM
-  ,PolyplateM t (OneOpM RainTypeM A.Process) () RainTypeM
-  ,PolyplateM t (OneOpM RainTypeM A.Expression) () RainTypeM
-  ,PolyplateM t (TwoOpM RainTypeM A.Process A.Expression) () RainTypeM
-  ,PolyplateM t (TwoOpM RainTypeM A.Process A.Choice) () RainTypeM
-  ,PolyplateM t (TwoOpM RainTypeM A.Process A.Alternative) () RainTypeM
-  ,PolyplateM t () (OneOpM PassM A.Type) PassM
-  ,PolyplateM t (OneOpM PassM A.Type) () PassM
+  (PolyplateM t (OneOpM A.Specification) BaseOpM
+  ,PolyplateM t (OneOpM A.Process) BaseOpM
+  ,PolyplateM t (OneOpM A.Expression) BaseOpM
+  ,PolyplateM t (TwoOpM A.Process A.Expression) BaseOpM
+  ,PolyplateM t (TwoOpM A.Process A.Choice) BaseOpM
+  ,PolyplateM t (TwoOpM A.Process A.Alternative) BaseOpM
+  ,PolyplateM t BaseOpM (OneOpM A.Type)
+  ,PolyplateM t (OneOpM A.Type) BaseOpM
   ) => Pass t
 performTypeUnification = rainOnlyPass "Rain Type Checking"
   ([Prop.noInt] ++ Prop.agg_namesDone)
diff --git a/pass/Pass.hs b/pass/Pass.hs
index aa06b1d..15bfb7e 100644
--- a/pass/Pass.hs
+++ b/pass/Pass.hs
@@ -97,21 +97,21 @@ instance Warn (ReaderT r PassM) where
 -- against AST fragments of other types as well.
 type PassType t = t -> PassM t
 
-type PassOnOpsM m ops
-  = (PolyplateM t ops () m, PolyplateM t () ops m) => Pass t
+type PassOnOpsM ops
+  = (PolyplateM t ops BaseOpM, PolyplateM t BaseOpM ops) => Pass t
 
-type PassOnOps ops = PassOnOpsM PassM ops
+type PassOnOps ops = PassOnOpsM ops
 
 type PassASTOnOps ops
-  = (PolyplateM A.AST ops () PassM, PolyplateM A.AST () ops PassM) => Pass A.AST
+  = (PolyplateM A.AST ops BaseOpM, PolyplateM A.AST BaseOpM ops) => Pass A.AST
 
 type PassTypeOnOps ops
-  = (PolyplateM t ops () PassM, PolyplateM t () ops PassM) => PassType t
+  = (PolyplateM t ops BaseOpM, PolyplateM t BaseOpM ops) => PassType t
 
-type PassOn t = PassOnOps (OneOpM PassM t)
-type PassOn2 s t = PassOnOps (TwoOpM PassM s t)
-type PassOnM2 m s t = PassOnOpsM m (TwoOpM m s t)
-type PassTypeOn t = PassTypeOnOps (OneOpM PassM t)
+type PassOn t = PassOnOps (OneOpM t)
+type PassOn2 s t = PassOnOps (TwoOpM s t)
+type PassOnM2 s t = PassOnOpsM (TwoOpM s t)
+type PassTypeOn t = PassTypeOnOps (OneOpM t)
 
 -- | A description of an AST-mangling pass.
 data Pass t = Pass {
diff --git a/pass/Traversal.hs b/pass/Traversal.hs
index 50c1480..d2f15a3 100644
--- a/pass/Traversal.hs
+++ b/pass/Traversal.hs
@@ -51,77 +51,79 @@ type CheckM m t = t -> m ()
 -- | As 'CheckM', but specialised for 'PassM'.
 type Check t = CheckM PassM t
 
-type ExtOpMP opT t = ExtOpM PassM opT t
+type ExtOpMP opT t = t :-* opT
 
-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
+type ExtOpMS opT =
+          (A.Structured ()) :-*
+          (A.Structured A.Alternative) :-*
+          (A.Structured A.Choice) :-*
+          (A.Structured A.ExpressionList) :-*
+          (A.Structured A.Option) :-*
+          (A.Structured A.Process) :-*
+          (A.Structured A.Variant) :-*
+          opT
 
-type PassOnStruct = PassOnOps (ExtOpMSP BaseOp)
-type PassASTOnStruct = PassASTOnOps (ExtOpMSP BaseOp)
+type ExtOpMSP opT = ExtOpMS opT PassM
 
-class (PolyplateM (A.Structured a) () opsM m
-      ,PolyplateM (A.Structured a) opsM () m
+type PassOnStruct = PassOnOps (ExtOpMS BaseOpM)
+type PassASTOnStruct = PassASTOnOps (ExtOpMS BaseOpM)
+
+class (PolyplateM (A.Structured a) BaseOpM opsM
+      ,PolyplateM (A.Structured a) opsM BaseOpM
       ,Data a
       ,Monad m
       ) => ASTStructured a opsM m opsQ r
 
-instance (PolyplateM (A.Structured ()) () opsM m
-         ,PolyplateM (A.Structured ()) opsM () m
+instance (PolyplateM (A.Structured ()) BaseOpM opsM
+         ,PolyplateM (A.Structured ()) opsM BaseOpM
          ,Monad m) => ASTStructured () opsM m opsQ r
 
-instance (PolyplateM (A.Structured A.Alternative) () opsM m
-         ,PolyplateM (A.Structured A.Alternative) opsM () m
+instance (PolyplateM (A.Structured A.Alternative) BaseOpM opsM
+         ,PolyplateM (A.Structured A.Alternative) opsM BaseOpM
          ,Monad m) => ASTStructured A.Alternative opsM m opsQ r
 
-instance (PolyplateM (A.Structured A.Choice) () opsM m
-         ,PolyplateM (A.Structured A.Choice) opsM () m
+instance (PolyplateM (A.Structured A.Choice) BaseOpM opsM
+         ,PolyplateM (A.Structured A.Choice) opsM BaseOpM
          ,Monad m) => ASTStructured A.Choice opsM m opsQ r
 
-instance (PolyplateM (A.Structured A.ExpressionList) () opsM m
-         ,PolyplateM (A.Structured A.ExpressionList) opsM () m
+instance (PolyplateM (A.Structured A.ExpressionList) BaseOpM opsM
+         ,PolyplateM (A.Structured A.ExpressionList) opsM BaseOpM
          ,Monad m) => ASTStructured A.ExpressionList opsM m opsQ r
 
-instance (PolyplateM (A.Structured A.Option) () opsM m
-         ,PolyplateM (A.Structured A.Option) opsM () m
+instance (PolyplateM (A.Structured A.Option) BaseOpM opsM
+         ,PolyplateM (A.Structured A.Option) opsM BaseOpM
          ,Monad m) => ASTStructured A.Option opsM m opsQ r
 
-instance (PolyplateM (A.Structured A.Process) () opsM m
-         ,PolyplateM (A.Structured A.Process) opsM () m
+instance (PolyplateM (A.Structured A.Process) BaseOpM opsM
+         ,PolyplateM (A.Structured A.Process) opsM BaseOpM
          ,Monad m) => ASTStructured A.Process opsM m opsQ r
 
-instance (PolyplateM (A.Structured A.Variant) () opsM m
-         ,PolyplateM (A.Structured A.Variant) opsM () m
+instance (PolyplateM (A.Structured A.Variant) BaseOpM opsM
+         ,PolyplateM (A.Structured A.Variant) opsM BaseOpM
          ,Monad m) => ASTStructured A.Variant opsM m opsQ r
 
 
 extOpMS :: forall m opT op0T.
-          (PolyplateM (A.Structured ()) () op0T m,
-           PolyplateM (A.Structured A.Alternative) () op0T m,
-           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 ->
+          (PolyplateM (A.Structured ()) BaseOpM op0T,
+           PolyplateM (A.Structured A.Alternative) BaseOpM op0T,
+           PolyplateM (A.Structured A.Choice) BaseOpM op0T,
+           PolyplateM (A.Structured A.ExpressionList) BaseOpM op0T,
+           PolyplateM (A.Structured A.Option) BaseOpM op0T,
+           PolyplateM (A.Structured A.Process) BaseOpM op0T,
+           PolyplateM (A.Structured A.Variant) BaseOpM op0T,
+           PolyplateM (A.Structured ()) op0T BaseOpM,
+           PolyplateM (A.Structured A.Alternative) op0T BaseOpM,
+           PolyplateM (A.Structured A.Choice) op0T BaseOpM,
+           PolyplateM (A.Structured A.ExpressionList) op0T BaseOpM,
+           PolyplateM (A.Structured A.Option) op0T BaseOpM,
+           PolyplateM (A.Structured A.Process) op0T BaseOpM,
+           PolyplateM (A.Structured A.Variant) op0T BaseOpM,
+           Monad m) =>
+          opT m ->
           -- Pairing the next two arguments allows us to apply this function infix:
-          (op0T, -- just a type witness
+          (op0T m, -- just a type witness
            forall t. ASTStructured t op0T m () () => A.Structured t -> m (A.Structured t)) ->
-          ExtOpMS m opT
+          ExtOpMS opT m
 extOpMS ops (_, f)
     = ops
       `extOpM` (f :: A.Structured A.Variant -> m (A.Structured A.Variant))
@@ -132,21 +134,21 @@ extOpMS ops (_, f)
       `extOpM` (f :: A.Structured A.Alternative -> m (A.Structured A.Alternative))
       `extOpM` (f :: A.Structured () -> m (A.Structured ()))
 
-applyBottomUpMS :: (PolyplateM t (ExtOpMSP BaseOp) () PassM) =>
-  (forall a. (Data a, PolyplateM (A.Structured a) () (ExtOpMSP BaseOp) PassM) =>
+applyBottomUpMS :: (PolyplateM t (ExtOpMS BaseOpM) BaseOpM) =>
+  (forall a. (Data a, PolyplateM (A.Structured a) BaseOpM (ExtOpMS BaseOpM)) =>
      (A.Structured a -> PassM (A.Structured a)))
   -> t -> PassM t
 applyBottomUpMS f = makeRecurseM ops
   where
-    ops = baseOp `extOpMS` (ops, makeBottomUpM ops f)
+    ops = baseOpM `extOpMS` (ops, makeBottomUpM ops f)
 
 type TransformStructured ops
-  = (PolyplateM (A.Structured t) () ops PassM, Data t) => Transform (A.Structured t)
+  = (PolyplateM (A.Structured t) BaseOpM ops, Data t) => Transform (A.Structured t)
 
 type TransformStructured' ops
-  = (PolyplateM (A.Structured t) () ops PassM
-    ,PolyplateM (A.Structured t) ops () PassM , Data t) => Transform (A.Structured t)
+  = (PolyplateM (A.Structured t) BaseOpM ops
+    ,PolyplateM (A.Structured t) ops BaseOpM, Data t) => Transform (A.Structured t)
 
 type TransformStructuredM' m ops
-  = (PolyplateM (A.Structured t) () ops m
-    ,PolyplateM (A.Structured t) ops () m , Data t) => A.Structured t -> m (A.Structured t)
+  = (PolyplateM (A.Structured t) BaseOpM ops
+    ,PolyplateM (A.Structured t) ops BaseOpM, Data t) => A.Structured t -> m (A.Structured t)
diff --git a/polyplate/Data/Generics/Polyplate.hs b/polyplate/Data/Generics/Polyplate.hs
index ac82d37..d942606 100644
--- a/polyplate/Data/Generics/Polyplate.hs
+++ b/polyplate/Data/Generics/Polyplate.hs
@@ -178,8 +178,8 @@ import Data.Generics.Polyplate.Route
 --
 -- Generally you will not use this function or type-class directly, but will instead
 -- use the helper functions lower down in this module.
-class Monad m => PolyplateMRoute t o o' m outer where
-  transformMRoute :: o m outer -> o' m outer -> (t, Route t outer) -> m t
+class PolyplateMRoute t o o' where
+  transformMRoute :: Monad m => o m outer -> o' m outer -> (t, Route t outer) -> m t
 
 -- | A derivative of PolyplateMRoute without all the route stuff.
 --
@@ -217,14 +217,14 @@ class Monad m => PolyplateMRoute t o o' m outer where
 --
 -- Generally you will not use this function or type-class directly, but will instead
 -- use the helper functions lower down in this module.
-class (Monad m) => PolyplateM t o o' m where
-  transformM :: o m -> o' m -> t -> m t
+class PolyplateM t o o' where
+  transformM :: (Monad m) => o m -> o' m -> t -> m t
 
 
-instance (Monad m
-  , PolyplateMRoute t o o' m ()
+instance (
+    PolyplateMRoute t o o'
   , ConvertOpsToIgnoreRoute ro o
-  , ConvertOpsToIgnoreRoute ro' o') => PolyplateM t ro ro' m where
+  , ConvertOpsToIgnoreRoute ro' o') => PolyplateM t ro ro' where
   transformM o o' t = transformMRoute (convertOpsToIgnoreRoute o)
                                       (convertOpsToIgnoreRoute o')
                                       (t, fakeRoute t) 
@@ -238,12 +238,12 @@ instance (Monad m
 class Polyplate t o o' where
   transform :: o -> o' -> t -> t
 
-instance (PolyplateM t mo mo' Identity, ConvertOpsToIdentity o mo, ConvertOpsToIdentity o' mo') => Polyplate t o o' where
+instance (PolyplateM t mo mo', ConvertOpsToIdentity o mo, ConvertOpsToIdentity o' mo') => Polyplate t o o' where
   transform o o' t = runIdentity (transformM (convertOpsToIdentity o) (convertOpsToIdentity o') t)
 
 -- | A type representing a monadic modifier function that applies the given ops
 -- (opT) in the given monad (m) directly to the given type (t).
-type RecurseM m opT = forall t. PolyplateM t opT BaseOpM m => t -> m t
+type RecurseM m opT = forall t. PolyplateM t opT BaseOpM => t -> m t
 
 -- | Given a set of operations (as described in the 'PolyplateM' type-class),
 -- makes a recursive modifier function.
@@ -252,7 +252,7 @@ makeRecurseM ops = transformM ops baseOpM
 
 -- | A type representing a monadic modifier function that applies the given ops
 -- (opT) in the given monad (m) to the children of the given type (t).
-type DescendM m opT = forall t. PolyplateM t BaseOpM opT m => t -> m t
+type DescendM m opT = forall t. PolyplateM t BaseOpM opT => t -> m t
 
 -- | Given a set of operations (as described in the 'PolyplateM' type-class),
 -- makes a descent modifier function that applies the operation to the type's children.
diff --git a/polyplate/Data/Generics/Polyplate/GenInstances.hs b/polyplate/Data/Generics/Polyplate/GenInstances.hs
index fe62d03..b1bd11e 100644
--- a/polyplate/Data/Generics/Polyplate/GenInstances.hs
+++ b/polyplate/Data/Generics/Polyplate/GenInstances.hs
@@ -305,7 +305,7 @@ instancesFrom genOverlapped genClass boxes w
     -- and last arguments swapped.
     genInst :: [String] -> String -> String -> [String] -> [String]
     genInst context ops0 ops1 body
-      = ["instance (Monad m" ++ concatMap (", " ++) context ++ ") =>"
+      = ["instance (" ++ concat (intersperse ", " context) ++ ") =>"
         ,"         " ++ contextSameType ops0 ops1 ++ " where"
         ] ++ map ("  " ++) body
 
@@ -313,17 +313,17 @@ instancesFrom genOverlapped genClass boxes w
     -- sets.  The class name will be the same as genInst.
     contextSameType :: String -> String -> String
     contextSameType ops0 ops1 = case genClass of
-      GenOneClass -> "PolyplateMRoute (" ++ wName ++ ") " ++ ops0 ++ " " ++ ops1 ++ " m outer"
-      GenClassPerType -> "PolyplateMRoute" ++ wMunged ++" " ++ ops0 ++ " " ++ ops1 ++ " m outer"
-      GenSlowDelegate -> "PolyplateMRoute' m " ++ ops0 ++ " " ++ ops1 ++ " (" ++ wName ++ ") outer"
+      GenOneClass -> "PolyplateMRoute (" ++ wName ++ ") " ++ ops0 ++ " " ++ ops1
+      GenClassPerType -> "PolyplateMRoute" ++ wMunged ++" " ++ ops0 ++ " " ++ ops1
+      GenSlowDelegate -> "PolyplateMRoute' " ++ ops0 ++ " " ++ ops1 ++ " (" ++ wName ++ ")"
 
     -- Generates the name of an instance for a different type (for processing children).
     --  This will be PolyplateM or PolyplateM'.
     contextNewType :: String -> String -> String -> String
     contextNewType cName ops0 ops1 = case genClass of
-      GenOneClass -> "PolyplateMRoute (" ++ cName ++ ") " ++ ops0 ++ " " ++ ops1 ++ " m outer"
-      GenClassPerType -> "PolyplateMRoute (" ++ cName ++ ") " ++ ops0 ++ " " ++ ops1 ++ " m outer"
-      GenSlowDelegate -> "PolyplateMRoute' m " ++ ops0 ++ " " ++ ops1 ++ " (" ++ cName ++ ") outer"
+      GenOneClass -> "PolyplateMRoute (" ++ cName ++ ") " ++ ops0 ++ " " ++ ops1
+      GenClassPerType -> "PolyplateMRoute (" ++ cName ++ ") " ++ ops0 ++ " " ++ ops1
+      GenSlowDelegate -> "PolyplateMRoute' " ++ ops0 ++ " " ++ ops1 ++ " (" ++ cName ++ ")"
       
 
     -- The function to define in the body, and also to use for processing the same
@@ -362,12 +362,12 @@ instancesFrom genOverlapped genClass boxes w
               "(a :-@ r)" "ops" 
                 [funcSameType ++ " (_ :-@ rest) ops vr = " ++ funcSameType ++ " rest ops vr"]
           ,if genClass == GenClassPerType
-             then ["class Monad m => PolyplateMRoute" ++ wMunged ++ " o o' m outer where"
+             then ["class PolyplateMRoute" ++ wMunged ++ " o o' where"
                   ,"  " ++ funcSameType ++ " :: o m outer -> o' m outer -> (" ++ wName
                     ++ ", Route (" ++ wName ++ ") outer) -> m (" ++ wName ++ ")"
                   ,""
-                  ,"instance (Monad m, " ++ contextSameType "o0" "o1" ++ ") =>"
-                  ,"         PolyplateMRoute (" ++ wName ++ ") o0 o1 m outer where"
+                  ,"instance (" ++ contextSameType "o0" "o1" ++ ") =>"
+                  ,"         PolyplateMRoute (" ++ wName ++ ") o0 o1 where"
                   ,"  transformMRoute = " ++ funcSameType
                   ]
              else []
diff --git a/polyplate/Data/Generics/Polyplate/Schemes.hs b/polyplate/Data/Generics/Polyplate/Schemes.hs
index 58ac9ad..ceb6eb5 100644
--- a/polyplate/Data/Generics/Polyplate/Schemes.hs
+++ b/polyplate/Data/Generics/Polyplate/Schemes.hs
@@ -37,11 +37,11 @@ makeBottomUp ops f v = f (makeDescend ops v)
 -- function to first descend into the value before then applying the modifier function.
 --  This can be used to perform a bottom-up depth-first traversal of a structure
 -- (see 'applyBottomUpM').
-makeBottomUpM :: PolyplateM t BaseOpM opT m => opT m -> (t -> m t) -> t -> m t
+makeBottomUpM :: (PolyplateM t BaseOpM opT, Monad m) => opT m -> (t -> m t) -> t -> m t
 makeBottomUpM ops f v = makeDescendM ops v >>= f
 
 -- | As makeBottomUpM, but with routes as well.
-makeBottomUpMRoute :: forall m opT t outer. PolyplateMRoute t BaseOpMRoute opT m outer =>
+makeBottomUpMRoute :: forall m opT t outer. (Monad m, PolyplateMRoute t BaseOpMRoute opT) =>
   opT m outer -> ((t, Route t outer) -> m t) -> (t, Route t outer) -> m t
 makeBottomUpMRoute ops f (v, r)
   = do v' <- transformMRoute base ops (v, r)
@@ -61,11 +61,11 @@ makeTopDown ops f v = makeDescend ops (f v)
 -- function to first apply the modifier function before then descending into the value.
 --  This can be used to perform a top-down depth-first traversal of a structure
 -- (see 'applyTopDownM').
-makeTopDownM :: PolyplateM t BaseOpM opT m => opT m -> (t -> m t) -> t -> m t
+makeTopDownM :: (PolyplateM t BaseOpM opT, Monad m) => opT m -> (t -> m t) -> t -> m t
 makeTopDownM ops f v = f v >>= makeDescendM ops
 
 -- | As makeTopDownM, but with routes as well.
-makeTopDownMRoute :: PolyplateMRoute t BaseOpMRoute opT m outer =>
+makeTopDownMRoute :: (PolyplateMRoute t BaseOpMRoute opT, Monad m) =>
   opT m outer -> ((t, Route t outer) -> m t) -> (t, Route t outer) -> m t
 makeTopDownMRoute ops f (v, r)
   = do v' <- f (v, r)
@@ -89,8 +89,8 @@ makeCheckM ops f v
 -- the item in the list, False to drop it), finds all items of type \"s\" in some
 -- larger item (of type \"t\") that satisfy this function, listed in depth-first
 -- order.
-listifyDepth :: (PolyplateM t (OneOpM s) BaseOpM (State [s])
-                ,PolyplateM s BaseOpM (OneOpM s) (State [s])) => (s -> Bool) -> t -> [s]
+listifyDepth :: (PolyplateM t (OneOpM s) BaseOpM
+                ,PolyplateM s BaseOpM (OneOpM s)) => (s -> Bool) -> t -> [s]
 -- We use applyBottomUp because we are prepending to the list.  If we prepend from
 -- the bottom up, that's the same as appending from the top down, which is what
 -- this function is meant to be doing.
@@ -99,8 +99,8 @@ listifyDepth qf = flip execState [] . applyBottomUpM qf'
     qf' x = if qf x then modify (x:) >> return x else return x
 
 -- | Like listifyDepth, but with routes
-listifyDepthRoute :: (PolyplateMRoute t (OneOpMRoute s) (BaseOpMRoute) (State [(s, Route s t)]) t
-                     ,PolyplateMRoute s (BaseOpMRoute) (OneOpMRoute s) (State [(s, Route s t)]) t)
+listifyDepthRoute :: (PolyplateMRoute t (OneOpMRoute s) (BaseOpMRoute)
+                     ,PolyplateMRoute s (BaseOpMRoute) (OneOpMRoute s))
                      => ((s, Route s t) -> Bool) -> t -> [(s, Route s t)]
 listifyDepthRoute qf = flip execState [] . applyBottomUpMRoute qf'
   where
@@ -115,15 +115,15 @@ listifyDepthRoute qf = flip execState [] . applyBottomUpMRoute qf'
 --
 -- This can be used, for example, to perform checks on items in an error monad,
 -- or to accumulate information in a state monad.
-checkDepthM :: (Monad m, PolyplateM t (OneOpM s) BaseOpM m
-                       , PolyplateM s BaseOpM (OneOpM s) m) => (s -> m ()) -> t -> m ()
+checkDepthM :: (Monad m, PolyplateM t (OneOpM s) BaseOpM
+                       , PolyplateM s BaseOpM (OneOpM s)) => (s -> m ()) -> t -> m ()
 checkDepthM f x = applyBottomUpM (\x -> f x >> return x) x >> return ()
 
 -- | As 'checkDepthM', but takes two functions (one operating on type \"r\", the
 -- other on type \"s\").
-checkDepthM2 :: (Monad m, PolyplateM t (TwoOpM r s) (BaseOpM) m
-                        , PolyplateM r (BaseOpM) (TwoOpM r s) m
-                        , PolyplateM s (BaseOpM) (TwoOpM r s) m
+checkDepthM2 :: (Monad m, PolyplateM t (TwoOpM r s) (BaseOpM)
+                        , PolyplateM r (BaseOpM) (TwoOpM r s)
+                        , PolyplateM s (BaseOpM) (TwoOpM r s)
                         ) =>
   (r -> m ()) -> (s -> m ()) -> t -> m ()
 checkDepthM2 f g x = applyBottomUpM2 (\x -> f x >> return x)
@@ -137,16 +137,17 @@ checkDepthM2 f g x = applyBottomUpM2 (\x -> f x >> return x)
 -- traversal in order of a constructor's children (assuming you are using one of
 -- the generated instances, not your own), descending first and applying the function
 -- afterwards on the way back up.
-applyBottomUpM :: (PolyplateM t (OneOpM s) BaseOpM m,
-                   PolyplateM s BaseOpM (OneOpM s) m) =>
+applyBottomUpM :: (PolyplateM t (OneOpM s) BaseOpM,
+                   PolyplateM s BaseOpM (OneOpM s), Monad m) =>
                   (s -> m s) -> t -> m t
 applyBottomUpM f = makeRecurseM ops
   where
     ops = baseOpM `extOpM` makeBottomUpM ops f
 
 applyBottomUpMRoute :: forall m s t.
-                       (PolyplateMRoute t (OneOpMRoute s) (BaseOpMRoute) m t,
-                        PolyplateMRoute s (BaseOpMRoute) (OneOpMRoute s) m t) =>
+                       (PolyplateMRoute t (OneOpMRoute s) (BaseOpMRoute),
+                        PolyplateMRoute s (BaseOpMRoute) (OneOpMRoute s),
+                        Monad m) =>
                        ((s, Route s t) -> m s) -> t -> m t
 applyBottomUpMRoute f x = transformMRoute ops base (x, identityRoute)
   where
@@ -158,9 +159,10 @@ applyBottomUpMRoute f x = transformMRoute ops base (x, identityRoute)
 
 -- | As 'applyBottomUpM', but applies two functions.  These should not be modifying
 -- the same type.
-applyBottomUpM2 :: (PolyplateM t (TwoOpM sA sB) (BaseOpM) m,
-                    PolyplateM sA (BaseOpM) (TwoOpM sA sB) m,
-                    PolyplateM sB (BaseOpM) (TwoOpM sA sB) m
+applyBottomUpM2 :: (PolyplateM t (TwoOpM sA sB) (BaseOpM),
+                    PolyplateM sA (BaseOpM) (TwoOpM sA sB),
+                    PolyplateM sB (BaseOpM) (TwoOpM sA sB),
+                    Monad m
                    ) =>
                    (sA -> m sA) -> (sB -> m sB) -> t -> m t
 applyBottomUpM2 fA fB = makeRecurseM ops
@@ -190,8 +192,9 @@ applyBottomUp2 fA fB = makeRecurse ops
 -- traversal in order of a constructor's children (assuming you are using one of
 -- the generated instances, not your own), applying the function first and then
 -- descending.
-applyTopDownM :: (PolyplateM t (s :-* BaseOpM) BaseOpM m,
-                  PolyplateM s BaseOpM (s :-* BaseOpM) m) =>
+applyTopDownM :: (PolyplateM t (s :-* BaseOpM) BaseOpM,
+                  PolyplateM s BaseOpM (s :-* BaseOpM),
+                  Monad m) =>
                  (s -> m s) -> t -> m t
 applyTopDownM f = makeRecurseM ops
   where
@@ -199,9 +202,10 @@ applyTopDownM f = makeRecurseM ops
 
 -- | As applyTopDownM, but applies two functions.  These should not be modifying
 -- the same type.
-applyTopDownM2 :: (PolyplateM t (sA :-* sB :-* BaseOpM) BaseOpM m,
-                   PolyplateM sA BaseOpM (sA :-* sB :-* BaseOpM) m,
-                   PolyplateM sB BaseOpM (sA :-* sB :-* BaseOpM) m
+applyTopDownM2 :: (PolyplateM t (sA :-* sB :-* BaseOpM) BaseOpM,
+                   PolyplateM sA BaseOpM (sA :-* sB :-* BaseOpM),
+                   PolyplateM sB BaseOpM (sA :-* sB :-* BaseOpM),
+                   Monad m
                   ) =>
                   (sA -> m sA) -> (sB -> m sB) -> t -> m t
 applyTopDownM2 fA fB = makeRecurseM ops
diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs
index 8841acb..f349d73 100644
--- a/transformations/ImplicitMobility.hs
+++ b/transformations/ImplicitMobility.hs
@@ -203,15 +203,15 @@ implicitMobility
 mobiliseArrays :: PassASTOnStruct
 mobiliseArrays = pass "Make all arrays mobile" [] [] recurse
   where
-    ops :: ExtOpMSP BaseOp
-    ops = baseOp `extOpMS` (ops, doStructured)
+    ops :: ExtOpMSP BaseOpM
+    ops = baseOpM `extOpMS` (ops, doStructured)
 
-    recurse :: RecurseM PassM (ExtOpMSP BaseOp)
+    recurse :: RecurseM PassM (ExtOpMS BaseOpM)
     recurse = makeRecurseM ops
-    descend :: DescendM PassM (ExtOpMSP BaseOp)
+    descend :: DescendM PassM (ExtOpMS BaseOpM)
     descend = makeDescendM ops
 
-    doStructured :: TransformStructured' (ExtOpMSP BaseOp)
+    doStructured :: TransformStructured' (ExtOpMS BaseOpM)
     doStructured s@(A.Spec m (A.Specification m' n (A.Declaration m'' t@(A.Array ds
       innerT))) scope)
       = case innerT of
@@ -309,11 +309,11 @@ instance Dereferenceable A.Actual where
 inferDeref :: PassOn2 A.Process A.Variable
 inferDeref = pass "Infer mobile dereferences" [] [] recurse
   where
-    ops = baseOp `extOpM` doProcess `extOpM` doVariable
+    ops = doProcess :-* doVariable :-* baseOpM
 
-    recurse :: RecurseM PassM (TwoOpM PassM A.Process A.Variable)
+    recurse :: RecurseM PassM (TwoOpM A.Process A.Variable)
     recurse = makeRecurseM ops
-    descend :: DescendM PassM (TwoOpM PassM A.Process A.Variable)
+    descend :: DescendM PassM (TwoOpM A.Process A.Variable)
     descend = makeDescendM ops
 
     unify :: (Dereferenceable a, ASTTypeable a, ShowOccam a, ShowRain a) => Meta
diff --git a/transformations/SimplifyAbbrevs.hs b/transformations/SimplifyAbbrevs.hs
index fece9c6..8e7ffae 100644
--- a/transformations/SimplifyAbbrevs.hs
+++ b/transformations/SimplifyAbbrevs.hs
@@ -49,14 +49,14 @@ simplifyAbbrevs =
     ]
 
 -- | Rewrite 'InitialAbbrev' into a variable and an assignment.
-removeInitial :: PassOnOps (ExtOpMSP BaseOp)
+removeInitial :: PassOnOps (ExtOpMS BaseOpM)
 removeInitial
     = pass "Remove INITIAL abbreviations"
            []
            [Prop.initialRemoved]
            (applyBottomUpMS doStructured)
   where
-    doStructured :: TransformStructured (ExtOpMSP BaseOp)
+    doStructured :: TransformStructured (ExtOpMS BaseOpM)
     doStructured (A.Spec m spec s) = doSpec m spec s
     doStructured s = return s
 
@@ -191,20 +191,20 @@ updateAbbrevsInState
     doAbbrevMode s = s
 
 type AbbrevCheckM = StateT [Map.Map Var Bool] PassM
-type ExtAbbM a b = ExtOpM AbbrevCheckM a b
-type AbbrevCheckOps
-  = ExtOpMS AbbrevCheckM BaseOp
-      `ExtAbbM` A.Variable
-      `ExtAbbM` A.Process
-      `ExtAbbM` A.InputItem
 
-abbrevCheckPass :: (PolyplateM t AbbrevCheckOps () AbbrevCheckM, PolyplateM t () AbbrevCheckOps AbbrevCheckM) => Pass t
+type AbbrevCheckOps
+  = ExtOpMS BaseOpM
+      `ExtOpMP` A.Variable
+      `ExtOpMP` A.Process
+      `ExtOpMP` A.InputItem
+
+abbrevCheckPass :: (PolyplateM t AbbrevCheckOps BaseOpM, PolyplateM t BaseOpM AbbrevCheckOps) => Pass t
 abbrevCheckPass
     = pass "Abbreviation checking" [] []
            ({-passOnlyOnAST "abbrevCheck" $ -} flip evalStateT [Map.empty] . recurse)
   where
-    ops :: AbbrevCheckOps
-    ops = baseOp `extOpMS` (ops, doStructured) `extOpM` doVariable
+    ops :: AbbrevCheckOps AbbrevCheckM
+    ops = baseOpM `extOpMS` (ops, doStructured) `extOpM` doVariable
             `extOpM` doProcess `extOpM` doInputItem
 
     descend :: DescendM AbbrevCheckM AbbrevCheckOps
@@ -212,7 +212,7 @@ abbrevCheckPass
     recurse :: RecurseM AbbrevCheckM AbbrevCheckOps
     recurse = makeRecurseM ops
 
-    pushRecurse :: (PolyplateM a AbbrevCheckOps () AbbrevCheckM) => a -> AbbrevCheckM a
+    pushRecurse :: (PolyplateM a AbbrevCheckOps BaseOpM) => a -> AbbrevCheckM a
     pushRecurse x = modify (Map.empty:) >> recurse x
     pop :: StateT [Map.Map Var Bool] PassM ()
     pop = modify $ \st -> case st of
@@ -232,8 +232,8 @@ abbrevCheckPass
     -- on an abbreviation if either the RHS *or* the LHS is exempt by a PERMITALIASEs
     -- pragma
 
-    doStructured :: (PolyplateM (A.Structured t) () AbbrevCheckOps AbbrevCheckM
-                    ,PolyplateM (A.Structured t) AbbrevCheckOps () AbbrevCheckM, Data t) =>
+    doStructured :: (PolyplateM (A.Structured t) BaseOpM AbbrevCheckOps
+                    ,PolyplateM (A.Structured t) AbbrevCheckOps BaseOpM, Data t) =>
       A.Structured t -> AbbrevCheckM (A.Structured t)
     doStructured s@(A.Spec _ (A.Specification _ n (A.Is _ A.Abbrev _ (A.ActualVariable v))) scope)
       = do nonce <- nameIsNonce n
diff --git a/transformations/SimplifyAbbrevsTest.hs b/transformations/SimplifyAbbrevsTest.hs
index ce15297..3ea858f 100644
--- a/transformations/SimplifyAbbrevsTest.hs
+++ b/transformations/SimplifyAbbrevsTest.hs
@@ -94,8 +94,8 @@ testRemoveInitial = TestLabel "testRemoveInitial" $ TestList
               inner)
   ]
   where
-    ok :: (PolyplateM a (ExtOpMSP BaseOp) () PassM
-          ,PolyplateM a () (ExtOpMSP BaseOp) PassM
+    ok :: (PolyplateM a (ExtOpMS BaseOpM) BaseOpM
+          ,PolyplateM a BaseOpM (ExtOpMS BaseOpM)
           ,Data a, Data b) => Int -> a -> b -> Test
     ok n inp exp = TestCase $ testPass ("testRemoveInitial" ++ show n)
                                        exp removeInitial inp setupState
@@ -152,7 +152,7 @@ testRemoveResult = TestLabel "testRemoveResult" $ TestList
             (A.Formal A.Abbrev       A.Int foo)
   ]
   where
-    ok :: (Polyplate a (OneOp A.AbbrevMode) ()
+    ok :: (Polyplate a (OneOp A.AbbrevMode) BaseOp
           ,Data a, Data b) => Int -> a -> b -> Test
     ok n inp exp = TestCase $ testPass ("testRemoveResult" ++ show n)
                                        exp removeResult inp setupState
diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs
index 4b0a278..9f6825f 100644
--- a/transformations/SimplifyExprs.hs
+++ b/transformations/SimplifyExprs.hs
@@ -215,7 +215,7 @@ pullRepCounts = pass "Pull up replicator counts for SEQs, PARs and ALTs"
            return $ A.Seq m $ spec $ A.Only m $ A.Par m p body'
     pullRepCountProc p = return p
 
-transformConstr :: PassOnOps (ExtOpMSP BaseOp)
+transformConstr :: PassOnOps (ExtOpMS BaseOpM)
 transformConstr = pass "Transform array constructors into initialisation code"
   (Prop.agg_namesDone ++ Prop.agg_typesDone ++ [Prop.subscriptsPulledUp])
   [Prop.arrayConstructorsRemoved]
@@ -323,7 +323,7 @@ transformConstr = pass "Transform array constructors into initialisation code"
 
     doStructured s = return s
 
-type PullUpOps = ExtOpMSP BaseOp
+type PullUpOps = ExtOpMS BaseOpM
   `ExtOpMP` A.Process
   `ExtOpMP` A.Structured A.Expression
   `ExtOpMP` A.Specification
@@ -340,8 +340,8 @@ pullUp pullUpArraysInsideRecords = pass "Pull up definitions"
   [Prop.functionCallsRemoved, Prop.subscriptsPulledUp]
   recurse
   where
-    ops :: PullUpOps
-    ops = baseOp
+    ops :: PullUpOps PassM
+    ops = baseOpM
           `extOpMS` (ops, doStructured)
           `extOpM` doProcess
           `extOpM` doRepArray
diff --git a/transformations/SimplifyProcs.hs b/transformations/SimplifyProcs.hs
index 5eac6eb..7b61b7e 100644
--- a/transformations/SimplifyProcs.hs
+++ b/transformations/SimplifyProcs.hs
@@ -45,15 +45,15 @@ simplifyProcs =
       ]
 
 type ForkM = StateT [A.Name] PassM
-type ForkOps = ExtOpM ForkM (ExtOpMS ForkM BaseOp) A.Process
+type ForkOps = A.Process :-* (ExtOpMS BaseOpM)
 
 -- | Add an extra barrier parameter to every PROC for FORKING
-addForkNames :: PassOnOpsM ForkM ForkOps
+addForkNames :: PassOnOpsM ForkOps
 addForkNames = occamOnlyPass "Add FORK labels" [] []
   (flip evalStateT [] . recurse)
   where
-    ops :: ForkOps
-    ops = baseOp `extOpMS` (ops, doStructured) `extOpM` doProcess
+    ops :: ForkOps ForkM
+    ops = baseOpM `extOpMS` (ops, doStructured) `extOpM` doProcess
 
     recurse :: RecurseM ForkM ForkOps
     recurse = makeRecurseM ops
@@ -153,14 +153,14 @@ removeParAssign = pass "Remove parallel assignment"
     doProcess p = return p
 
 -- | Turn assignment of arrays and records into multiple assignments.
-flattenAssign :: PassOnOps (ExtOpMSP BaseOp `ExtOpMP` A.Process)
+flattenAssign :: PassOnOps (A.Process :-* ExtOpMS BaseOpM)
 flattenAssign = pass "Flatten assignment"
   (Prop.agg_typesDone ++ [Prop.assignParRemoved])
   [Prop.assignFlattened]
   (makeRecurseM ops)
   where
-    ops = baseOp `extOpMS` (ops, makeBottomUpM ops doStructured)
-                 `extOpM` makeBottomUpM ops doProcess
+    ops = baseOpM `extOpMS` (ops, makeBottomUpM ops doStructured)
+                  `extOpM` makeBottomUpM ops doProcess
 
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.Assign m [v] (A.ExpressionList m' [e]))
diff --git a/transformations/SimplifyTypesTest.hs b/transformations/SimplifyTypesTest.hs
index d172d65..3bd7802 100644
--- a/transformations/SimplifyTypesTest.hs
+++ b/transformations/SimplifyTypesTest.hs
@@ -51,8 +51,8 @@ testResolveNamedTypes = TestLabel "testResolveNamedTypes" $ TestList
             (array10 A.Int)
   ]
   where
-    ok :: (PolyplateM a (OneOpM PassM A.Type) () PassM
-          ,PolyplateM a () (OneOpM PassM A.Type) PassM
+    ok :: (PolyplateM a (OneOpM A.Type) BaseOpM
+          ,PolyplateM a BaseOpM (OneOpM A.Type)
           ,Data a, Data b) => Int -> a -> b -> Test
     ok n inp exp = TestCase $ testPass ("testResolveNamedTypes" ++ show n)
                                        exp resolveNamedTypes inp setupState
diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs
index 8904dfc..469f233 100644
--- a/transformations/Unnest.hs
+++ b/transformations/Unnest.hs
@@ -48,22 +48,22 @@ type NameMap = Map.Map String A.Name
 
 type FreeNameM = State (Map.Map String A.Name)
 
-type FreeNameOps = ExtOpM FreeNameM (ExtOpMS FreeNameM (ExtOpM FreeNameM BaseOp A.Name)) A.SpecType
+type FreeNameOps = A.SpecType :-* (ExtOpMS (A.Name :-* BaseOpM))
 
 -- | Get the set of free names within a block of code.
-freeNamesIn :: PolyplateM t FreeNameOps () FreeNameM  => t -> NameMap
+freeNamesIn :: PolyplateM t FreeNameOps BaseOpM => t -> NameMap
 freeNamesIn = flip execState Map.empty . recurse
   where
     flattenTree :: Tree (Maybe NameMap) -> NameMap
     flattenTree = foldl Map.union Map.empty . catMaybes . flatten
     
-    ops :: FreeNameOps
-    ops = baseOp `extOpM` doName `extOpMS` (ops, doStructured) `extOpM` doSpecType
+    ops :: FreeNameOps FreeNameM
+    ops = baseOpM `extOpM` doName `extOpMS` (ops, doStructured) `extOpM` doSpecType
 
-    recurse :: PolyplateM t FreeNameOps () FreeNameM => t -> FreeNameM t
-    recurse = transformM ops ()
-    descend :: PolyplateM t () FreeNameOps FreeNameM => t -> FreeNameM t
-    descend = transformM () ops
+    recurse :: PolyplateM t FreeNameOps BaseOpM => t -> FreeNameM t
+    recurse = transformM ops baseOpM
+    descend :: PolyplateM t BaseOpM FreeNameOps => t -> FreeNameM t
+    descend = transformM baseOpM ops
     
     ignore :: t -> NameMap
     ignore s = Map.empty
@@ -71,15 +71,15 @@ freeNamesIn = flip execState Map.empty . recurse
     doName :: A.Name -> FreeNameM A.Name
     doName n = modify (Map.insert (A.nameName n) n) >> return n
 
-    doStructured :: (Data a, PolyplateM (A.Structured a) () FreeNameOps FreeNameM
-                           , PolyplateM (A.Structured a) FreeNameOps () FreeNameM
+    doStructured :: (Data a, PolyplateM (A.Structured a) BaseOpM FreeNameOps
+                           , PolyplateM (A.Structured a) FreeNameOps BaseOpM
                     )
       => A.Structured a -> FreeNameM (A.Structured a)
     doStructured x@(A.Spec _ spec s) = doSpec spec s >> return x
     doStructured s = descend s
 
-    doSpec :: (PolyplateM t () FreeNameOps FreeNameM
-              ,PolyplateM t FreeNameOps () FreeNameM) => A.Specification -> t -> FreeNameM ()
+    doSpec :: (PolyplateM t BaseOpM FreeNameOps
+              ,PolyplateM t FreeNameOps BaseOpM) => A.Specification -> t -> FreeNameM ()
     doSpec (A.Specification _ n st) child
         = modify (Map.union $ Map.union fns $ Map.delete (A.nameName n) $ freeNamesIn child)
       where
@@ -98,15 +98,15 @@ freeNamesIn = flip execState Map.empty . recurse
 -- have expressions as dimensions, and those expressions can contain free names
 -- which are being replaced.  This is fine, but when that happens we need to update
 -- CompState so that the type has the replaced name, not the old name.
-replaceNames :: PolyplateM t (TwoOpM PassM A.Name A.Specification) () PassM => [(A.Name, A.Name)] -> t -> PassM t
+replaceNames :: PolyplateM t (TwoOpM A.Name A.Specification) BaseOpM => [(A.Name, A.Name)] -> t -> PassM t
 replaceNames map = recurse
   where
     smap = Map.fromList [(A.nameName f, t) | (f, t) <- map]
 
-    ops :: TwoOpM PassM A.Name A.Specification
-    ops = baseOp `extOpM` doName `extOpM` doSpecification
+    ops :: TwoOpM A.Name A.Specification PassM
+    ops = doName :-* doSpecification :-* baseOpM
 
-    recurse :: RecurseM PassM (TwoOpM PassM A.Name A.Specification)
+    recurse :: RecurseM PassM (TwoOpM A.Name A.Specification)
     recurse = makeRecurseM ops
 
     doName :: Transform A.Name
@@ -124,7 +124,7 @@ replaceNames map = recurse
            return $ A.Specification m n' sp'
 
 -- | Turn free names in PROCs into arguments.
-removeFreeNames :: PassOnM2 (StateT (Map.Map String [A.Actual]) PassM) A.Specification A.Process
+removeFreeNames :: PassOnM2 A.Specification A.Process
 removeFreeNames = pass "Convert free names to arguments"
   [Prop.mainTagged, Prop.parsWrapped, Prop.functionCallsRemoved]
   [Prop.freeNamesToArgs]
@@ -213,7 +213,7 @@ removeFreeNames = pass "Convert free names to arguments"
     doProcess p = return p
 
 -- | Pull nested declarations to the top level.
-removeNesting :: PassASTOnOps (ExtOpMSP BaseOp)
+removeNesting :: PassASTOnOps (ExtOpMS BaseOpM)
 removeNesting = pass "Pull nested definitions to top level"
   [Prop.freeNamesToArgs]
   [Prop.nestedPulled]
@@ -223,16 +223,16 @@ removeNesting = pass "Pull nested definitions to top level"
           popPullContext
           return s')
   where
-    ops :: ExtOpMSP BaseOp
-    ops = baseOp `extOpMS` (ops, doStructured)
+    ops :: ExtOpMSP BaseOpM
+    ops = baseOpM `extOpMS` (ops, doStructured)
 
 
-    recurse :: RecurseM PassM (ExtOpMSP BaseOp)
+    recurse :: RecurseM PassM (ExtOpMS BaseOpM)
     recurse = makeRecurseM ops
-    descend :: DescendM PassM (ExtOpMSP BaseOp)
+    descend :: DescendM PassM (ExtOpMS BaseOpM)
     descend = makeDescendM ops
 
-    doStructured :: TransformStructured (ExtOpMSP BaseOp)
+    doStructured :: TransformStructured (ExtOpMS BaseOpM)
     doStructured s@(A.Spec m spec subS)
         = do spec'@(A.Specification _ n st) <- recurse spec
              isConst <- isConstantName n