diff --git a/DDC/Core/Flow/Compounds.hs b/DDC/Core/Flow/Compounds.hs
--- a/DDC/Core/Flow/Compounds.hs
+++ b/DDC/Core/Flow/Compounds.hs
@@ -1,22 +1,27 @@
 
 -- | Short-hands for constructing compound expressions.
 module DDC.Core.Flow.Compounds
-        ( module DDC.Core.Compounds.Simple
+        ( module DDC.Core.Exp.Simple.Compounds
 
           -- * Fragment specific kinds
         , kRate
+        , kProc
 
           -- * Fragment specific types
         , isRateNatType
         , isSeriesType
+        , isRateVecType
         , isRefType
         , isVectorType
+        , isProcessType
         , tTuple1, tTuple2, tTupleN
-        , tVector, tSeries, tSegd, tSel1, tSel2, tRef, tWorld
+        , tVector, tBuffer, tSeries, tRateVec, tSegd, tSel1, tSel2, tRef, tWorld
         , tRateNat
         , tDown
         , tTail
+        , tRateAppend, tRateCross
         , tProcess
+        , tResize
 
           -- * Primtiive types
         , tVoid, tBool, tNat, tInt, tWord, tFloat, tVec
@@ -41,6 +46,7 @@
         , xNext, xNextC
         , xDown
         , xTail
+        , xSeriesOfRateVec
 
           -- * Control operators
         , xLoopN
@@ -62,6 +68,7 @@
 import DDC.Core.Flow.Prim.DaConPrim
 import DDC.Core.Flow.Prim.OpControl
 import DDC.Core.Flow.Prim.OpConcrete
+import DDC.Core.Flow.Prim.OpSeries
 import DDC.Core.Flow.Prim.OpStore
 import DDC.Core.Flow.Prim.OpPrim
-import DDC.Core.Compounds.Simple
+import DDC.Core.Exp.Simple.Compounds
diff --git a/DDC/Core/Flow/Context.hs b/DDC/Core/Flow/Context.hs
--- a/DDC/Core/Flow/Context.hs
+++ b/DDC/Core/Flow/Context.hs
@@ -1,29 +1,7 @@
 
 module DDC.Core.Flow.Context
-        (Context (..))
+        ( module DDC.Core.Flow.Context.Base
+        , module DDC.Core.Flow.Context.FillPath )
 where
-import DDC.Type.Exp
-import DDC.Core.Flow.Prim
-
-data Context
-        -- | A top-level context associated with a rate that is a parameter
-        --   of the process. This context isn't created by the process itself.
-        = ContextRate
-        { contextRate           :: Type Name }
-
-        -- | A nested context created by a mkSel1# function.
-        | ContextSelect
-        { contextOuterRate      :: Type  Name
-        , contextInnerRate      :: Type  Name
-        , contextFlags          :: Bound Name
-        , contextSelector       :: Bind  Name }
-
-
-        -- | A nested context created by a mkSegd# function.
-        | ContextSegment
-        { contextOuterRate      :: Type  Name
-        , contextInnerRate      :: Type  Name
-        , contextLens           :: Bound Name
-        , contextSegd           :: Bind  Name }
-        deriving (Show, Eq)
-
+import DDC.Core.Flow.Context.Base
+import DDC.Core.Flow.Context.FillPath
diff --git a/DDC/Core/Flow/Context/Base.hs b/DDC/Core/Flow/Context/Base.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Context/Base.hs
@@ -0,0 +1,44 @@
+
+module DDC.Core.Flow.Context.Base
+        (Context (..))
+where
+import DDC.Type.Exp
+import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Process.Operator
+
+
+data Context
+        -- | A top-level context associated with a rate that is a parameter
+        --   of the process. This context isn't created by the process itself.
+        = ContextRate
+        { contextRate           :: Type Name
+        , contextOps            :: [Operator]
+        , contextInner          :: [Context] }
+
+        -- | A nested context created by a mkSel1# function.
+        | ContextSelect
+        { contextOuterRate      :: Type  Name
+        , contextInnerRate      :: Type  Name
+        , contextFlags          :: Bound Name
+        , contextSelector       :: Bind  Name
+        , contextOps            :: [Operator]
+        , contextInner          :: [Context] }
+
+
+        -- | A nested context created by a mkSegd# function.
+        | ContextSegment
+        { contextOuterRate      :: Type  Name
+        , contextInnerRate      :: Type  Name
+        , contextLens           :: Bound Name
+        , contextSegd           :: Bind  Name
+        , contextOps            :: [Operator]
+        , contextInner          :: [Context] }
+
+        | ContextAppend
+        { contextRate1          :: Type Name
+        , contextInner1         :: Context
+        , contextRate2          :: Type Name
+        , contextInner2         :: Context }
+        deriving Show
+
+
diff --git a/DDC/Core/Flow/Context/FillPath.hs b/DDC/Core/Flow/Context/FillPath.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Context/FillPath.hs
@@ -0,0 +1,148 @@
+
+module DDC.Core.Flow.Context.FillPath
+        ( FillMap, FillPath
+        , pathsOfFills
+        , getAccForPath
+        , getAcc
+        , isSimple
+        , isNone )
+where
+import DDC.Type.Exp
+import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Process.Operator
+import DDC.Core.Flow.Context.Base
+
+import qualified Data.Map as Map
+import Control.Monad
+
+
+type FillMap = Map.Map Name (FillPath, Type Name)
+
+data FillPath
+        = PathNone
+        | PathRate      (Type  Name)
+        | PathSelect    (Bound Name)
+        | PathSegment   (Bound Name)
+        | PathAppend     FillPath       FillPath
+        deriving (Eq, Show)
+
+
+pathsOfFills :: Context -> Maybe FillMap
+pathsOfFills ctx
+ = go ctx Map.empty
+ where
+  go c@ContextAppend{} _
+   = do m1 <- go (contextInner1 c) Map.empty
+        m2 <- go (contextInner2 c) Map.empty
+        return $ Map.unionWith merge
+          (Map.map appl m1)
+          (Map.map appr m2)
+
+  go c m
+   = do m' <- insertFillsNoDupes (contextOps c) (path c) m
+        foldM (flip go) m' (contextInner c)
+
+  appl (p,t)
+   = (PathAppend p PathNone, t)
+  appr (p,t)
+   = (PathAppend PathNone p, t)
+
+  merge (PathAppend PathNone _, t) (PathAppend _ PathNone, _)
+   = (PathNone, t)
+  merge (PathAppend l _, t) (PathAppend _ r, _)
+   = (PathAppend l r, t)
+  merge _ _
+   = error "ddc-core-flow.pathsOfFills: impossible!"
+
+  path c@ContextRate{} 
+   = PathRate $ contextRate c
+  path c@ContextSelect{} 
+   = PathSelect $ contextFlags c
+  path c@ContextSegment{} 
+   = PathSegment $ contextLens c
+  path ContextAppend{} 
+   = PathAppend PathNone PathNone
+
+
+  insertFillsNoDupes ops p m
+   = foldM (insert1 p) m ops
+
+  insert1 p m OpFill{ opTargetVector = UName n
+                    , opElemType     = ty }
+   = case Map.lookup n m of
+     Nothing
+      -> Just (Map.insert n (p,ty) m)
+     Just _
+      -> Nothing
+  insert1 _ m _
+   = Just m
+
+
+isPrefixOf :: FillPath -> FillPath -> Bool
+isPrefixOf PathNone _
+ = True
+isPrefixOf (PathAppend h i) (PathAppend j k)
+ =  h == j && isPrefixOf i k
+ || i == PathNone && k == PathNone && isPrefixOf h j
+isPrefixOf a b
+ = a == b
+
+isNone :: FillPath -> Bool
+isNone PathNone
+ = True
+isNone (PathAppend i j)
+ = isNone i && isNone j
+isNone _
+ = False
+
+-- A simple fill path has only one place it's filling, and it's just a rate with no select or segment
+isSimple :: FillPath -> Bool
+isSimple (PathAppend i j)
+ =  isSimple i && isNone j
+ || isSimple j && isNone i
+isSimple (PathRate _)
+ = True
+isSimple _
+ = False
+
+
+
+getAccForPath :: FillMap -> FillPath -> Maybe Name
+getAccForPath m fp
+ = case Map.minViewWithKey $ Map.filter search m of
+   Nothing            -> Nothing
+   Just ((k,_),_)     -> Just k
+ where
+  search (fp', _)
+   = isPrefixOf fp fp'
+
+-- If acc is Nothing, you can just use the current index ^0
+getAcc :: FillMap -> Name -> Maybe Name
+getAcc m n
+ = case Map.lookup n m of
+   Nothing
+    -> Nothing -- ???
+   Just (fp, _)
+    -> if   isSimple fp
+       then Nothing
+       else getAccForPath m fp
+
+-- I don't think this actually gives us the fewest number of accumulators.
+-- Depending on the ordering of the map, maybe we'd have
+--
+-- [ h = App a None;
+--   i = App a None;
+--   j = App a b;
+--   k = App a c ]
+--   
+-- here, @h@ and @i@ will be given the same accumulator, but @j@ and @k@ need separate
+-- accumulators: three accumulators in total.
+--
+-- If the order were different, such as
+-- [ j = App a b;
+--   h = App a None;
+--   i = App a None;
+--   k = App a c ]
+-- then searching for @h@ or @i@ would find @j@, and we would end up with only two accumulators, @j@ and @k@.
+--   
+
diff --git a/DDC/Core/Flow/Convert.hs b/DDC/Core/Flow/Convert.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Convert.hs
@@ -0,0 +1,187 @@
+
+-- | Conversion of Flow to Tetra
+--
+module DDC.Core.Flow.Convert
+        ( tetraOfFlowModule )
+where
+
+import DDC.Core.Flow.Convert.Base
+import DDC.Core.Flow.Convert.Type
+import DDC.Core.Flow.Convert.Exp
+import DDC.Core.Exp.Annot
+import DDC.Core.Module
+import DDC.Control.Monad.Check
+
+import qualified DDC.Core.Flow.Prim      as F
+import qualified DDC.Core.Salt.Name      as T
+import qualified DDC.Core.Salt.Compounds       as T
+
+import DDC.Core.Salt.Convert (initRuntime)
+import DDC.Core.Salt.Runtime (Config(..))
+
+import qualified Data.Set                as S
+
+
+tetraOfFlowModule :: Module a F.Name -> Either Error (Module a T.Name)
+tetraOfFlowModule mm
+ = evalCheck (S.empty, S.empty)
+ $ convertM  mm
+
+convertM :: Module a F.Name -> ConvertM (Module a T.Name)
+convertM mm
+  = do  
+        -- Convert signatures of imported functions.
+        tsImportT' <- mapM convertImportNameTypeM  $ moduleImportTypes  mm
+        tsImportV' <- mapM convertImportNameValueM $ moduleImportValues mm
+
+        let tsImportV'rest =
+              [ ( T.NameVar       "getFieldOfBoxed"
+                , ImportValueSea  "getFieldOfBoxed" 
+                   $ tForalls [kRegion, kData] 
+                   $ \[r,d] -> T.tPtr r T.tObj `tFun` T.tNat `tFun` d)
+
+              , ( T.NameVar       "setFieldOfBoxed"
+                , ImportValueSea  "setFieldOfBoxed" 
+                   $ tForalls [kRegion, kData] 
+                   $ \[r,d] -> T.tPtr r T.tObj `tFun` T.tNat `tFun` d `tFun` T.tVoid)
+
+              , ( T.NameVar       "allocBoxed"
+                , ImportValueSea  "allocBoxed"     
+                   $ tForalls [kRegion       ] 
+                   $ \[r  ] -> T.tTag          `tFun` T.tNat `tFun` T.tPtr r T.tObj)
+              ]
+
+        -- Convert signatures of exported functions.
+        tsExportT' <- mapM convertExportM
+                   $  moduleExportTypes  mm
+
+        tsExportV' <- mapM convertExportM
+                   $  moduleExportValues mm
+
+        -- Convert the body of the module
+        body'      <- convertX $ moduleBody mm
+
+        -- Build the output module.
+        let mm_tetra 
+                = ModuleCore
+                { moduleName            = moduleName mm
+                , moduleIsHeader        = moduleIsHeader mm
+
+                , moduleExportTypes     = tsExportT'
+                , moduleExportValues    = tsExportV'
+
+                , moduleImportTypes     = tsImportT'
+                , moduleImportCaps      = []
+                , moduleImportValues    = tsImportV' ++ tsImportV'rest
+
+                -- We're only using whole module compilation for
+                -- flow programs, so there aren't any imports.
+                , moduleImportDataDefs  = []
+                , moduleDataDefsLocal   = []
+
+                , moduleBody           = body' }
+
+        -- Initialise the salt heap.
+        -- Hardcode this for now, because eventually this will target tetra.
+        mm_init <- case initRuntime (Config 10000)  mm_tetra of
+                        Nothing   -> return mm_tetra
+                        Just mm'  -> return mm'
+
+        return $ mm_init
+
+
+---------------------------------------------------------------------------------------------------
+-- | Convert an export spec.
+convertExportM
+        :: (F.Name, ExportSource F.Name)                
+        -> ConvertM (T.Name, ExportSource T.Name)
+
+convertExportM (n, esrc)
+ = do   n'      <- convertName n
+        esrc'   <- convertExportSourceM esrc
+        return  (n', esrc')
+
+
+-- Convert an export source.
+convertExportSourceM 
+        :: ExportSource F.Name
+        -> ConvertM (ExportSource T.Name)
+
+convertExportSourceM esrc
+ = case esrc of
+        ExportSourceLocal n t
+         -> do  n'      <- convertName n
+                t'      <- convertType t
+                return  $ ExportSourceLocal n' t'
+
+        ExportSourceLocalNoType n
+         -> do  n'      <- convertName n
+                return  $ ExportSourceLocalNoType n'
+
+
+---------------------------------------------------------------------------------------------------
+-- | Convert an import spec.
+convertImportNameTypeM
+        :: (F.Name, ImportType F.Name)
+        -> ConvertM (T.Name, ImportType T.Name)
+
+convertImportNameTypeM (n, isrc)
+ = do   n'      <- convertImportNameM n
+        isrc'   <- convertImportTypeM isrc
+        return  (n', isrc')
+
+
+-- | Convert an import spec.
+convertImportNameValueM
+        :: (F.Name, ImportValue F.Name)
+        -> ConvertM (T.Name, ImportValue T.Name)
+
+convertImportNameValueM (n, isrc)
+ = do   n'      <- convertImportNameM n
+        isrc'   <- convertImportValueM isrc
+        return  (n', isrc')
+
+
+-- | Convert an imported name.
+--   These can be variable names for values, 
+--   or variable or constructor names for type imports.
+convertImportNameM :: F.Name -> ConvertM T.Name
+convertImportNameM n
+ = case n of
+        F.NameVar str   -> return $ T.NameVar str
+        F.NameCon str   -> return $ T.NameCon str
+        _               -> throw  $ ErrorInvalidBinder n
+
+
+-- | Convert an import source.
+convertImportTypeM 
+        :: ImportType F.Name
+        -> ConvertM (ImportType T.Name)
+
+convertImportTypeM isrc
+ = case isrc of
+        ImportTypeAbstract t
+         -> do  t'      <- convertType t
+                return $ ImportTypeAbstract t'
+
+        ImportTypeBoxed t
+         -> do  t'      <- convertType t
+                return $ ImportTypeBoxed t'
+
+
+-- | Convert an import value spec.
+convertImportValueM 
+        :: ImportValue F.Name
+        -> ConvertM (ImportValue T.Name)
+
+convertImportValueM isrc
+ = case isrc of
+        ImportValueModule mn n t _
+         -> do  n'      <- convertName n
+                t'      <- convertType t
+                return  $ ImportValueModule mn n' t' Nothing
+
+        ImportValueSea str t
+         -> do  t'      <- convertType t 
+                return  $ ImportValueSea str t'
+
diff --git a/DDC/Core/Flow/Convert/Base.hs b/DDC/Core/Flow/Convert/Base.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Convert/Base.hs
@@ -0,0 +1,89 @@
+
+module DDC.Core.Flow.Convert.Base
+        (  ConvertM
+        ,  Error (..)
+        ,  withRateXLAM, isRateXLAM
+        ,  withSuspFns,   isSuspFn)
+where
+import DDC.Base.Pretty
+import DDC.Core.Exp.Annot.Compounds
+import DDC.Type.Exp
+import DDC.Core.Flow.Prim                       as F
+import qualified DDC.Control.Monad.Check        as G
+
+import qualified Data.Set                       as S
+import Data.Maybe
+
+-- | Conversion Monad
+-- State contains
+--  * names of function that have been converted to Suspended computations.
+--    whenever these are called, we need to add a "run" cast.
+--  * names of rate XLAMs that have been removed.
+--    any reference to these must also be removed.
+type ConvertM x = G.CheckM (S.Set F.Name, S.Set F.Name) Error x
+
+
+withRateXLAM :: Bind F.Name -> ConvertM a -> ConvertM a
+withRateXLAM r c
+ | Just r' <- takeNameOfBind r
+ = do   (fs,rs) <- G.get
+        G.put (fs, S.insert r' rs)
+        val <- c
+        G.put (fs, rs)
+        return $ val
+ | otherwise
+ = c
+
+
+isRateXLAM :: F.Name -> ConvertM Bool
+isRateXLAM r
+ = do   (_,rs) <- G.get
+        return $ S.member r rs
+
+
+withSuspFns :: [Bind F.Name] -> ConvertM a -> ConvertM a
+withSuspFns bs c
+ = do   (fs,rs) <- G.get
+        let ns = catMaybes $ map takeNameOfBind bs
+        G.put (S.union (S.fromList ns) fs, rs)
+        val <- c
+        G.put (fs, rs)
+        return $ val
+
+isSuspFn :: F.Name -> ConvertM Bool
+isSuspFn f
+ = do   (fs,_) <- G.get
+        return $ S.member f fs
+
+
+-- | Things that can go wrong during the conversion.
+data Error
+        -- | An invalid name used in a binding position
+        = ErrorInvalidBinder F.Name
+
+        -- | A partially applied primitive, such as "Series"
+        | ErrorPartialPrimitive F.Name
+
+        -- | Something we can't convert, like "runKernel0#",
+        -- but that shouldn't be created
+        | ErrorNotSupported F.Name
+
+        -- | Found an unexpected type sum.
+        | ErrorUnexpectedSum
+
+
+instance Pretty Error where
+ ppr err
+  = case err of
+        ErrorInvalidBinder n
+         -> vcat [ text "Invalid name used in binder '" <> ppr n <> text "'."]
+
+        ErrorPartialPrimitive n
+         -> vcat [ text "Cannot convert primitive " <> ppr n <> text "." ]
+
+        ErrorNotSupported n
+         -> vcat [ text "Cannot convert " <> ppr n <> text ", as it shouldn't be generated by flow transforms." ]
+
+        ErrorUnexpectedSum
+         -> vcat [ text "Unexpected type sum."]
+
diff --git a/DDC/Core/Flow/Convert/Exp.hs b/DDC/Core/Flow/Convert/Exp.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Convert/Exp.hs
@@ -0,0 +1,463 @@
+
+-- | Conversion of Flow expressions to Tetra expressions
+-- This only handles the subset of flow that occurs after lowering.
+module DDC.Core.Flow.Convert.Exp
+        ( convertX )
+where
+
+import DDC.Core.Flow.Convert.Base
+import DDC.Core.Flow.Convert.Type
+import DDC.Core.Exp.Annot
+import DDC.Type.Transform.BoundT
+
+import qualified DDC.Core.Flow.Prim             as F
+import qualified DDC.Core.Flow.Compounds        as F
+
+import qualified DDC.Core.Salt.Name            as T
+import qualified DDC.Core.Salt.Compounds       as T
+import qualified DDC.Core.Salt.Env             as T
+
+import Control.Monad
+
+
+convertX :: Exp a F.Name -> ConvertM (Exp a T.Name)
+convertX xx
+ -- Remove any /\(k : Rate). They are not needed any more.
+ | XLAM _ b x <- xx
+ , typeOfBind b == F.kRate
+ = withRateXLAM b $ removeXLAM b <$> convertX x
+
+ -- Operators that just need a region added as first argument
+ | Just (op, xs@(_:_)) <- takeXPrimApps xx
+ = case op of
+    F.NameOpStore F.OpStoreNew
+     | [ ty, val ] <- xs
+     , Just tY     <- takeXType ty
+     -> do  tY'    <- convertType tY
+            val'   <- convertX val
+            return $ allocRef anno tY' val'
+
+    F.NameOpStore F.OpStoreRead
+     | [ ty, ref ] <- xs
+     -> do  ty'  <- convertX ty
+            ref' <- convertX ref
+
+            return $ mk (T.PrimStore T.PrimStorePeek)
+                     [ xRTop anno, ty', ref', T.xNat anno 0 ]
+
+    F.NameOpStore F.OpStoreWrite
+     | [ ty, ref, val ] <- xs
+     -> do  ty'  <- convertX ty
+            ref' <- convertX ref
+            val' <- convertX val
+
+            return
+             $ XLet anno
+                    (LLet (BNone T.tVoid)
+                    $  mk (T.PrimStore T.PrimStorePoke)
+                       [ xRTop anno, ty', ref', T.xNat anno 0, val' ])
+               (XCon anno $ DaConUnit)
+
+
+    -- natOfRateNat becomes a noop, as RateNats become Nats.
+    F.NameOpConcrete F.OpConcreteNatOfRateNat
+     | [ _r, n ] <- xs
+     -> convertX n
+
+    F.NameOpConcrete (F.OpConcreteNext 1)
+     | [t, _r, v, i] <- xs
+     -> do  v'      <- convertX v
+            i'      <- convertX i
+            t'      <- convertX t
+            return $ mk (T.PrimStore T.PrimStorePeek)
+                     [ xRTop anno, t', v'
+                     , mk (T.PrimArith T.PrimArithMul)
+                       [ XType anno T.tNat, i'
+                       , mk (T.PrimStore T.PrimStoreSize) [t'] ] ]
+
+    -- vlength# [t] vec
+    -- becomes a projection
+    F.NameOpVector F.OpVectorLength
+     | [xt, v] <- xs
+     , Just t               <- takeXType xt
+     -> do  t'      <- convertType t
+            v'      <- convertX    v
+            return $ xVecLen t' v'
+
+    -- vwrite# [t] buf ix val
+    F.NameOpStore (F.OpStoreWriteVector 1)
+     | [xt, buf, ix, val] <- xs
+     , Just t             <- takeXType xt
+     -> do  t'      <- convertType t
+            buf'    <- convertX    buf
+            ix'     <- convertX    ix
+            val'    <- convertX    val
+
+            return
+             $ XLet anno
+                    (LLet (BNone T.tVoid)
+                    $  mk (T.PrimStore T.PrimStorePoke)
+                       [ xRTop anno
+                       , XType anno t'
+                       , buf'
+                       , mk (T.PrimArith T.PrimArithMul)
+                         [ XType anno T.tNat, ix'
+                         , mk (T.PrimStore T.PrimStoreSize) [XType anno t'] ]
+                       , val' ])
+               (XCon anno DaConUnit)
+
+    -- vbuf# [t] vec
+    F.NameOpStore F.OpStoreBufOfVector
+     | [xt, vec]          <- xs
+     , Just t             <- takeXType xt
+     -> do  t'      <- convertType t
+            vec'    <- convertX    vec
+
+            return
+             $ xVecPtr t' vec'
+
+
+    -- vnew# [t] len
+    F.NameOpStore F.OpStoreNewVector
+     | [xt, sz] <- xs
+     , Just t   <- takeXType xt
+     -> do  t'      <- convertType t
+            sz'     <- convertX    sz
+
+            let lenR = allocRef    anno T.tNat sz'
+                datR = allocPtr    anno t'     sz'
+                tup  = allocTupleN anno [(tRef rTop T.tNat, lenR), (T.tPtr rTop t', datR)]
+            return tup
+
+    -- vtrunc# [t] len vec
+    F.NameOpStore F.OpStoreTruncVector
+     | [xt, sz, v]  <- xs
+     , Just t       <- takeXType xt
+     -> do  _t'     <- convertType t
+            sz'     <- convertX    sz
+            v'      <- convertX    v
+
+            return
+             $ XLet anno
+                (LLet (BNone T.tVoid)
+                    $  mk (T.PrimStore T.PrimStorePoke)
+                       [ xRTop anno
+                       , XType anno T.tNat
+                       , projTuple anno v' 0 (T.tPtr rTop T.tNat)
+                       , T.xNat anno 0
+                       , sz' ])
+               (XCon anno $ DaConUnit)
+
+    F.NameOpSeries F.OpSeriesRunProcess
+     | [proc]               <- xs
+     -> do  proc'   <- convertX proc
+            return
+               $ XApp anno proc' $ XCon anno $ DaConUnit
+
+{-
+    -- runKernelN# [ty1]...[tyN] v1...vN proc
+    -- becomes
+    -- proc (length v1) (ptrOfVec v1) ... (ptrOfVec vN)
+    F.NameOpConcrete (F.OpConcreteRunKernel n)
+     | (xts, xs')           <- splitAt n xs
+     , Just ts              <- mapM takeXType xts
+     , (vs, [proc])         <- splitAt n xs'
+     -> do  vs'   <- mapM convertX    vs
+            ts'   <- mapM convertType ts
+
+            proc' <-      convertX    proc
+
+            case (vs',ts') of
+             ((v':_), (t':_))
+              -> return
+               $ XLet anno (LLet (BNone tUnit)
+                           ( xApps anno proc'
+                             (xVecLen t' v' : zipWith xVecPtr ts' vs')))
+                 true
+             (_, _)
+              -> throw $ ErrorNotSupported op
+-}
+
+    _
+     -> case takeXApps xx of
+         Just (f,args) -> convertApp f args
+         Nothing       -> error "ddc-core-flow.convertX: impossible!"
+
+ | Just
+    (DaConPrim (F.NameDaConFlow (F.DaConFlowTuple n)) _
+    , args)                                             <- takeXConApps xx
+ , length args == n * 2
+ , (xts, xs)            <- splitAt n args
+ , Just ts              <- mapM takeXType xts
+ = do   ts' <- mapM convertType ts
+        xs' <- mapM convertX    xs
+        return
+         $ allocTupleN anno (ts' `zip` xs')
+
+ | Just (f, args@(_:_)) <- takeXApps xx
+ = convertApp f args
+
+ | XCase _ x
+    [AAlt (PData (DaConPrim (F.NameDaConFlow (F.DaConFlowTuple n)) _) bs) x1]
+                                                        <- xx
+ , length bs == n 
+ = do   x'  <- convertX x
+        bs' <- mapM convertBind bs
+        x1' <- convertX x1
+        return
+         $ xLets anno
+            [ LLet b (projTuple anno x' i $ typeOfBind b)
+             | (b,i) <- bs' `zip` [0..] ]
+           x1'
+
+ -- otherwise just boilerplate recursion
+ | otherwise
+ = case xx of
+   XVar a b
+    -> XVar a <$> convertBound b
+   XCon a c
+    -> XCon a <$> convertDaCon c
+   XLAM a b x
+    -> XLAM a <$> convertBind  b <*> convertX x
+   XLam a b x
+    -> XLam a <$> convertBind  b <*> convertX x
+   XApp a p q
+    -> XApp a <$> convertX     p <*> convertX q
+   XLet a ls x
+    -> let bs = valwitBindsOfLets ls
+       in  withSuspFns bs $ XLet a <$> convertLets ls <*> convertX x
+   XCase a x as
+    -> XCase a<$> convertX     x <*> mapM convertAlt as
+   XCast a c x
+    -> XCast a<$> convertCast  c <*> convertX x
+   XType a t
+    -> XType a<$> convertType  t
+   XWitness a w
+    -> XWitness a <$> convertWit w
+ where
+  anno = annotOfExp xx
+
+  mk = prim anno
+
+prim anno n args
+ = let t = T.typeOfPrimOp n
+   in      xApps anno (XVar anno (UPrim (T.NamePrimOp n) t)) args
+
+
+convertApp :: Exp a F.Name -> [Exp a F.Name] -> ConvertM (Exp a T.Name)
+convertApp f args
+ = do   f'      <- convertX f
+        -- filter out any type args that reference deleted XLAMs
+        let checkT arg
+             | XType _ (TVar (UName n)) <- arg
+             = not <$> isRateXLAM n
+             | otherwise
+             = return True
+        args'   <-  filterM checkT args
+                >>= mapM convertX
+
+        let checkF
+             | XVar _ (UName n) <- f
+             = isSuspFn n
+             | otherwise
+             = return False
+
+        isSusp <- checkF
+        if    isSusp
+         then return $ xApps anno f' args'
+         else return $ xApps anno f' args'
+ where
+  anno = annotOfExp f
+
+convertDaCon :: DaCon F.Name -> ConvertM (DaCon T.Name)
+convertDaCon dd
+ = case dd of
+   DaConUnit
+    -> return DaConUnit
+   DaConPrim n t
+    -> DaConPrim  <$> convertName n <*> convertType t
+   DaConBound n
+    -> DaConBound <$> convertName n
+
+convertLets :: Lets a F.Name -> ConvertM (Lets a T.Name)
+convertLets ll
+ = case ll of
+
+   LLet b x
+    -> LLet <$> convertBind b <*> convertX x
+
+   LRec bxs
+    -> LRec <$> mapM (both convertBind convertX) bxs
+
+   LPrivate rs t ws
+    -> LPrivate <$> mapM convertBind rs
+                <*> liftMaybe convertType t -- ??
+                <*> mapM convertBind ws
+
+ where
+  liftMaybe f m
+   = case m of
+     Just a  -> Just <$> f a
+     Nothing -> return Nothing
+
+  both f g
+   = \(a,b) -> (,) <$> f a <*> g b
+
+convertAlt  :: Alt a F.Name -> ConvertM (Alt a T.Name)
+convertAlt aa
+ = case aa of
+   AAlt p x
+    -> AAlt <$> convertPat p <*> convertX x
+
+convertPat :: Pat F.Name -> ConvertM (Pat T.Name)
+convertPat pp
+ = case pp of
+   PDefault
+    -> return $ PDefault
+   PData dc bs
+    -> PData <$> convertDaCon dc <*> mapM convertBind bs
+
+convertCast :: Cast a F.Name -> ConvertM (Cast a T.Name)
+convertCast cc
+ = case cc of
+   CastWeakenEffect et
+    -> CastWeakenEffect  <$> convertType et
+
+   CastPurify w
+    -> CastPurify        <$> convertWit w
+
+   CastBox
+    -> return $ CastBox
+
+   CastRun
+    -> return $ CastRun
+
+
+convertWit :: Witness a F.Name -> ConvertM (Witness a T.Name)
+convertWit = error "ddc-core-flow.convertWit: cannot convert witness from core flow program"
+
+
+-- | When replacing @/\(b : Rate). x@ with @x@, if @b@ is a de bruijn index then any type vars in @x@ must be lowered.
+-- @b@ must not be mentioned in @x@.
+removeXLAM :: Bind F.Name -> Exp a T.Name -> Exp a T.Name
+removeXLAM b t
+ = case b of
+   BAnon _
+    -> lowerT 1 t
+   _
+    ->          t
+
+
+-- | Type of the top-level region.
+xRTop :: a -> Exp a T.Name
+xRTop a = XType a rTop
+
+-- | Get the Nat# of length from a Vector
+xVecLen :: Type T.Name -> Exp a T.Name -> Exp a T.Name
+xVecLen _t x
+ = prim anno (T.PrimStore T.PrimStorePeek)
+ [ xRTop anno, XType anno T.tNat
+ , projTuple anno x 0 (T.tPtr rTop T.tNat)
+ , T.xNat anno 0 ]
+ where
+  anno = annotOfExp x
+
+-- | Get the pointer to the data from a Vector
+xVecPtr :: Type T.Name -> Exp a T.Name -> Exp a T.Name
+xVecPtr t x
+ = projTuple anno x 1 (T.tPtr rTop t)
+ where
+  anno = annotOfExp x
+
+allocRef :: a -> Type T.Name -> Exp a T.Name -> Exp a T.Name
+allocRef anno tY val
+ = let ty  = XType anno tY
+
+       sz   = prim anno (T.PrimStore T.PrimStoreSize)  [ty]
+       addr = prim anno (T.PrimStore T.PrimStoreAlloc) [sz]
+       ptr  = prim anno (T.PrimStore T.PrimStoreMakePtr)
+                 [ xRTop anno, ty, addr ]
+                
+       ll   = LLet (BAnon $ T.tPtr rTop tY)
+                   ptr
+
+       ptr' = XVar anno $ UIx 0
+       poke = prim anno (T.PrimStore T.PrimStorePoke)
+               [ xRTop anno, ty, ptr', T.xNat anno 0, val ]
+   in  XLet anno ll
+     $ XLet anno (LLet (BNone T.tVoid) poke) 
+       ptr'
+
+allocPtr :: a -> Type T.Name -> Exp a T.Name -> Exp a T.Name
+allocPtr anno tY elts
+ = let ty  = XType anno tY
+
+       sz   = prim anno (T.PrimStore T.PrimStoreSize)  [ty]
+       addr = prim anno (T.PrimStore T.PrimStoreAlloc)
+                 [ prim anno (T.PrimArith T.PrimArithMul)
+                    [ XType anno T.tNat, elts, sz] ]
+       ptr  = prim anno (T.PrimStore T.PrimStoreMakePtr)
+                 [ xRTop anno, ty, addr ]
+                
+   in  ptr
+
+
+unptr :: Type T.Name -> Type T.Name
+unptr t
+ | Just (_,t') <- T.takeTPtr t
+ = t'
+ | otherwise
+ = t
+
+trybox :: a -> Type T.Name -> Exp a T.Name -> Exp a T.Name
+trybox anno t x
+ -- Already a pointer, don't bother
+ | Just (_,_) <- T.takeTPtr t
+ = x
+ | otherwise
+ = allocRef anno t x
+
+tryunbox :: a -> Type T.Name -> Exp a T.Name -> Exp a T.Name
+tryunbox anno t x
+ -- Already a pointer, don't bother
+ | Just (_,_) <- T.takeTPtr t
+ = x
+ | otherwise
+ = prim anno (T.PrimStore T.PrimStorePeek)
+ [ xRTop anno, XType anno t
+ , x, T.xNat anno 0 ]
+
+projTuple :: a -> Exp a T.Name -> Integer -> Type T.Name -> Exp a T.Name
+projTuple anno x i t
+ = let t' = unptr t
+ in tryunbox anno t
+  $ castPtr  anno t' T.tObj
+  $ xApps    anno (XVar anno $ UName $ T.NameVar "getFieldOfBoxed")
+    [ xRTop anno, XType anno $ T.tPtr rTop T.tObj, x, T.xNat anno i ]
+
+
+allocTupleN :: a -> [(Type T.Name, Exp a T.Name)] -> Exp a T.Name
+allocTupleN anno txs
+ = let tup  = xApps anno (XVar anno $ UName $ T.NameVar "allocBoxed")
+              [ xRTop anno, T.xTag anno 0, T.xNat anno (fromIntegral $ length txs) ]
+
+       tup' = XVar anno $ UIx 0
+    
+       set i t x
+        = let t' = unptr t
+              x' = trybox anno t x
+          in xApps anno (XVar anno $ UName $ T.NameVar "setFieldOfBoxed")
+              [ xRTop anno, XType anno (T.tPtr rTop T.tObj), tup', T.xNat anno i
+              , castPtr anno T.tObj t' x' ]
+                
+   in  XLet anno (LLet (BAnon $ T.tPtr rTop T.tObj) tup)
+     $ xLets anno
+        [LLet (BNone T.tVoid) (set i t x) | ((t,x), i) <- txs `zip` [0..]]
+       tup'
+
+
+castPtr :: a -> Type T.Name -> Type T.Name -> Exp a T.Name -> Exp a T.Name
+castPtr anno to from x
+ = prim anno (T.PrimStore T.PrimStoreCastPtr)
+    [ xRTop anno, XType anno to, XType anno from, x ]
+
diff --git a/DDC/Core/Flow/Convert/Type.hs b/DDC/Core/Flow/Convert/Type.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Convert/Type.hs
@@ -0,0 +1,206 @@
+
+-- | Conversion of Flow types to Tetra types
+-- This only handles the subset of flow that occurs after lowering.
+module DDC.Core.Flow.Convert.Type
+        ( convertType
+        , convertBind
+        , convertBound
+        , convertName
+        , rTop
+        , tVec
+        , tRef )
+where
+import DDC.Core.Flow.Convert.Base
+import DDC.Core.Exp.Annot
+import DDC.Control.Monad.Check                  (throw)
+import DDC.Type.Transform.BoundT
+
+import qualified DDC.Core.Flow.Prim             as F
+import qualified DDC.Core.Flow.Compounds        as F
+
+import qualified DDC.Core.Salt.Name            as T
+import qualified DDC.Core.Salt.Compounds       as T
+
+
+
+tRef   :: Type T.Name -> Type T.Name -> Type T.Name
+tRef = T.tPtr 
+
+tVec :: Type T.Name
+tVec = T.tPtr rTop T.tObj
+
+
+-- | Convert types from Flow to Tetra.
+--
+-- The majority of type conversions are just replacing one name with another,
+-- so these are performed in @convertName@.
+--
+-- Others require removing arguments or adding regions are performed here, before name conversion:
+-- * Rate foralls are removed
+-- * @Series k a@ becomes @Ptr# rTop a@
+-- * @RateNat  k@ becomes @Nat#@
+-- * @Ref a@      becomes @Ref# rTop a@
+-- * @a->b->c@    becomes @a -> b -> S (Read rT + Write rT + Alloc rT) c@
+--
+convertType :: Type F.Name -> ConvertM (Type T.Name)
+convertType tt
+ -- Remove [k : Rate] foralls.
+ | TForall b t  <- tt
+ , typeOfBind b == F.kRate
+ = removeForall b <$> convertType t
+
+ -- Convert @Vector a@ to @Tuple2# (Ptr# a) (Ref# Nat#)@
+ | Just (F.NameTyConFlow F.TyConFlowVector, [tA])   <- takePrimTyConApps tt
+ = do   _tA' <- convertType tA
+        return $ tVec -- T.tTupleN [T.tPtr rTop tA', T.tRef rTop T.tNat]
+
+ -- Convert @Buffer a@ to @Ptr# a@
+ | Just (F.NameTyConFlow F.TyConFlowBuffer, [tA])   <- takePrimTyConApps tt
+ = do   tA' <- convertType tA
+        return $ T.tPtr rTop tA'
+
+ -- Convert @TupleN#@ to @Ptr# rTop Obj@
+ | Just (F.NameTyConFlow (F.TyConFlowTuple _), ts)   <- takePrimTyConApps tt
+ = do   -- Might as well attempt to convert the types, just so we know they're valid
+        mapM_ convertType ts
+        return $ tVec
+
+ -- Convert @Series k a@ to just @Ptr# a@
+ | Just (F.NameTyConFlow F.TyConFlowSeries, [_K, tA])   <- takePrimTyConApps tt
+ = T.tPtr rTop <$> convertType tA
+
+ -- Convert @RateNat  k@ to @Nat#@
+ | Just (F.NameTyConFlow F.TyConFlowRateNat, [_K])      <- takePrimTyConApps tt
+ = return  $  T.tNat
+
+ -- Convert Refs
+ | Just (F.NameTyConFlow F.TyConFlowRef, [tA])          <- takePrimTyConApps tt
+ = tRef rTop <$> convertType tA
+
+ -- Convert normal TFuns to TFunECs with pure and empty. why?
+ | (args@(_:_), res)                                    <- takeTFunArgResult tt
+ = do   args'   <- mapM convertType args
+        res'    <-      convertType res
+
+        return   $ foldr tFun res' args'
+        
+
+ -- For other primitives, convertName will handle convert them
+ | otherwise
+ = case tt of
+    TVar b
+     -> TVar    <$> convertBound b
+    TCon c
+     -> TCon    <$> convertTyCon c
+
+    TForall b t
+     -> TForall <$> convertBind  b <*> convertType t
+
+    TApp p q
+     -> TApp    <$> convertType  p <*> convertType q
+
+    TSum _t
+     -> return $ TSum $ TypeSumBot $ kData -- throw    $ ErrorUnexpectedSum
+
+
+convertBind :: Bind F.Name -> ConvertM (Bind T.Name)
+convertBind b
+ = case b of
+   BNone   t -> BNone <$> convertType t
+   BAnon   t -> BAnon <$> convertType t
+   BName n t -> BName <$> convertName n <*> convertType t
+
+
+convertBound :: Bound F.Name -> ConvertM (Bound T.Name)
+convertBound b
+ = case b of
+   UIx     i -> return $  UIx i
+   UName n   -> UName <$> convertName n
+   UPrim n t -> UPrim <$> convertName n <*> convertType t
+
+
+
+
+convertName :: F.Name -> ConvertM T.Name
+convertName nn
+ = case nn of
+   F.NameVar n
+    -> return $ T.NameVar n
+   F.NameVarMod n x
+    -> flip T.NameExt x <$> convertName n
+   F.NameCon n
+    -> return $ T.NameCon n
+
+   F.NameKiConFlow _
+    -> throw $ ErrorPartialPrimitive nn
+
+   F.NameTyConFlow tf
+    -> case tf of
+        -- F.TyConFlowTuple n
+        -- -> return $ T.NameTyConTetra $ T.TyConTetraTuple n
+
+        -- Vector, Series, RateNat and Ref are handled elsewhere as arguments must be changed
+        _
+         -> throw $ ErrorPartialPrimitive nn
+
+   -- Machine primitives ------------------
+   -- F.NamePrimTyCon T.PrimTyConBool
+   --  -> return $ T.NamePrimTyCon T.PrimTyConNat
+
+   F.NamePrimTyCon p
+    -> return $ T.NamePrimTyCon p
+
+   F.NamePrimArith p
+    -> return $ T.NamePrimOp $ T.PrimArith p
+
+   F.NamePrimCast p
+    -> return $ T.NamePrimOp $ T.PrimCast p
+
+   -- Literals -----------------------------
+   F.NameLitBool b
+    -> return $ T.NamePrimLit (T.PrimLitBool b)
+
+   F.NameLitNat l
+    -> return $ T.NamePrimLit (T.PrimLitNat  l)
+
+   F.NameLitInt l
+    -> return $ T.NamePrimLit (T.PrimLitInt l)
+
+   F.NameLitWord l k
+    -> return $ T.NamePrimLit (T.PrimLitWord l k)
+
+   _ -> throw  $ ErrorInvalidBinder nn
+
+
+convertTyCon :: TyCon F.Name -> ConvertM (TyCon T.Name)
+convertTyCon tc
+ = case tc of
+   TyConSort s
+    -> return $ TyConSort s
+   TyConKind k
+    -> return $ TyConKind k
+   TyConWitness w
+    -> return $ TyConWitness w
+   TyConSpec s
+    -> return $ TyConSpec s
+   TyConBound b k
+    -> TyConBound <$> convertBound b <*> convertType k
+   TyConExists i k
+    -> TyConExists    i              <$> convertType k
+
+
+-- | When replacing @Forall b t@ with @t@, if @b@ is a de bruijn
+--   index then @t@ must be lowered. @b@ must not be mentioned in @t@.
+removeForall :: Bind F.Name -> Type T.Name -> Type T.Name
+removeForall b t
+ = case b of
+   BAnon _
+    -> lowerT 1 t
+   _
+    ->          t
+
+
+-- | Top region
+rTop :: Type T.Name
+rTop = TVar $ UName $ T.NameVar "rT"
+
diff --git a/DDC/Core/Flow/Env.hs b/DDC/Core/Flow/Env.hs
--- a/DDC/Core/Flow/Env.hs
+++ b/DDC/Core/Flow/Env.hs
@@ -111,7 +111,7 @@
 kindOfPrimName :: Name -> Maybe (Kind Name)
 kindOfPrimName nn
  = case nn of
-        NameKiConFlow KiConFlowRate     -> Just sProp
+        NameKiConFlow _                 -> Just sProp
         NameTyConFlow tc                -> Just $ kindTyConFlow tc
         NamePrimTyCon tc                -> Just $ kindPrimTyCon tc
         _                               -> Nothing
diff --git a/DDC/Core/Flow/Exp.hs b/DDC/Core/Flow/Exp.hs
--- a/DDC/Core/Flow/Exp.hs
+++ b/DDC/Core/Flow/Exp.hs
@@ -1,6 +1,6 @@
 
 module DDC.Core.Flow.Exp
-        ( module DDC.Core.Exp.Simple 
+        ( module DDC.Core.Exp.Simple.Exp
         , KindEnvF, TypeEnvF
         , TypeF
         , ModuleF
@@ -15,7 +15,7 @@
 where
 import DDC.Core.Module
 import DDC.Core.Flow.Prim
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Exp
 import DDC.Type.Env             (Env)
 
 type KindEnvF   = Env Name
diff --git a/DDC/Core/Flow/Lower.hs b/DDC/Core/Flow/Lower.hs
--- a/DDC/Core/Flow/Lower.hs
+++ b/DDC/Core/Flow/Lower.hs
@@ -21,7 +21,9 @@
 import DDC.Core.Flow.Exp
 import DDC.Core.Module
 
+import DDC.Core.Transform.TransformUpX
 import DDC.Core.Transform.Annotate
+import DDC.Core.Transform.Deannotate
 
 import qualified DDC.Core.Simplifier                    as C
 import qualified DDC.Core.Simplifier.Recipe             as C
@@ -82,8 +84,8 @@
 
 
 -- Lower ----------------------------------------------------------------------
--- | Take a module that contains only well formed series processes defined
---   at top-level, and lower them all into procedures. 
+-- | Take a module that contains some well formed series processes defined
+--   at top-level, and lower them into procedures. 
 lowerModule :: Config -> ModuleF -> Either Error ModuleF
 lowerModule config mm
  = case slurpProcesses mm of
@@ -95,8 +97,14 @@
     -- We've got a process definition for all of then.
     Right procs
      -> do      
+        -- Find names of all process bindings
+        let procname (Left  p) = [processName p]
+            procname (Right _) = []
+
+            procnames   = concatMap procname procs
+
         -- Schedule the processeses into procedures.
-        lets            <- mapM (lowerProcess config) procs
+        lets            <- mapM (lowerEither config procnames) procs
 
         -- Wrap all the procedures into a new module.
         let mm_lowered  = mm
@@ -108,6 +116,59 @@
         return mm_clean
 
 
+-- | Look at slurped result, and if it's a process lower it, otherwise remove any runProcess# inside expressions
+lowerEither  :: Config -> [Name] -> (Either Process (Bind Name, Exp () Name)) -> Either Error (BindF, ExpF)
+lowerEither  config _ (Left process)
+ = lowerProcess config process
+
+lowerEither _config _procnames (Right (b,xx))
+ = let xx' = deannotate (const Nothing)
+           $ transformSimpleUpX' replaceRunProc
+           $ annotate () xx
+   in  return (b, xx')
+ where
+
+  -- Replace all calls to runProcess# with runProcessUnit#
+  replaceRunProc (XVar (UPrim (NameOpSeries OpSeriesRunProcess) _))
+   = Just
+   $ XVar
+   $ UPrim (NameOpSeries OpSeriesRunProcessUnit)
+           (typeOpSeries OpSeriesRunProcessUnit)
+  -- Also replace any Process# types with Units
+  replaceRunProc (XType t)
+   = Just
+   $ XType (replaceProcTy t)
+  replaceRunProc (XLet (LLet bind x) e)
+   = Just
+   $ XLet (LLet (replaceProcTyB bind) x) e
+  replaceRunProc (XLet (LRec bxs) e)
+   | (bs,xs) <- unzip bxs
+   , bs'     <- map replaceProcTyB bs
+   = Just
+   $ XLet (LRec (zip bs' xs)) e
+
+  replaceRunProc _
+   = Nothing
+
+  replaceProcTyB (BName n t) = BName n $ replaceProcTy t
+  replaceProcTyB (BAnon   t) = BAnon   $ replaceProcTy t
+  replaceProcTyB (BNone   t) = BNone   $ replaceProcTy t
+
+  -- Replace Process# a b with Unit
+  replaceProcTy tt
+   = case tt of
+      TVar{} -> tt
+      TCon{} -> tt
+      TForall bind tt' -> TForall bind (replaceProcTy tt')
+      TApp l r
+       | Just (NameTyConFlow TyConFlowProcess, [_,_]) <- takePrimTyConApps tt
+       -> tUnit
+       | otherwise
+       -> TApp (replaceProcTy l) (replaceProcTy r)
+      TSum ts
+       -> TSum ts
+ 
+
 -- | Lower a single series process into fused code.
 lowerProcess :: Config -> Process -> Either Error (BindF, ExpF)
 lowerProcess config process
@@ -116,10 +177,10 @@
  | MethodScalar         <- configMethod config
  = do  
         -- Schedule process into scalar code.
-        let Right proc              = scheduleScalar process
+        proc                 <- scheduleScalar process
 
         -- Extract code for the kernel
-        let (bProc, xProc)          = extractProcedure proc
+        let (bProc, xProc)    = extractProcedure proc
 
         return (bProc, xProc)
 
@@ -130,18 +191,18 @@
  --  the rate variable (k), as well as a (RateNat k) witness.
  --
  | MethodVector lifting <- configMethod config
- , [nRN]  <- [ nRN | BName nRN tRN <- processParamValues process
+ , [nRN]  <- [ nRN | (flag, BName nRN tRN) <- processParamFlags process
+                   , not flag
                    , isRateNatType tRN ]
- , bK : _ <- processParamTypes process
+ , tK <- processLoopRate process
  = do   let c           = liftingFactor lifting
 
-        -- Get the primary rate variable.
-        let Just uK     = takeSubstBoundOfBind bK
-        let tK          = TVar uK
-
         -- The RateNat witness
         let xRN         = XVar (UName nRN)
 
+        let tProc       = processProcType process
+        let _tLoopRate   = processLoopRate process
+
         -----------------------------------------
         -- Create the vector version of the kernel.
         --  Vector code processes several elements per loop iteration.
@@ -152,9 +213,10 @@
         let bxsDownSeries       
                 = [ ( bS
                     , ( BName (NameVarMod n "down")
-                              (tSeries (tDown c tK) tE)
-                      , xDown c tK tE (XVar (UIx 0)) xS))
-                  | bS@(BName n tS)  <- processParamValues process
+                              (tSeries tProc (tDown c tK) tE)
+                      , xDown c tProc tK tE (XVar (UIx 0)) xS))
+                  | (flag, bS@(BName n tS)) <- processParamFlags process
+                  , not flag
                   , let Just tE = elemTypeOfSeriesType tS
                   , let Just uS = takeSubstBoundOfBind bS
                   , let xS      = XVar uS
@@ -170,16 +232,19 @@
 
         let Just xsVecValArgs    
                 = sequence 
-                $ map getDownValArg (processParamValues process)
+                $ map getDownValArg 
+                $ map snd
+                $ filter (not.fst)
+                $ processParamFlags process
 
         let bRateDown
-                = BAnon (tRateNat (tDown c (TVar uK)))
+                = BAnon (tRateNat (tDown c tK))
 
         let xProcVec'       
                 = XLam bRateDown
                 $ xLets [LLet b x | (_, (b, x)) <- bxsDownSeries]
-                $ xApps (XApp xProcVec (XType (TVar uK)))
-                $ xsVecValArgs
+                $ xApps xProcVec
+                $ [XType tProc, XType tK] ++ xsVecValArgs
 
 
         -----------------------------------------
@@ -190,9 +255,10 @@
 
         -- Window the input series to select the tails.
         let bxsTailSeries
-                = [ ( bS, ( BName (NameVarMod n "tail") (tSeries (tTail c tK) tE)
-                          , xTail c tK tE (XVar (UIx 0)) xS))
-                  | bS@(BName n tS)    <- processParamValues process
+                = [ ( bS, ( BName (NameVarMod n "tail") (tSeries tProc (tTail c tK) tE)
+                          , xTail c tProc tK tE (XVar (UIx 0)) xS))
+                  | (flag, bS@(BName n tS)) <- processParamFlags process
+                  , not flag
                   , let Just tE = elemTypeOfSeriesType tS
                   , let Just uS = takeSubstBoundOfBind bS
                   , let xS      = XVar uS
@@ -202,7 +268,8 @@
         let bxsTailVector
                 = [ ( bV, ( BName (NameVarMod n "tail") (tVector tE)
                           , xTailVector c tK tE (XVar (UIx 0)) xV))
-                  | bV@(BName n tV)     <- processParamValues process
+                  | (flag, bV@(BName n tV)) <- processParamFlags process
+                  , not flag
                   , let Just tE = elemTypeOfVectorType tV
                   , let Just uV = takeSubstBoundOfBind bV
                   , let xV      = XVar uV
@@ -221,28 +288,27 @@
 
         let Just xsTailValArgs
                 = sequence 
-                $ map getTailValArg (procedureParamValues procTail)
+                $ map getTailValArg (map snd $ filter (not.fst) $ procedureParamFlags procTail)
 
         let bRateTail
-                = BAnon (tRateNat (tTail c (TVar uK)))
+                = BAnon (tRateNat (tTail c tK))
 
         let xProcTail'
                 = XLam bRateTail
                 $ xLets [LLet b x | (_, (b, x)) <- bxsTailSeries]
                 $ xLets [LLet b x | (_, (b, x)) <- bxsTailVector]
-                $ xApps (XApp xProcTail (XType (tTail c (TVar uK))))
-                $ xsTailValArgs
+                $ xApps xProcTail
+                $ [XType tProc, XType (tTail c tK)] ++ xsTailValArgs
 
         ------------------------------------------
         -- Stich the vector and scalar versions together.
         let xProc
-                = foldr XLAM 
-                       (foldr XLam xBody (processParamValues process))
-                       (processParamTypes process)
+                = makeXLamFlags (processParamFlags process)
+                                xBody
 
             xBody
                 = XLet (LLet   (BNone tUnit) 
-                               (xSplit c (TVar uK) xRN xProcVec' xProcTail'))
+                               (xSplit c tK xRN xProcVec' xProcTail'))
                        xUnit
                 
         -- Reconstruct a binder for the whole procedure / process.
@@ -266,6 +332,7 @@
  | otherwise
  = error $  "ddc-core-flow.lowerProcess: invalid lowering method"
          
+
 
 -- Clean ----------------------------------------------------------------------
 -- | Do some beta-reductions to ensure that arguments to worker functions
diff --git a/DDC/Core/Flow/Prim.hs b/DDC/Core/Flow/Prim.hs
--- a/DDC/Core/Flow/Prim.hs
+++ b/DDC/Core/Flow/Prim.hs
@@ -75,6 +75,8 @@
 import DDC.Core.Flow.Prim.OpVector
 import DDC.Core.Flow.Prim.OpPrim
 
+import DDC.Core.Lexer.Names             (isVarStart)
+
 import DDC.Core.Salt.Name
         ( readPrimTyCon
         
@@ -86,12 +88,14 @@
         , lowerPrimVecToArith
         
         , readPrimCast
-        , readLitPrimNat
-        , readLitPrimInt
-        , readLitPrimWordOfBits
-        , readLitPrimFloatOfBits)
+        , readLitNat
+        , readLitInt
+        , readLitWordOfBits
+        , readLitFloatOfBits)
         
 import DDC.Base.Pretty
+import DDC.Base.Name
+import DDC.Data.ListUtils
 import Control.DeepSeq
 import Data.Char        
 
@@ -153,6 +157,16 @@
         NameLitFloat    r bits  -> double (fromRational r) <> text "f" <> int bits <> text "#"
 
 
+instance CompoundName Name where
+ extendName n str       
+  = NameVarMod n str
+ 
+ splitName nn
+  = case nn of
+        NameVarMod n str   -> Just (n, str)
+        _                  -> Nothing
+
+
 -- | Read the name of a variable, constructor or literal.
 readName :: String -> Maybe Name
 readName str
@@ -177,32 +191,36 @@
         | str == "False#" = Just $ NameLitBool False
 
         -- Literal Nat
-        | Just val <- readLitPrimNat str
+        | Just str'     <- stripSuffix "#" str
+        , Just val      <- readLitNat str'
         = Just $ NameLitNat  val
 
         -- Literal Ints
-        | Just val <- readLitPrimInt str
+        | Just str'     <- stripSuffix "#" str
+        , Just val      <- readLitInt str'
         = Just $ NameLitInt  val
 
         -- Literal Words
-        | Just (val, bits)      <- readLitPrimWordOfBits str
+        | Just str'             <- stripSuffix "#" str
+        , Just (val, bits)      <- readLitWordOfBits str'
         , elem bits [8, 16, 32, 64]
         = Just $ NameLitWord val bits
 
         -- Literal Floats
-        | Just (val, bits)      <- readLitPrimFloatOfBits str
+        | Just str'             <- stripSuffix "#" str
+        , Just (val, bits)      <- readLitFloatOfBits str'
         , elem bits [32, 64]
         = Just $ NameLitFloat (toRational val) bits
 
         -- Variables.
         | c : _                 <- str
-        , isLower c
+        , isVarStart c
         , Just (str1, strMod)   <- splitModString str
         , Just n                <- readName str1
         = Just $ NameVarMod n strMod
 
         | c : _         <- str
-        , isLower c      
+        , isVarStart c      
         = Just $ NameVar str
 
         -- Constructors.
diff --git a/DDC/Core/Flow/Prim/Base.hs b/DDC/Core/Flow/Prim/Base.hs
--- a/DDC/Core/Flow/Prim/Base.hs
+++ b/DDC/Core/Flow/Prim/Base.hs
@@ -94,6 +94,7 @@
 -- | Fragment specific kind constructors.
 data KiConFlow
         = KiConFlowRate
+        | KiConFlowProc
         deriving (Eq, Ord, Show)
 
 
@@ -102,9 +103,15 @@
         -- | @TupleN#@ constructor. Tuples.
         = TyConFlowTuple Int            
 
-        -- | @Vector#@ constructor. Vectors. 
+        -- | @Vector#@ constructor. Vector is a pair of mutable length and mutable data
         | TyConFlowVector
 
+        -- | @Buffer#@ constructor. Mutable Buffer with no associated length
+        | TyConFlowBuffer
+
+        -- | @RateVec#@ constructor. Vector is a pair of mutable length and mutable data
+        | TyConFlowRateVec
+
         -- | @Series#@ constructor. Series types.
         | TyConFlowSeries
 
@@ -123,6 +130,11 @@
         -- | @RateNat#@ constructor. Naturals witnessing a type-level Rate.          
         | TyConFlowRateNat
 
+        -- | Multiply two @Rate@s together
+        | TyConFlowRateCross
+        -- | Add two @Rate@s together
+        | TyConFlowRateAppend
+
         -- | @DownN#@ constructor.   Rate decimation. 
         | TyConFlowDown Int
 
@@ -131,6 +143,9 @@
 
         -- | @Process@ constructor.
         | TyConFlowProcess
+
+        -- | @Resize p j k@ is a witness that @Process p j@ can be resized to @Process p k@
+        | TyConFlowResize
         deriving (Eq, Ord, Show)
 
 
@@ -173,6 +188,9 @@
         -- | Pack a series according to a flags vector.
         | OpSeriesPack
 
+        -- | Generate a new series with size based on klok/rate
+        | OpSeriesGenerate
+
         -- | Reduce a series with an associative operator,
         --   updating an existing accumulator.
         | OpSeriesReduce
@@ -180,9 +198,49 @@
         -- | Segmented fold.
         | OpSeriesFolds
 
-        -- | Convert vector(s) into series, all with same length with runtime check.
-        | OpSeriesRunProcess Int
+        -- | Execute a process
+        | OpSeriesRunProcess
 
+        -- | Introduce a Proc type, but argument returns unit instead of process
+        -- Has exact same type as RunProcess except for that,
+        -- so that they can easily be swapped during lowering
+        | OpSeriesRunProcessUnit
+
+        -- | Convert vector(s) into manifests, all with same length with runtime check.
+        | OpSeriesRateVecsOfVectors Int
+
+        -- | Convert manifest into series
+        | OpSeriesSeriesOfRateVec
+
+        -- | Append two series
+        | OpSeriesAppend
+
+        -- | Cross a series and a vector
+        | OpSeriesCross
+
+
+        -- | Resize a process
+        | OpSeriesResizeProc
+
+        -- | Resize a process
+        | OpSeriesResizeId
+
+        -- | Inject a series into the left side of an append
+        | OpSeriesResizeAppL
+        -- | Inject a series into the right side of an append
+        | OpSeriesResizeAppR
+
+        -- | Map over the contents of an append
+        | OpSeriesResizeApp
+
+        -- | Move from filtered to filtee
+        | OpSeriesResizeSel1
+        -- | Move from segment data to segment lens
+        | OpSeriesResizeSegd
+        -- | Move from (cross a b) to a
+        | OpSeriesResizeCross
+
+
         -- | Join two series processes.
         | OpSeriesJoin
         deriving (Eq, Ord, Show)
@@ -265,6 +323,12 @@
 
         -- | Truncate a vector to a smaller length.
         | OpStoreTruncVector
+
+        -- | Get a vector's data buffer
+        | OpStoreBufOfVector
+
+        -- | Get a vector's data buffer
+        | OpStoreBufOfRateVec
         deriving (Eq, Ord, Show)
 
 
@@ -284,5 +348,11 @@
 
         -- | Get a vector's length.
         | OpVectorLength
+
+        -- | Gather  (read) elements from a vector:
+        --
+        -- > gather v ix = map (v!) ix
+        --
+        | OpVectorGather
         deriving (Eq, Ord, Show)
 
diff --git a/DDC/Core/Flow/Prim/DaConFlow.hs b/DDC/Core/Flow/Prim/DaConFlow.hs
--- a/DDC/Core/Flow/Prim/DaConFlow.hs
+++ b/DDC/Core/Flow/Prim/DaConFlow.hs
@@ -5,15 +5,17 @@
 where
 import DDC.Core.Flow.Prim.TyConFlow
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Exp.Simple
-import DDC.Core.Compounds.Simple
+import DDC.Core.Exp.Simple.Exp
+import DDC.Core.Exp.Simple.Compounds
 import DDC.Base.Pretty
 import Data.List
 import Data.Char
 import Control.DeepSeq
 
 
-instance NFData DaConFlow
+instance NFData DaConFlow where
+ rnf !_ = ()
+ 
 
 instance Pretty DaConFlow where
  ppr dc
diff --git a/DDC/Core/Flow/Prim/DaConPrim.hs b/DDC/Core/Flow/Prim/DaConPrim.hs
--- a/DDC/Core/Flow/Prim/DaConPrim.hs
+++ b/DDC/Core/Flow/Prim/DaConPrim.hs
@@ -9,8 +9,8 @@
 import DDC.Core.Flow.Prim.TyConPrim
 import DDC.Core.Flow.Prim.DaConFlow
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 
 
 -- | A literal @Bool#@
diff --git a/DDC/Core/Flow/Prim/KiConFlow.hs b/DDC/Core/Flow/Prim/KiConFlow.hs
--- a/DDC/Core/Flow/Prim/KiConFlow.hs
+++ b/DDC/Core/Flow/Prim/KiConFlow.hs
@@ -1,22 +1,25 @@
 
 module DDC.Core.Flow.Prim.KiConFlow
         ( readKiConFlow
-        , kRate)
+        , kRate
+        , kProc )
 where
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Exp
+import DDC.Type.Compounds
 import DDC.Base.Pretty
 import Control.DeepSeq
 
 
-instance NFData KiConFlow
+instance NFData KiConFlow where
+ rnf !_ = ()
 
 
 instance Pretty KiConFlow where
  ppr con
   = case con of
         KiConFlowRate   -> text "Rate"
+        KiConFlowProc   -> text "Proc"
 
 
 -- | Read a kind constructor name.
@@ -24,8 +27,11 @@
 readKiConFlow str
  = case str of
         "Rate"  -> Just $ KiConFlowRate
+        "Proc"  -> Just $ KiConFlowProc
         _       -> Nothing
 
 
 -- Compounds ------------------------------------------------------------------
 kRate   = TCon (TyConBound (UPrim (NameKiConFlow KiConFlowRate) sProp) sProp)
+
+kProc   = TCon (TyConBound (UPrim (NameKiConFlow KiConFlowProc) sProp) sProp)
diff --git a/DDC/Core/Flow/Prim/OpConcrete.hs b/DDC/Core/Flow/Prim/OpConcrete.hs
--- a/DDC/Core/Flow/Prim/OpConcrete.hs
+++ b/DDC/Core/Flow/Prim/OpConcrete.hs
@@ -11,21 +11,22 @@
         , xNextC
 
         , xDown
-        , xTail)
+        , xTail )
 where
 import DDC.Core.Flow.Prim.KiConFlow
 import DDC.Core.Flow.Prim.TyConFlow
 import DDC.Core.Flow.Prim.TyConPrim
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 import DDC.Base.Pretty
 import Control.DeepSeq
 import Data.List
 import Data.Char
 
 
-instance NFData OpConcrete
+instance NFData OpConcrete where
+ rnf !_ = ()
 
 
 instance Pretty OpConcrete where
@@ -101,11 +102,11 @@
                         (TVar (UIx (a - ix)))
 
 
-        -- rateOfSeries#   :: [k : Rate]. [a : Data]
-        --                 .  Series k a -> RateNat k
+        -- rateOfSeries#   :: [p : Proc]. [k : Rate]. [a : Data]
+        --                 .  Series p k a -> RateNat k
         OpConcreteRateOfSeries 
-         -> tForalls [kRate, kData] $ \[tK, tA]
-                -> tSeries tK tA `tFun` tRateNat tK
+         -> tForalls [kProc, kRate, kData] $ \[tP, tKR, tA]
+                -> tSeries tP tKR tA `tFun` tRateNat tKR
 
         -- natOfRateNat#   :: [k : Rate]. RateNat k -> Nat#
         OpConcreteNatOfRateNat 
@@ -114,30 +115,31 @@
 
         -- next#   :: [a : Data]. [k : Rate]. Series# k a -> Nat# -> a
         OpConcreteNext 1
-         -> tForalls [kData, kRate]
-         $  \[tA, tK] -> tSeries tK tA `tFun` tNat `tFun` tA
+         -> tForalls [kData, kProc, kRate]
+         $  \[tA, tP, tK] -> tSeries tP tK tA `tFun` tNat `tFun` tA
 
         -- next$N# :: [a : Data]. [k : Rate]
         --         .  Series# (DownN# k) a -> Nat# -> VecN# a
         OpConcreteNext n
-         -> tForalls [kData, kRate]
-         $  \[tA, tK] -> tSeries (tDown n tK) tA `tFun` tNat `tFun` tVec n tA
+         -> tForalls [kData, kProc, kRate]
+         $  \[tA, tP, tK] -> tSeries tP (tDown n tK) tA `tFun` tNat `tFun` tVec n tA
 
         -- down$N# :: [k : Rate]. [a : Data].
         --         .  RateNat (DownN# k) -> Series# k a -> Series# (DownN# k) a
         OpConcreteDown n
-         -> tForalls [kRate, kData]
-         $  \[tK, tA] -> tRateNat (tDown n tK) 
-                        `tFun` tSeries tK tA `tFun` tSeries (tDown n tK) tA
+         -> tForalls [kProc, kRate, kData]
+         $  \[tP, tK, tA] -> tRateNat (tDown n tK) 
+                        `tFun` tSeries tP tK tA `tFun` tSeries tP (tDown n tK) tA
 
         -- tail$N# :: [k : Rate]. [a : Data].
         --         .  RateNat (TailN# k) -> Series# k a -> Series# (TailN# k) a
         OpConcreteTail n
-         -> tForalls [kRate, kData]
-         $  \[tK, tA] -> tRateNat (tTail n tK)
-                        `tFun` tSeries tK tA `tFun` tSeries (tTail n tK) tA
+         -> tForalls [kProc, kRate, kData]
+         $  \[tP, tK, tA] -> tRateNat (tTail n tK)
+                        `tFun` tSeries tP tK tA `tFun` tSeries tP (tTail n tK) tA
 
 
+
 -- Compounds ------------------------------------------------------------------
 type TypeF      = Type Name
 type ExpF       = Exp () Name
@@ -148,10 +150,10 @@
                   ([XType t | t <- ts] ++ [x])
 
 
-xRateOfSeries :: TypeF -> TypeF -> ExpF -> ExpF
-xRateOfSeries tK tA xS 
+xRateOfSeries :: TypeF -> TypeF -> TypeF -> ExpF -> ExpF
+xRateOfSeries tP tK tA xS 
          = xApps  (xVarOpConcrete OpConcreteRateOfSeries) 
-                  [XType tK, XType tA, xS]
+                  [XType tP, XType tK, XType tA, xS]
 
 
 xNatOfRateNat :: TypeF -> ExpF -> ExpF
@@ -160,28 +162,29 @@
                  [XType tK, xR]
 
 
-xNext  :: TypeF -> TypeF -> ExpF -> ExpF -> ExpF
-xNext tRate tElem xStream xIndex
+xNext  :: TypeF -> TypeF -> TypeF -> ExpF -> ExpF -> ExpF
+xNext tProc tRate tElem xStream xIndex
  = xApps (xVarOpConcrete (OpConcreteNext 1))
-         [XType tElem, XType tRate, xStream, xIndex]
+         [XType tElem, XType tProc, XType tRate, xStream, xIndex]
 
 
-xNextC :: Int -> TypeF -> TypeF -> ExpF -> ExpF -> ExpF
-xNextC c tRate tElem xStream xIndex
+xNextC :: Int -> TypeF -> TypeF -> TypeF -> ExpF -> ExpF -> ExpF
+xNextC c tProc tRate tElem xStream xIndex
  = xApps (xVarOpConcrete (OpConcreteNext c))
-         [XType tElem, XType tRate, xStream, xIndex]
+         [XType tElem, XType tProc, XType tRate, xStream, xIndex]
 
 
-xDown  :: Int -> TypeF -> TypeF -> ExpF -> ExpF -> ExpF
-xDown n tR tE xRN xS
+xDown  :: Int -> TypeF -> TypeF -> TypeF -> ExpF -> ExpF -> ExpF
+xDown n tP tK tE xRN xS
  = xApps (xVarOpConcrete (OpConcreteDown n))
-         [XType tR, XType tE, xRN, xS]
+         [XType tP, XType tK, XType tE, xRN, xS]
 
 
-xTail  :: Int -> TypeF -> TypeF -> ExpF -> ExpF -> ExpF
-xTail n tR tE xRN xS
+xTail  :: Int -> TypeF -> TypeF -> TypeF -> ExpF -> ExpF -> ExpF
+xTail n tP tK tE xRN xS
  = xApps (xVarOpConcrete (OpConcreteTail n))
-         [XType tR, XType tE, xRN, xS]
+         [XType tP, XType tK, XType tE, xRN, xS]
+
 
 
 -- Utils -----------------------------------------------------------------------
diff --git a/DDC/Core/Flow/Prim/OpControl.hs b/DDC/Core/Flow/Prim/OpControl.hs
--- a/DDC/Core/Flow/Prim/OpControl.hs
+++ b/DDC/Core/Flow/Prim/OpControl.hs
@@ -12,15 +12,16 @@
 import DDC.Core.Flow.Prim.TyConPrim
 import DDC.Core.Flow.Prim.TyConFlow
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 import DDC.Base.Pretty
 import Control.DeepSeq
 import Data.Char
 import Data.List
 
 
-instance NFData OpControl
+instance NFData OpControl where
+ rnf !_ = ()
 
 
 instance Pretty OpControl where
@@ -68,9 +69,8 @@
 
         -- guard#   :: Ref# Nat# -> Bool# -> (Nat# -> Unit) -> Unit
         OpControlGuard 
-         -> tRef tNat
-                `tFun` tBool
-                `tFun` (tNat `tFun` tUnit)
+         ->            tBool
+                `tFun` (tUnit `tFun` tUnit)
                 `tFun` tUnit
 
         -- segment# :: Ref Nat# -> Nat#  -> (Nat# -> Nat# -> Unit) -> Unit
@@ -78,9 +78,8 @@
         --   element in the segment, and the second is the index into the 
         --   overall series.
         OpControlSegment
-         -> tRef tNat
-                `tFun` tNat
-                `tFun` (tNat `tFun` tNat `tFun` tUnit)
+         ->            tNat
+                `tFun` (tNat `tFun` tUnit)
                 `tFun` tUnit
 
         -- split#  :: [k : Rate]. RateNat# k
@@ -106,16 +105,16 @@
                 [XType tR, xRN, xF]
 
 
-xGuard   :: ExpF -> ExpF -> ExpF -> ExpF
-xGuard xCount xFlag xFun
+xGuard   :: ExpF -> ExpF -> ExpF
+xGuard xFlag xFun
         = xApps (xVarOpControl OpControlGuard) 
-                [xCount, xFlag, xFun]
+                [xFlag, xFun]
 
 
-xSegment :: ExpF -> ExpF -> ExpF -> ExpF
-xSegment xCount xIters xFun
+xSegment :: ExpF -> ExpF -> ExpF
+xSegment xIters xFun
         = xApps (xVarOpControl OpControlSegment)
-                [xCount, xIters, xFun]
+                [xIters, xFun]
 
 
 xSplit  :: Int  -> TypeF -> ExpF
diff --git a/DDC/Core/Flow/Prim/OpPrim.hs b/DDC/Core/Flow/Prim/OpPrim.hs
--- a/DDC/Core/Flow/Prim/OpPrim.hs
+++ b/DDC/Core/Flow/Prim/OpPrim.hs
@@ -12,9 +12,10 @@
 where
 import DDC.Core.Flow.Prim.TyConPrim
 import DDC.Core.Flow.Prim.TyConFlow
+import DDC.Core.Flow.Prim.KiConFlow
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 
 
 -- | Take the type of a primitive cast.
@@ -87,8 +88,8 @@
          $  \t -> tVec n t `tFun` t
 
         PrimVecGather n
-         -> tForall kData
-         $  \t -> tVector t `tFun` tVec n tNat `tFun` tVec n t
+         -> tForalls [kRate, kData]
+         $  \[k, t] -> tRateVec k t `tFun` tVec n tNat `tFun` tVec n t
 
         PrimVecScatter n
          -> tForall kData
@@ -106,10 +107,10 @@
  = xApps (xVarPrimVec (PrimVecProj n i))
          [XType tA, xV]
 
-xvGather  :: Int -> Type Name -> Exp () Name -> Exp () Name -> Exp () Name
-xvGather c tA xVec xIxs
+xvGather  :: Int -> Type Name -> Type Name -> Exp () Name -> Exp () Name -> Exp () Name
+xvGather c tK tA xVec xIxs
  = xApps (xVarPrimVec (PrimVecGather c))
-         [XType tA, xVec, xIxs]
+         [XType tK, XType tA, xVec, xIxs]
 
 
 xvScatter :: Int -> Type Name -> Exp () Name -> Exp () Name -> Exp () Name -> Exp () Name
diff --git a/DDC/Core/Flow/Prim/OpSeries.hs b/DDC/Core/Flow/Prim/OpSeries.hs
--- a/DDC/Core/Flow/Prim/OpSeries.hs
+++ b/DDC/Core/Flow/Prim/OpSeries.hs
@@ -1,22 +1,26 @@
 
 module DDC.Core.Flow.Prim.OpSeries
         ( readOpSeries
-        , typeOpSeries)
+        , typeOpSeries
+        
+        -- Compounds
+        , xSeriesOfRateVec)
 where
 import DDC.Core.Flow.Prim.KiConFlow
 import DDC.Core.Flow.Prim.TyConFlow
 import DDC.Core.Flow.Prim.TyConPrim
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Transform.LiftT
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Transform.BoundT
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 import DDC.Base.Pretty
 import Control.DeepSeq
 import Data.List
 import Data.Char        
 
 
-instance NFData OpSeries
+instance NFData OpSeries where
+ rnf !_ = ()
 
 
 instance Pretty OpSeries where
@@ -42,15 +46,32 @@
 
         OpSeriesPack            -> text "spack"                 <> text "#"
 
+        OpSeriesGenerate        -> text "sgenerate"             <> text "#"
+
         OpSeriesReduce          -> text "sreduce"               <> text "#"
         OpSeriesFolds           -> text "sfolds"                <> text "#"
 
         OpSeriesJoin            -> text "pjoin"                 <> text "#"
 
-        OpSeriesRunProcess 1    -> text "runProcess"            <> text "#"
-        OpSeriesRunProcess n    -> text "runProcess" <> int n   <> text "#"
+        OpSeriesRunProcess      -> text "runProcess"            <> text "#"
+        OpSeriesRunProcessUnit  -> text "runProcessUnit"        <> text "#"
 
+        OpSeriesRateVecsOfVectors n -> text "ratify"   <> int n <> text "#"
 
+        OpSeriesSeriesOfRateVec -> text "series"                <> text "#"
+        OpSeriesAppend          -> text "sappend"               <> text "#"
+        OpSeriesCross           -> text "scross"                <> text "#"
+
+        OpSeriesResizeProc      -> text "presize"               <> text "#"
+        OpSeriesResizeId        -> text "rid"                   <> text "#"
+        OpSeriesResizeAppL      -> text "rappl"                 <> text "#"
+        OpSeriesResizeAppR      -> text "rappr"                 <> text "#"
+        OpSeriesResizeApp       -> text "rapp"                  <> text "#"
+        OpSeriesResizeSel1      -> text "rsel1"                 <> text "#"
+        OpSeriesResizeSegd      -> text "rsegd"                 <> text "#"
+        OpSeriesResizeCross     -> text "rcross"                <> text "#"
+
+
 -- | Read a data flow operator name.
 readOpSeries :: String -> Maybe OpSeries
 readOpSeries str
@@ -67,11 +88,11 @@
         , arity == 1
         = Just $ OpSeriesMkSel arity
 
-        | Just rest     <- stripPrefix "runProcess" str
+        | Just rest     <- stripPrefix "ratify" str
         , (ds, "#")     <- span isDigit rest
         , not $ null ds
         , arity         <- read ds
-        = Just $ OpSeriesRunProcess arity
+        = Just $ OpSeriesRateVecsOfVectors arity
 
 
         | otherwise
@@ -84,12 +105,27 @@
                 "smkSegd#"      -> Just $ OpSeriesMkSegd
                 "smap#"         -> Just $ OpSeriesMap   1
                 "spack#"        -> Just $ OpSeriesPack
+                "sgenerate#"    -> Just $ OpSeriesGenerate
                 "sreduce#"      -> Just $ OpSeriesReduce
                 "sfolds#"       -> Just $ OpSeriesFolds
                 "sfill#"        -> Just $ OpSeriesFill
                 "sscatter#"     -> Just $ OpSeriesScatter
                 "pjoin#"        -> Just $ OpSeriesJoin
-                "runProcess#"   -> Just $ OpSeriesRunProcess 1
+                "runProcess#"   -> Just $ OpSeriesRunProcess
+                "runProcessUnit#"->Just $ OpSeriesRunProcessUnit
+                "series#"       -> Just $ OpSeriesSeriesOfRateVec
+                "sappend#"      -> Just $ OpSeriesAppend
+                "scross#"       -> Just $ OpSeriesCross
+
+                "presize#"      -> Just $ OpSeriesResizeProc
+                "rid#"          -> Just $ OpSeriesResizeId
+                "rappl#"        -> Just $ OpSeriesResizeAppL
+                "rappr#"        -> Just $ OpSeriesResizeAppR
+                "rapp#"         -> Just $ OpSeriesResizeApp
+                "rsel1#"        -> Just $ OpSeriesResizeSel1
+                "rsegd#"        -> Just $ OpSeriesResizeSegd
+                "rcross#"       -> Just $ OpSeriesResizeCross
+
                 _               -> Nothing
 
 
@@ -108,38 +144,38 @@
 takeTypeOpSeries op
  = case op of
         -- Replicates -------------------------
-        -- rep  :: [k : Rate] [a : Data] 
-        --      .  a -> Series k a
+        -- rep  :: [p : Proc] [k : Rate] [a : Data] 
+        --      .  a -> Series p k a
         OpSeriesRep 
-         -> Just $ tForalls [kRate, kData] $ \[tR, tA]
-                -> tA `tFun` tSeries tR tA
+         -> Just $ tForalls [kProc, kRate, kData] $ \[tP, tR, tA]
+                -> tA `tFun` tSeries tP tR tA
 
-        -- reps  :: [k1 k2 : Rate]. [a : Data]
-        --       .  Segd k1 k2 -> Series k1 a -> Series k2 a
+        -- reps  :: [p : Proc]. [k1 k2 : Rate]. [a : Data]
+        --       .  Segd k1 k2 -> Series p k1 a -> Series p k2 a
         OpSeriesReps 
-         -> Just $ tForalls [kRate, kRate, kData] $ \[tK1, tK2, tA]
-                -> tSegd tK1 tK2 `tFun` tSeries tK1 tA `tFun` tSeries tK2 tA
+         -> Just $ tForalls [kProc, kRate, kRate, kData] $ \[tP, tK1, tK2, tA]
+                -> tSegd tK1 tK2 `tFun` tSeries tP tK1 tA `tFun` tSeries tP tK2 tA
 
 
         -- Indices ------------------------------
-        -- indices :: [k1 k2 : Rate]. 
-        --         .  Segd k1 k2 -> Series k2 Nat
+        -- indices :: [p : Proc]. [k1 k2 : Rate]. 
+        --         .  Segd k1 k2 -> Series p k2 k1 Nat
         OpSeriesIndices
-         -> Just $ tForalls [kRate, kRate] $ \[tK1, tK2]
-                 -> tSegd tK1 tK2 `tFun` tSeries tK2 tNat
+         -> Just $ tForalls [kProc, kRate, kRate] $ \[tP, tK1, tK2]
+                 -> tSegd tK1 tK2 `tFun` tSeries tP tK2 tNat
 
 
         -- Maps ---------------------------------
-        -- map   :: [k : Rate] [a b : Data]
-        --       .  (a -> b) -> Series k a -> Series k b
+        -- map   :: [p : Proc]. [kR kL : Rate] [a b : Data]
+        --       .  (a -> b) -> Series p kR kL a -> Series p kR kL b
         OpSeriesMap 1
-         -> Just $ tForalls [kRate, kData, kData] $ \[tK, tA, tB]
+         -> Just $ tForalls [kProc, kRate, kData, kData] $ \[tP, tKR, tA, tB]
                 ->       (tA `tFun` tB)
-                `tFun` tSeries tK tA
-                `tFun` tSeries tK tB
+                `tFun` tSeries tP tKR tA
+                `tFun` tSeries tP tKR tB
 
-        -- mapN  :: [k : Rate] [a0..aN : Data]
-        --       .  (a0 -> .. aN) -> Series k a0 -> .. Series k aN
+        -- mapN  :: [p : Proc] [kR kL : Rate] [a0..aN : Data]
+        --       .  (a0 -> .. aN) -> Series p kR kL a0 -> .. Series p kR kL aN
         OpSeriesMap n
          | n >= 2
          , Just tWork <- tFunOfList   
@@ -147,115 +183,289 @@
                                 | i <- reverse [0..n] ]
 
          , Just tBody <- tFunOfList
-                         (tWork : [tSeries (TVar (UIx (n + 1))) (TVar (UIx i)) 
+                         (tWork : [tSeries (TVar $ UIx $ n + 2) (TVar $ UIx $ n + 1)
+                                           (TVar $ UIx   i) 
                                 | i <- reverse [0..n] ])
 
          -> Just $ foldr TForall tBody
-                         [ BAnon k | k <- kRate : replicate (n + 1) kData ]
+                         [ BAnon k | k <- kProc : kRate : replicate (n + 1) kData ]
 
 
         -- Packs --------------------------------
-        -- pack  :: [k1 k2 : Rate]. [a : Data]
+        -- pack  :: [p : Proc]. [k1 k2 kL : Rate]. [a : Data]
         --       .  Sel2 k1 k2
-        --       -> Series k1 a -> Series k2 a
+        --       -> Series p k1 kL a -> Series p k2 kL a
         OpSeriesPack
-         -> Just $ tForalls [kRate, kRate, kData] $ \[tK1, tK2, tA]
-                ->     tSel1   tK1 tK2 
-                `tFun` tSeries tK1 tA `tFun` tSeries tK2 tA
+         -> Just $ tForalls [kProc, kRate, kRate, kData] $ \[tP, tK1, tK2, tA]
+                ->     tSel1   tP tK1 tK2 
+                `tFun` tSeries tP tK1 tA
+                `tFun` tSeries tP tK2 tA
 
 
         -- Processes ----------------------------
-        -- join#    :: Process -> Process -> Process
+        -- join#    :: [p : Proc]. [k : Rate]. [a b : Data].
+        --          .  Process p k a
+        --          -> Process p k b
+        --          -> Process p k (a,b)
         OpSeriesJoin
-         -> Just $ tProcess `tFun` tProcess `tFun` tProcess
+         -> Just $ tForalls [kProc, kRate] $
+                \[tP, tK]
+                ->     tProcess tP tK
+                `tFun` tProcess tP tK
+                `tFun` tProcess tP tK
 
 
-        -- mkSel1#  :: [k1 : Rate].
-        --          .  Series k1 Bool#
-        --          -> ([k2 : Rate]. Sel1 k1 k2 -> Process#)
-        --          -> Process#
+        -- mkSel1#  :: [p : Proc]. [k1 kL : Rate]
+        --          .  Series p k1 kL Bool#
+        --          -> ([k2 : Rate]. Sel1 p k1 k2 -> Process# p kL)
+        --          -> Process# p kL
         OpSeriesMkSel 1
-         -> Just $ tForalls [kRate] $ \[tK1]
-                ->       tSeries tK1 tBool
+         -> Just $ tForalls [kProc, kRate, kRate] $ \[tP, tK1, tKL]
+                ->       tSeries tP tK1 tBool
                 `tFun` (tForall kRate $ \tK2 
-                                -> tSel1 (liftT 1 tK1) tK2 `tFun` tProcess)
-                `tFun` tProcess
+                                -> tSel1 (liftT 1 tP) (liftT 1 tK1) tK2 `tFun` tProcess (liftT 1 tP) (liftT 1 tKL))
+                `tFun` tProcess tP tKL
 
 
-        -- mkSegd#  :: [k1 : Rate]
-        --          .  Series# k1 Nat#
-        --          -> ([k2 : Rate]. Segd# k1 k2 -> Process#)
-        --          -> Process#
+        -- mkSegd#  :: [p : Proc]. [k1 kL : Rate]
+        --          .  Series# p k1 kL Nat#
+        --          -> ([k2 : Rate]. Segd# k1 k2 -> Process# p kL)
+        --          -> Process# p kL
         OpSeriesMkSegd
-         -> Just $ tForalls [kRate] $ \[tK1]
-                ->      tSeries tK1 tNat
+         -> Just $ tForalls [kProc, kRate] $ \[tP, tK1]
+                ->      tSeries tP tK1 tNat
                 `tFun` (tForall kRate $ \tK2
-                                -> tSegd (liftT 1 tK1) tK2 `tFun` tProcess)
-                `tFun` tProcess
+                                -> tSegd (liftT 1 tK1) tK2 `tFun` tProcess (liftT 1 tP) (liftT 1 tK1))
+                `tFun` tProcess tP tK1
 
 
-        -- runProcessN# :: [a0..aN : Data]
+        -- runProcess# :: [k : Rate]
+        --          .  
+        --             ([p : Proc]. Unit -> Process p k)
+        --          ->  Unit
+        OpSeriesRunProcess
+         -> Just $ tForalls [kRate] $ \[tK]
+                -> (tForall kProc $ \tP
+                        -> tUnit `tFun` tProcess tP (liftT 1 tK))
+                   `tFun` tUnit
+
+        -- runProcessUnit# :: [k : Rate]
+        --          .  
+        --             ([p : Proc]. Unit -> Unit)
+        --          ->  Unit
+        OpSeriesRunProcessUnit
+         -> Just $ tForalls [kRate] $ \[_]
+                -> (tForall kProc $ \_
+                        -> tUnit `tFun` tUnit)
+                   `tFun` tUnit
+
+
+        -- ratify0# :: [z : Data]
+        --          .  Nat
+        --          -> ([k : Rate]. z)
+        --          -> z
+        OpSeriesRateVecsOfVectors 0
+         -> Just $ tForall kData $ \tA
+                -> tNat
+            `tFun` (tForall kRate $ \_ -> liftT 1 tA)
+            `tFun` tA
+
+        -- ratifyN# :: [a0..aN z : Data]
         --          .  Vector    a0 .. Vector   aN 
-        --          -> ([k : Rate]. RateNat k -> Series k a0 .. Series k aN -> Process)
-        --          -> Bool
-        OpSeriesRunProcess n
+        --          -> ([k : Rate]. RateVec k a0 .. RateVec k aN -> z)
+        --          -> z
+        OpSeriesRateVecsOfVectors n
          | tK         <- TVar (UIx 0)
 
          , Just tWork <- tFunOfList   
-                       $ [ tRateNat tK ]
-                       ++[ tSeries tK (TVar (UIx i))
-                                | i <- reverse [1..n] ]
-                       ++[ tProcess ]
+                       $ [ tRateVec tK (TVar (UIx i))
+                                | i <- reverse [2..n+1] ]
+                       ++[ TVar (UIx 1) ]
 
          , tWork'     <- TForall (BAnon kRate) tWork
 
          , Just tBody <- tFunOfList
-                         $ [ tVector (TVar (UIx i)) | i <- reverse [0..n-1] ]
-                         ++[ tWork', tBool ]
+                         $ [ tVector (TVar (UIx i)) | i <- reverse [1..n] ]
+                         ++[ tWork', TVar (UIx 0) ]
 
          -> Just $ foldr TForall tBody
-                         [ BAnon k | k <- replicate n kData ]
+                         [ BAnon k | k <- replicate (n+1) kData ]
 
+        -- series# :: [p : Proc]. [k : Rate]. [a : Data]
+        --         .  RateVec k a -> Series p k a
+        OpSeriesSeriesOfRateVec
+         -> Just $ tForalls [kProc, kRate, kData] $ \[tP, tK, tA]
+                -> tRateVec tK tA `tFun` tSeries tP tK tA
 
+        -- sappend# :: [p : Proc]. [k1R k2R : Rate]. [a : Data]
+        --          .  Series p k1R a -> Series p k2R a
+        --          -> Series p (k1R + k2R) a
+        OpSeriesAppend
+         -> Just $ tForalls [kProc, kRate, kRate, kData] $
+                \[tP, tK1, tK2, tA]
+                -> tSeries tP tK1 tA
+            `tFun` tSeries tP tK2 tA
+            `tFun` tSeries tP (tRateAppend tK1 tK2) tA
+
+        -- scross#  :: [p : Proc]. [kR kO : Rate]. [a b : Data]
+        --          .  Series p kR a
+        --          -> RateVec  kO b
+        --          -> Series p (kR * kO) (a,b)
+        OpSeriesCross
+         -> Just $ tForalls [kProc, kRate, kRate, kData, kData] $
+                \[tP, tKR, tKO, tA, tB]
+                -> tSeries tP tKR tA
+            `tFun` tRateVec   tKO tB
+            `tFun` tSeries tP (tRateCross tKR tKO) (tTuple2 tA tB)
+
+
+        -- generate# :: [p : Proc]. [k : Rate]. [a : Data]
+        --        .  (Nat# -> a) -> Series p k a
+        OpSeriesGenerate
+         -> Just $ tForalls [kProc, kRate, kData] $ \[tP, tK, tA]
+                 ->     (tNat `tFun` tA)
+                 `tFun` tSeries tP tK tA
+
         -- Reductions -------------------------------
-        -- reduce# :: [k : Rate]. [a : Data]
-        --        .  Ref a -> (a -> a -> a) -> a -> Series k a -> Process
+        -- reduce# :: [p : Proc]. [k : Rate]. [a : Data]
+        --        .  Ref a -> (a -> a -> a) -> a -> Series p k a -> Process p k
         OpSeriesReduce
-         -> Just $ tForalls [kRate, kData] $ \[tK, tA]
+         -> Just $ tForalls [kProc, kRate, kData] $ \[tP, tK, tA]
                  ->     tRef tA
                  `tFun` (tA `tFun` tA `tFun` tA)
                  `tFun` tA
-                 `tFun` tSeries tK tA
-                 `tFun` tProcess
+                 `tFun` tSeries  tP tK tA
+                 `tFun` tProcess tP tK
 
 
-        -- folds#   :: [k1 k2 : Rate]. [a : Data]
-        --          .  Segd# k1 k2 -> Series k1 a -> Series k2 b
+        -- folds#   :: [p : Proc]. [k1 k2 : Rate]. [a : Data]
+        --          .  Segd# k1 k2 -> Series p k1 a -> Series k2 b
         OpSeriesFolds
-         -> Just $ tForalls [kRate, kRate, kData] $ \[tK1, tK2, tA]
-                 ->     tSegd tK1 tK2 `tFun` tSeries tK1 tA `tFun` tSeries tK2 tA
+         -> Just $ tForalls [kProc, kRate, kRate, kData] $ \[tP, tK1, tK2, tA]
+                 ->     tSegd      tK1 tK2
+                 `tFun` tSeries tP tK1 tA
+                 `tFun` tSeries tP tK2 tA
 
 
         -- Store operators ---------------------------
-        -- scatter# :: [k : Rate]. [a : Data]
-        --          .  Vector a -> Series k Nat# -> Series k a -> Process
+        -- scatter# :: [p : Proc]. [k : Rate]. [a : Data]
+        --          .  Vector a -> Series p k Nat# -> Series p k a -> Process p k
         OpSeriesScatter
-         -> Just $ tForalls [kRate, kData] $ \[tK, tA]
-                 -> tVector tA 
-                 `tFun` tSeries tK tNat `tFun` tSeries tK tA `tFun` tProcess
+         -> Just $ tForalls [kProc, kRate, kData] $ \[tP, tK, tA]
+                 ->     tVector  tA
+                 `tFun` tSeries  tP tK tNat
+                 `tFun` tSeries  tP tK tA
+                 `tFun` tProcess tP tK
 
 
-        -- gather#  :: [k : Rate]. [a : Data]
-        --          . Vector a -> Series k Nat# -> Series k a
+        -- gather#  :: [p : Proc]. [k1 k2 : Rate]. [a : Data]
+        --          . RateVec k1 a -> Series p k2 Nat# -> Series p k2 a
         OpSeriesGather
-         -> Just $ tForalls [kRate, kData] $ \[tK, tA]
-                 -> tVector tA 
-                 `tFun` tSeries tK tNat `tFun` tSeries tK tA
+         -> Just $ tForalls [kProc, kRate, kRate, kData] $ \[tP, tK1, tK2, tA]
+                 ->     tRateVec   tK1     tA 
+                 `tFun` tSeries tP tK2 tNat
+                 `tFun` tSeries tP tK2 tA
 
 
-        -- fill#    :: [k : Rate]. [a : Data]. Vector a -> Series k a -> Process
+        -- fill#    :: [p : Proc]. [k : Rate]. [a : Data]. Vector a -> Series p k a -> Process p k
         OpSeriesFill
-         -> Just $ tForalls [kRate, kData] $ \[tK, tA] 
-                -> tVector tA `tFun` tSeries tK tA `tFun` tProcess
+         -> Just $ tForalls [kProc, kRate, kData] $ \[tP, tK, tA] 
+                ->    tVector        tA
+               `tFun` tSeries  tP tK tA
+               `tFun` tProcess tP tK
 
+
+        -- Resizing -----------------------
+
+        -- presize#  :: [p : Proc]. [j k : Rate]
+        --           .  Resize  p j k
+        --           -> Process p j
+        --           -> Process p   k
+        OpSeriesResizeProc
+         -> Just $ tForalls [kProc, kRate, kRate] $
+                \[tP, tJ, tK]
+                -> tResize  tP tJ tK
+            `tFun` tProcess tP tJ
+            `tFun` tProcess tP    tK
+
+        -- rid#      :: [p : Proc]. [k : Rate]
+        --           .  Resize  p k k
+        OpSeriesResizeId
+         -> Just $ tForalls [kProc, kRate] $
+                \[tP, tK]
+                -> tResize  tP tK tK
+
+        -- rappl#    :: [p : Proc]. [k l : Rate]
+        --           .  Resize p k (Append k l)
+        OpSeriesResizeAppL
+         -> Just $ tForalls [kProc, kRate, kRate] $
+                \[tP, tK, tL]
+                -> tResize tP tK (tRateAppend tK tL)
+
+        -- rappr#    :: [p : Proc]. [k l : Rate]
+        --           .  Resize p l (Append k l)
+        OpSeriesResizeAppR
+         -> Just $ tForalls [kProc, kRate, kRate] $
+                \[tP, tK, tL]
+                -> tResize tP tL (tRateAppend tK tL)
+
+
+        -- rapp#     :: [p : Proc]. [k k' l l' : Rate]
+        --           .  Resize         k            k'
+        --           -> Resize           l             l'
+        --           -> Resize (Append k l) (Append k' l')
+        OpSeriesResizeApp
+         -> Just $ tForalls [kProc, kRate, kRate, kRate, kRate] $
+                \[tP, tK, tK', tL, tL']
+                -> tResize tP              tK                  tK'
+            `tFun` tResize tP                 tL                   tL'
+            `tFun` tResize tP (tRateAppend tK tL) (tRateAppend tK' tL')
+
+        -- rsel1#    :: [p : Proc]. [j k l : Rate]
+        --           .  Sel1   p   k l
+        --           -> Resize p j   l
+        --           -> Resize p j k
+        OpSeriesResizeSel1
+         -> Just $ tForalls [kProc, kRate, kRate, kRate] $
+                \[tP, tJ, tK, tL]
+                -> tSel1   tP    tK tL
+            `tFun` tResize tP tJ    tL
+            `tFun` tResize tP tJ tK
+
+        -- rsegd#    :: [p : Proc]. [j k l : Rate]
+        --           .  Segd       k l
+        --           -> Resize p j   l
+        --           -> Resize p j k
+        OpSeriesResizeSegd
+         -> Just $ tForalls [kProc, kRate, kRate, kRate] $
+                \[tP, tJ, tK, tL]
+                -> tSegd         tK tL
+            `tFun` tResize tP tJ    tL
+            `tFun` tResize tP tJ tK
+
+        -- rcross#   :: [p : Proc]. [j k l : Rate]
+        --           .  Resize p j (Cross k l)
+        --           -> Resize p j        k
+        OpSeriesResizeCross
+         -> Just $ tForalls [kProc, kRate, kRate, kRate] $
+                \[tP, tJ, tK, tL]
+                -> tResize tP tJ (tRateCross tK tL)
+            `tFun` tResize tP tJ             tK
+
+
+
         _ -> Nothing
+
+
+-- Compounds ------------------------------------------------------------------
+xSeriesOfRateVec :: Type Name -> Type Name -> Type Name -> Exp () Name -> Exp () Name
+xSeriesOfRateVec tP tK tA xV 
+         = xApps  (xVarOpSeries   OpSeriesSeriesOfRateVec) 
+                  [XType tP, XType tK, XType tA, xV]
+
+
+-- Utils -----------------------------------------------------------------------
+xVarOpSeries   :: OpSeries -> Exp () Name
+xVarOpSeries   op
+        = XVar  (UPrim (NameOpSeries   op) (typeOpSeries   op))
+
diff --git a/DDC/Core/Flow/Prim/OpStore.hs b/DDC/Core/Flow/Prim/OpStore.hs
--- a/DDC/Core/Flow/Prim/OpStore.hs
+++ b/DDC/Core/Flow/Prim/OpStore.hs
@@ -8,20 +8,22 @@
         , xReadVector,  xReadVectorC
         , xWriteVector, xWriteVectorC
         , xTailVector
-        , xTruncVector)
+        , xTruncVector
+        , xBufOfVector, xBufOfRateVec)
 where
 import DDC.Core.Flow.Prim.KiConFlow
 import DDC.Core.Flow.Prim.TyConFlow
 import DDC.Core.Flow.Prim.TyConPrim
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 import DDC.Base.Pretty
 import Control.DeepSeq
 import Data.List
 import Data.Char
 
-instance NFData OpStore
+instance NFData OpStore where
+ rnf !_ = ()
 
 
 instance Pretty OpStore where
@@ -47,6 +49,8 @@
         OpStoreTailVector  n    -> text "vtail"   <> int n <> text "#"
 
         OpStoreTruncVector      -> text "vtrunc#"
+        OpStoreBufOfVector      -> text "vbuf#"
+        OpStoreBufOfRateVec     -> text "vbufofratevec#"
 
 
 -- | Read a store operator name.
@@ -86,6 +90,8 @@
                 "vwrite#"       -> Just (OpStoreWriteVector 1)
                 "vtail#"        -> Just (OpStoreTailVector  1)
                 "vtrunc#"       -> Just OpStoreTruncVector
+                "vbuf#"         -> Just OpStoreBufOfVector
+                "vbufofratevec#"-> Just OpStoreBufOfRateVec
 
                 _               -> Nothing
 
@@ -126,22 +132,22 @@
         -- vread#  :: [a : Data]. Vector# a -> Nat# -> a
         OpStoreReadVector 1
          -> tForall kData 
-         $  \tA -> tVector tA `tFun` tNat `tFun` tA
+         $  \tA -> tBuffer tA `tFun` tNat `tFun` tA
 
         -- vreadN#  :: [a : Data]. Vector# a -> Nat# -> VecN# a
         OpStoreReadVector n
          -> tForall kData 
-         $  \tA -> tVector tA `tFun` tNat `tFun` tVec n tA
+         $  \tA -> tBuffer tA `tFun` tNat `tFun` tVec n tA
 
         -- vwrite# :: [a : Data]. Vector# a -> Nat# -> a -> Unit
         OpStoreWriteVector 1
          -> tForall kData 
-         $  \tA -> tVector tA `tFun` tNat `tFun` tA `tFun` tUnit
+         $  \tA -> tBuffer tA `tFun` tNat `tFun` tA `tFun` tUnit
 
         -- vwriteN# :: [a : Data]. Vector# a -> Nat# -> VecN# a -> Unit
         OpStoreWriteVector n
          -> tForall kData 
-         $  \tA -> tVector tA `tFun` tNat `tFun` tVec n tA `tFun` tUnit
+         $  \tA -> tBuffer tA `tFun` tNat `tFun` tVec n tA `tFun` tUnit
 
         -- vtail$N# :: [k : Rate]. [a : Data]. RateNat (TailN k) -> Vector# a -> Vector# a
         OpStoreTailVector n
@@ -153,7 +159,18 @@
          -> tForall kData 
          $  \tA -> tNat `tFun` tVector tA `tFun` tUnit
 
+        -- vbuf#   :: [a : Data]. Vector# a -> Buffer# a
+        OpStoreBufOfVector
+         -> tForall kData 
+         $  \tA -> tVector tA `tFun` tBuffer tA
 
+        -- vbufofratevec#   :: [k : Rate]. [a : Data]. RateVec# k a -> Buffer# a
+        OpStoreBufOfRateVec
+         -> tForalls [kRate, kData]
+         $  \[tK, tA] -> tRateVec tK tA `tFun` tBuffer tA
+
+
+
 -- Compounds ------------------------------------------------------------------
 xNew :: Type Name -> Exp () Name -> Exp () Name
 xNew t xV
@@ -225,6 +242,18 @@
 xTruncVector tElem xLen xArr
  = xApps (xVarOpStore OpStoreTruncVector)
          [XType tElem, xLen, xArr]
+
+xBufOfVector :: Type Name -> Exp () Name -> Exp () Name
+xBufOfVector tElem xArr
+ = xApps (xVarOpStore OpStoreBufOfVector)
+         [XType tElem, xArr]
+
+xBufOfRateVec :: Type Name -> Type Name -> Exp () Name -> Exp () Name
+xBufOfRateVec tRate tElem xArr
+ = xApps (xVarOpStore OpStoreBufOfRateVec)
+         [XType tRate, XType tElem, xArr]
+
+
 
 
 -- Utils ----------------------------------------------------------------------
diff --git a/DDC/Core/Flow/Prim/OpVector.hs b/DDC/Core/Flow/Prim/OpVector.hs
--- a/DDC/Core/Flow/Prim/OpVector.hs
+++ b/DDC/Core/Flow/Prim/OpVector.hs
@@ -6,15 +6,16 @@
 import DDC.Core.Flow.Prim.TyConFlow
 import DDC.Core.Flow.Prim.TyConPrim
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 import DDC.Base.Pretty
 import Control.DeepSeq
 import Data.List
 import Data.Char        
 
 
-instance NFData OpVector
+instance NFData OpVector where
+ rnf !_ = ()
 
 
 instance Pretty OpVector where
@@ -30,7 +31,9 @@
         OpVectorGenerate          -> text "vgenerate"             <> text "#"
         OpVectorLength            -> text "vlength"               <> text "#"
 
+        OpVectorGather            -> text "vgather"               <> text "#"
 
+
 -- | Read a data flow operator name.
 readOpVector :: String -> Maybe OpVector
 readOpVector str
@@ -47,6 +50,7 @@
                 "vreduce#"      -> Just $ OpVectorReduce
                 "vgenerate#"    -> Just $ OpVectorGenerate
                 "vlength#"      -> Just $ OpVectorLength
+                "vgather#"      -> Just $ OpVectorGather
                 _               -> Nothing
 
 
@@ -120,6 +124,13 @@
         OpVectorLength
          -> Just $ tForalls [kData] $ \[tA] 
                 -> tVector tA `tFun` tNat
+
+        -- gather   :: [a : Data]. Vector a -> Vector Nat# -> Vector a
+        OpVectorGather
+         -> Just $ tForalls [kData] $ \[tA] 
+                ->     tVector tA
+                `tFun` tVector tNat
+                `tFun` tVector tA
 
         _ -> Nothing
 
diff --git a/DDC/Core/Flow/Prim/TyConFlow.hs b/DDC/Core/Flow/Prim/TyConFlow.hs
--- a/DDC/Core/Flow/Prim/TyConFlow.hs
+++ b/DDC/Core/Flow/Prim/TyConFlow.hs
@@ -9,12 +9,17 @@
         , isSeriesType
         , isRefType
         , isVectorType
+        , isRateVecType
+        , isBufferType
+        , isProcessType
 
           -- * Compounds
         , tTuple1
         , tTuple2
         , tTupleN
         , tVector
+        , tBuffer
+        , tRateVec
         , tSeries
         , tSegd
         , tSel1
@@ -22,37 +27,46 @@
         , tRef
         , tWorld
         , tRateNat
+        , tRateAppend
+        , tRateCross
         , tDown
         , tTail
-        , tProcess)
+        , tProcess
+        , tResize)
 where
 import DDC.Core.Flow.Prim.KiConFlow
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 import DDC.Base.Pretty
 import Control.DeepSeq
 import Data.Char
 import Data.List
 
 
-instance NFData TyConFlow
+instance NFData TyConFlow where
+ rnf !_ = ()
 
 
 instance Pretty TyConFlow where
  ppr dc
   = case dc of
-        TyConFlowTuple n        -> text "Tuple" <> int n <> text "#"
+        TyConFlowTuple n        -> text "Tuple"   <> int n <> text "#"
+        TyConFlowBuffer         -> text "Buffer#"
         TyConFlowVector         -> text "Vector#"
+        TyConFlowRateVec        -> text "RateVec#"
         TyConFlowSeries         -> text "Series#"
         TyConFlowSegd           -> text "Segd#"
-        TyConFlowSel n          -> text "Sel"   <> int n <> text "#"
+        TyConFlowSel n          -> text "Sel"     <> int n <> text "#"
         TyConFlowRef            -> text "Ref#"
         TyConFlowWorld          -> text "World#"
         TyConFlowRateNat        -> text "RateNat#"
-        TyConFlowDown n         -> text "Down"  <> int n <> text "#"
-        TyConFlowTail n         -> text "Tail"  <> int n <> text "#"
+        TyConFlowRateCross      -> text "RateCross#"
+        TyConFlowRateAppend     -> text "RateAppend#"
+        TyConFlowDown n         -> text "Down"    <> int n <> text "#"
+        TyConFlowTail n         -> text "Tail"    <> int n <> text "#"
         TyConFlowProcess        -> text "Process#"
+        TyConFlowResize         -> text "Resize#"
 
 
 -- | Read a type constructor name.
@@ -78,14 +92,19 @@
 
         | otherwise
         = case str of
+                "Buffer#"       -> Just $ TyConFlowBuffer
                 "Vector#"       -> Just $ TyConFlowVector
+                "RateVec#"      -> Just $ TyConFlowRateVec
                 "Series#"       -> Just $ TyConFlowSeries
                 "Segd#"         -> Just $ TyConFlowSegd
                 "Sel1#"         -> Just $ TyConFlowSel 1
                 "Ref#"          -> Just $ TyConFlowRef
                 "World#"        -> Just $ TyConFlowWorld
                 "RateNat#"      -> Just $ TyConFlowRateNat
+                "RateCross#"    -> Just $ TyConFlowRateCross
+                "RateAppend#"   -> Just $ TyConFlowRateAppend
                 "Process#"      -> Just $ TyConFlowProcess
+                "Resize#"       -> Just $ TyConFlowResize
                 _               -> Nothing
 
 
@@ -95,16 +114,21 @@
 kindTyConFlow tc
  = case tc of
         TyConFlowTuple n        -> foldr kFun kData (replicate n kData)
-        TyConFlowVector         -> kData `kFun` kData
-        TyConFlowSeries         -> kRate `kFun` kData `kFun` kData
+        TyConFlowBuffer         -> kData `kFun` kData
+        TyConFlowVector         ->              kData `kFun` kData
+        TyConFlowRateVec        -> kRate `kFun` kData `kFun` kData
+        TyConFlowSeries         -> kProc `kFun` kRate `kFun` kData `kFun` kData
         TyConFlowSegd           -> kRate `kFun` kRate `kFun` kData
-        TyConFlowSel n          -> foldr kFun kData (replicate (n + 1) kRate)
+        TyConFlowSel n          -> kProc `kFun` foldr kFun kData (replicate (n + 1) kRate)
         TyConFlowRef            -> kData `kFun` kData
         TyConFlowWorld          -> kData
         TyConFlowRateNat        -> kRate `kFun` kData
+        TyConFlowRateCross      -> kRate `kFun` kRate `kFun` kRate
+        TyConFlowRateAppend     -> kRate `kFun` kRate `kFun` kRate
         TyConFlowDown{}         -> kRate `kFun` kRate
         TyConFlowTail{}         -> kRate `kFun` kRate
-        TyConFlowProcess        -> kData
+        TyConFlowProcess        -> kProc `kFun` kRate `kFun` kData
+        TyConFlowResize         -> kProc `kFun` kRate `kFun` kRate `kFun` kData
 
 
 -- Predicates -----------------------------------------------------------------
@@ -120,11 +144,11 @@
 isSeriesType :: Type Name -> Bool
 isSeriesType tt
  = case takePrimTyConApps tt of
-        Just (NameTyConFlow TyConFlowSeries, [_, _]) -> True
-        _                                            -> False
+        Just (NameTyConFlow TyConFlowSeries, [_, _, _]) -> True
+        _                                               -> False
 
 
--- | Check is some type is a fully applied type of a Ref.
+-- | Check if some type is a fully applied type of a Ref.
 isRefType :: Type Name -> Bool
 isRefType tt
  = case takePrimTyConApps tt of
@@ -132,7 +156,7 @@
         _                                            -> False
 
 
--- | Check is some type is a fully applied type of a Vector.
+-- | Check if some type is a fully applied type of a Vector.
 isVectorType :: Type Name -> Bool
 isVectorType tt
  = case takePrimTyConApps tt of
@@ -140,6 +164,29 @@
         _                                            -> False
 
 
+-- | Check if some type is a fully applied type of a Buffer.
+isBufferType :: Type Name -> Bool
+isBufferType tt
+ = case takePrimTyConApps tt of
+        Just (NameTyConFlow TyConFlowBuffer, [_])    -> True
+        _                                            -> False
+
+-- | Check if some type is a fully applied type of a RateVec.
+isRateVecType :: Type Name -> Bool
+isRateVecType tt
+ = case takePrimTyConApps tt of
+        Just (NameTyConFlow TyConFlowRateVec, [_, _])-> True
+        _                                            -> False
+
+-- | Check if some type is a fully applied Process.
+isProcessType :: Type Name -> Bool
+isProcessType tt
+ = case takePrimTyConApps tt of
+        Just (NameTyConFlow TyConFlowProcess, [_, _]) -> True
+        _                                             -> False
+
+
+
 -- Compounds ------------------------------------------------------------------
 tTuple1 :: Type Name -> Type Name
 tTuple1 tA      = tApps (tConTyConFlow (TyConFlowTuple 1)) [tA]
@@ -153,24 +200,31 @@
 tTupleN tys     = tApps (tConTyConFlow (TyConFlowTuple (length tys))) tys
 
 
-tVector :: Type Name -> Type Name
+tBuffer :: Type Name -> Type Name
+tBuffer tA      = tApps (tConTyConFlow TyConFlowBuffer)    [tA]
+
+
+tVector ::  Type Name -> Type Name
 tVector tA      = tApps (tConTyConFlow TyConFlowVector)    [tA]
 
+tRateVec :: Type Name -> Type Name -> Type Name
+tRateVec tK tA = tApps (tConTyConFlow TyConFlowRateVec)  [tK, tA]
 
-tSeries :: Type Name -> Type Name -> Type Name
-tSeries tK tA   = tApps (tConTyConFlow TyConFlowSeries)    [tK, tA]
 
+tSeries :: Type Name -> Type Name -> Type Name -> Type Name
+tSeries tP tK tA   = tApps (tConTyConFlow TyConFlowSeries)    [tP, tK, tA]
 
+
 tSegd :: Type Name -> Type Name -> Type Name
 tSegd tK1 tK2   = tApps (tConTyConFlow TyConFlowSegd)      [tK1, tK2]
 
 
-tSel1 :: Type Name -> Type Name -> Type Name
-tSel1 tK1 tK2   = tApps (tConTyConFlow $ TyConFlowSel 1) [tK1, tK2]
+tSel1 :: Type Name -> Type Name -> Type Name -> Type Name
+tSel1 tP tK1 tK2   = tApps (tConTyConFlow $ TyConFlowSel 1) [tP, tK1, tK2]
 
 
-tSel2 :: Type Name -> Type Name -> Type Name -> Type Name
-tSel2 tK1 tK2 tK3 = tApps (tConTyConFlow $ TyConFlowSel 2) [tK1, tK2, tK3]
+tSel2 :: Type Name -> Type Name -> Type Name -> Type Name -> Type Name
+tSel2 tP tK1 tK2 tK3 = tApps (tConTyConFlow $ TyConFlowSel 2) [tP, tK1, tK2, tK3]
 
 
 tRef  :: Type Name -> Type Name
@@ -184,7 +238,14 @@
 tRateNat :: Type Name -> Type Name
 tRateNat tK     = tApp (tConTyConFlow TyConFlowRateNat)  tK
 
+tRateCross :: Type Name -> Type Name -> Type Name
+tRateCross tKa tKb = tConTyConFlow TyConFlowRateCross `tApps` [tKa, tKb]
 
+tRateAppend :: Type Name -> Type Name -> Type Name
+tRateAppend tKa tKb = tConTyConFlow TyConFlowRateAppend `tApps` [tKa, tKb]
+
+
+
 tDown :: Int -> Type Name -> Type Name 
 tDown n tK      = tApp (tConTyConFlow $ TyConFlowDown n) tK
 
@@ -193,8 +254,13 @@
 tTail n tK      = tApp (tConTyConFlow $ TyConFlowTail n) tK
 
 
-tProcess :: Type Name 
-tProcess = tConTyConFlow $ TyConFlowProcess
+tProcess :: Type Name -> Type Name -> Type Name 
+tProcess tP tK = (tConTyConFlow TyConFlowProcess) `tApps` [tP, tK]
+
+tResize  :: Type Name -> Type Name -> Type Name -> Type Name 
+tResize  tP tJ tK = (tConTyConFlow TyConFlowResize) `tApps` [tP, tJ, tK]
+
+
 
 
 -- Utils ----------------------------------------------------------------------
diff --git a/DDC/Core/Flow/Prim/TyConPrim.hs b/DDC/Core/Flow/Prim/TyConPrim.hs
--- a/DDC/Core/Flow/Prim/TyConPrim.hs
+++ b/DDC/Core/Flow/Prim/TyConPrim.hs
@@ -10,8 +10,8 @@
         , tVec)
 where
 import DDC.Core.Flow.Prim.Base
-import DDC.Core.Compounds.Simple
-import DDC.Core.Exp.Simple
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
 
 
 -- | Yield the kind of a type constructor.
@@ -19,16 +19,17 @@
 kindPrimTyCon tc
  = case tc of
         PrimTyConVoid    -> kData
-        PrimTyConPtr     -> (kRegion `kFun` kData `kFun` kData)
+        PrimTyConPtr     -> kRegion `kFun` kData `kFun` kData
         PrimTyConAddr    -> kData
         PrimTyConBool    -> kData
         PrimTyConNat     -> kData
         PrimTyConInt     -> kData
+        PrimTyConSize    -> kData
         PrimTyConWord  _ -> kData
         PrimTyConFloat _ -> kData
         PrimTyConTag     -> kData
+        PrimTyConTextLit -> kData
         PrimTyConVec   _ -> kData `kFun` kData
-        PrimTyConString  -> kData
 
 
 -- Compounds ------------------------------------------------------------------
diff --git a/DDC/Core/Flow/Procedure.hs b/DDC/Core/Flow/Procedure.hs
--- a/DDC/Core/Flow/Procedure.hs
+++ b/DDC/Core/Flow/Procedure.hs
@@ -15,15 +15,13 @@
 import DDC.Core.Flow.Exp
 import DDC.Core.Flow.Prim
 import DDC.Core.Flow.Context
-import Data.Monoid
 
 
 -- | An imperative procedure made up of some loops.
 data Procedure
         = Procedure
         { procedureName         :: Name
-        , procedureParamTypes   :: [BindF]
-        , procedureParamValues  :: [BindF]
+        , procedureParamFlags   :: [(Bool,BindF)]
         , procedureNest         :: Nest }
 
 -- | A loop nest.
@@ -39,8 +37,7 @@
         , nestStart             :: [StmtStart]
         , nestBody              :: [StmtBody]
         , nestInner             :: Nest
-        , nestEnd               :: [StmtEnd] 
-        , nestResult            :: Exp () Name }
+        , nestEnd               :: [StmtEnd] }
 
         -- Guarded context, 
         -- used when lowering pack-like operations.
@@ -168,5 +165,5 @@
         | EndVecTrunc
         { endVecName            :: Name
         , endVecType            :: Type Name
-        , endVecRate            :: Type Name }
+        , endVecAcc             :: Bound Name }
         deriving Show
diff --git a/DDC/Core/Flow/Process.hs b/DDC/Core/Flow/Process.hs
--- a/DDC/Core/Flow/Process.hs
+++ b/DDC/Core/Flow/Process.hs
@@ -1,7 +1,6 @@
 
 module DDC.Core.Flow.Process
         ( Process       (..)
-        , typeOfProcess
 
         , Operator      (..))
 where
diff --git a/DDC/Core/Flow/Process/Operator.hs b/DDC/Core/Flow/Process/Operator.hs
--- a/DDC/Core/Flow/Process/Operator.hs
+++ b/DDC/Core/Flow/Process/Operator.hs
@@ -1,6 +1,7 @@
 
 module DDC.Core.Flow.Process.Operator
-        (Operator (..))
+        ( Operator (..)
+        , bindOfOp)
 where
 import DDC.Core.Flow.Exp
 
@@ -112,6 +113,9 @@
           -- Rate of input and output series.
         , opInputRate           :: TypeF
 
+          -- Rate of input vector series.
+        , opVectorRate          :: TypeF
+
           -- Type of gathered elements.
         , opElemType            :: TypeF 
         }
@@ -182,6 +186,22 @@
         , opElemType            :: TypeF }
 
         -----------------------------------------
+        -- | Generate a new Series, with elements based on index
+        | OpGenerate
+        { -- Binder for result series.
+          opResultSeries        :: BindF
+
+          -- Rate of output series.
+        , opOutputRate          :: TypeF
+
+          -- Worker parameter for function index input.
+        , opWorkerParamIndex    :: BindF
+
+          -- Worker body.
+        , opWorkerBody          :: ExpF
+        }
+
+        -----------------------------------------
         -- | Reduce the elements of a series into a reference.
         | OpReduce
         { -- Binder for result value (a Unit)
@@ -208,5 +228,66 @@
           -- Worker body.
         , opWorkerBody          :: ExpF
         }
-        deriving Show
 
+        -----------------------------------------
+        -- | Convert a series from a vector
+        | OpSeriesOfRateVec
+        { -- Binder for result series.
+          opResultSeries        :: BindF
+
+          -- Rate of the input series.
+        , opInputRate           :: TypeF
+
+          -- Bound of the input vector
+        , opInputRateVec        :: BoundF
+
+          -- Type of the elements.
+        , opElemType            :: TypeF
+        }
+
+        -----------------------------------------
+        -- | Use an existing series passed in as argument
+        | OpSeriesOfArgument
+        { -- Binder for result series.
+          opResultSeries        :: BindF
+
+          -- Rate of the input series.
+        , opInputRate           :: TypeF
+
+          -- Type of the elements.
+        , opElemType            :: TypeF
+        }
+
+
+        deriving (Show, Eq)
+
+bindOfOp :: Operator -> BindF
+bindOfOp o
+ = case o of
+    OpId{}
+     -> opResultSeries o
+    OpRep{}
+     -> opResultSeries o
+    OpReps{}
+     -> opResultSeries o
+    OpIndices{}
+     -> opResultSeries o
+    OpMap{}
+     -> opResultSeries o
+    OpPack{}
+     -> opResultSeries o
+    OpGenerate{}
+     -> opResultSeries o
+    OpSeriesOfRateVec{}
+     -> opResultSeries o
+    OpSeriesOfArgument{}
+     -> opResultSeries o
+
+    OpFill{}
+     -> opResultBind o
+    OpGather{}
+     -> opResultBind o
+    OpScatter{}
+     -> opResultBind o
+    OpReduce{}
+     -> opResultBind o
diff --git a/DDC/Core/Flow/Process/Pretty.hs b/DDC/Core/Flow/Process/Pretty.hs
--- a/DDC/Core/Flow/Process/Pretty.hs
+++ b/DDC/Core/Flow/Process/Pretty.hs
@@ -2,6 +2,7 @@
 module DDC.Core.Flow.Process.Pretty where
 import DDC.Core.Flow.Process.Process
 import DDC.Core.Flow.Process.Operator
+import DDC.Core.Flow.Context
 import DDC.Base.Pretty
 import DDC.Core.Pretty          ()
 
@@ -10,10 +11,43 @@
  ppr p
   = vcat
   $     [ ppr (processName p)
-        , text "  parameters:    " <> ppr (processParamValues p) ]
-        ++ map (indent 2 . ppr) (processOperators p)
+        , text "  parameters:    " <> ppr (processParamFlags p) 
+        , indent 2 $ ppr $ processContext p ]
 
 
+instance Pretty Context where
+ ppr cc
+  = case cc of
+    ContextRate{}
+       -> vcat
+        $ [ text "Rate " <> ppr (contextRate cc) ]
+          ++ ops
+          ++ inner
+    ContextSelect{}
+       -> vcat
+        $ [ text "Select " <> ppr (contextInnerRate cc) <> text " <= " <> ppr (contextOuterRate cc)
+          , text " flags: " <> ppr (contextFlags cc) 
+          , text " sel:   " <> ppr (contextSelector cc) ]
+          ++ ops
+          ++ inner
+    ContextSegment{}
+       -> vcat
+        $ [ text "Segment " <> ppr (contextInnerRate cc) <> text " <= " <> ppr (contextOuterRate cc)
+          , text " lens:  " <> ppr (contextLens cc) 
+          , text " segd:  " <> ppr (contextSegd cc) ]
+          ++ ops
+          ++ inner
+    ContextAppend{}
+       -> vcat
+        $ [ text "Append " <> ppr (contextRate1 cc) <> text " " <> ppr (contextRate2 cc)
+          , indent 2 $ ppr $ contextInner1 cc
+          , indent 2 $ ppr $ contextInner2 cc ]
+
+  where
+   ops = map (indent 2 . ppr) (contextOps cc)
+   inner = map (indent 2 . ppr) (contextInner cc)
+
+
 instance Pretty Operator where
  ppr op@OpId{}
         = vcat
@@ -70,6 +104,11 @@
         , text " rate:    "     <> ppr (opInputRate     op)
         , text " type:    "     <> ppr (opElemType      op) ]
 
+ ppr op@OpGenerate{}
+        = vcat
+        [ text "Generate"
+        , text " rate:    "     <> ppr (opOutputRate    op) ]
+
  ppr op@OpReduce{}
         = vcat
         [ text "Reduce"
@@ -79,10 +118,26 @@
  ppr op@OpMap{}
         = vcat
         [ text "Map"
-        , text " rate:    "     <> ppr (opInputRate     op) ]
+        , text " rate:    "     <> ppr (opInputRate     op)
+        , text " result:  "     <> ppr (opResultSeries  op) ]
 
  ppr op@OpPack{}
         = vcat
         [ text "Pack"
         , text " input  rate: " <> ppr (opInputRate     op) 
         , text " output rate: " <> ppr (opOutputRate    op) ]
+
+ ppr op@OpSeriesOfRateVec{}
+        = vcat
+        [ text "SeriesOfRateVec"
+        , text " rate:    "     <> ppr (opInputRate     op)
+        , text " input:   "     <> ppr (opInputRateVec  op)
+        , text " result:  "     <> ppr (opResultSeries  op) ]
+
+ ppr op@OpSeriesOfArgument{}
+        = vcat
+        [ text "SeriesOfArgument"
+        , text " rate:    "     <> ppr (opInputRate     op)
+        , text " result:  "     <> ppr (opResultSeries  op) ]
+
+
diff --git a/DDC/Core/Flow/Process/Process.hs b/DDC/Core/Flow/Process/Process.hs
--- a/DDC/Core/Flow/Process/Process.hs
+++ b/DDC/Core/Flow/Process/Process.hs
@@ -1,10 +1,7 @@
 
 module DDC.Core.Flow.Process.Process
-        ( Process       (..)
-        , typeOfProcess)
+        ( Process       (..))
 where
-import DDC.Core.Flow.Process.Operator
-import DDC.Core.Flow.Compounds
 import DDC.Core.Flow.Context
 import DDC.Core.Flow.Prim
 import DDC.Core.Flow.Exp
@@ -19,32 +16,20 @@
           --   source code.
           processName           :: Name
 
-          -- | Type parameters to process.
-          --   These are the type parameters of the original function.
-        , processParamTypes     :: [BindF]
+          -- | Proc type
+        , processProcType       :: TypeF
 
-          -- | Value parameters to process.
-          --   These are the value parameters of the original function.
-        , processParamValues    :: [BindF]
+          -- | Rate of process loop
+        , processLoopRate       :: TypeF
 
-          -- | Flow contexts in this process.
+          -- | Parameters to process.
+          --   These are the parameters of the original function, with flag being true for types.
+        , processParamFlags     :: [(Bool, BindF)]
+
+          -- | Flow context in this process.
           --   This contains a ContextRate entry for all the Rate variables
           --   in the parameters, along with an entry for all the nested
           --   contexts introduced by the process itself.
-        , processContexts       :: [Context]
-
-          -- | Flow operators in this process.
-        , processOperators      :: [Operator] 
+        , processContext        :: Context
         }
 
-
--- | Take the functional type of a process.
-typeOfProcess :: Process -> TypeF
-typeOfProcess process
- = let  tBody   = foldr tFun tProcess
-                $ map typeOfBind (processParamValues process)
-
-        tQuant  = foldr TForall tBody
-                $ processParamTypes process
-
-   in   tQuant
diff --git a/DDC/Core/Flow/Profile.hs b/DDC/Core/Flow/Profile.hs
--- a/DDC/Core/Flow/Profile.hs
+++ b/DDC/Core/Flow/Profile.hs
@@ -28,7 +28,8 @@
         , profilePrimKinds              = primKindEnv
         , profilePrimTypes              = primTypeEnv
         , profileTypeIsUnboxed          = const False 
-        , profileNameIsHole             = Nothing }
+        , profileNameIsHole             = Nothing 
+        , profileMakeStringName         = Nothing }
 
 
 features :: Features
@@ -39,10 +40,13 @@
         , featuresFunctionalEffects     = False
         , featuresFunctionalClosures    = False
         , featuresEffectCapabilities    = False
+        , featuresImplicitRun           = False
+        , featuresImplicitBox           = False
         , featuresPartialPrims          = True
         , featuresPartialApplication    = True
         , featuresGeneralApplication    = True
         , featuresNestedFunctions       = True
+        , featuresGeneralLetRec         = False
         , featuresDebruijnBinders       = True
         , featuresUnboundLevel0Vars     = False
         , featuresUnboxedInstantiation  = True
@@ -60,7 +64,7 @@
  where rn (Token strTok sp) 
         = case renameTok readName strTok of
                 Just t' -> Token t' sp
-                Nothing -> Token (KJunk "lexical error") sp
+                Nothing -> Token (KErrorJunk "lexical error") sp
 
 
 -- | Lex a string to tokens, using primitive names.
@@ -72,7 +76,7 @@
  where rn (Token strTok sp) 
         = case renameTok readName strTok of
                 Just t' -> Token t' sp
-                Nothing -> Token (KJunk "lexical error") sp
+                Nothing -> Token (KErrorJunk "lexical error") sp
 
 
 -- | Create a new type variable name that is not in the given environment.
diff --git a/DDC/Core/Flow/Transform/Concretize.hs b/DDC/Core/Flow/Transform/Concretize.hs
--- a/DDC/Core/Flow/Transform/Concretize.hs
+++ b/DDC/Core/Flow/Transform/Concretize.hs
@@ -37,24 +37,24 @@
         -- loop# -> loopn#
         -- using the length of a series to get the rate.
         | Just ( NameOpControl OpControlLoop
-               , [XType tK, xF]) <- takeXPrimApps xx
-        , Just (nS, _, tA)       <- findSeriesWithRate tenv tK
-        , xS                     <- XVar (UName nS)
+               , [XType tK, xF])   <- takeXPrimApps xx
+        , Just (nS, tP, _, tA)     <- findSeriesWithRate tenv tK
+        , xS                       <- XVar (UName nS)
         = Just 
         $ xLoopN 
                 tK                              -- type level rate
-                (xRateOfSeries tK tA xS)        -- 
+                (xRateOfSeries tP tK tA xS)  -- 
                 xF                              -- loop body
 
         -- newVectorR# -> newVector#
         | Just ( NameOpStore OpStoreNewVectorR
                , [XType tA, XType tK])  <- takeXPrimApps xx
-        , Just (nS, _, tS)      <- findSeriesWithRate tenv tK
-        , xS                    <- XVar (UName nS)
+        , Just (nS, tP, _, tS)          <- findSeriesWithRate tenv tK
+        , xS                            <- XVar (UName nS)
         = Just
         $ xNewVector
                 tA
-                (xNatOfRateNat tK $ xRateOfSeries tK tS xS)
+                (xNatOfRateNat tK $ xRateOfSeries tP tK tS xS)
                 
         | otherwise
         = Nothing
@@ -93,33 +93,33 @@
 
 -------------------------------------------------------------------------------
 -- | Search the given environment for the name of a series with the
---   given rate parameter. We only look at named binders.
+--   given result rate parameter. We only look at named binders.
 findSeriesWithRate 
         :: TypeEnvF             -- ^ Type Environment.
         -> Type Name            -- ^ Rate type.
-        -> Maybe (Name, Type Name, Type Name)
-                                -- ^ Series name, rate type, element type.
-findSeriesWithRate tenv tR
+        -> Maybe (Name, Type Name, Type Name, Type Name)
+        -- ^ Series name, process, result rate, element type.
+findSeriesWithRate tenv tK
  = go (Map.toList (Env.envMap tenv))
  where  go []           = Nothing
         go ((n, tS) : moar)
-         = case isSeriesTypeOfRate tR tS of
-                Nothing         -> go moar
-                Just (_, tA)    -> Just (n, tR, tA)
+         = case isSeriesTypeOfRate tK tS of
+                Nothing              -> go moar
+                Just (tP, _, tA) -> Just (n, tP, tK, tA)
 
 
 -- | Given a rate type and a stream type, check whether the stream
---   is of the given rate. If it is then return the rate and element
---   types, otherwise `Nothing`.
+--   is of the given result rate. If it is then return the process, result rate,
+--   loop rate and element types, otherwise `Nothing`.
 isSeriesTypeOfRate 
         :: Type Name -> Type Name 
-        -> Maybe (Type Name, Type Name)
+        -> Maybe (Type Name, Type Name, Type Name)
 
-isSeriesTypeOfRate tR tS
+isSeriesTypeOfRate tK tS
         | Just ( NameTyConFlow TyConFlowSeries
-               , [tR', tA])    <- takePrimTyConApps tS
-        , tR == tR'
-        = Just (tR, tA)
+               , [tP, tK', tA])    <- takePrimTyConApps tS
+        , tK == tK'
+        = Just (tP, tK, tA)
 
         | otherwise
         = Nothing
diff --git a/DDC/Core/Flow/Transform/Extract.hs b/DDC/Core/Flow/Transform/Extract.hs
--- a/DDC/Core/Flow/Transform/Extract.hs
+++ b/DDC/Core/Flow/Transform/Extract.hs
@@ -6,6 +6,7 @@
 import DDC.Core.Flow.Compounds
 import DDC.Core.Flow.Procedure
 import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Prim.OpStore
 import DDC.Core.Flow.Exp
 import DDC.Core.Transform.Annotate
 import DDC.Core.Module
@@ -27,15 +28,31 @@
 
 -- | Extract code for a whole procedure.
 extractProcedure  :: Procedure -> (Bind Name, ExpF)
-extractProcedure (Procedure n bsParam xsParam nest)
- = let  tBody   = foldr tFun    tUnit $ map typeOfBind xsParam
-        tQuant  = foldr TForall tBody $ bsParam
-   in   ( BName n tQuant
-        ,   xLAMs bsParam
-          $ xLams xsParam
+extractProcedure (Procedure n params nest)
+ = let  
+        tyOfFlags (True,  b) rest
+            = TForall b rest
+        tyOfFlags (False, b) rest
+            = tFun    (typeOfBind b) rest
+
+        tBody   = foldr tyOfFlags tUnit $ params
+   in   ( BName n tBody
+        ,   makeXLamFlags params
+          $ xLets (concatMap vecBuffers $ map snd $ filter (not.fst) params)
           $ extractNest nest xUnit )
 
+vecBuffers
+        :: BindF
+        -> [LetsF]
+vecBuffers (BName n t)
+ | isVectorType t
+ , Just (_, [t']) <- takePrimTyConApps t
+ = [ LLet (BName (NameVarMod n "buf") (tBuffer t'))
+          (xBufOfVector t' $ XVar $ UName n) ]
 
+vecBuffers _
+ = []
+
 -------------------------------------------------------------------------------
 -- | Extract code for a loop nest.
 extractNest 
@@ -52,7 +69,7 @@
 extractLoop      :: Nest -> [LetsF]
 
 -- Code in the top-level loop context.
-extractLoop (NestLoop tRate starts bodys inner ends _result)
+extractLoop (NestLoop tRate starts bodys inner ends)
  = let  
         -- Starting statements.
         lsStart = concatMap extractStmtStart starts
@@ -81,19 +98,15 @@
    in   lsStart ++ [lLoop] ++ lsEnd
 
 -- Code in a guard context.
-extractLoop (NestGuard _tRateOuter tRateInner uFlags stmtsBody nested)
+extractLoop (NestGuard _tRateOuter _tRateInner uFlags stmtsBody nested)
  = let
         -- Get the name of a single flag from the series of flags.
         UName nFlags    = uFlags
         nFlag           = NameVarMod nFlags "elem"
         xFlag           = XVar (UName nFlag)
 
-        -- Get the name of the entry counter.
-        TVar (UName nK) = tRateInner
-        uCounter        = UName (NameVarMod nK "count")
-
-        xBody           = xGuard (XVar uCounter) xFlag 
-                          (  XLam (BAnon tNat)
+        xBody           = xGuard xFlag 
+                          (  XLam (BNone tUnit)
                           $ xLets (lsBody ++ lsNested) xUnit)
 
         -- Statements in the guard context.
@@ -105,20 +118,15 @@
   in    [LLet (BNone tUnit) xBody]
 
 -- Code in a segment context.
-extractLoop (NestSegment _tRateOuter tRateInner uLengths stmtsBody nested)
+extractLoop (NestSegment _tRateOuter _tRateInner uLengths stmtsBody nested)
  = let
         -- Get the name of a single segment length from the series of lengths.
         UName nLengths  = uLengths
         nLength         = NameVarMod nLengths "elem"
         xLength         = XVar (UName nLength)
 
-        -- Get the name of the entry counter.
-        TVar (UName nK) = tRateInner
-        uCounter        = UName (NameVarMod nK "count")
-
-        xBody           = xSegment (XVar uCounter) xLength 
+        xBody           = xSegment xLength 
                         (  XLam (BAnon tNat)    -- Index into current segment.
-                        $  XLam (BAnon tNat)    -- Index into overall result series.
                         $ xLets (lsBody ++ lsNested) xUnit)
 
         -- Statements in the segment context.
@@ -170,7 +178,7 @@
         -- Write to a vector.
         BodyVecWrite nVec tElem xIx xVal
          -> [ LLet (BNone tUnit)
-                   (xWriteVector tElem (XVar (UName nVec)) xIx xVal)]
+                   (xWriteVector tElem (XVar (UName $ NameVarMod nVec "buf")) xIx xVal)]
 
         -- Read from an accumulator.
         BodyAccRead  n t bVar
@@ -198,11 +206,9 @@
                   (xRead t (XVar (UName nAcc))) ]
 
         -- Truncate a vector down to its final size.
-        EndVecTrunc nVec tElem tRate 
+        EndVecTrunc nVec tElem uCounter 
          -> let 
                 -- Get the name of the counter.
-                TVar (UName nK) = tRate
-                uCounter        = UName (NameVarMod nK "count")
                 xCounter        = xRead tNat (XVar uCounter)
                 xVec            = XVar (UName nVec)
 
diff --git a/DDC/Core/Flow/Transform/Forward.hs b/DDC/Core/Flow/Transform/Forward.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Forward.hs
@@ -0,0 +1,68 @@
+module DDC.Core.Flow.Transform.Forward
+        ( forwardProcesses )
+where
+import DDC.Core.Flow.Profile
+import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Prim.KiConFlow
+import DDC.Core.Flow.Prim.TyConFlow
+import DDC.Core.Exp.Annot
+import DDC.Core.Module
+import qualified DDC.Core.Simplifier                    as C
+
+import qualified DDC.Core.Transform.Forward             as Forward
+import qualified DDC.Core.Transform.TransformModX       as T
+
+-- | Find all top-level Process bindings, and forward all non-series operators.
+-- This is a bit of a hack, because lower doesn't accept any non-series bindings.
+forwardProcesses :: Module () Name -> Module () Name
+forwardProcesses mm
+ = T.transformModLet forwardBind mm
+
+
+-- | Forward a single process binding
+forwardBind :: Bind Name -> Exp () Name -> Exp () Name
+forwardBind b xx
+
+ -- If the result type of a top-level binding is a Process,
+ -- we must prepare it for the lowering transform.
+ -- Forward everything we can, while leaving series operators at the top.
+ | isProcessType $ snd $ takeTFunAllArgResult $ typeOfBind b
+ = C.result $ Forward.forwardX profile conf_process xx
+
+ -- Otherwise do minimal forwarding, except for pushing any rate-valued functions
+ -- into their runKernel#.
+ | otherwise
+ = C.result $ Forward.forwardX profile conf_nonproc xx
+ where
+  conf_process = Forward.Config isFloatable_process False
+  conf_nonproc = Forward.Config isFloatable_nonproc False
+
+  -- Deny forwarding of flow primitives.
+  -- Force anything else that's used only once.
+  --
+  -- For lower to work, we need to forward everything except primitives,
+  -- but that duplicates work. Lower should probably be changed.
+  isFloatable_process lts
+     = case lts of
+        LLet (BName _ _) x
+          | Just (n,_) <- takeXPrimApps x
+          -> case n of
+             NameOpConcrete _   -> Forward.FloatDeny
+             NameOpControl  _   -> Forward.FloatDeny
+             NameOpSeries   _   -> Forward.FloatDeny
+             NameOpStore    _   -> Forward.FloatDeny
+             NameOpVector   _   -> Forward.FloatDeny
+
+             _                  -> Forward.FloatForceUsedOnce
+        _ -> Forward.FloatForceUsedOnce
+
+
+  -- Forward any Process functions - they will have Rate foralls inside them.
+  isFloatable_nonproc lts
+     = case lts of
+        LLet _ x
+          | Just (lams,_) <- takeXLamFlags x
+          , any (\(_,bo) -> typeOfBind bo == kRate) lams
+          -> Forward.FloatForce
+        _ -> Forward.FloatAllow
+
diff --git a/DDC/Core/Flow/Transform/Melt.hs b/DDC/Core/Flow/Transform/Melt.hs
--- a/DDC/Core/Flow/Transform/Melt.hs
+++ b/DDC/Core/Flow/Transform/Melt.hs
@@ -9,7 +9,7 @@
 import DDC.Core.Module
 import DDC.Core.Transform.Annotate
 import DDC.Core.Transform.Deannotate
-import Control.Monad.Writer.Strict
+import Control.Monad.Writer.Strict      hiding (Alt(..))
 import qualified Data.Set               as Set
 import Data.Set                         (Set)
 
@@ -153,14 +153,16 @@
 instance Melt (Lets () Name) where
  melt lts
   = case lts of
-        LLet b x        -> liftM (LLet b) (melt x)
+        LLet b x
+         -> liftM (LLet b) (melt x)
+
         LRec bxs        
          -> do  let (bs, xs) = unzip bxs
                 xs'      <- mapM melt xs
                 return   $  LRec $ zip bs xs'
 
-        LPrivate{}      -> return lts
-        LWithRegion{}   -> return lts
+        LPrivate{}
+         -> return lts
 
 
 -- Alt ------------------------------------------------------------------------
diff --git a/DDC/Core/Flow/Transform/Rates/Clusters.hs b/DDC/Core/Flow/Transform/Rates/Clusters.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Rates/Clusters.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE CPP #-}
+module DDC.Core.Flow.Transform.Rates.Clusters
+    (cluster)
+ where
+
+#if DDC_FLOW_HAVE_LINEAR_SOLVER
+import DDC.Core.Flow.Transform.Rates.Clusters.Linear
+
+cluster = solve_linear
+
+#else
+import DDC.Core.Flow.Transform.Rates.Clusters.Greedy
+
+cluster = cluster_greedy
+
+#endif
+
diff --git a/DDC/Core/Flow/Transform/Rates/Clusters/Base.hs b/DDC/Core/Flow/Transform/Rates/Clusters/Base.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Rates/Clusters/Base.hs
@@ -0,0 +1,37 @@
+module DDC.Core.Flow.Transform.Rates.Clusters.Base where
+import DDC.Core.Flow.Transform.Rates.Graph
+
+type TransducerMap n = n -> n -> Maybe (n,n)
+
+-- \forall paths p from u to v, fusion preventing \not\in p
+noFusionPreventingPath :: (Ord n) => [((n,n),Bool)] -> n -> n -> Bool
+noFusionPreventingPath arcs u v
+ -- for all paths, for all nodes in path, is fusible
+ =  all (all snd) (paths u v)
+ && all (all snd) (paths v u)
+ where
+  -- list of all paths from w to x
+  paths w x
+    | w == x
+    = [[]]
+    | otherwise
+    = let outs = filter (\((i,_j),_f) -> i == w) arcs
+      in  concatMap (\((w',j),f) -> map (((w',j),f):) (paths j x)) outs
+   
+
+-- | Check if two nodes may be fused based on type.
+-- If they have the same type, it's fine.
+-- If they have a different type, we must look for any common type transducer parents.
+typeComparable :: (Ord n, Eq t) => Graph n t -> TransducerMap n -> n -> n -> Bool
+typeComparable g trans a b
+ = case (nodeType g a, nodeType g b) of
+   (Just a', Just b')
+    -> if   a' == b'
+       then True
+       else case trans a b of
+                 Just _  -> True
+                 Nothing -> False
+   _
+    -> False
+
+
diff --git a/DDC/Core/Flow/Transform/Rates/Clusters/Greedy.hs b/DDC/Core/Flow/Transform/Rates/Clusters/Greedy.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Rates/Clusters/Greedy.hs
@@ -0,0 +1,126 @@
+module DDC.Core.Flow.Transform.Rates.Clusters.Greedy
+    (cluster_greedy)
+ where
+
+import DDC.Base.Pretty
+import DDC.Core.Flow.Transform.Rates.Graph
+import DDC.Core.Flow.Transform.Rates.Clusters.Base
+
+cluster_greedy :: (Ord n, Eq t, Show n, Pretty n) => Graph n t -> TransducerMap n -> [[n]]
+cluster_greedy g trans
+ -- First find a greedy vertical clustering, then merge any leftover horizontal opportunities
+ --
+ -- The clusters are built in reverse order, so fix them up.
+ = reverse
+ $ map reverse
+ $ fuse_rest vertical
+ where
+  -- Vertical fusion.
+  -- Go through the graph in topo order, inserting each node into a cluster
+  vertical
+   = foldl go_vertical []
+   $ graphTopoOrder g
+
+  -- Insert node n into the clusters ns
+  go_vertical ns n
+         -- Find the parent we'd like to fuse n into. It has to be a fusible edge.
+   = let parent = [ n' | (n',fusible) <- nodeInEdges g n, fusible]
+         -- The default unfused clustering to use if we can't merge n into parent
+         unfused  = [n] : ns
+     in  case parent of
+          -- There is no parent (that is fusible)
+          []
+           -> unfused
+          -- Check that n and n' are the same type (can be fused).
+          (n':_)
+           | tcmp n n'
+           -> case insert n n' ns of
+               Just ns' -> ns'
+               Nothing  -> unfused
+           | otherwise
+           -> unfused
+
+  -- Try to insert n into the same cluster as n'.
+  -- If n relies on output of clusters after n' (before in cs - list is reversed), we cannot put
+  -- n in the n' cluster.
+  -- Also check that there are no fusion-preventing paths between cluster and n.
+
+  -- We haven't seen n' yet and we're at the end, so can't put n into same cluster as n'
+  insert _n _n' []
+   = Nothing
+
+  insert n n' (c:cs) 
+   -- We've reached n' cluster.
+   -- If there are no fusion-preventing edges between n and these nodes, we can fuse.
+   | n' `elem` c
+   = if   any (not . checkPath n) c
+     then Nothing
+     else Just ((n:c) : cs)
+
+   -- If n relies on any of these nodes and we haven't reached n',
+   -- we won't be able to merge n with n'
+   -- (because it would not be able to execute without result of these nodes)
+   | any (edge n) c
+   = Nothing
+
+   | otherwise
+   = do cs' <- insert n n' cs
+        return (c : cs')
+
+
+  -- Do any leftover horizontal fusion that we can
+  fuse_rest [] = []
+  fuse_rest (c:cs)
+   = case try_merge c cs of
+      Nothing
+       -> c : fuse_rest cs
+      Just cs'
+       -> fuse_rest cs'
+
+  -- Nothing to merge s with
+  try_merge _ []
+   = Nothing
+
+  try_merge s (c:cs)
+   -- Can s and c be merged together?
+   | miscible s c
+   = if   all (\a -> all (checkPath a) s) c
+     then Just ((s ++ c) : cs)
+     else Nothing
+
+   -- s and c can't be merged together, but we can't move s any further back
+   | any (\a -> any (edge a) s) c
+   = Nothing
+
+   | otherwise
+   = do cs' <- try_merge s cs
+        return (c : cs')
+
+
+  -- Helper functions
+  edge a b = hasEdge g (a,b) || hasEdge g (b,a)
+
+  checkPath = noFusionPreventingPath arcs
+  arcs = snd $ listOfGraph g
+
+  tcmp = typeComparable g trans
+
+  -- Check if two clusters can be merged together
+  miscible s c
+   = let sc = s ++ c
+         -- For each a in c and b in s
+     in  all (\a -> all (\b ->
+           -- If a and b have same type, they can be merged fine
+           case (nodeType g a, nodeType g b) of
+                (Just ta, Just tb)
+                 -> if   ta == tb
+                    then True
+                    -- If they have different types, but share parent transducers,
+                    -- they can only be merged if they are merged with both parents.
+                    else case trans a b of
+                     Just (a',b')  -> a' `elem` sc && b' `elem` sc
+                     Nothing       -> False
+                _
+                  -> False
+            ) s) c
+
diff --git a/DDC/Core/Flow/Transform/Rates/Clusters/Linear.hs b/DDC/Core/Flow/Transform/Rates/Clusters/Linear.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Rates/Clusters/Linear.hs
@@ -0,0 +1,320 @@
+{-# LANGUAGE DataKinds #-}
+module DDC.Core.Flow.Transform.Rates.Clusters.Linear
+    (solve_linear)
+ where
+
+import DDC.Base.Pretty
+import DDC.Core.Flow.Transform.Rates.Graph
+import DDC.Core.Flow.Transform.Rates.Clusters.Base
+
+import qualified Data.Map  as Map
+
+import Numeric.Limp.Program.ResultKind
+import Numeric.Limp.Program
+import Numeric.Limp.Rep
+import Numeric.Limp.Solvers.Cbc.Solve
+
+import qualified Numeric.Limp.Canon.Convert as Conv
+import qualified Numeric.Limp.Canon.Simplify as CSimp
+
+
+-- | Get parent transducers of two nodes, if exists.
+-- | Integer-valued variable type for linear program
+--
+-- SameCluster i j  - {0,1} 0 if i and j are fused together
+--
+-- C n - 0 if node is fused with all its users. Minimising this is good for array contraction.
+--
+data ZVar n
+ = SameCluster n n
+ | C n
+ deriving (Eq, Show, Ord)
+
+instance Pretty n => Pretty (ZVar n) where
+ ppr (SameCluster a b) = text "SC" <+> ppr a <+> ppr b
+ ppr (C a)             = text "C"  <+> ppr a
+
+
+-- | Variable type for linear program
+-- Pi i             - {0..} used to show the resulting partition is acyclic:
+--
+--      A graph is acyclic iff there is a mapping
+--          pi : Node -> Int
+--      such that \forall (i,j) \in Edge
+--          pi(j) > pi(i)
+--
+data RVar n
+ = Pi n
+ deriving (Eq, Show, Ord)
+
+instance Pretty n => Pretty (RVar n) where
+ ppr (Pi a) = text "O" <+> ppr a
+
+-- | Canonical form of SameCluster variables.
+-- Since we only want to generate one SameCluster variable for each pair, we generate the
+-- variable with min variable then max.
+mkSameCluster :: Ord n => n -> n -> ZVar n
+mkSameCluster m n
+ = SameCluster (min m n) (max m n)
+
+-- | Minimise objective:
+-- \Sigma_i,j Weight(i,j) * SameCluster(i,j)
+gobjective :: Ord n => [n] -> [(Int,n,n)] -> Linear (ZVar n) (RVar n) IntDouble 'KZ
+gobjective ns ws
+ =  foldl (.+.) c0
+ (  map (\(w,i,j) -> z (mkSameCluster i j) (Z w)) ws
+ ++ map (\n -> z (C n) (Z $ length ns)) ns)
+
+
+-- | Get variable bounds - Pi are unbounded, SameCluster and C are "bools" (0 or 1)
+getBounds :: Ord n => [n] -> [(Int,n,n)] -> [Bounds (ZVar n) (RVar n) IntDouble]
+getBounds ns ws
+ =  map boundC  ns
+ ++ map boundSC ws
+ where
+  boundC n
+   = binary (C n)
+  boundSC (_,i,j)
+   = binary (mkSameCluster i j)
+
+
+-- | Create constraints for edges and weights
+getConstraints :: (Ord n, Eq t, Show n)
+               => Int -> Graph n t
+               -> [((n,n),Bool)]
+               -> [(Int,n,n)]
+               -> TransducerMap n
+               -> Constraint (ZVar n) (RVar n) IntDouble
+getConstraints bigN g arcs ws trans
+ = mconcat $  map edgeConstraint arcs
+           ++ map weightConstraint ws
+ where
+  piDiff u v = r1 (Pi v) .-. r1 (Pi u)
+  sc     u v = z1 (mkSameCluster u v)
+
+  -- Edge constraints:
+  --
+  -- For nonfusible edges (u,v), add a constraint
+  --    pi(v) - pi(u) >= 1
+  -- which is equivalent to
+  --    pi(v) > pi(u)
+  -- or "v must be scheduled after u"
+  -- This will disallow u and v from being in the same cluster, as other
+  -- constraints require x(u,v) = 0 can only be true if pi(u) = pi(v).
+  --
+  -- For fusible edges (u,v)
+  --    if they are merged together,    x(u,v) = 0 and pi(v) = pi(u)
+  --    otherwise,                      x(u,v) = 1 and pi(v) > pi(u)
+  -- This is achieved with the constraint
+  --    x(u,v) <= pi(v) - pi(u) <= n * x(u,v)
+  --
+  --
+  -- Note that arcs are reversed in graph, so (v,u) below is actually an edge from u to v.
+  edgeConstraint ((v,u), fusible)
+   -- The edge must be fusible, the two nodes must have a similar size,
+   -- and there can be no other paths between u and v that aren't fusible.
+   | fusible && typeComparable g trans u v && noFusionPreventingPath arcs u v
+   -- We may want to remove the 'typeComparable' restriction later, and just check
+   -- that they have some iteration size, but not necessarily similar.
+   -- This would allow fusing @a@ into @c@ in @a = map...; c = cross a b@.
+   = let x = sc u v
+     in  Between x (piDiff u v) (Z bigN *. x)
+     :&& x :<= z1 (C u)
+
+   -- Non-fusible edge, or nodes are different types
+   | otherwise
+        -- pi(v) - pi(u) >= 1
+   =   piDiff u v :>= c1
+   :&& z1 (C u)   :== c1
+
+
+  -- Weights between other nodes:
+  --
+  -- For any two nodes that may be scheduled together,
+  -- we must make sure that if they are together, their pis *must* be the same.
+  -- If they are not together, their pis are unconstrained.
+  --
+  --    -n * x(u,v) <= pi(v) - pi(u) <= n * x(u,v)
+  --
+  -- That is, if u and v are in the same cluster (x(u,v)=0)
+  -- then     pi(v) - pi(u) = 0, or pi(v) = pi(u)
+  --
+  -- Otherwise, pi(v) - pi(u) has a large enough range to be practically unbounded.
+  -- 
+  -- This constraint is not necessary if there is a fusible edge between the two,
+  -- as a more restrictive constraint will be added by edgeConstraint.
+  --
+  weightConstraint (_,u,v)
+   -- If there's an edge between the two, don't bother adding this constraint
+   | not $ any (\((i,j),_) -> (u,v) == (i,j) || (v,u) == (i,j)) arcs
+   = let x = sc u v
+     in  Between (Z (-bigN) *. x) (piDiff u v) (Z bigN *. x) 
+     :&& checkTypes u v
+
+   | otherwise
+   = CTrue
+
+
+  -- If two nodes have different types, but parent transducers with same type,
+  -- we may still fuse them together if their parent transducers are fused together
+  checkTypes u v
+   | Just uT <- nodeType g u
+   , Just vT <- nodeType g v
+   , uT /= vT
+   , Just (u',v') <- trans u v
+   =   filtConstraint v' v  u v
+   :&& filtConstraint u' u  u v
+   :&& filtConstraint u' v' u v
+
+   | otherwise
+   = CTrue
+
+  -- c and d can only be fused if a and b are fused
+  filtConstraint a b c d
+   -- If a and b are the same node, they're already fused!
+   | a == b
+   = CTrue
+
+   -- Check if it's even possible for a and b to be fused.
+   -- There might be a fusion-preventing edge between them.
+   | checkFusible a b
+   -- If it's possible, constrain (SC a b) <= (SC c d).
+   -- This means that if (SC a b) is 1 (unfused), it forces (SC c d) = 1 too.
+   = sc a b :<= sc c d
+
+   -- There's a fusion-preventing path between a and b, so they can't possibly be fused.
+   -- So c and d won't be fused - let's just set it to 1.
+   | otherwise
+   = sc c d :== c1
+
+  checkFusible a b
+   = any (\(_, i,j) -> (i,j) == (a,b) || (i,j) == (b,a)) ws
+
+
+
+
+-- | Get list of all nodes that might be clustered together,
+-- and the weighted benefit of doing so.
+clusterings :: (Ord n, Eq t) => [((n,n),Bool)] -> [n] -> Int -> Graph n t -> TransducerMap n -> [(Int, n,n)]
+clusterings arcs ns bigN g trans
+ = go ns
+ where
+   -- For some node, find all later nodes of same or similar type, and calculate benefit
+   go (u:rest)
+    =  [ (w,u,v)
+       | v <- rest
+       , noFusionPreventingPath arcs u v
+       , cmp u v
+       , let w = weight u v
+       , w > 0]
+    ++ go rest
+   go []
+    = []
+
+   cmp = typeComparable g trans
+
+   -- Simple trick:
+   -- if there is an edge between the two,
+   --   there will be some cache locality benefit from merging
+   -- otherwise, 
+   --   the only benefit is reducing loop overhead
+   --
+   -- Another heuristic would be to count nodes with shared parents as having a locality benefit
+   weight u v
+    -- An edge between them
+    | (_:_) <- filter (\((i,j),_) -> (u,v) == (i,j) || (v,u) == (i,j)) arcs
+    = bigN * bigN
+
+    -- Share a parent
+    | ius <- map (fst.fst) $ filter (\((_,j),_) -> j == u) arcs
+    , ivs <- map (fst.fst) $ filter (\((_,j),_) -> j == v) arcs
+    , _:_ <- filter (flip elem ius) ivs
+
+    -- Assume that this is for an array.
+    = bigN * bigN
+    | otherwise
+    = 1
+
+
+-- | Create linear program for graph, and put all the pieces together.
+lp :: (Ord n, Eq t, Show n) => Graph n t -> TransducerMap n -> Program (ZVar n) (RVar n) IntDouble
+lp g trans
+ = minimise (gobjective names weights)
+            (getConstraints nNodes g arcs weights trans)
+            (getBounds names weights)
+ where
+   g'    = listOfGraph g
+   names = map fst $ fst g'
+   arcs  =           snd g'
+
+   weights = clusterings arcs names nNodes g trans
+
+   nNodes
+     = numNodes g
+
+
+-- | Find a good clustering for some graph.
+-- The output is:
+--  (Pi, Type number) -> list of nodes
+solve_linear :: (Ord n, Eq t, Show n, Pretty n) => Graph n t -> TransducerMap n -> [[n]]
+solve_linear g trans
+ = case solve lp's of
+   Left  e   -> error (show e)
+   Right ass -> Map.elems
+              $ fixMap (sub `mappend` ass)
+ where
+  lp'  = lp g trans
+  {- show_lp = CPr.ppr (show.ppr) (show.ppr) -}
+
+  lp'c        = Conv.program lp'
+  -- Simplify can return a (Left InfeasibleError) if the program can't be solved,
+  -- but we luckily have a proof that the programs we generate will always be feasible.
+  Right (sub, lp's) = CSimp.simplify lp'c
+
+
+  fixMap ass@(Assignment mz _r)
+   = reorder ass $ snd $ fillMap $ Map.foldWithKey go (0 :: Int, Map.empty) mz
+
+  go k v (n, m)
+   -- SameCluster i j = 0 --> i and j must be fused together
+   | SameCluster i j <- k
+   , v == 0
+   = case (Map.lookup i m, Map.lookup j m) of
+     (Just iC, Just jC)
+      -> if   iC == jC
+         then (n, m)
+         else (n, Map.map (\x -> if x == iC then jC else x) m)
+     (Just iC, Nothing)
+      -> (n, Map.insert j iC m)
+     (Nothing, Just jC)
+      -> (n, Map.insert i jC m)
+     (Nothing, Nothing)
+      -> ( n + 1
+         , Map.insert i n 
+         $ Map.insert j n m)
+
+   | otherwise
+   = (n, m)
+
+  fillMap (n, m)
+   = foldr goFill (n, m) (fst $ listOfGraph g)
+
+  goFill (k,_ty) (n, m)
+   | Map.member k m
+   = (n, m)
+   | otherwise
+   = ( n + 1
+     , Map.insert k n m)
+
+
+  reorder ass m
+   = Map.fromList
+   $ map (reorder' ass)
+   $ Map.toList $ invertMap m
+
+  reorder' ass (k,v:vs)
+   = let k' = rOf ass (Pi v)
+     in  ((truncate k' :: Int, k), v:vs)
+  reorder' _ (_, [])
+   = error "ddc-core-flow:DDC.Core.Flow.Transform.Rates.Linear: impossible, empty list in inverted map"
+
diff --git a/DDC/Core/Flow/Transform/Rates/CnfFromExp.hs b/DDC/Core/Flow/Transform/Rates/CnfFromExp.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Rates/CnfFromExp.hs
@@ -0,0 +1,205 @@
+module DDC.Core.Flow.Transform.Rates.CnfFromExp
+        (cnfOfExp, takeXLamFlags_safe) where
+import DDC.Core.Collect
+import DDC.Core.Flow.Compounds
+import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Exp
+import DDC.Core.Flow.Transform.Rates.Fail
+import DDC.Core.Flow.Transform.Rates.Combinators        as CNF
+import qualified DDC.Type.Env           as Env
+
+import           Control.Monad
+import           Data.List              (intersect, nub)
+import           Data.Maybe             (catMaybes)
+import           Data.Monoid
+import qualified Data.Set               as Set
+
+
+-----------------------------------
+-- = Conversion from ExpF to CNF.
+--
+-- | Convert a given expression function to CNF.
+-- For this to succeed, the function must:
+--      - be in A-normal form, *except* worker functions should also be inlined
+--      - all bindings are named, not de Bruijn indices
+--      - names must be unique
+--      - no recursive bindings
+--      - no @letregion@s
+--
+-- If it succeeds, it should be true that
+-- >>> expOfCnf . right . cnfOfExp = id
+-- at least semantically, if not syntactically
+-- 
+cnfOfExp :: ExpF -> Either ConversionError (Program Name Name)
+cnfOfExp fun
+ = do   -- Peel off the lambdas
+        let (lams, body)   = takeXLamFlags_safe fun
+        -- Assuming the body is already in a-normal form.
+            (lets, xx)     = splitXLets         body
+
+        -- Split into name and values and warn for recursive bindings
+        binds             <- takeLets           lets
+
+        let lam_names = catMaybes $ map (takeNameOfBind . snd) lams
+        let names     = lam_names ++ map fst binds
+        -- Make sure names are unique
+        when (length names /= length (nub names)) $
+          Left FailNamesNotUnique
+
+        -- For each value-level lambda binder, decide whether it's scalar or vector based on type
+        let inputs  = mconcat $ map getInput lams
+            getInput (False, BName n ty)
+             -- Vectors on the right, scalars on the left
+             | isTypeArray ty
+             = ([],[n])
+             | otherwise
+             = ([n],[])
+            getInput (_,_) = ([],[])
+
+        -- For each binding, classify it as either array, scalar or external.
+        --
+        -- We must be careful about creating externals, though: if a binding is just a
+        -- worker function, we don't really need that as an external.
+        -- However, if we assume that all scalars will be fusion-preventing (they currently are),
+        -- then creating externals for these will not affect scheduling.
+        -- But what of worker functions referencing vectors? It becomes harder to outlaw if the
+        -- worker function is not inlined into the combinator binding.
+        -- Tuples are another potential problem here: looking at the tuple's type, it would not be
+        -- an array binding.
+        let (binds', env') = getBinds binds inputs 
+        let outs           = localEnv env'  xx
+
+        return (Program inputs binds' outs)
+
+-- | Check if type is an array type, so we know whether variables are scalar or array.
+-- This is perhaps a crude way to test, as what if the result of a fold is actually a vector?
+-- Well, let's not worry about that right now.
+isTypeArray :: TypeF -> Bool
+isTypeArray = isVectorType
+
+
+getBinds :: [(Name,(TypeF,ExpF))] -> ([Name],[Name]) -> ([CNF.Bind Name Name], ([Name],[Name]))
+getBinds bs env
+ = go bs env
+ where
+  go [] e = ([], e)
+  go (b:rest) e
+   = let b'          = getBind b e
+         e'          = envOfBind b' <> e
+         (rest',e'') = go rest e'
+     in  (b' : rest', e'')
+
+
+-- | Convert an epression to a CNF binding.
+-- Assuming the incoming expression is well typed, this should never fail:
+-- if we can't convert it to a "real" combinator, it will just be converted to an external.
+--
+-- Perhaps this is the wrong approach, and if a vector operator cannot be converted,
+-- it should be an error or warning.
+getBind :: (Name,(TypeF,ExpF)) -> ([Name], [Name]) -> CNF.Bind Name Name
+getBind (nm,(t,x)) env
+ -- Try to match against a known vector combinator.
+ | Just (f, args) <- takeXApps x
+ , XVar (UPrim (NameOpVector ov) _) <- f
+ -- throw away that pesky type information
+ , args' <- filter ((==Nothing) . takeXType) args
+ = case (ov, args') of
+   (OpVectorReduce, [worker, seed, arr])
+    | Just fun     <- getFun worker
+    , snm          <- name seed
+    , Just a       <- name arr
+    -> SBind nm (Fold fun (Scalar seed snm) a)
+
+   (OpVectorMap n, worker : arrs)
+    | Just fun       <- getFun worker
+    , Just as        <- names  arrs
+    , length arrs    == n
+    -> ABind nm (MapN fun as)
+
+   (OpVectorFilter, [worker, arr])
+    | Just fun       <- getFun worker
+    , Just a         <- name   arr
+    -> ABind nm (Filter fun a)
+
+   (OpVectorGenerate, [sz, worker])
+    | Just fun       <- getFun worker
+    , snm            <- name   sz
+    -> ABind nm (Generate (Scalar sz snm) fun)
+
+   (OpVectorGather, [v, ix])
+    | Just v'        <- name   v
+    , Just ix'       <- name   ix
+    -> ABind nm (Gather v' ix')
+
+   _ | otherwise
+    -> external
+
+ -- It's not a vector combinator, so we'll have to create an external binding for it.
+ | otherwise
+ = external
+ where
+  external
+   = let ins = localEnv env x
+         out | isTypeArray t = NameArray  nm
+             | otherwise     = NameScalar nm
+     in  Ext out x ins
+
+  names as
+   | xs <- catMaybes $ map name as
+   , length xs == length as
+   = Just xs
+   | otherwise
+   = Nothing
+
+  name xx
+   | XVar (UName n) <- xx
+   = Just n
+   | otherwise
+   = Nothing
+
+  -- Try to extract a worker function from an expression.
+  -- This fails if the worker function mentions any local arrays.
+  -- I'm not sure if failing in this case is strictly necessary; it should just be nonfusible edges.
+  getFun xx
+   = let (ss, as) = localEnv env xx
+         -- Check that no local arrays are referenced
+     in  if   null as
+         then Just $ Fun xx ss
+         else Nothing
+
+
+-- | Find local variables that are mentioned in expression, sorted into scalar and array
+localEnv :: ([Name],[Name]) -> ExpF -> ([Name],[Name])
+localEnv env xx
+       -- Get all the free variables mentioned in exp
+ = let free = catMaybes
+            $ map takeNameOfBound
+            $ Set.toList
+            $ freeX Env.empty xx
+       -- Limit to just the scalar references
+       ss = free `intersect` fst env
+       -- and array refs
+       as = free `intersect` snd env
+       -- Check that no local arrays are referenced
+  in  (ss, as)
+
+
+-- | Peel the lambdas off, or leave it alone if there are none
+takeXLamFlags_safe x
+ | Just (binds, body) <- takeXLamFlags x
+ = (binds, body)
+ | otherwise
+ = ([],    x)
+
+
+-- | Split into name and values and error for outlawed bindings
+takeLets :: [LetsF] -> Either ConversionError [(Name, (TypeF, ExpF))]
+takeLets lets
+ = mapM get lets
+ where
+  get (LLet (BName n t) x) = return (n,(t,x))
+  get (LLet (BNone _)   _) = Left   FailNoAnonAllowed
+  get (LLet (BAnon _)   _) = Left   FailNoDeBruijnAllowed
+  get (LRec        _     ) = Left   FailRecursiveBindings
+  get (LPrivate _ _ _)     = Left   FailLetRegionNotHandled
+
diff --git a/DDC/Core/Flow/Transform/Rates/Combinators.hs b/DDC/Core/Flow/Transform/Rates/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Rates/Combinators.hs
@@ -0,0 +1,304 @@
+-- | Converting DDC expressions to and from Combinator Normal Form.
+module DDC.Core.Flow.Transform.Rates.Combinators
+        ( Fun(..), Bind(..), ABind(..), SBind(..), Scalar(..)
+        , Program(..)
+        , CName(..)
+        , lookupA, lookupS, lookupB
+        , envOfBind
+        , freeOfBind, cnameOfBind
+        , outputsOfCluster, inputsOfCluster
+        , seriesInputsOfCluster
+        ) 
+where
+import DDC.Base.Pretty
+import DDC.Core.Flow.Exp (ExpF)
+import Data.Maybe (catMaybes)
+import Data.List  (nub)
+import Prelude                  hiding ((<$>))
+
+-----------------------------------
+-- = Combinator normal form.
+
+
+-- | Worker function. May only reference scalars in the environment, not arrays.
+-- Takes the expression of the function, and a list of the free scalars that are referenced inside it.
+-- The expression must be a function from scalar to scalar.
+data Fun s a
+ = Fun ExpF [s]
+   deriving Show
+
+-- | Array, scalar and external bindings.
+-- Array bindings are those whose value is an array, such as map, filter.
+-- Scalar bindings have scalar values, currently only fold.
+-- External expressions are those that cannot be converted to primitive combinators.
+-- The they take a single expression that computes all outputs, with the list of free scalar and array inputs.
+data Bind s a
+ = ABind a (ABind s a)
+ | SBind s (SBind s a)
+ | Ext
+   { _beOut  :: CName s a
+   , _beExp  :: ExpF
+   , _beIns  :: ([s], [a])
+   }
+   deriving Show
+
+-- | An array-valued binding.
+data ABind s a
+ -- | map_n     :: (a_1 ... a_n -> b) -> Array a_1 ... Array a_n -> Array b
+ = MapN       (Fun s a) [a]
+ -- | filter    :: (a -> Bool)        -> Array a                 -> Array a
+ | Filter     (Fun s a)  a
+ -- | generate  ::  Nat               -> (Nat -> a)              -> Array a
+ | Generate (Scalar s a) (Fun s a) 
+ -- | gather    ::  Array a           -> Array Nat               -> Array a
+ | Gather                a a
+ -- | cross     ::  Array a           -> Array b                 -> Array (a, b)
+ | Cross                 a a
+   deriving Show
+
+-- | Scalars can either be a literal such as "0", or a named scalar reference.
+-- If it's not a named scalar reference, we need to keep the expression so we can reconstruct it later.
+-- (We do not have array literals, so this is only necessary for scalars)
+data Scalar s a
+ = Scalar ExpF (Maybe s)
+   deriving Show
+
+-- | A scalar-valued binding
+data SBind s a
+ -- | fold      :: (a -> a -> a) -> a -> Array a                 -> a
+ = Fold       (Fun s a) (Scalar s a) a
+   deriving Show
+
+-- | An entire program/function to find a fusion clustering for
+data Program s a
+ = Program
+   { _ins   :: ([s], [a])
+   , _binds :: [Bind s a]
+   , _outs  :: ([s], [a])
+   }
+   deriving Show
+
+-- | Name of a combinator.
+-- This will also be the name of the corresponding node of the graph.
+data CName s a
+ = NameScalar s
+ | NameArray a
+ deriving (Eq, Ord, Show)
+
+
+lookupA :: Eq a => Program s a -> a -> Maybe (ABind s a)
+lookupA p a
+ = go $ _binds p
+ where
+  go [] = Nothing
+  go (ABind a' b : _)
+   | a == a'
+   = Just b
+  go (_ : bs)
+   = go bs
+
+lookupS :: Eq s => Program s a -> s -> Maybe (SBind s a)
+lookupS p s
+ = go $ _binds p
+ where
+  go [] = Nothing
+  go (SBind s' b : _)
+   | s == s'
+   = Just b
+  go (_ : bs)
+   = go bs
+
+
+lookupB :: (Eq s, Eq a) => Program s a -> CName s a -> Maybe (Bind s a)
+lookupB p nm = go (_binds p)
+ where
+  go [] = Nothing
+  go (b@(ABind a _) : _)
+   | NameArray a' <- nm
+   , a == a'
+   = Just b
+  go (b@(SBind s _) : _)
+   | NameScalar s' <- nm
+   , s == s'
+   = Just b
+  go (b@(Ext nm' _ _) : _)
+   | nm == nm'
+   = Just $ b
+  go (_ : bs)
+   = go bs
+
+
+
+envOfBind :: Bind s a -> ([s], [a])
+envOfBind (SBind s _)              = ([s], [])
+envOfBind (ABind a _)              = ([], [a])
+envOfBind (Ext (NameScalar s) _ _) = ([s], [])
+envOfBind (Ext (NameArray  a) _ _) = ([], [a])
+
+
+cnameOfBind :: Bind s a -> CName s a
+cnameOfBind (SBind s _) = NameScalar s
+cnameOfBind (ABind a _) = NameArray  a
+cnameOfBind (Ext n _ _) = n
+
+freeOfBind :: Bind s a -> [CName s a]
+freeOfBind b
+ = case b of
+   SBind _ (Fold fun i a)
+    -> ffun fun ++ fscalar i ++ [fa a]
+   ABind _ (MapN fun as)
+    -> ffun fun ++ map fa as
+   ABind _ (Filter fun a)
+    -> ffun fun ++ [fa a]
+   ABind _ (Generate s fun)
+    -> ffun fun ++ fscalar s
+   ABind _ (Gather x y)
+    -> [fa x, fa y]
+   ABind _ (Cross x y)
+    -> [fa x, fa y]
+   Ext _ _ (inS,inA)
+    -> map fs inS ++ map fa inA
+ where
+  ffun  (Fun _ f)               = map fs f
+  fscalar (Scalar _ Nothing)        = []
+  fscalar (Scalar _ (Just s))       = [NameScalar s]
+  fs                            = NameScalar
+  fa                            = NameArray
+
+-- | Get inputs that must be converted to series or rate vectors
+seriesInputOfBind :: Bind s a -> [a]
+seriesInputOfBind b
+ = case b of
+   SBind _ (Fold _fun _i a)
+    -> [a]
+   ABind _ (MapN _fun as)
+    -> as
+   ABind _ (Filter _fun a)
+    -> [a]
+   ABind _ (Generate _s _fun)
+    -> []
+   ABind _ (Gather v ix)
+   -- Only the indices array is consumed series-wise.
+   -- The vector is random access.
+    -> [v, ix]
+   -- Cross product's first is consumed in series, but second is consumed multiple times
+   ABind _ (Cross x y)
+    -> [x, y]
+   -- Externals do not require series inputs.
+   Ext _ _ (_inS,_inA)
+    -> []
+
+
+
+-- | For a given program and list of nodes that will be clustered together,
+-- find a list of the nodes that are used afterwards.
+-- Only these nodes must be made manifest.
+-- The output nodes is a subset of the input cluster nodes.
+outputsOfCluster :: (Eq s, Eq a) => Program s a -> [CName s a] -> [CName s a]
+outputsOfCluster prog cluster
+       -- Get all bindings in the program that aren't in this cluster
+ = let notin   = filter (not . flip elem cluster . cnameOfBind) (_binds prog)
+       -- And find their free variables
+       frees   = concatMap freeOfBind          notin
+
+       -- Convert the returns of the program to CNames
+       (ss,as) = _outs prog
+       pouts   = map NameScalar ss ++ map NameArray as
+
+       -- We want to look in both returns and free variables of bindings
+       alls    = frees ++ pouts
+       -- Now search through and find those in the cluster
+       found   = filter (flip elem cluster) alls
+   in  nub $ found
+
+
+-- | For a given program and list of nodes that will be clustered together,
+-- find a list of the nodes that are used as inputs.
+-- The input nodes will not mention any of the cluster nodes.
+inputsOfCluster :: (Eq s, Eq a) => Program s a -> [CName s a] -> [CName s a]
+inputsOfCluster prog cluster
+       -- Get bindings of clusters
+ = let binds   = catMaybes
+               $ map (lookupB prog) cluster
+       -- And find the free variables
+       frees   = concatMap freeOfBind          binds
+
+       -- Ignore the ones in the cluster
+       found   = filter (not . flip elem cluster) frees
+   in  nub $ found
+
+-- | For a given program and list of nodes that will be clustered together,
+-- find a list of the inputs that need to be converted to series.
+-- If the cluster is correct, these should all be the same size.
+seriesInputsOfCluster :: (Eq s, Eq a) => Program s a -> [CName s a] -> [a]
+seriesInputsOfCluster prog cluster
+       -- Get bindings of clusters
+ = let binds   = catMaybes
+               $ map (lookupB prog) cluster
+       -- And find the free variables
+       frees   = concatMap seriesInputOfBind      binds
+
+       -- Ignore the ones in the cluster
+       found   = filter (not . flip elem cluster . NameArray) frees
+   in  nub $ found
+
+
+-----------------------------------
+-- == Pretty printing
+-- This is just the notation I used in the prototype.
+
+instance (Pretty s, Pretty a) => Pretty (Fun s a) where
+ ppr (Fun _ ss)
+  = encloseSep lbrace rbrace space
+  $ map ppr ss
+
+instance (Pretty s, Pretty a) => Pretty (Scalar s a) where
+ ppr (Scalar _ Nothing)
+  = text "-"
+ ppr (Scalar _ (Just s))
+  = ppr s
+
+instance (Pretty s, Pretty a) => Pretty (Bind s a) where
+ ppr (SBind n (Fold f i a))
+  = bind (ppr n) "reduce" (ppr f <+> ppr i <+> ppr a)
+
+ ppr (ABind n (MapN f as))
+  = bind (ppr n) "mapN"   (ppr f <+> hsep (map ppr as))
+
+ ppr (ABind n (Filter f a))
+  = bind (ppr n) "filter" (ppr f <+> ppr a)
+
+ ppr (ABind n (Gather a b))
+  = bind (ppr n) "gather" (ppr a <+> ppr b)
+
+ ppr (ABind n (Generate sz f))
+  = bind (ppr n) "generate" (ppr sz <+> ppr f)
+
+ ppr (ABind n (Cross a b))
+  = bind (ppr n) "cross"    (ppr a <+> ppr b)
+
+ ppr (Ext out _ ins)
+  = bind (ppr out) "external" (binds ins)
+  where
+   binds (ss,as)
+    = encloseSep lbrace rbrace space (map ppr ss) <+> hcat (map ppr as)
+
+bind :: Doc -> String -> Doc -> Doc
+bind nm com args
+ = nm <+> nest 4 (equals <+> text com <+> args)
+
+instance (Pretty s, Pretty a) => Pretty (Program s a) where
+ ppr (Program ins binds outs)
+  = params <$> vcat (map ppr binds) <$> returns
+  where
+   params
+    =   vcat (map (\i -> text "param scalar" <+> ppr i) (fst ins))
+    <$> vcat (map (\i -> text "param array"  <+> ppr i) (snd ins))
+
+   returns
+    =   vcat (map (\i -> text "return"       <+> ppr i) (fst outs))
+    <$> vcat (map (\i -> text "return"       <+> ppr i) (snd outs))
+
+instance (Pretty s, Pretty a) => Pretty (CName s a) where
+ ppr (NameScalar s) = text "{" <> ppr s <> text "}"
+ ppr (NameArray  a) =             ppr a
diff --git a/DDC/Core/Flow/Transform/Rates/Constraints.hs b/DDC/Core/Flow/Transform/Rates/Constraints.hs
deleted file mode 100644
--- a/DDC/Core/Flow/Transform/Rates/Constraints.hs
+++ /dev/null
@@ -1,351 +0,0 @@
-module DDC.Core.Flow.Transform.Rates.Constraints
-        ( Constraint(..)
-        , ConstraintMap, EquivClass
-        , canonName
-        , checkBindConstraints
-        , getMaxSize )
-where
-import DDC.Core.Flow.Compounds
-import DDC.Core.Flow.Prim
-import DDC.Core.Flow.Exp
-import DDC.Core.Flow.Transform.Rates.Fail
-import Control.Monad
-import qualified Data.Map               as Map
-import qualified Data.Set               as Set
-
-
-
--- | Constraint information
--- An equal can have multiple - eg map3
--- Filtered only has its source input
-data Constraint
- = ConEqual     [Name]
- | ConFiltered   Name
- deriving (Eq,Show)
-
-type ConstraintMap = Map.Map Name Constraint
-type EquivClass    = [Set.Set Name]
-
-
--- | Get canonical name for given equivalence class
--- Return original if there is none
--- (for example, a filter with no maps applied would have none since equiv classes are only built from maps)
-canonName :: EquivClass -> Name -> Name
-canonName equivs n
- = case equivSet equivs n of
-    Nothing -> n
-    Just s  -> Set.findMin s
-
-
--- | Get set of associated names in given equivalence class
-equivSet :: EquivClass -> Name -> Maybe (Set.Set Name)
-equivSet equivs n = go equivs
- where
-  -- No classes left, not found
-  go []
-   = Nothing
-
-  -- If @n@ is a member of this class, return it
-  go (c:cs')
-   | Set.member n c
-   = Just c
-
-   -- Check the rest 
-   | otherwise
-   = go cs'
-
-
--- | Check constraints for a single function body's bindings.
--- The bindings must be in a-normal form.
-checkBindConstraints :: [(Name,ExpF)] -> LogFailures (ConstraintMap, EquivClass)
-checkBindConstraints binds
- = -- Generate all constraints
-   let constrs       = getConstraints binds
-   -- Squash down eqs into equivalence classes
-       equivs        = equivConstrs   constrs
-   -- Get filter constraints as pairs
-       filts         = filterConstrs  constrs equivs
-
-   -- Check for ill-formed constraints:
-   --      Filter "a <= a" is bad, as restricts to a=a
-   --      Filter "a <= b" and "a <= c" is bad because 'a' mentioned twice in lhs
-   in   checkFilters filts >> return (constrs, equivs)
-
-
-getMaxSize :: ConstraintMap -> EquivClass -> [Name] -> Name -> Name
-getMaxSize constrs equivs mans get
- = let get' = upFiltered get
-   in  getFromMans get'
- where
-  -- Keep moving up through filtered constraints until we hit the top
-  upFiltered g
-   | Just eqs <- equivSet equivs g
-   = upFiltered' g (Set.toList eqs)
-   | otherwise
-   = g
-
-  upFiltered' g []
-   = g
-  upFiltered' g (e:es)
-   | Just (ConFiltered g') <- Map.lookup e constrs
-   = upFiltered g'
-   | otherwise
-   = upFiltered' g es
-
-  -- Find a manifest vector in the same equivalence class
-  getFromMans g
-   = let e = canonName equivs g
-     in  getFromMans' e mans
-
-  getFromMans' g []
-   = g
-  getFromMans' g (m:ms)
-   | g == canonName equivs m
-   = m
-   | otherwise
-   = getFromMans' g ms
-   
- 
-
--- | Squash constraints into equivalence classes
--- I'm sure this could be smarter.
-equivConstrs :: ConstraintMap -> EquivClass
-equivConstrs m
- = let sets = filter (not . Set.null)
-            $ map gen
-            $ Map.toList m
-   in  squash sets []
- where
-  -- Simply generate a set from each constraint
-  gen (k, (ConEqual eqs))
-   = Set.fromList (k:eqs)
-  -- Ignore filter constraints
-  gen (k, (ConFiltered _from))
-   = Set.singleton k
-
-  -- Squash constraint sets together
-  squash []     acc
-   = acc
-
-  squash (a:as) acc
-   -- Try to merge the @a@ set into @acc@ somewhere
-   -- If so, start merging the whole thing again
-   | Just merged <- squash_merge a acc
-   = squash (merged ++ as) []
-
-   -- Nothing in @a@ is mentioned in @acc@, so no merging required:
-   --   just add this set to the accumulator
-   | otherwise
-   = squash as (a:acc)
-
-  squash_merge ins (s:ss)
-   -- Check if any members of @ins@ are mentioned in @s@
-   -- If so, merge them into one equivalence class
-   | not $ Set.null $ ins `Set.intersection` s
-   = Just (ins `Set.union` s : ss)
-
-   -- Check if there is a chance to merge later
-   | Just ss' <- squash_merge ins ss
-   = Just (s : ss')
-
-  -- No merge is possible
-  squash_merge _ins _ss
-   = Nothing
-
-
--- Get canonical names of all filter constraints
-filterConstrs :: ConstraintMap -> EquivClass -> [(Name,Name, Name, Name)]
-filterConstrs m equivs = Map.foldWithKey go [] m
- where
-  go k (ConFiltered src) ms
-   = (canonName equivs k, canonName equivs src, k, src) : ms
-  go _  _                ms
-   = ms
-
-
--- | Generate constraints map from bindings
-getConstraints :: [(Name,ExpF)] -> ConstraintMap
-getConstraints lets
- = foldl go Map.empty lets
- where
-  go m (n,x)
-   | Just (n',c) <- getConstraint n x 
-   = Map.insert n' c m
-   | otherwise
-   = m
-
-getConstraint :: Name -> ExpF -> Maybe (Name, Constraint)
-getConstraint n xx
- | Just (f, args)                   <- takeXApps xx
- , XVar (UPrim (NameOpVector ov) _) <- f
- = case ov of
-   OpVectorMap i
-    -- Args:
-    -- map1 :: [a b   : *]. (a -> b)      -> Vector a -> Vector b
-    -- (drop 3)
-    -- map2 :: [a b c : *]. (a -> b -> c) -> Vector a -> Vector b -> Vector c
-    -- (drop 4)
-    | vecs         <- drop (i+2) args
-    -- Must be fully applied
-    , length vecs  == i
-    , names        <- getNames vecs
-    -- Each name must also be a bound variable
-    , length names == i
-    -> Just (n, ConEqual names)
-
-   OpVectorFilter
-    | [_tyA, _p, XVar (UName vec)] <- args
-    -> Just (n, ConFiltered vec)
-
-   OpVectorGenerate
-   -- Not really sure about this
-    -> Just (n, ConEqual [])
-
-   OpVectorReduce
-    | [_tyA, _f, _z, XVar (UName vec)] <- args
-    -> Just (n, ConEqual [vec])
-
-   OpVectorLength
-    | [_tyA, XVar (UName vec)] <- args
-    -> Just (n, ConEqual [vec])
-
-   _
-    -> Nothing
-
- | otherwise
- = Nothing
-
--- | Get bound name for each expression
--- All expressions must be variables of bound names,
--- otherwise result list will be shorter than input.
-getNames :: [ExpF] -> [Name]
-getNames vs
- = concatMap get vs
- where
-  get x
-   | XVar (UName v) <- x
-   = [v]
-   | otherwise
-   = []
-
-
--- | Check for ill-formed constraints:
----
---      Filter 'a <= a' is bad, as restricts to 'a=a'
---      Filter 'a <= b' and 'a <= c' is bad because a mentioned twice in lhs
--- For some filter
--- > bs = filter p as
--- the arguments are
--- > (canon bs, canon as,  bs, as)
--- the 'raw' variable names bs and as are only used for error messages;
--- comparisons are done on canonical names.
-checkFilters :: [(Name,Name, Name,Name)] -> LogFailures ()
-checkFilters cs
- = go cs
- where
-  go []
-   = return ()
-  go ((lc,rc, ln, rn):cs')
-   = do when (lc == rc) $
-          warn $ FailConstraintFilteredLessFiltered ln rn
-        -- Check against later ones
-        forM_ cs' $ \(lc', _, ln', _) ->
-          when (lc == lc') $
-            warn $ FailConstraintFilteredNotUnique  ln ln'
-
-        go cs'
-
-
-
-{-
-
-f = \(as : Vector a).
-    as'    = vmap [:a b:] g as
-    return as'
-
-==>
-[as=as']
-==>
-
-f = \(as : Vector a).
-    runSeries as /\(k1 : Rate). \(asS : Series k1 a).
-    as'    = valloc [:k1 b:]
-    as'S   = smap   [:k1 a b:] g asS
-    sfill [:k1 b:] as' as'S
-    return as'
-
----
-
-f = \(as : Vector a).
-    as'    = vmap [:a b:] g as
-    as''   = vmap [:b b:] h as'
-    return as''
-
-==>
-[as = as' = as'']
-==>
-
-f = \(as : Vector a).
-    runSeries as /\(k1 : Rate). \(asS : Series k1 a).
-    as'S   = smap   [:k1 a b:] g asS
-    as''   = valloc [:k1 c:]
-    as''S  = smap   [:k1 b c:] h as'S
-    sfill [:k1 b:] as'' as''S
-    return as''
-
----
-
-f = \(as : Vector a).
-    as' = filter p as
-    n   = length   as'
-    ns  = map (/n) as'
-
-==>
-[as' <= as
-,ns   = as']
-==>
-
-f = \(as : Vector a).
-    runSeries as /\(k1 : Rate). \(asS : Series k1 a).
-    as'F = smap [:k1 a Bool:] p asS
-    mkSel [:k1:] as'F /\(k2 : Rate). \(as'Se : Sel k1 k2).
-    as'S = spack   [:k1 k2 a:] as'Se asS
-    n    = slength [:k2:]
-    nsS  = smap    [:k2 a a:] (/n) as'S
-    ns   = valloc  [:k2 a:]
-    sfill [:k2 a:] ns nsS
-
-    return ns
-
----
-
-f = \(as : Vector a).
-    bs = filter p as
-    cs = map2   f as bs
-    return cs
-
-==>
-[bs <= as
-,cs = as = bs]
-==>
-[as <= as]
-Error!
-
----
-
-f = \(as bs : Vector a).
-    cs = filter p as
-    ds = filter p bs
-    es = map2   f cs ds
-    return es
-
-==>
-[cs <= as
-,ds <= bs
-,cs=ds=es]
-==>
-[cs <= as
-,cs <= bs]
-Error, cs mentioned twice in lhs!
--}
-
diff --git a/DDC/Core/Flow/Transform/Rates/Fail.hs b/DDC/Core/Flow/Transform/Rates/Fail.hs
--- a/DDC/Core/Flow/Transform/Rates/Fail.hs
+++ b/DDC/Core/Flow/Transform/Rates/Fail.hs
@@ -1,5 +1,6 @@
 module DDC.Core.Flow.Transform.Rates.Fail
         ( Fail (..)
+        , ConversionError (..)
         , LogFailures
         , warn, run)
 where
@@ -8,9 +9,8 @@
 import Control.Monad.Writer
 import Data.List
 
-
--- | Why can't rates be inferred?
-data Fail
+-- | Why couldn't it be converted to CNF?
+data ConversionError
         -- | Function is not in a-normal form
         = FailNotANormalForm
 
@@ -20,12 +20,21 @@
         -- | Bindings must be named
         | FailNoDeBruijnAllowed
 
+        -- | Bindings cannot be anonymous _.
+        | FailNoAnonAllowed
+
         -- | Function contains letrec
         | FailRecursiveBindings
 
         -- | Function contains letregion
         | FailLetRegionNotHandled
+        deriving (Show, Eq)
 
+
+-- | Why can't rates be inferred?
+data Fail
+        -- | The function couldn't be converted to combinator form
+        = FailCannotConvert ConversionError
         -- | The constraint would require a buffer. User must expicitly buffer.
         | FailConstraintFilteredLessFiltered Name Name
 
diff --git a/DDC/Core/Flow/Transform/Rates/Graph.hs b/DDC/Core/Flow/Transform/Rates/Graph.hs
--- a/DDC/Core/Flow/Transform/Rates/Graph.hs
+++ b/DDC/Core/Flow/Transform/Rates/Graph.hs
@@ -1,24 +1,24 @@
 module DDC.Core.Flow.Transform.Rates.Graph
-        ( Graph
+        ( Graph(..)
         , Edge
         , graphOfBinds
         , graphTopoOrder 
         , mergeWeights
-        , traversal
         , invertMap
-        , mlookup )
+        , numNodes, numEdges
+        , hasNode, hasEdge
+        , nodeInputs, nodeInEdges
+        , nodeType
+        , listOfGraph, graphOfList )
 where
-import DDC.Core.Collect
-import DDC.Core.Flow.Compounds
-import DDC.Core.Flow.Prim
-import DDC.Core.Flow.Exp
-import qualified DDC.Type.Env           as Env
+import DDC.Core.Flow.Transform.Rates.Combinators
+import DDC.Core.Flow.Transform.Rates.SizeInference
 
-import           Data.List              (intersect, nub)
+import           Data.List              (nub)
 import qualified Data.Map               as Map
-import           Data.Maybe             (catMaybes)
 import qualified Data.Set               as Set
 
+
 -- | Graph for function
 --   Each node is a binding, edges are dependencies, and the bool is whether the node's output
 --   can be fused or contracted.
@@ -26,58 +26,64 @@
 --   but a fold cannot as it must consume the entire stream before producing output.
 --
 
-type Edge  = (Name, Bool)
-type Graph = Map.Map Name [Edge]
+type Edge  n   = (n, Bool)
+data Graph n t = Graph (Map.Map n (Maybe t, [Edge n]))
 
-graphOfBinds :: [(Name,ExpF)] -> [Name] -> Graph
-graphOfBinds binds extra_names
- = Map.map mkEdges graph1
- where
-  mkEdges (refs, _fusible)
-   = map getFusible refs
-  
-  getFusible r
-   | Just (_,f) <- Map.lookup r graph1
-   = (r, f)
-   | otherwise
-   = (r, True)
 
-  graph1
+graphOfBinds :: (Ord s, Ord a) => Program s a -> Env a -> Graph (CName s a) (Type a)
+graphOfBinds prog env
+ = Graph $ graph
+ where
+  graph
    = Map.fromList
    $ map gen
-   $ binds
+   $ _binds prog
 
-  gen (k, xx)
-   = let free = catMaybes
-              $ map takeNameOfBound
-              $ Set.toList
-              $ freeX Env.empty xx
-         refs = free `intersect` names
-     in  (k, (refs, fusible xx))
+  gen b
+   = let n    = cnameOfBind b
+         ty   = iter prog env n
+         es   = edges n b
+     in (n, (ty, es))
 
-  names = map fst binds ++ extra_names
+  edges n (ABind _ (Gather a b))
+   = let a' = mkedgeA (const False) a
+         b' = mkedgeA (inedge n)    b
+     in [a', b']
 
-  fusible xx
-   | Just (f, _)                      <- takeXApps xx
-   , XVar (UPrim (NameOpVector ov) _) <- f
-   = case ov of
-     OpVectorReduce
-      -> False
-     
-     -- Length of `concrete rate' is known before iteration, so should be contractible.
-     OpVectorLength
-      -> False
-     _
-      -> True
+  edges n (ABind _ (Cross a b))
+   = let a' = mkedgeA (inedge n)    a
+         b' = mkedgeA (const False) b
+     in [a', b']
 
+  edges n b
+   = let fs   = freeOfBind  b
+         fs' = map (pairon (inedge n)) fs
+     in  fs'
+
+  mkedgeA f a
+   = (pairon f (NameArray a))
+
+  pairon f x
+   = (x, f x)
+
+  inedge to from
+   -- scalar output:
+   | NameScalar _ <- from
+   = False
+   | Just (Ext{}) <- lookupB prog from
+   = False
+   | Just (Ext{}) <- lookupB prog to
+   = False
    | otherwise
    = True
 
 
+
+
 -- | Find topological ordering of DAG
 -- Does not check for cycles - really must be a DAG!
-graphTopoOrder :: Graph -> [Name]
-graphTopoOrder graph
+graphTopoOrder :: Ord n => Graph n t -> [n]
+graphTopoOrder (Graph graph)
  = reverse $ go ([], Map.keysSet graph)
  where
   go (l, s)
@@ -89,8 +95,8 @@
 
   visit (l,s) m
    | Set.member m s
-   = let edges    = mlookup "visit" graph m
-         pres     = map fst edges
+   , (_ty, edges) <- graph Map.! m
+   = let pres     = map fst edges
          s'       = Set.delete m s
          (l',s'') = foldl visit (l,s') pres
      in (m : l', s'')
@@ -100,31 +106,15 @@
 
 
 
-traversal :: Graph -> (Edge -> Name -> Int) -> Map.Map Name Int
-traversal graph weight
- = foldl go Map.empty
- $ graphTopoOrder graph
- where
-  go m node
-   = let pres  = mlookup "traversal" graph node
-
-         get e@(u,_)
-          | Just v <- Map.lookup u m
-          = v + weight e node
-          | otherwise
-          = 0
-
-         w     = foldl max 0
-               $ map get
-               $ pres
-
-     in  Map.insert node w m
-
-
-mergeWeights :: Graph -> Map.Map Name Int -> Graph
-mergeWeights graph weights
- = foldl go Map.empty
- $ graphTopoOrder graph
+-- | Merge nodes together with same value in weight map.
+-- Type information of each node is thrown away.
+-- It is, perhaps surprisingly, legal to merge nodes of different types (eg filtered data),
+-- so the only sensible thing is to choose () for all new types.
+mergeWeights :: Ord n => Graph n t -> Map.Map n Int -> Graph n ()
+mergeWeights g@(Graph graph) weights
+ = Graph
+ $ foldl go Map.empty
+ $ graphTopoOrder g
  where
   go m node
    -- Merge if it's a weighted one
@@ -134,17 +124,21 @@
    = merge node node m
 
   merge node k m
-   | Just edges <- Map.lookup node graph
+   | Just (_ty,edges) <- Map.lookup node graph
    = let edges' = nub $ map (\(n,f) -> (name n, f)) edges
-     in  Map.insertWith (\x y -> nub $ x ++ y) k edges' m
+     in  Map.insertWith ins k (Nothing,edges') m
    | otherwise
    = m
 
+  ins (_, e1) (_, e2)
+   = (Nothing, nub $ e1 ++ e2)
+
   weights' = invertMap weights
 
   name n
    = maybe n id (name_maybe n)
 
+  -- If this node is mentioned in the weights map, then find some canonical name for it.
   name_maybe n
    | Just i      <- Map.lookup n weights
    , Just (v:_)  <- Map.lookup i weights'
@@ -160,11 +154,76 @@
   go k v m' = Map.insertWith (++) v [k] m'
 
 
-mlookup :: Ord k => String -> Map.Map k v -> k -> v
-mlookup str m k
- | Just v <- Map.lookup k m
- = v
+-- | Number of nodes in graph
+numNodes :: Graph n t -> Int
+numNodes (Graph g)
+ = Map.size g
+
+-- | Total number of edges in graph
+numEdges :: Graph n t -> Int
+numEdges (Graph g)
+ = Map.fold (+)            0
+ $ Map.map  (length . snd) g
+
+
+hasNode :: Ord n => Graph n t -> n -> Bool
+hasNode (Graph gmap) k
+ = k `Map.member` gmap
+
+hasEdge :: Ord n => Graph n t -> (n,n) -> Bool
+hasEdge g (i,j)
+ = i `elem` nodeInputs g j
+
+nodeInputs :: Ord n => Graph n t -> n -> [n]
+nodeInputs g k
+ = map fst
+ $ nodeInEdges g k
+
+nodeInEdges :: Ord n => Graph n t -> n -> [(n,Bool)]
+nodeInEdges (Graph gmap) k
+ | Just (_,es) <- Map.lookup k gmap
+ = es
  | otherwise
- = error ("ddc-core-flow.mlookup: no key " ++ str)
+ = []
 
+
+-- | Find type, or iteration size, of node, if it has one.
+-- An external can't be represented as a loop, so it will be Nothing.
+-- Similarly with input nodes.
+nodeType :: Ord n => Graph n t -> n -> Maybe t
+nodeType (Graph gmap) k
+ | Just (Just na,_) <- Map.lookup k gmap
+ = Just na
+ | otherwise
+ = Nothing
+
+
+-- | Convert @Graph@ to a lists of nodes and a list of edges
+listOfGraph :: Ord n => Graph n t -> ([(n,Maybe t)], [((n,n),Bool)])
+listOfGraph (Graph g)
+ = (nodes, edges)
+ where
+  gl = Map.toList g
+
+  nodes = map       (\(k,(na,_)) -> (k,na)) gl
+  edges = concatMap (\(k,(_,es)) -> map (\(k',ea) -> ((k,k'),ea)) es) gl
+
+
+-- | Convert lists of nodes and list of edges to a @Graph@
+graphOfList :: Ord n => ([(n,Maybe t)], [((n,n),Bool)]) -> Graph n t
+graphOfList (nodes, edges)
+ = Graph
+ $ addEdges nodeMap
+ where
+  nodeMap
+   = Map.fromList
+   $ map (\(k,na) -> (k,(na,[])))
+   $ nodes
+
+  addEdges g
+   = foldl insE g edges
+
+  insE g ((k,k'),ea)
+   = Map.adjust (\(na,es) -> (na, (k',ea):es))
+     k g
 
diff --git a/DDC/Core/Flow/Transform/Rates/SeriesOfVector.hs b/DDC/Core/Flow/Transform/Rates/SeriesOfVector.hs
--- a/DDC/Core/Flow/Transform/Rates/SeriesOfVector.hs
+++ b/DDC/Core/Flow/Transform/Rates/SeriesOfVector.hs
@@ -1,3 +1,4 @@
+
 module DDC.Core.Flow.Transform.Rates.SeriesOfVector
         (seriesOfVectorModule
         ,seriesOfVectorFunction)
@@ -5,22 +6,24 @@
 import DDC.Core.Collect
 import DDC.Core.Flow.Compounds
 import DDC.Core.Flow.Prim
-import DDC.Core.Flow.Exp
-import DDC.Core.Flow.Transform.Rates.Constraints
+import DDC.Core.Flow.Exp                           as DDC
+import DDC.Core.Flow.Transform.Rates.Combinators   as Com
+import DDC.Core.Flow.Transform.Rates.CnfFromExp
 import DDC.Core.Flow.Transform.Rates.Fail
 import DDC.Core.Flow.Transform.Rates.Graph
+import qualified DDC.Core.Flow.Transform.Rates.SizeInference as SI
+import DDC.Core.Flow.Transform.Rates.Clusters
 import DDC.Core.Module
 import DDC.Core.Transform.Annotate
 import DDC.Core.Transform.Deannotate
 import qualified DDC.Type.Env           as Env
 
-import           Control.Applicative
-import           Control.Monad
-import           Data.List              (intersect, nub)
-import qualified Data.Map               as Map
-import           Data.Maybe             (catMaybes)
-import qualified Data.Set               as Set
+import qualified Data.Map as Map
+import           Data.Map   (Map)
+import qualified Data.Set as Set
+import Data.List   (partition)
 
+
 seriesOfVectorModule :: ModuleF -> (ModuleF, [(Name,Fail)])
 seriesOfVectorModule mm
  = let body       = deannotate (const Nothing)
@@ -29,454 +32,501 @@
        (lets, xx) = splitXLets body
        letsErrs   = map seriesOfVectorLets lets
 
-       lets'      = map       fst letsErrs
+       lets'      = concatMap fst letsErrs
        errs       = concatMap snd letsErrs
 
        body'      = annotate ()
                   $ xLets lets' xx
 
 
-   in  -- trace ("ORIGINAL:"++ show (ppr $ moduleBody mm))
-       -- trace ("MODULE:" ++ show (ppr body'))
-       (mm { moduleBody = body' }, errs)
+   in  (mm { moduleBody = body' }, errs)
        
 
 
-seriesOfVectorLets :: LetsF -> (LetsF, [(Name,Fail)])
+seriesOfVectorLets :: LetsF -> ([LetsF], [(Name,Fail)])
 seriesOfVectorLets ll
  | LLet b@(BName n _) x <- ll
- , (x',errs)  <- seriesOfVectorFunction x
- = (LLet b x', map (\f -> (n,f)) errs)
+ , (x',ls',errs)  <- seriesOfVectorFunction x
+ = ( map (uncurry LLet) ls' ++ [LLet b x']
+   , map (\f -> (n,f)) errs)
 
  | LRec bxs             <- ll
  , (bs,xs)              <- unzip bxs
- , (xs',_errs)          <- unzip $ map seriesOfVectorFunction xs
- = (LRec (bs `zip` xs'), []) 
+ , (xs',ls', _errs)          <- unzip3 $ map seriesOfVectorFunction xs
+ = ( [LRec (concat ls' ++ (bs `zip` xs'))]
+   , []) 
         -- We still need to produce errors if this doesn't work.
 
  | otherwise
- = (ll, [])
+ = ([ll], [])
 
 
 -- | Takes a single function body. Function body must be in a-normal form.
-seriesOfVectorFunction :: ExpF -> (ExpF, [Fail])
+seriesOfVectorFunction :: ExpF -> (ExpF, [(BindF,ExpF)], [Fail])
 seriesOfVectorFunction fun
- = run $ do
-        -- Peel off the lambdas
-        let (lams, body)   = takeXLamFlags_safe fun
-        
-            -- This assumes the body is already in a-normal form.
-            (lets, xx)     = splitXLets         body
-        
-        -- Split into name and values and warn for recursive bindings
-        binds             <- takeLets           lets
-        let tymap          = takeTypes          (concatMap valwitBindsOfLets lets ++ map snd lams)
+ = case cnfOfExp fun of
+   Left err
+    -> (fun, [], [FailCannotConvert err])
+   Right prog
+    -> case SI.generate prog of
+           Nothing
+            -> (fun, [], [])
 
-        -- Assumes the binds only use vector primitives,
-        -- OR   if not vector primitives, do not refer to bound vectors
+           Just (env,_s)
+            -> let g          = graphOfBinds prog env
+                   tmap a b   = SI.parents prog env a b
+                   clusters   = cluster g tmap
+                   (re, ls)   = reconstruct fun prog env clusters
+               in  (re, ls, [])
 
-        let names = map fst binds
-        -- Make sure names are unique
-        when (length names /= length (nub names)) $
-          warn FailNamesNotUnique
 
-        (constrs, equivs)
-                  <- checkBindConstraints binds
+reconstruct
+        :: ExpF
+        -> Program Name Name
+        -> SI.Env Name
+        -> [[CName Name Name]]
+        -> (ExpF, [(BindF, ExpF)])
+reconstruct fun prog env clusters
+ = (makeXLamFlags lams
+   $ xLets lets' xx
+   , procs)
+ where
 
-        let extras = catMaybes
-                   $ map (takeNameOfBind . snd) lams
-        let graph  = graphOfBinds         binds extras
+  (lams, body)   = takeXLamFlags_safe fun
+  (olds, xx)     = splitXLets         body
 
-        let rets   = catMaybes
-                   $ map takeNameOfBound
-                   $ Set.toList
-                   $ freeX Env.empty xx
-        
-        loops     <- schedule             graph equivs rets
+  types          = takeTypes          (concatMap valwitBindsOfLets olds ++ map snd lams)
 
-        binds'    <- orderBinds           binds loops
+  lets           = concatMap convert clusters
+  (lets', procs) = extractProcs lets lams
 
-        -- True <- trace ("TYMAP:" ++ show tymap) return True
-        -- True <- trace ("NAMES,LOOPS,NAMES':" ++ show (names, loops, map (map fst) binds')) 
-        --         return True
+  convert c
+   = let outputs = outputsOfCluster prog c
 
-        let outputs = map lOutputs loops
-        let inputs  = map lInputs  loops
+         arrIns  = seriesInputsOfCluster prog c
 
-        let getMax  = getMaxSize constrs equivs extras
+         -- Map over the list of all binds and find only those that we want.
+         -- This way is better than mapping lookup over c, as we get them in program order.
+         binds   = filter (flip elem c . cnameOfBind) (_binds prog)
+         binds'  = map (\a -> (a, cnameOfBind a `elem` outputs)) binds
+      in mkLets types env arrIns binds'
 
-        return $ construct getMax lams (zip3 binds' outputs inputs) equivs tymap xx
 
--- | Peel the lambdas off, or const if there are none
-takeXLamFlags_safe x
- | Just (binds, body) <- takeXLamFlags x
- = (binds, body)
- | otherwise
- = ([],    x)
+-- | Extract processes out so they can be made into separate bindings
+extractProcs :: [LetsF] -> [(Bool, DDC.Bind Name)] -> ([LetsF], [(BindF,ExpF)])
+extractProcs lets env
+ = go lets $ env
+ where
+  go [] _
+   = ([], [])
 
+  go (l:ls) e
+   -- Actually, we know they're all LLets. Maybe it should just be (Name,ExpF)
+   | LLet b x <- l
+   , BName nm _ <- b
+   = let this = go1 b nm x e
+         rest = go ls ((False,b) : e)
+     in this `mappend` rest
 
--- | Split into name and values and warn for recursive bindings
-takeLets :: [LetsF] -> LogFailures [(Name, ExpF)]
-takeLets lets
- = concat <$> mapM get lets
- where
-  get (LLet (BName n _) x) = return [(n,x)]
-  get (LLet (BNone _)   _) = return []
-  get (LLet (BAnon _)   _) = w      FailNoDeBruijnAllowed
-  get (LRec        _     ) = w      FailRecursiveBindings
-  get (LPrivate _ _ _)     = w      FailLetRegionNotHandled
-  get (LWithRegion _     ) = w      FailLetRegionNotHandled
+   | otherwise
+   = ([l],[]) `mappend` go ls e
 
-  w err                    = warn err >> return []
+  go1 b nm x e
+   | Just (op, args)                                      <- takeXApps x
+   , XVar (UPrim (NameOpSeries (OpSeriesRateVecsOfVectors n)) _)    <- op
+   , (xs, [lam])                                        <- splitAt (length args - 1) args
+   , (lams,body)                                        <- takeXLamFlags_safe lam
+   , ([LLet n' x'], binds)                              <- go1 b nm body (lams ++ e)
+   = ([LLet n'
+        (xApps (xVarOpSeries (OpSeriesRateVecsOfVectors n))
+            (xs ++ [makeXLamFlags lams x']))]
+     , binds)
 
--- | Split into name and values and warn for recursive bindings
-takeTypes :: [Bind Name] -> Map.Map Name TypeF
-takeTypes binds
- = Map.fromList $ concatMap get binds
- where
-  get (BName n t) = [(n,t)]
-  get _           = []
+   | Just (op, args)                                      <- takeXApps x
+   , XVar (UPrim (NameOpSeries OpSeriesRunProcess) _)    <- op
+   , (xs, [lam])                                         <- splitAt (length args - 1) args
 
+   = let fsX = freeX Env.empty lam
+         fsT = freeT Env.empty lam
 
-data Loop
- = Loop 
- { lBindings :: [Name]
- , lOutputs  :: [Name]
- , lInputs   :: [Name]
- } deriving (Eq,Show)
+         isMentioned (ty,bo)
+          | Just bo' <- takeSubstBoundOfBind bo
+          = if   ty
+            then Set.member bo' fsT
+            else Set.member bo' fsX
+          | otherwise
+          = False
 
-schedule :: Graph -> EquivClass -> [Name] -> LogFailures [Loop]
-schedule graph equivs rets
- = let type_order    = map (canonName equivs . Set.findMin) equivs
-       -- minimumBy length $ map scheduleTypes $ permutations type_order
-       (wts, graph') = scheduleTypes graph equivs type_order
-       loops         = scheduleAll (map snd wts) graph graph'
-       -- Use the original graph to find vars that cross loop boundaries
-       outputs       = scheduleOutputs loops graph rets
-       inputs        = scheduleInputs  loops graph
-   in  -- trace ("GRAPH,GRAPH',WTS,EQUIVS:" ++ show (graph, graph', wts, equivs)) 
-       return $ zipWith3 Loop loops outputs inputs
+         os = filter isMentioned e
 
-scheduleTypes :: Graph -> EquivClass -> [Name] -> ([(Name, Map.Map Name Int)], Graph)
-scheduleTypes graph types type_order
- = foldl go ([],graph) type_order
- where
-  go (w,g) ty
-   = let w' = typedTraversal g types ty
-         g' = mergeWeights   g w'
-     in  ((ty,w') : w, g')
+         ss  = takeSubstBoundsOfBinds . map snd
+         osT = filter     (fst) os
+         osX = filter (not.fst) os
 
+         nm' = NameVarMod nm "process"
 
-scheduleAll :: [Map.Map Name Int] -> Graph -> Graph -> [[Name]]
-scheduleAll weights graph graph'
- = loops
- where
-  weights' = map invertMap  weights
-  topo     = graphTopoOrder graph'
-  loops    = map getNames topo
+         x' = xApps op (xs ++
+                [xApps (XVar $ UName nm')
+                  (  map (XType . TVar) (ss osT)
+                  ++ map  XVar          (ss osX))])
 
-  getNames n
-   = sort $ find n (weights `zip` weights')
+         p' = makeXLamFlags (osT ++ osX) lam
+     in ([LLet b x'], [(BName nm' (tBot kData),  p')])
 
-  original_order = graphTopoOrder graph
+   | otherwise
+   = ([LLet b x], [])
 
-  -- Cheesy hack to get ns in same order as the original graph's topo:
-  -- filter topo to only those elements in ns
-  sort ns
-   = filter (flip elem ns) original_order
+-- | Make "lets" for a cluster.
+-- If it's external, this is trivial.
+-- If not, make a runProcess# etc
+mkLets :: Map Name TypeF -> SI.Env Name -> [Name] -> [(Com.Bind Name Name, Bool)] -> [LetsF]
+mkLets types env arrIns bs
+ | any isExt (map fst bs)
+ = case bs of
+    [(Ext (NameArray  b) xx _, _)] -> [LLet (BName b (types Map.! b)) xx]
+    [(Ext (NameScalar b) xx _, _)] -> [LLet (BName b (types Map.! b)) xx]
 
-  find _ []
-   = []
+    _    -> error ("ddc-core-flow:DDC.Core.Flow.Transform.Rates.SeriesOfVector impossible\n" ++
+                   "an external node has been clustered with another node.\n" ++
+                   "this means there must be a bug in the clustering algorithm.\n" ++
+                   show bs)
 
-  find n ((w,w') : rest)
-   | Just i  <- n `Map.lookup` w
-   , Just ns <- i `Map.lookup` w'
-   = ns
+ -- We *could* just return an empty list in this case, but I don't think that's a good idea.
+ | [] <- bs
+ =          error ("ddc-core-flow:DDC.Core.Flow.Transform.Rates.SeriesOfVector impossible\n" ++
+                   "a cluster was created with no bindings.\n" ++
+                   "this means there must be a bug in the clustering algorithm.\n" ++
+                   show bs)
 
-   | otherwise
-   = find n rest
+ | otherwise
+ = process types env arrIns
+ $ map toEither bs
 
--- Find any variables that cross loop boundaries - they must be reified
-scheduleOutputs :: [[Name]] -> Graph -> [Name] -> [[Name]]
-scheduleOutputs loops graph rets
- = map output loops
  where
-  output ns
-   = graphOuts ns ++ filter (`elem` ns) rets 
+  isExt (Ext{}) = True
+  isExt _       = False
 
-  graphOuts ns
-   = concatMap (\(k,es) -> if   k `elem` ns
-                           then []
-                           else ns `intersect` map fst es)
-   $ Map.toList graph
+  toEither (SBind s b, out) = ((s, Left  b), out)
+  toEither (ABind a b, out) = ((a, Right b), out)
+  toEither (Ext{},     _)   = error "ddc-core-flow.mkLets: impossible!"
 
--- Find any variables that cross loop boundaries - they must be reified
-scheduleInputs  :: [[Name]] -> Graph -> [[Name]]
-scheduleInputs  loops graph
- = map input loops
+
+-- | Create a process for a cluster of array and scalar bindings.
+-- No externals.
+-- List of bindings cannot be empty
+process :: Map Name TypeF
+        -> SI.Env Name
+        -> [Name]
+        -> [((Name, Either (SBind Name Name) (ABind Name Name)), Bool)]
+        -> [LetsF]
+process types env arrIns bs
+ = let pres  = concatMap  getPre  bs
+       mid   = getRateVecs arrIns
+             $ getGenerates bs
+             $ runProcs   
+             $ xLets (map getInSeries arrIns)
+             $ mkProcs bs
+       posts = concatMap  getPost bs
+   in pres ++ [LLet (BName (NameVarMod outname "runproc") tUnit) mid] ++ posts
  where
-  input ns
-   = filter (\n -> not (n `elem` ns))
-   $ graphIns ns
+  getPre b
+   -- There is no point of having a reduce that isn't returned.
+   | ((s, Left (Fold _ (Scalar z _) _)), _)       <- b
+   = [LLet (BName (NameVarMod s "ref") $ tRef $ tyOf s) (xNew (tyOf s) z)]
 
-  graphIns ns
-   = nub $ concatMap (map fst . mlookup "graphIns" graph) ns
+   -- Returned vectors
+   | ((v, Right _), True)                       <- b
+   = [LLet (BName v $ tVector $ sctyOf v) (xNewVector (sctyOf v) allocSize)]
 
-typedTraversal :: Graph -> EquivClass -> Name -> Map.Map Name Int
-typedTraversal graph types current_type
- = restrictTypes types current_type
- $ traversal graph w
- where
-  w  u v = if w' u v then 1 else 0
+   -- Otherwise, it's not returned or we needn't allocate anything
+   | _                                          <- b
+   = []
 
-  w' (u, fusible) v
-   | canonName types u == current_type
-   = canonName types v /= current_type || not fusible
 
+  getGenerates [] innerX
+   = innerX
+  getGenerates (b:rest) innerX
+   | ((n, Right (Generate (Scalar sz _) _)), _) <- b
+   , rest' <- getGenerates rest innerX
+   = xApps (xVarOpSeries (OpSeriesRateVecsOfVectors 0))
+           [ XType tUnit
+           , sz
+           , XLAM (BName (klokV n) kRate) rest' ]
    | otherwise
-   = False
+   = getGenerates rest innerX
 
+  getRateVecs [] innerX
+   = innerX
 
-restrictTypes :: EquivClass -> Name -> Map.Map Name Int -> Map.Map Name Int
-restrictTypes types current_type weights
- = Map.filterWithKey restrict weights
- where
-  restrict n _
-   = canonName types n == current_type
+  getRateVecs (a:as) innerX
+   | Just t        <- SI.lookupV env a
+   , (same,others) <- partition ((==Just t) . SI.lookupV env) as
+   , rest'         <- getRateVecs others innerX
 
+   , these         <- (a : same)
+   , nums          <- length these
 
-orderBinds :: [(Name,ExpF)] -> [Loop] -> LogFailures [[(Name,ExpF)]]
-orderBinds binds loops
- = let bindsM = Map.fromList binds
-       order  = map lBindings loops
-       get k  | Just v <- Map.lookup k bindsM
-              = [(k,v)]
-              | otherwise
-              = []
-   in  return $ map (\o -> concatMap get o) order
+   , op            <- OpSeriesRateVecsOfVectors nums
 
+   , flags         <- map (\n -> (False, BName (NameVarMod n "rv") (tRateVec (klokT a) (sctyOf n)))) these
+   = xApps (xVarOpSeries op)
+       (   map xsctyOf these ++ [XType tUnit]
+       ++  map var     these
+       ++[ makeXLamFlags ((True, BName (klokV a) kRate) : flags)
+            rest' ]
+       )
 
-construct
-        :: (Name -> Name)
-        -> [(Bool, BindF)]
-        -> [([(Name, ExpF)], [Name], [Name])]
-        -> EquivClass
-        -> Map.Map Name TypeF
-        -> ExpF
-        -> ExpF
-construct getMax lams loops equivs tys xx
- = let lets   = concatMap convert loops
-   in  makeXLamFlags lams
-     $ xLets lets
-     $ xx
- where
-  convert (binds, outputs, inputs)
-   = convertToSeries getMax binds outputs inputs equivs tys
+   -- Input array doesn't have a type..
+   | otherwise
+   = getRateVecs as innerX
 
+  getInSeries n
+   = LLet (BName (NameVarMod n "s") (tSeries procT (klokT n) (sctyOf n)))
+          (xApps (xVarOpSeries OpSeriesSeriesOfRateVec)
+            [ procX, klokX n, xsctyOf n, var $ NameVarMod n "rv" ] )
 
--- We still need to join procs,
--- split output procs into separate functions
-convertToSeries 
-        :: (Name -> Name) -> [(Name,ExpF)] -> [Name] -> [Name] 
-        -> EquivClass -> Map.Map Name TypeF -> [LetsF]
 
-convertToSeries getMax binds outputs inputs equivs tys
- =  concat setups
- ++ [LLet (BNone tBool) (runprocs inputs' processes)]
- ++ concat readrefs
- where
-  runprocs :: [(Name,TypeF)] -> ExpF -> ExpF
-  runprocs vecs@((cn,_):_) body
-   = let cnn    = canonName equivs cn
-         kN     = NameVarMod cnn "k"
-         kFlags = [ (True,  BName kN kRate)
-                  , (False, BNone $ tRateNat $ TVar $ UName kN)]
-         vFlags = map (\(n,t) -> (False, BName (NameVarMod n "s") (tSeries (TVar (UName kN)) t)))
-                        vecs
-     in  xApps (xVarOpSeries (OpSeriesRunProcess $ length vecs))
-               (  map (XType .         snd) vecs
-               ++ map (XVar  . UName . fst) vecs
-               ++ [(makeXLamFlags (kFlags ++ vFlags) body)])
 
-  -- Should we introduce a rate parameter for generates?
-  runprocs [] body
-   = body
-
-  inputs' :: [(Name,TypeF)]
-  inputs' = concatMap filterInputs inputs
+  getPost b
+   | ((s, Left (Fold _ (Scalar _ _) _)), _)       <- b
+   = [ LLet (BName s $ sctyOf s) (xRead (tyOf s) (var $ NameVarMod s "ref")) ]
 
-  filterInputs inp
-   | tyI <- mlookup "collectKloks" tys inp
-   , Just (_tcVec, [tyA]) <- takeTyConApps tyI
-   , tyI == tVector tyA
-   = [(inp, tyA)]
-   | otherwise
+   -- Ignore anything else
+   | _   <- b
    = []
 
-  processes 
-   = foldr wrap joins binds
+  runProcs body
+   = let flags = [ (True,  BName procName kProc)
+                 , (False, BNone tUnit) ]
+     in  xApps (xVarOpSeries OpSeriesRunProcess)
+               ([XType processRate, makeXLamFlags flags body])
 
-  wrap (n,x) body
-   = wrapSeriesX equivs outputs n (mlookup "wrap" tys n) x body
 
-  joins
-   | not $ null outputs
-   = foldl1 mkJoin
-   $ map (\n -> XVar $ UName $ NameVarMod n "proc") outputs
+  mkProcs (b:rs)
+   | ((s, Left (Fold (Fun xf _) (Scalar xs _) ain)), _)   <- b
+   = let rest = mkProcs rs
+     in  XLet (LLet   (BName (NameVarMod s "proc") $ tProcess procT $ klokT ain)
+              $ xApps (xVarOpSeries OpSeriesReduce)
+                      [ procX, klokX ain, xtyOf s, var (NameVarMod s "ref")
+                      , xf, xs, var (NameVarMod ain "s")])
+         rest
+
+   | ((n, Right abind), out) <- b
+   = let rest   = mkProcs rs
+         n'proc = NameVarMod n "proc"
+         n's    = NameVarMod n "s"
+         n'flag = NameVarMod n "flags"
+         n'sel  = NameVarMod n "sel"
+
+         llet nm t x1
+                = XLet (LLet (BName nm t) x1)
+
+         go     | out
+                = llet n'proc (tProcess procT $ klokT n)
+                ( xApps (xVarOpSeries OpSeriesFill) [procX, klokX n, xsctyOf n, var $ n, var $ n's] )
+                  rest
+                | otherwise
+                = rest
+
+     in  case abind of
+         MapN (Fun xf _) ains
+          -> llet n's (tSeries procT (klokT n) $ sctyOf n)
+           ( xApps (xVarOpSeries (OpSeriesMap (length ains)))
+                   ([procX, klokX n] ++ (map xsctyOf  ains) ++ [xsctyOf n, xf] 
+                        ++ map (var . flip NameVarMod "s") ains) )
+             go
+
+         Filter (Fun xf _) ain
+          -> llet n'flag (tSeries procT (klokT ain) tBool)
+           ( xApps (xVarOpSeries (OpSeriesMap 1))
+                   [ procX, klokX ain, xsctyOf n, XType tBool, xf, var $ NameVarMod ain "s"] )
+           $ xApps (xVarOpSeries $ OpSeriesMkSel 1)
+                   [ procX, klokX ain, XType processRate, var n'flag
+                   ,        XLAM (BName (klokV n) kRate)
+                          $ XLam (BName n'sel (tSel1 procT (klokT ain) (klokT n)))
+                          $ llet n's (tSeries procT (klokT n) $ sctyOf n)
+                          ( xApps (xVarOpSeries OpSeriesPack)
+                                  [ procX, klokX ain, klokX n, xsctyOf n
+                                  , var n'sel, var $ NameVarMod ain "s"] )
+                            go ]
+
+         Generate _sz (Fun xf _)
+          -> llet n's (tSeries procT (klokT n) $ sctyOf n)
+           ( xApps (xVarOpSeries OpSeriesGenerate)
+                   [ procX, klokX n, xsctyOf n, xf ])
+             go
+
+         Gather v ix
+          -> llet n's (tSeries procT (klokT n) $ sctyOf n)
+           ( xApps (xVarOpSeries OpSeriesGather)
+                   ([ procX, klokX v, klokX ix, xsctyOf v
+                    , var $ NameVarMod v "rv", var $ NameVarMod ix "s"]) )
+             go
+         Cross _a _b
+          -> error "ddc-core-flow.process: Cross combinator not implemented yet"
+
+   -- All cases are handled above
    | otherwise
-   = xUnit -- ???
+   = error "ddc-core-flow.process: impossible!"
 
+
+
+  mkProcs []
+   -- bs cannot be empty: there's no point of an empty cluster.
+   = let procs = concatMap getProc bs
+     in  case procs of
+         (_:_)  -> foldl1 mkJoin $ concatMap getProc bs
+         []     -> error "ddc-core-flow.process: cluster with no outputs?"
+
   mkJoin p q
    = xApps (xVarOpSeries OpSeriesJoin) [p, q]
 
-  -- fill vectors and read references
-  (setups, readrefs)
-   = unzip
-   $ map setread 
-   $ filter (flip elem outputs . fst) binds
+  getProc b@((s, Left _), _)
+   = [resizeProc b $ var $ NameVarMod s "proc"]
+  getProc b@((a, _), True)
+   = [resizeProc b $ var $ NameVarMod a "proc"]
+  getProc _
+   = []
 
-  setread (n,x)
-   = setreadSeriesX getMax tys n (mlookup "setread" tys n) x
+  resizeProc b v
+   = goResize (fst $ fst b) v (reverse bs)
 
+  goResize _ v []
+   = v
+  goResize n v (((n',b),_):rest)
+   | n == n'
+   = case b of
+      Left (Fold _ _ ain)
+       -> goResize ain v rest
+      Right (MapN _ (i:_))
+       -> goResize i   v rest
+      Right (MapN _ [])
+       -> error "ddc-core-flow.process: Map with no inputs."
 
-setreadSeriesX 
-        :: (Name -> Name) -> Map.Map Name TypeF -> Name -> TypeF -> ExpF -> ([LetsF], [LetsF])
-setreadSeriesX getMax tys name ty xx
- | Just (f, args)                       <- takeXApps xx
- , XVar (UPrim (NameOpVector ov) _)     <- f
- = case ov of
-   -- any folds MUST be known as outputs, so this is safe
-   OpVectorReduce
-    | [_tA, _f, z, _vA]   <- args
-    -> ([ LLet (BName (nm "ref") (tRef ty)) (xNew  ty z) ]
-       ,[ LLet (BName  name       ty)       (xRead ty (vr $ nm "ref"))])
+      Right (Filter _ ain)
+       -> goResize ain
+        ( xApps (xVarOpSeries OpSeriesResizeProc)
+          [ procX, klokX n, klokX ain
+          , xApps (xVarOpSeries OpSeriesResizeSel1)
+                [ procX, klokX n, klokX ain, klokX n
+                , var $ NameVarMod n "sel"
+                , xApps (xVarOpSeries OpSeriesResizeId)
+                        [ procX, klokX n ]
+                ]
+         , v ]) rest
 
-   _
-    | [_vec, tyR]       <- takeTApps ty
-    , v                 <- getMax name -- canonName equivs name
-    , [_vec, tyCR]      <- takeTApps $ mlookup "setreadSeriesX" tys v
-    -> let vl = xApps (xVarOpVector OpVectorLength)
-                      [XType tyCR, XVar $ UName v]
-       in  ([ LLet (BName name $ tBot kData) $ xNewVector tyR vl ]
-           ,  [])
+      Right (Generate _ _)
+       -> v
 
-   _
-    -> ([], [])
- | otherwise
- = ([],[])
- where
-  nm s = NameVarMod name s
-  vr n = XVar $ UName n
+      Right (Gather _ ain)
+       -> goResize ain v rest
 
+      Right (Cross a _b)
+       -> goResize a v rest
 
-wrapSeriesX :: EquivClass -> [Name] -> Name -> TypeF -> ExpF -> ExpF -> ExpF
-wrapSeriesX equivs outputs name ty xx wrap
- | Just (op, args)                      <- takeXApps xx
- , XVar (UPrim (NameOpVector ov) _)     <- op
- = case ov of
-   OpVectorReduce
-    | [_tA, f, z, vA]   <- args
-    , XVar (UName nvA)  <- vA
-    , kA                <- klok nvA
-    -> XLet (LLet (BName name'proc tProcess)
-                 $ xApps (xVarOpSeries OpSeriesReduce)
-                         [kA, XType ty, XVar (UName name'ref), f, z, modNameX "s" vA])
-             wrap
+   | otherwise
+   = goResize n v rest
 
-   OpVectorMap n
-    | (tys, f : rest) <- splitAt (n+1) args
-    , length rest     == n
-    , kT              <- klok name
-    , rest'           <- map (modNameX "s") rest
-    -> XLet (LLet (BName name's $ tBot kData)
-                 $ xApps (xVarOpSeries (OpSeriesMap n))
-                         ([kT] ++ tys ++ [f] ++ rest'))
-             wrap'fill
+     
+  allocSize
+   -- If there are any inputs, use the size of one of those
+   | (i:_) <- arrIns
+   = xApps (xVarOpVector OpVectorLength) [xsctyOf i, var i]
+   -- Or if it's a generate, find the size of the generate expression.
+   | (Scalar sz _:_) <- concatMap findGenerateSize bs
+   = sz
+   -- XXX Otherwise it must be an external, and this won't be called...
+   | otherwise
+   = error ("ddc-core-flow: allocSize, but no size known" ++ show arrIns ++ "\n" ++ show bs)
 
-   OpVectorFilter
-    | [tA, p, vA]       <- args
-    , XVar (UName nvA)  <- vA
-    , tkA               <- klokT nvA
-    , kA                <- klok nvA
-    , TVar (UName nkT)  <- klokT name
-    , tkT               <- klokT name
-    -> XLet (LLet (BName name'flags (tBot kData))
-                 $ xApps (xVarOpSeries (OpSeriesMap 1))
-                         ([kA, tA, XType tBool, p, modNameX "s" vA]))
-     $ xApps (xVarOpSeries (OpSeriesMkSel 1))
-             ([kA, XVar (UName name'flags)
-              ,    XLAM (BName nkT       kRate)
-                 $ XLam (BName name'sel (tSel1 tkA tkT))
-                 $ XLet (LLet (BName name's (tBot kData))
-                             $ xApps (xVarOpSeries OpSeriesPack)
-                                     ([kA, XType tkT, tA, XVar (UName name'sel), modNameX "s" vA]))
-                         wrap'fill ])
+  -- Find the loop rate of the process.
+  -- Since we don't have appends, it's just the rate of the first binding
+  processRate
+   = bindRate (head bs)
 
-   _
-    -> xx
- | otherwise
- = xx
+  bindRate b
+   = let k = klokT (fst $ fst b)
+     in case snd $ fst b of
+        Left (Fold _ _ ain)
+         -> klokT ain
+        Right (MapN _ _)
+         -> k
+        Right (Filter _ ain)
+         -> klokT ain
+        Right (Generate _ _)
+         -> k
+        Right (Gather _ _)
+         -> k
+        Right (Cross ain _)
+         -> klokT ain
 
- where
-  name'flags= NameVarMod name "flags"
-  name'proc = NameVarMod name "proc"
-  name'ref  = NameVarMod name "ref"
-  name's    = NameVarMod name "s"
-  name'sel  = NameVarMod name "sel"
+  -- We just need a name for the Proc type
+  procName = NameVarMod outname "PROC"
+  procT    = TVar  $ UName $ procName
+  procX    = XType $ procT
 
-  klokT n
-   = let n'  = canonName equivs n
-         kN  = NameVarMod n' "k"
-     in  TVar $ UName kN
-  klok n
-   = XType $ klokT n
+  klokV = getKlok env
+  klokT = TVar . UName . klokV
+  klokX = XType . klokT
 
-  tyR
-   | [_vec, tyR']        <- takeTApps ty
-   = Just tyR'
-   | otherwise
-   = Nothing
+  findGenerateSize ((_, Right (Generate sz _)), _)
+   = [sz]
+  findGenerateSize _
+   = []
 
-  wrap'fill
-   | name `elem` outputs
-   , Just tyR' <- tyR
-   = XLet (LLet (BName name'proc tProcess) $ xApps fillV [klok name, XType tyR', vr name, vr name's])
-           wrap
-   | otherwise
-   = wrap
 
-  fillV = xVarOpSeries OpSeriesFill
+  -- We just need to find the name of any binding
+  -- This head is safe because @mkLets@ will not call @process@ with an empty cluster.
+  outname
+   = fst $ fst $ head bs
 
-  vr n = XVar $ UName n
+  tyOf n  = types Map.! n
+  sctyOf  = getScalarType . tyOf
+  xtyOf   = XType . tyOf
+  xsctyOf = XType . sctyOf
 
---  tySeries
---   | Vector n
+  var n   = XVar $ UName n
 
+
 xVarOpSeries n = XVar (UPrim (NameOpSeries n) (typeOpSeries n))
 xVarOpVector n = XVar (UPrim (NameOpVector n) (typeOpVector n))
 
-modNameX :: String -> ExpF -> ExpF
-modNameX s xx
- = case xx of
-    XVar (UName n)
-     -> XVar (UName (NameVarMod n s))
-    _
-     -> xx
 
-{-
+-- | Get underlying scalar of a vector type - or just return original type if it's not a vector.
+getScalarType :: TypeF -> TypeF
+getScalarType tt
+ = case takePrimTyConApps tt of
+        Just (NameTyConFlow TyConFlowVector, [sc])      -> sc
+        _                                               -> tt
 
-\as,bs...
-cs = map as
-ds = filter as
-n  = fold ds
-es = map3 bs cs
-return es
 
-==>
-schedule graph equivs [es]
-==>
+-- | Create map of types of binders
+takeTypes :: [DDC.Bind Name] -> Map Name TypeF
+takeTypes binds
+ = Map.fromList $ concatMap get binds
+ where
+  get (BName n t) = [(n,t)]
+  get _           = []
 
-[ [ds, n]
-, [cs, es] ]
 
--}
+getKlok :: SI.Env Name -> Name -> Name
+getKlok e n
+ | Just t <- SI.lookupV e n
+ = ty $ goT t
+ | otherwise
+ = ty n
+ where
+  ty = flip NameVarMod "k"
+
+  goT (SI.TVar kv)
+   = goKV kv
+  -- This doesn't matter much..
+  goT (SI.TCross ta tb)
+   = NameVarMod (goT ta) (show tb)
+
+  goKV (SI.KV v)
+   = v
+  goKV (SI.K' kv)
+   = NameVarMod (goKV kv) "'"
+
+
diff --git a/DDC/Core/Flow/Transform/Rates/SizeInference.hs b/DDC/Core/Flow/Transform/Rates/SizeInference.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Rates/SizeInference.hs
@@ -0,0 +1,484 @@
+-- | Performing size inference on a program in Combinator Normal Form
+module DDC.Core.Flow.Transform.Rates.SizeInference
+    ( Type(..), K(..), Env, Scope(..), Scheme(..)
+    , generate
+    , lookupV
+    , iter
+    , parents
+    , trans ) where
+import DDC.Base.Pretty
+import DDC.Core.Flow.Transform.Rates.Combinators
+
+import Data.List
+import Data.Function (on)
+import Data.Maybe
+import qualified Control.Applicative as A
+import Control.Monad
+
+-----------------------------------
+-- = Size types, constraints and schemes
+
+-- | Given some variable type, append a number of primes onto it.
+-- We want to be able to distinguish between the raw variable types and unification, existential Klock (rate) variables.
+-- We generate constraints so that raw variables will appear on the left of equalities, and Ks may appear on the right.
+data K v
+ = KV v
+ | K' (K v)
+ deriving (Eq,Ord,Show)
+
+
+-- | tau ::=
+data Type v
+ -- | k
+ = TVar   (K v)
+ -- | tau * tau
+ | TCross (Type v) (Type v)
+ deriving (Eq, Ord,Show)
+
+-- | Find all variables in type
+freeT :: Type a -> [K a]
+freeT (TVar a)     = [a]
+freeT (TCross a b) = freeT a ++ freeT b
+
+
+-- | C ::=
+data Constraint v
+ -- | true
+ = CTrue
+ -- | v = tau
+ | CEqual v (Type v)
+ -- | C /\ C
+ | CAnd (Constraint v) (Constraint v)
+ deriving (Show)
+
+-- | Big conjunction. Join a bunch of constraints together
+ands :: [Constraint v] -> Constraint v
+ands = foldr CAnd CTrue
+
+-- | Flatten a set of constraints into a simpler, canonical form.
+-- Turn it into a list of variable/type equalities, ordered by variable name.
+flatten :: Ord v => Constraint v -> [(v, Type v)]
+flatten = sortBy (compare `on` fst) . go
+ where
+  go CTrue        = []
+  go (CEqual v k) = [(v,k)]
+  go (CAnd a b)   = go a ++ go b
+
+-- | Convert back from flattened form to a set of @Constraint@
+unflatten :: [(v, Type v)] -> Constraint v
+unflatten = ands . map (uncurry CEqual)
+
+
+-- | sigma ::= forall k... exists k... (x : t)... -> (x : t)...
+-- Note that these are all raw variable types.
+-- There is no point mentioning unification variables in this solved form.
+data Scheme v
+ = Scheme
+ { _forall :: [K v]
+ , _exists :: [K v]
+ , _from   :: [(v, Type v)]
+ , _to     :: [(v, Type v)]
+ }
+ deriving (Show)
+
+
+-----------------------------------
+-- = Constraint generation
+-- == Environment
+
+-- | Gamma ::= • | Gamma, Gamma...
+type Env v = [Scope v]
+
+-- | Gamma ::= ...
+data Scope v
+ -- | v : k
+ = EVar v (Type v)
+ -- | k
+ | EUnify (K v)
+ -- | exists k
+ | ERigid (K v)
+ deriving (Show)
+
+evar :: v -> Scope v
+evar v
+ = EVar v $ TVar $ KV v
+
+
+-- | Search for first (should be only) mention of k in environment, along with its index
+lookupV :: Eq v => Env v -> v -> Maybe (Type v)
+lookupV es v
+ = go es
+ where
+  go [] = Nothing
+  go (EVar v' t : _)
+     | v == v'
+     = Just t
+  go (_:es')
+   = go es'
+
+-- | Search for first (should be only) mention of k in environment, along with its index
+isUnify :: Eq v => Env v -> K v -> Bool
+isUnify es k
+ = go es
+ where
+  go [] = False
+  go (EUnify k' : _)
+     | k == k'
+     = True
+  go (_:es')
+   = go es'
+
+
+-- | Find all free variables in types of environment
+freeE :: Env a -> [K a]
+freeE es
+ = concatMap go es
+ where
+  go (EVar _ t) = freeT t
+  go  _         = []
+
+
+-- == Generation of constraints
+-- For example, the program
+--
+-- > normalize2 :: Array Int -> (Array Int, Array Int)
+-- > normalize2 xs
+-- >  = let sum1 = fold (+) 0 xs
+-- >        gts = filter (> 0) xs
+-- >        sum2 = fold (+) 0 gts
+-- >        ys1 = map (/ sum1) xs
+-- >        ys2 = map (/ sum2) xs
+-- >    in (ys1, ys2)
+--
+-- will generate environment and constraints
+--
+-- >    xs : kxs, gts : kgts, ys1 : kys1, ys2 : kys2, ∃k1, k2, k3
+-- > |- true ∧ kgts = k1 ∧ true
+-- >         ∧ kxs  = k2 ∧ kys1 = k2 ∧ kxs = k3 ∧ kys2 = k3
+--
+-- | program :_s sigma
+generate :: Ord a => Program s a -> Maybe (Env a, Scheme a)
+generate program@(Program (_inSs,inAs) _binds (_outSs,outAs))
+ = do   e <- generateEnv program
+        let fvs = freeE e
+
+        let alls  x = case x of
+                        EUnify v | v `elem` fvs -> [v]
+                        _                       -> []
+        let exis  x = case x of
+                        ERigid v | v `elem` fvs -> [v]
+                        _                       -> []
+
+        let us = concatMap alls e
+        let rs = concatMap exis e
+
+        let inTs = catMaybes $ map (lookupV e) inAs
+        let ouTs = catMaybes $ map (lookupV e) outAs
+
+        let fvIn = nub $ concatMap freeT inTs
+        let fvOu = nub $ concatMap freeT ouTs
+
+        -- check if there are any rigids mentioned in input types:
+        -- this means we'd have an existential input, which is nonsense.
+        when (any (flip elem rs) fvIn)
+            Nothing
+
+        let sch = Scheme
+                { _forall = fvIn  `intersect` us
+                , _exists = fvOu  `intersect` rs
+                , _from   = inAs  `zip` inTs
+                , _to     = outAs `zip` ouTs
+                }
+        return (e, sch)
+
+
+-- | Get environment
+generateEnv :: Ord a => Program s a -> Maybe (Env a)
+generateEnv (Program (_inSs,inAs) binds _outs)
+ = do   let e         = concatMap (\i -> [EUnify (KV i), evar i]) inAs
+        let (e',  c') = generateLets e binds
+        -- If solve succeeds, there will be no duplicate left-hand sides in c''.
+        (e'', c'')   <- solve e' c'
+        -- Now, we must group the variables into equivalence classes.
+        -- Take all the leftover constraints and substitute them into the environment
+        return $ substEAll c'' e''
+
+
+-- | Gamma |- lets ~> Gamma |- C
+generateLets :: Ord a => Env a -> [Bind s a] -> (Env a, Constraint a)
+generateLets e bs
+ = foldl go (e, CTrue) bs
+ where
+  go (e',c') b
+   = let (e'', c'') = generateBind e' b
+     in  (e'', c' `CAnd` c'')
+
+-- | Gamma | z |- bind ~> Gamma |- C
+generateBind :: Ord a => Env a -> Bind s a -> (Env a, Constraint a)
+generateBind env b
+ = case b of
+   ABind z (MapN _ xs)
+    -> let u    = K' (KV z)
+           env' = evar z : EUnify u : env
+           con  = ands $ map (\i -> CEqual i (TVar u)) (z : xs)
+       in (env', con)
+
+   ABind z (Filter _ _)
+    -> let u    = K' (KV z)
+           env' = evar z : ERigid u : env
+           con  = CEqual z (TVar u)
+       in (env', con)
+
+   SBind _ (Fold _ _ _)
+    -> (env, CTrue)
+
+   ABind z (Generate _ _)
+    -> let u    = K' (KV z)
+           env' = evar z : ERigid u : env
+           con  = CEqual z (TVar u)
+       in (env', con)
+
+   ABind z (Gather _ i)
+    -> let u    = K' (KV z)
+           env' = evar z : EUnify u : env
+           con  = CEqual z (TVar u) `CAnd` CEqual i (TVar u)
+       in (env', con)
+
+   ABind z (Cross x y)
+    -> let u    =     K' (KV z)
+           u'   = K' (K' (KV z))
+           env' = evar z : EUnify u' : EUnify u : env
+           con  = ands [ CEqual z (TCross (TVar u) (TVar u'))
+                       , CEqual x (TVar u)
+                       , CEqual y (TVar u') ]
+       in (env', con)
+
+   Ext (NameArray  a) _ (_, _)
+    -> let env' = [evar a, ERigid $ K' $ KV a] ++ env
+           con  = CEqual a $ TVar $ K' $ KV a
+       in (env', con)
+
+   Ext (NameScalar _) _ (_, _)
+    -> (env, CTrue)
+
+
+
+        
+-- | Solving constraints.
+-- If we take the environment and constraints from @normalize2@,
+-- >    xs : kxs, gts : kgts, ys1 : kys1, ys2 : kys2, ∃k1, k2, k3
+-- > |- true ∧ kgts = k1 ∧ true
+-- >         ∧ kxs  = k2 ∧ kys1 = k2 ∧ kxs = k3 ∧ kys2 = k3
+-- the constraints can be converted to canonical form by 'flatten':
+-- >  [kgts = k1, kxs = k2, kxs = k3, kys1 = k2, kys2 = k3]
+-- After that, we iterate through the list of constraints, finding duplicate left hand sides.
+-- For some duplicate left hand side, such as
+-- >              kxs = k2, kxs = k3
+-- the k2 and k3 must be unified in Env.
+solve :: Ord a => Env a -> Constraint a -> Maybe (Env a, Constraint a)
+solve e c
+ = let cs   = flatten c
+   in  go cs e cs
+ where
+  go [ ] e' c' = return (e', unflatten c')
+  go [_] e' c' = return (e', unflatten c')
+
+  go ((x,a):(y,b):rs) e' c'
+   | x == y
+   = do  sub <- unify e a b
+         -- Substitute into both the full constraint set,
+         -- and just those remaining to check
+         let e'' = substE  sub e'
+         let c'' = substCs sub c'
+         let rest= substCs sub ((y,b) : rs)
+         go rest e'' c''
+   | otherwise
+   = go ((y,b) : rs) e' c'
+
+
+-- | A substitution, mapping some variable to a type
+type Subst a = [(K a, Type a)]
+
+
+-- | Perform substitution over types
+substT :: Ord a => Subst a -> Type a -> Type a
+substT sub t@(TVar a)
+ | Just t' <- lookup a sub
+ = t'
+ | otherwise
+ = t
+substT sub (TCross a b)
+ = TCross (substT sub a) (substT sub b)
+
+
+-- | Perform substitution over already-flattened constraints
+substCs :: Ord a => Subst a -> [(a, Type a)] -> [(a, Type a)]
+substCs sub cs
+ = map (\(v,t) -> (v, substT sub t)) cs
+
+
+-- | Perform substitution over environment
+substE :: Ord a => Subst a -> Env a -> Env a
+substE sub es
+ = map go es
+ where
+  go (EVar v t) = EVar v (substT sub t)
+  go e          = e
+
+
+-- | Take all constraints, treat them as substitutions
+substEAll :: Ord a => Constraint a -> Env a -> Env a
+substEAll cs es
+ = substE (map mkSub $ flatten cs) es
+ where
+  mkSub (v,t) = (KV v, t)
+
+
+-- | Given two types, find a substitution that unifies the two together
+-- The substitution may only change the value of unifier variables
+unify :: Ord a => Env a -> Type a -> Type a -> Maybe (Subst a)
+unify e l r
+ = go l r
+ where
+  go (TVar a) (TVar b)
+   | a == b       = Just []
+   | isUnify e a  = Just [(a, TVar b)]
+   | isUnify e b  = Just [(b, TVar a)]
+   -- Neither variables are unifiers. It cannot be done.
+   | otherwise    = Nothing
+
+  go (TCross a1 a2) (TCross b1 b2)
+   = (++) A.<$> go a1 b1 A.<*> go a2 b2
+
+  go (TVar a) b@(TCross _ _)
+   | isUnify e a
+   = Just [(a, b)]
+   | otherwise
+   = Nothing
+
+  go a@(TCross _ _) (TVar b)
+   | isUnify e b
+   = Just [(b, a)]
+   | otherwise
+   = Nothing
+
+
+-- = Iteration size and transducers
+
+-- | Find iteration size of given combinator
+iter :: (Eq a, Eq s) => Program s a -> Env a -> CName s a -> Maybe (Type a)
+iter program e nm
+ | NameScalar  nm' <- nm
+ = do   b <- lookupS program nm'
+        case b of
+         Fold _ _ n -> get n 
+ | NameArray   nm' <- nm
+ = do   b <- lookupA program nm'
+        case b of
+         MapN{}         -> get nm'
+         Filter _ as    -> get as
+         Generate _ _   -> get nm'
+         Gather _d is   -> get is
+         Cross  as bs   -> TCross A.<$> get as A.<*> get bs
+ -- Otherwise, it's external.
+ | otherwise
+ = Nothing
+ where
+  get = lookupV e
+
+
+-- | Find a bindings' transducer.
+-- Only array bindings can have transducers.
+trans :: (Eq a, Eq s) => Program s a -> CName s a -> Maybe (CName s a)
+trans bs nm
+ | NameArray nm' <- nm
+ , Just (Filter _ n) <- lookupA bs nm' = trans' (NameArray n)
+ | otherwise                           = trans' nm
+ where
+  trans' (NameScalar o)
+   = case lookupS bs o of
+     Just (Fold _ _ n)
+      -> trans' (NameArray n)
+
+     -- Not a binding, or an external
+     Nothing
+      -> Nothing
+
+  trans' (NameArray o)
+   = case lookupA bs o of
+     Just (Filter _ _n)
+      -> Just (NameArray o)
+
+     Just (MapN _ ns)
+      -> listToMaybe $ catMaybes $ map (trans' . NameArray) ns
+     Just (Gather _d i)
+      -> trans' (NameArray i)
+
+     Just (Generate _ _)
+      -> Nothing
+     Just (Cross _ _)
+      -> Nothing
+
+     -- Not a binding, or an external
+     Nothing
+      -> Nothing
+
+
+-- | Find pair of parent transducers with same iteration size
+parents :: (Eq a, Eq s) => Program s a -> Env a -> CName s a -> CName s a -> Maybe (CName s a, CName s a)
+parents bs e a b
+ | itsz a == itsz b
+ = Just (a,b)
+
+ | otherwise
+ = let pas = trans bs a >>= \a'' -> parents bs e a'' b
+       pbs = trans bs b >>= \b'' -> parents bs e a   b''
+       ps  = catMaybes [pas, pbs]
+       -- If @b@ is a child of @a@, we want to find the parents @(a,a)@.
+       -- There may be other parents, but @(a,a)@ is the "most specific".
+       -- There is actually an error in the paper - nodes may have multiple parents
+       -- if one node is the parent/transducer of the other.
+       same= filter (\(a',b') -> a' `elem` [a,b] || b' `elem` [a,b]) ps
+   in  case same of
+        (s:_) -> Just s
+        []    -> listToMaybe ps
+
+ where
+  itsz = iter bs e
+ 
+-----------------------------------
+-- == Pretty printing
+
+instance (Pretty v) => Pretty (K v) where
+ ppr (KV v) = ppr v
+ ppr (K' v) = ppr v <> squote
+
+instance (Pretty v) => Pretty (Type v) where
+ ppr (TVar   v)   = ppr v
+ ppr (TCross a b) = ppr a <+> text "*" <+> ppr b
+
+
+instance (Pretty v) => Pretty (Maybe (Type v)) where
+ ppr (Just t)     = ppr t
+ ppr Nothing      = text "(no type)"
+
+instance (Pretty v) => Pretty (Scope v) where
+ ppr (EVar v t)   = ppr v <+> text ":" <+> ppr t
+ ppr (EUnify v)   = text "∀" <> ppr v
+ ppr (ERigid v)   = text "∃" <> ppr v
+
+{-
+instance (Pretty v) => Pretty (Env v) where
+ ppr = hcat . map ppr
+-}
+
+instance (Pretty v) => Pretty (Scheme v) where
+ ppr (Scheme foralls exists from to)
+  =   text "∀" <> hcat (map ppr foralls) <> text ". "
+  <+> text "∃" <> hcat (map ppr exists)  <> text ". "
+  <+> tupled (map tppr from) <+> text "→"
+  <+> tupled (map tppr to)
+  where
+   tppr (v,t) = ppr v <+> text ":" <+> ppr t
+
+
diff --git a/DDC/Core/Flow/Transform/Schedule/Base.hs b/DDC/Core/Flow/Transform/Schedule/Base.hs
--- a/DDC/Core/Flow/Transform/Schedule/Base.hs
+++ b/DDC/Core/Flow/Transform/Schedule/Base.hs
@@ -3,16 +3,17 @@
         ( elemBindOfSeriesBind
         , elemBoundOfSeriesBound
         , elemTypeOfSeriesType
-        , rateTypeOfSeriesType
-        , slurpRateOfParamTypes
+        , resultRateTypeOfSeriesType
+        , procTypeOfSeriesType
 
-        , elemTypeOfVectorType)
+        , rateTypeOfRateVecType
+
+        , elemTypeOfVectorType
+        , bufOfVectorName)
 where
-import DDC.Core.Flow.Transform.Schedule.Error
 import DDC.Core.Flow.Compounds
 import DDC.Core.Flow.Prim
 import DDC.Core.Flow.Exp
-import Data.Maybe
 
 
 -- | Given the bind of a series,  produce the bound that refers to the
@@ -44,34 +45,48 @@
 --   of a single element, namely the @e@.
 elemTypeOfSeriesType :: TypeF -> Maybe TypeF
 elemTypeOfSeriesType tSeries'
-        | Just (_tcSeries, [_tK, tE]) <- takeTyConApps tSeries'
+        | Just (_tcSeries, [_tP, _tK, tE]) <- takeTyConApps tSeries'
         = Just tE
 
         | otherwise
         = Nothing
 
 
--- | Given the type of a series like @Series k e@, produce the type
+-- | Given the type of a series like @Series p k l e@, produce the type
+--   of the result rate, namely the @k@.
+resultRateTypeOfSeriesType :: TypeF -> Maybe TypeF
+resultRateTypeOfSeriesType tSeries'
+        | isSeriesType tSeries'
+        , Just (_tcSeries, [_tP, tK, _tE]) <- takeTyConApps tSeries'
+        = Just tK
+
+        | otherwise
+        = Nothing
+
+-- | Given the type of a series like @Series p k l e@, produce the type
+--   of the process, namely the @p@
+procTypeOfSeriesType :: TypeF -> Maybe TypeF
+procTypeOfSeriesType tSeries'
+        | isSeriesType tSeries'
+        , Just (_tcSeries, [tP, _tK, _tE]) <- takeTyConApps tSeries'
+        = Just tP
+
+        | otherwise
+        = Nothing
+
+
+-- | Given the type of a rate-annotated vector like @RateVec k e@, produce the type
 --   of the rate, namely the @k@.
-rateTypeOfSeriesType :: TypeF -> Maybe TypeF
-rateTypeOfSeriesType tSeries'
-        | Just (_tcSeries, [tK, _tE]) <- takeTyConApps tSeries'
+rateTypeOfRateVecType :: TypeF -> Maybe TypeF
+rateTypeOfRateVecType tV'
+        | isRateVecType tV'
+        , Just (_tcV, [tK, _tE]) <- takeTyConApps tV'
         = Just tK
 
         | otherwise
         = Nothing
 
 
--- | Given the type of the process parameters, 
---   yield the rate of the overall process.
-slurpRateOfParamTypes :: [Type Name] -> Either Error (Type Name)
-slurpRateOfParamTypes tsParam
- = case mapMaybe rateTypeOfSeriesType tsParam of
-        []                      -> Left ErrorNoSeriesParameters
-        [tK]                    -> Right tK
-        (tK : ts)
-         | all (== tK) ts       -> Right tK
-         | otherwise            -> Left ErrorMultipleRates
 
 
 -- Vector ---------------------------------------------------------------------
@@ -84,3 +99,10 @@
 
         | otherwise
         = Nothing
+
+-- | Given the name of a vector, find the name of the binding of its underlying buffer.
+-- This binding is produced by Extract.
+bufOfVectorName :: BoundF -> BoundF
+bufOfVectorName (UName n) = UName $ NameVarMod n "buf"
+bufOfVectorName b         = error (show b)
+
diff --git a/DDC/Core/Flow/Transform/Schedule/Error.hs b/DDC/Core/Flow/Transform/Schedule/Error.hs
--- a/DDC/Core/Flow/Transform/Schedule/Error.hs
+++ b/DDC/Core/Flow/Transform/Schedule/Error.hs
@@ -15,10 +15,6 @@
         -- | Process has no rate parameters.
         = ErrorNoRateParameters
 
-        -- | Process has no series parameters, 
-        --   but there needs to be at least one.
-        | ErrorNoSeriesParameters
-
         -- | Process has series of different rates,
         --   but all series must have the same rate.
         | ErrorMultipleRates
@@ -36,6 +32,9 @@
         -- | Current scheduler does not support this operator.
         | ErrorUnsupported Operator
 
+        -- | Multiple fills to the same output, in "interfering contexts" (eg same branch of an append)
+        | ErrorMultipleFills
+
         -- | Cannot slurp process description from one of the top-level
         --   declarations.
         | ErrorSlurpError Slurp.Error
@@ -48,9 +47,6 @@
         ErrorNoRateParameters
          -> vcat [ text "Series process has no rate parameters." ]
 
-        ErrorNoSeriesParameters
-         -> vcat [ text "Series process has no series parameters."]
-
         ErrorMultipleRates
          -> vcat [ text "Series process has multiple rate parameters."]
 
@@ -69,6 +65,9 @@
 
         ErrorUnsupported _
          -> vcat [ text "Cannot lower series operator with this method."]
+
+        ErrorMultipleFills
+         -> vcat [ text "Multiple fills to the same output, in 'interfering contexts' (eg same branch of an append)" ]
 
         ErrorSlurpError errSlurp
          -> vcat [ text "Error slurping series process."
diff --git a/DDC/Core/Flow/Transform/Schedule/Kernel.hs b/DDC/Core/Flow/Transform/Schedule/Kernel.hs
--- a/DDC/Core/Flow/Transform/Schedule/Kernel.hs
+++ b/DDC/Core/Flow/Transform/Schedule/Kernel.hs
@@ -13,8 +13,7 @@
 import DDC.Core.Flow.Compounds
 import DDC.Core.Flow.Exp
 import DDC.Core.Flow.Prim
-import Control.Monad
-import Data.Maybe
+import DDC.Core.Flow.Context
 
 
 -- | Schedule a process kernel into a procedure.
@@ -36,60 +35,39 @@
 scheduleKernel 
        lifting
        (Process { processName           = name
-                , processParamTypes     = bsParamTypes
-                , processParamValues    = bsParamValues
-                , processOperators      = operators })
+                , processParamFlags     = bsParams
+                , processContext        = context })
  = do   
-        -- Check the parameter series all have the same rate.
-        tK      <- slurpRateOfParamTypes (map typeOfBind bsParamValues)
-
-        -- Check the primary rate variable matches the rates of the series.
-        (case bsParamTypes of
-          []            -> Left ErrorNoRateParameters
-          BName n k : _ 
-           | k == kRate
-           , TVar (UName n) == tK -> return ()
-          _             -> Left ErrorPrimaryRateMismatch)
-
-        -- Lower rates of series parameters.
-        let bsParamValues_lowered
-                = map (\(BName n t) 
-                        -> let t' = fromMaybe t $ lowerSeriesRate lifting t
-                           in  BName n t')
-                $ bsParamValues
+        -- Lower rates of RateVec parameters.
+        -- We also keep a copy of the original RateVec,
+        -- in case it is used by a cross or a gather.
+        let bsParams_lowered
+                = map (\(flag, BName n t) 
+                        -> if   not flag
+                           then case lowerSeriesRate lifting t of
+                                Just t'
+                                 -> (flag, BName n t')
+                                Nothing
+                                 -> (flag, BName n t)
+                           else (flag, BName n t))
+                $ bsParams
 
-        -- Create the initial loop nest of the process rate.
-        let bsSeries    = [ b   | b <- bsParamValues
-                                , isSeriesType (typeOfBind b) ]
+        let bsParamValues
+                = map snd
+                $ filter (not.fst)
+                $ bsParams
 
-        -- Body expressions that take the next vec of elements from each
-        -- input series. If the type can't be lifted this will just throw
-        -- a pattern match error.
         let c           = liftingFactor lifting
-        let ssBody      = [ BodyStmt 
-                                (BName (NameVarMod nS "elem") tElem_lifted)
-                                (xNextC c tK tElem (XVar (UName nS)) (XVar uIndex))
-                                | BName nS tS     <- bsSeries
-                                , let Just tElem        = elemTypeOfSeriesType tS 
-                                , let uIndex            = UIx 0 
-                                , let Just tElem_lifted = liftType lifting tElem ]
 
-        let nest0       = NestLoop 
-                        { nestRate      = tDown c tK 
-                        , nestStart     = []
-                        , nestBody      = ssBody
-                        , nestInner     = NestEmpty
-                        , nestEnd       = []
-                        , nestResult    = xUnit }
+        let frate r _   = return $ tDown c r
+        let fop         = scheduleOperator lifting bsParamValues 
 
-        nest'   <- foldM (scheduleOperator lifting bsParamValues) 
-                         nest0 operators
+        nest <- scheduleContext frate fop context
 
         return  $ Procedure
                 { procedureName         = name
-                , procedureParamTypes   = bsParamTypes
-                , procedureParamValues  = bsParamValues_lowered
-                , procedureNest         = nest' }
+                , procedureParamFlags   = bsParams_lowered
+                , procedureNest         = nest }
 
 
 -------------------------------------------------------------------------------
@@ -97,18 +75,46 @@
 scheduleOperator 
         :: Lifting
         -> ScalarEnv
-        -> Nest         -- ^ The current loop nest.
+        -> FillMap      -- ^ Map of which operators use which write-to accs
         -> Operator     -- ^ The operator to schedule.
-        -> Either Error Nest
+        -> Either Error ([StmtStart], [StmtBody], [StmtEnd])
 
-scheduleOperator lifting envScalar nest op
+scheduleOperator lifting envScalar fills op
+ -- Id -------------------------------------------
+ | OpId{}     <- op
+ = do   -- Get binders for the input elements.
+        let Just bResult =   elemBindOfSeriesBind   (opResultSeries op)
+                         >>= liftTypeOfBind lifting
+        let Just uInput  = elemBoundOfSeriesBound (opInputSeries  op)
+
+        return ( [] 
+               , [ BodyStmt bResult (XVar uInput) ]
+               , [] )
+
+ | OpSeriesOfArgument{} <- op
+ = do   let c            = liftingFactor lifting
+        let tK           = opInputRate    op
+        let tA           = opElemType     op
+        let BName n t    = opResultSeries op
+        let Just t'      = lowerSeriesRate lifting t
+        let bS           = BName n t'
+        let Just uS      = takeSubstBoundOfBind                   bS
+        let Just tP      = procTypeOfSeriesType   (typeOfBind     bS)
+        let Just bResult =   elemBindOfSeriesBind                   bS
+                         >>= liftTypeOfBind lifting
+
+        -- Body expressions that take the next element from each input series.
+        let bodies
+                = [ BodyStmt bResult
+                        (xNextC c tP tK tA (XVar uS) (XVar (UIx 0))) ]
+
+        return ( []
+               , bodies
+               , [] )
+
  -- Map -----------------------------------------
  | OpMap{}      <- op
- = do   let c           = liftingFactor lifting
-        let tK          = opInputRate op
-        let tK_down     = tDown c tK
-
-        -- Bind for the result element.
+ = do   -- Bind for the result element.
         let Just bResultE =   elemBindOfSeriesBind (opResultSeries op)
                           >>= liftTypeOfBind lifting
 
@@ -132,42 +138,39 @@
                                         | b <- bsParam_lifted
                                         | u <- usInput ]
 
-        let Just nest2  = insertBody nest tK_down
-                        $ [ BodyStmt bResultE xBody ]
+        let bodies      = [ BodyStmt bResultE xBody ]
 
-        return nest2
+        return ([], bodies, [])
 
  -- Fill ----------------------------------------
  | OpFill{}     <- op
  = do   let c           = liftingFactor lifting
-        let tK          = opInputRate op
-        let tK_down     = tDown c tK
 
         -- Bound for input element.
         let Just uInput = elemBoundOfSeriesBound 
                         $ opInputSeries op
 
+        let UName nVec  = opTargetVector op
+        let index
+                | Just n <- getAcc fills nVec 
+                = xRead tNat 
+                $ XVar $ UName $ NameVarMod n "count"
+                | otherwise
+                = XVar $ UIx 0
+
         -- Write to target vector.
-        let Just nest2  = insertBody nest tK_down
-                        $ [ BodyStmt (BNone tUnit)
+        let bodies      = [ BodyStmt (BNone tUnit)
                                      (xWriteVectorC c
                                         (opElemType op)
-                                        (XVar $ opTargetVector op)
-                                        (XVar $ UIx 0)
+                                        (XVar $ bufOfVectorName $ opTargetVector op)
+                                        index
                                         (XVar $ uInput)) ]
 
-        -- Bind final unit value.
-        let Just nest3  = insertEnds nest2 tK_down
-                        $ [ EndStmt  (opResultBind op)
-                                     xUnit ]
-
-        return nest3
+        return ([], bodies, [])
 
  -- Reduce --------------------------------------
  | OpReduce{}   <- op
  = do   let c           = liftingFactor lifting
-        let tK          = opInputRate op
-        let tK_down     = tDown c tK
         let tA          = typeOfBind $ opWorkerParamElem op
 
         -- Evaluate the zero value and initialize the vector accumulator.
@@ -179,9 +182,8 @@
         let nAccVec     = NameVarMod nRef "vec"
         let uAccVec     = UName nAccVec
 
-        let Just nest2  
-                = insertStarts nest tK_down
-                $ [ StartStmt   bAccZero    (opZero op)
+        let starts
+                = [ StartStmt   bAccZero    (opZero op)
                   , StartAcc    nAccVec
                                 (tVec c tA)
                                 (xvRep c tA (XVar uAccZero)) ]
@@ -211,9 +213,8 @@
                              x1)
                         x2
 
-        let Just nest3  
-                = insertBody nest2 tK_down
-                $ [ BodyAccRead  nAccVec (tVec c tA) bAccVal
+        let bodies
+                = [ BodyAccRead  nAccVec (tVec c tA) bAccVal
                   , BodyAccWrite nAccVec (tVec c tA) 
                                  (xBody_lifted (XVar uAccVal) (XVar uInput)) ]
 
@@ -233,9 +234,8 @@
                              x1)
                         x2
 
-        let Just nest4  
-                =  insertEnds nest3 tK_down
-                $  [ EndStmt    bAccResult
+        let ends
+                =  [ EndStmt    bAccResult
                                 (xRead (tVec c tA) (XVar uAccVec))
 
                    , EndStmt    (BName nAccInit tA)
@@ -249,28 +249,22 @@
                                 (xBody  (XVar (uPart (i - 1)))
                                         (xvProj c i tA (XVar uAccResult)))
                                 | i <- [1.. c - 1]]
-
         -- Write final value to destination.
-        let Just nest5  = insertEnds nest4 tK_down
-                        $ [ EndStmt    (BNone tUnit)
-                                       (xWrite tA (XVar $ opTargetRef op)
-                                                  (XVar $ uPart (c - 1))) ]
+                ++ [ EndStmt    (BNone tUnit)
+                                (xWrite tA (XVar $ opTargetRef op)
+                                           (XVar $ uPart (c - 1))) ]
         -- Bind final unit value.
-        let Just nest6  
-                = insertEnds nest5 tK_down
-                $ [ EndStmt     (opResultBind op)
-                                xUnit ]
+                ++ [ EndStmt    (opResultBind op)
+                                 xUnit ]
 
 
-        return $ nest6
+        return (starts, bodies, ends)
 
 
  -- Gather --------------------------------------
  | OpGather{}   <- op
  = do   
         let c           = liftingFactor lifting
-        let tK          = opInputRate op
-        let tK_down     = tDown c tK
 
         -- Bind for result element.
         let Just bResultE =   elemBindOfSeriesBind (opResultBind op)
@@ -280,21 +274,19 @@
         let Just uIndex = elemBoundOfSeriesBound (opSourceIndices op)
 
         -- Read from vector.
-        let Just nest2  = insertBody nest tK_down
-                        $ [ BodyStmt bResultE
+        let bodies      = [ BodyStmt bResultE
                                 (xvGather c 
+                                        (opVectorRate    op)
                                         (opElemType      op)
                                         (XVar $ opSourceVector  op)
                                         (XVar $ uIndex)) ]
 
-        return nest2
+        return ([], bodies, [])
 
  -- Scatter -------------------------------------
  | OpScatter{}  <- op
  = do   
         let c           = liftingFactor lifting
-        let tK          = opInputRate op
-        let tK_down     = tDown c tK
 
         -- Bound of source index.
         let Just uIndex = elemBoundOfSeriesBound (opSourceIndices op)
@@ -303,19 +295,17 @@
         let Just uElem  = elemBoundOfSeriesBound (opSourceElems op)
 
         -- Read from vector.
-        let Just nest2  = insertBody nest tK_down
-                        $ [ BodyStmt (BNone tUnit)
+        let bodies      = [ BodyStmt (BNone tUnit)
                                 (xvScatter c
                                         (opElemType op)
                                         (XVar $ opTargetVector op)
                                         (XVar $ uIndex) (XVar $ uElem)) ]
 
         -- Bind final unit value.
-        let Just nest3  = insertEnds nest2 tK_down
-                        $ [ EndStmt     (opResultBind op)
+        let ends        = [ EndStmt     (opResultBind op)
                                         xUnit ]
 
-        return nest3
+        return ([], bodies, ends)
 
  -- Unsupported ---------------------------------
  | otherwise
diff --git a/DDC/Core/Flow/Transform/Schedule/Lifting.hs b/DDC/Core/Flow/Transform/Schedule/Lifting.hs
--- a/DDC/Core/Flow/Transform/Schedule/Lifting.hs
+++ b/DDC/Core/Flow/Transform/Schedule/Lifting.hs
@@ -119,10 +119,11 @@
 --   to account for lifting of the code that consumes it.
 lowerSeriesRate :: Lifting -> TypeF -> Maybe TypeF 
 lowerSeriesRate lifting tt
- | Just (NameTyConFlow TyConFlowSeries, [tK, tA])
+ | Just (NameTyConFlow TyConFlowSeries, [tP, tK, tA])
         <- takePrimTyConApps tt
  , c    <- liftingFactor lifting
- = Just (tSeries (tDown c tK) tA)
+ = Just (tSeries tP (tDown c tK) tA)
+
 
  | otherwise
  = Nothing
diff --git a/DDC/Core/Flow/Transform/Schedule/Nest.hs b/DDC/Core/Flow/Transform/Schedule/Nest.hs
--- a/DDC/Core/Flow/Transform/Schedule/Nest.hs
+++ b/DDC/Core/Flow/Transform/Schedule/Nest.hs
@@ -1,253 +1,183 @@
 
 module DDC.Core.Flow.Transform.Schedule.Nest
         ( -- * Insertion into a loop nest
-          insertContext
-        , insertStarts
-        , insertBody
-        , insertEnds
-
-          -- * Rate predicates
-        , nestContainsRate
-        , nestContainsGuardedRate)
+          scheduleContext
+        )
 where
 import DDC.Core.Flow.Procedure
-import DDC.Core.Flow.Compounds
-import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Process
 import DDC.Core.Flow.Exp
-import Data.Monoid
+import DDC.Core.Flow.Transform.Schedule.Error
+import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Compounds
+import DDC.Core.Flow.Context
 
+import Control.Arrow
+import qualified Data.Map as Map
 
--------------------------------------------------------------------------------
--- | Insert a skeleton context into a nest.
---    The new context doesn't contain any statements, it just provides
---    the infrastructure to execute statements at the new rate.
---
-insertContext :: Nest -> Context -> Maybe Nest
+scheduleContext
+    :: (Type Name -> Context  -> Either Error (Type Name))
+    -> (FillMap -> Operator -> Either Error ([StmtStart], [StmtBody], [StmtEnd]))
+    -> Context
+    -> Either Error Nest
 
--- Context already exists, don't bother.
-insertContext nest            context@ContextRate{}
- | nestContainsRate nest (contextRate context)
- = Just nest
+scheduleContext frate fop topctx
+ = do   fills <- maybe (Left ErrorMultipleFills) Right
+               $ pathsOfFills topctx
 
--- Loop context at top level.
-insertContext  NestEmpty      context@ContextRate{}
- = Just $ nestOfContext context
+        let (starts', ends')  = allocAndTrunc fills
 
+        (starts, nest, ends) <- go topctx
+         
+        return $ insertStarts (starts' ++ starts)
+               $ insertEnds   (ends'   ++ ends)
+               $ nest
+ where
+  fop' op
+   = do fills <- maybe (Left ErrorMultipleFills) Right
+               $ pathsOfFills topctx
+        fop fills op
 
--- Drop Selector Context ------------------------
--- Selector context goes at this level in the loop nest.
-insertContext nest@NestLoop{} context@ContextSelect{}
- | nestRate nest == contextOuterRate context
- , Just starts  <- startsForContext context
- = Just $ nest 
-        { nestInner = nestInner nest <> nestOfContext context 
-        , nestStart = nestStart nest ++ starts }
 
--- Selector context need to be inserted deeper in the nest.
-insertContext nest@NestLoop{} context@ContextSelect{}
- | nestContainsRate nest (contextOuterRate context)
- , Just inner'  <- insertContext (nestInner nest) context
- , Just starts  <- startsForContext context
- = Just $ nest 
-        { nestInner = inner' 
-        , nestStart = nestStart nest ++ starts }
+  go ctx
+   = case ctx of
+      ContextRate{}
+       -> do (s1,bodies,e1) <- ops   ctx
+             (s2,i2,    e2) <- inner ctx
+             rate'          <- frate (contextRate ctx) ctx
 
--- Selector context inserted inside an existing selector context.
-insertContext nest@NestGuard{}   context@ContextSelect{}
- | nestInnerRate nest == contextOuterRate context
- = Just $ nest { nestInner = nestInner nest <> nestOfContext context }
+             let nest = NestLoop
+                      { nestRate  = rate'
+                      , nestStart = []
+                      , nestBody  = bodies
+                      , nestInner = i2
+                      , nestEnd   = [] }
 
+             return ( s1 ++ s2
+                    , nest
+                    , e1 ++ e2)
 
--- Drop Segment Context -------------------------
--- Selector context goes at this level in the loop nest.
-insertContext nest@NestLoop{} context@ContextSegment{}
- | nestRate nest == contextOuterRate context
- , Just starts  <- startsForContext context
- = Just $ nest
-        { nestInner = nestInner nest <> nestOfContext context
-        , nestStart = nestStart nest ++ starts }
+      ContextSelect{}
+       -> do (s1,bodies,e1) <- ops   ctx
+             (s2,i2, e2) <- inner ctx
 
-insertContext _nest _context
- = Nothing
+             rateOuter      <- frate (contextOuterRate ctx) ctx
+             rateInner      <- frate (contextInnerRate ctx) ctx
 
+             let nest = NestGuard
+                      { nestOuterRate  = rateOuter
+                      , nestInnerRate  = rateInner
+                      , nestFlags      = contextFlags     ctx
+                      , nestBody  = bodies
+                      , nestInner = i2 }
 
--------------------------------------------------------------------------------
--- | Insert starting statements in the given context.
-insertStarts :: Nest -> TypeF -> [StmtStart] -> Maybe Nest
-insertStarts nest tRate starts'
- = case nest of
-        NestLoop{}
-         -- Desired context is right here.
-         |  tRate == nestRate nest
-         -> Just $ nest { nestStart = nestStart nest ++ starts' }
+             return ( s1 ++ s2
+                    , nest
+                    , e1 ++ e2)
 
-         -- Desired context is deeper in the nest.
-         -- The starting statements run before all interations of it.
-         |  nestContainsRate nest tRate
-         -> Just $ nest { nestStart = nestStart nest ++ starts' }
 
-        _ -> Nothing
+      ContextSegment{}
+       -> do (s1,bodies,e1) <- ops   ctx
+             (s2,i2,    e2) <- inner ctx
 
+             rateOuter      <- frate (contextOuterRate ctx) ctx
+             rateInner      <- frate (contextInnerRate ctx) ctx
 
--------------------------------------------------------------------------------
--- | Insert starting statements in the given context.
-insertBody :: Nest -> TypeF -> [StmtBody] -> Maybe Nest
-insertBody nest tRate body'
- = case nest of
-        NestLoop{}
-         -- Desired context is right here.
-         |  tRate == nestRate nest
-         -> Just $ nest { nestBody = nestBody nest ++ body' }
 
-         -- Desired context is deeper in the nest.
-         |  Just inner' <- insertBody (nestInner nest) tRate body'
-         -> Just $ nest { nestInner = inner' }
+             let nest = NestSegment
+                      { nestOuterRate  = rateOuter
+                      , nestInnerRate  = rateInner
+                      , nestLength     = contextLens      ctx
+                      , nestBody  = bodies
+                      , nestInner = i2 }
 
-        NestGuard{}
-         -- Desired context is right here.
-         |  tRate == nestInnerRate nest
-         -> Just $ nest { nestBody = nestBody nest ++ body' }
+             return ( s1 ++ s2
+                    , nest
+                    , e1 ++ e2)
 
-         -- Desired context is deeper in the nest.
-         |  Just inner' <- insertBody (nestInner nest) tRate body'
-         -> Just $ nest { nestInner = inner' }
+      ContextAppend{}
+       -> do (s1,i1,e1)     <- go (contextInner1 ctx)
+             (s2,i2,e2)     <- go (contextInner2 ctx)
 
-        NestSegment{}
-         -- Desired context is right here.
-         |  tRate == nestInnerRate nest
-         -> Just $ nest { nestBody = nestBody nest ++ body' }
+             let nest = NestList
+                      [ i1, i2 ]
 
-         -- Desired context is deeper in the nest.
-         |  Just inner' <- insertBody (nestInner nest) tRate body'
-         -> Just $ nest { nestInner = inner' }
+             return ( s1 ++ s2
+                    , nest
+                    , e1 ++ e2)
 
-        NestList (n : ns)
-         |  Just n'             <- insertBody n tRate body'
-         -> Just $ NestList (n':ns)
 
-         |  Just (NestList ns') <- insertBody (NestList ns) tRate body'
-         -> Just $ NestList (n:ns')
 
-
-        _ -> Nothing
-
+  ops ctx
+   = do outs <- mapM fop' (contextOps ctx)
+        let (ss,bs,es) = unzip3 outs
+        return (concat ss, concat bs, concat es)
 
--------------------------------------------------------------------------------
--- | Insert ending statements in the given context.
-insertEnds :: Nest -> TypeF -> [StmtEnd] -> Maybe Nest
-insertEnds nest tRate ends'
- = case nest of
-        NestLoop{}
-         -- Desired context is right here.
-         |  tRate == nestRate nest
-         -> Just $ nest { nestEnd = nestEnd nest ++ ends' }
+  inner ctx
+   = do outs <- mapM go  (contextInner ctx)
+        let (ss,ins,es) = unzip3 outs
+        return (concat ss, listNest ins, concat es)
 
-         -- Desired context is deeper in the nest.
-         -- The ending statements run before all iterations of it.
-         |  nestContainsRate nest tRate
-         -> Just $ nest { nestEnd = nestEnd nest ++ ends' }
- 
-        _ -> Nothing
+  listNest []
+   = NestEmpty
+  listNest [n]
+   = n
+  listNest ns
+   = NestList ns
 
 
--- Rate Predicates ------------------------------------------------------------
--- | Check whether the top-level of this nest contains the given rate.
---   It might be in a nested context.
-nestContainsRate :: Nest -> TypeF -> Bool
-nestContainsRate nest tRate
- = case nest of
-        NestEmpty       
-         -> False
-
-        NestList ns     
-         -> any (flip nestContainsRate tRate) ns
+allocAndTrunc :: FillMap -> ([StmtStart], [StmtEnd])
+allocAndTrunc fills
+ = concat *** concat
+ $ unzip
+ $ map go 
+ $ Map.toList fills
+ where
+  go (k,(f,t))
+   | isSimple f || isNone f
+   = ([], [])
+   | otherwise
+   = let k' = getAccForPath fills f
+         kk = maybe k id k'
+         co = NameVarMod kk "count"
 
-        NestLoop{}
-         ->  nestRate nest == tRate
-          || nestContainsRate (nestInner nest) tRate
+         s  | k == kk
+            = [StartAcc
+              { startAccName = co
+              , startAccType = tNat
+              , startAccExp  = xNat 0 } ]
+            | otherwise
+            = []
 
-        NestGuard{}
-         ->  nestInnerRate nest == tRate
-          || nestContainsRate (nestInner nest) tRate
+         e  = [EndVecTrunc
+                k t
+                (UName co) ]
 
-        NestSegment{}
-         ->  nestInnerRate nest == tRate
-          || nestContainsRate (nestInner nest) tRate
+     in  (s, e)
 
 
--- | Check whether the given rate is the inner rate of some 
---  `NestGuard` constructor.
-nestContainsGuardedRate :: Nest -> TypeF -> Bool
-nestContainsGuardedRate nest tRate
+-------------------------------------------------------------------------------
+-- | Insert starting statements in the given context.
+insertStarts :: [StmtStart] -> Nest -> Nest
+insertStarts starts' nest
  = case nest of
-        NestEmpty
-         -> False
-
-        NestList ns
-         -> any (flip nestContainsRate tRate) ns
-
-        NestLoop{}
-         -> nestContainsGuardedRate (nestInner nest) tRate
-
-        NestGuard{}
-         -> nestInnerRate nest == tRate
-         || nestContainsGuardedRate (nestInner nest) tRate
-
-        NestSegment{}
-         -> nestContainsGuardedRate (nestInner nest) tRate
-
-
--- Skeleton nests -------------------------------------------------------------
--- | Yield a skeleton nest for a given context.
-nestOfContext :: Context -> Nest
-nestOfContext context
- = case context of
-        ContextRate tRate
-         -> NestLoop
-          { nestRate            = tRate
-          , nestStart           = []
-          , nestBody            = []
-          , nestInner           = NestEmpty
-          , nestEnd             = []
-          , nestResult          = xUnit }
-
-        ContextSelect{}
-         -> NestGuard
-          { nestOuterRate       = contextOuterRate context
-          , nestInnerRate       = contextInnerRate context
-          , nestFlags           = contextFlags     context
-          , nestBody            = [] 
-          , nestInner           = NestEmpty }
-
-        ContextSegment{}
-         -> NestSegment
-          { nestOuterRate       = contextOuterRate context
-          , nestInnerRate       = contextInnerRate context
-          , nestLength          = contextLens      context
-          , nestBody            = []
-          , nestInner           = NestEmpty }
-
-
--- | For selector and segment contexts, make statements that initialize a 
---   counter for how many times the context has been entered.
-startsForContext :: Context -> Maybe [StmtStart]
-startsForContext context
- = case context of
-        ContextSelect{}
-         -> let TVar (UName nK) = contextInnerRate context
-                nCounter        = NameVarMod nK "count"
-            in  Just [ StartAcc 
-                        { startAccName = nCounter
-                        , startAccType = tNat
-                        , startAccExp  = xNat 0 }]
-
-        ContextSegment{}
-         -> let TVar (UName nK) = contextInnerRate context
-                nCounter        = NameVarMod nK "count"
-            in  Just [ StartAcc 
-                        { startAccName = nCounter
-                        , startAccType = tNat
-                        , startAccExp  = xNat 0 }]
+    NestList (n:ns)
+     -> NestList (insertStarts starts' n : ns) 
+    NestLoop{}
+     -> nest { nestStart = nestStart nest ++ starts' }
+    _
+     -> nest
 
-        _  -> Nothing
+-------------------------------------------------------------------------------
+-- | Insert ends statements in the given context.
+insertEnds :: [StmtEnd] -> Nest -> Nest
+insertEnds ends' nest
+ = case nest of
+    NestList ns
+     | (r:rs) <- reverse ns
+     -> NestList (reverse rs ++ [insertEnds ends' r])
+    NestLoop{}
+     -> nest { nestEnd = nestEnd nest ++ ends' }
+    _
+     -> nest
 
diff --git a/DDC/Core/Flow/Transform/Schedule/Scalar.hs b/DDC/Core/Flow/Transform/Schedule/Scalar.hs
--- a/DDC/Core/Flow/Transform/Schedule/Scalar.hs
+++ b/DDC/Core/Flow/Transform/Schedule/Scalar.hs
@@ -9,96 +9,93 @@
 import DDC.Core.Flow.Process
 import DDC.Core.Flow.Compounds
 import DDC.Core.Flow.Prim
+import DDC.Core.Flow.Prim.OpStore
 import DDC.Core.Flow.Exp
-import Control.Monad
+import DDC.Core.Flow.Context
 
 
 -- | Schedule a process into a procedure, producing scalar code.
 scheduleScalar :: Process -> Either Error Procedure
 scheduleScalar 
        (Process { processName           = name
-                , processParamTypes     = bsParamTypes
-                , processParamValues    = bsParamValues
-                , processOperators      = operators
-                , processContexts       = contexts})
+                , processParamFlags     = bsParams
+                , processContext        = context })
   = do
-        -- Check the parameter series all have the same rate.
-        tK      <- slurpRateOfParamTypes 
-                        $ filter isSeriesType 
-                        $ map typeOfBind bsParamValues
-
-        -- Check the primary rate variable matches the rates of the series.
-        (case bsParamTypes of
-          []            -> Left ErrorNoRateParameters
-          BName n k : _ 
-           | k == kRate
-           , TVar (UName n) == tK -> return ()
-          _             -> Left ErrorPrimaryRateMismatch)
-
-        -- Create the initial loop nest of the process rate.
-        let bsSeries    = [ b   | b <- bsParamValues
-                                , isSeriesType (typeOfBind b) ]
-
-        -- Body expressions that take the next element from each input series.
-        let ssBody      
-                = [ BodyStmt bElem
-                        (xNext tK tElem (XVar (UName nS)) (XVar uIndex))
-                        | bS@(BName nS tS)      <- bsSeries
-                        , let Just tElem        = elemTypeOfSeriesType tS 
-                        , let Just bElem        = elemBindOfSeriesBind bS
-                        , let uIndex            = UIx 0 ]
-
-        -- The initial loop nest.
-        let nest0       
-                = NestLoop 
-                { nestRate              = tK 
-                , nestStart             = []
-                , nestBody              = ssBody
-                , nestInner             = NestEmpty
-                , nestEnd               = []
-                , nestResult            = xUnit }
-
-        -- Create the nested contexts
-        let Just nest1  =  foldM insertContext nest0 contexts
-
-        -- Schedule the series operators into the nest.
-        nest2           <- foldM scheduleOperator nest1 operators
+        nest            <- scheduleContext (\r _ -> return r)
+                                           (scheduleOperator context) context
 
         return  $ Procedure
                 { procedureName         = name
-                , procedureParamTypes   = bsParamTypes
-                , procedureParamValues  = bsParamValues
-                , procedureNest         = nest2 }
+                , procedureParamFlags   = bsParams
+                , procedureNest         = nest }
 
 
 -------------------------------------------------------------------------------
 -- | Schedule a single series operator into a loop nest.
 scheduleOperator 
-        :: Nest         -- ^ The current loop nest.
+        :: Context      -- ^ Context of all operators
+        -> FillMap      -- ^ Map of which operators use which write-to accs
         -> Operator     -- ^ Operator to schedule.
-        -> Either Error Nest
+        -> Either Error ([StmtStart], [StmtBody], [StmtEnd])
 
-scheduleOperator nest0 op
+scheduleOperator _ctx fills op
 
  -- Id -------------------------------------------
  | OpId{}     <- op
- = do   let tK          = opInputRate op
-
-        -- Get binders for the input elements.
+ = do   -- Get binders for the input elements.
         let Just bResult = elemBindOfSeriesBind   (opResultSeries op)
         let Just uInput  = elemBoundOfSeriesBound (opInputSeries  op)
 
-        let Just nest1   
-                = insertBody nest0 tK
-                $ [ BodyStmt bResult (XVar uInput) ]
+        return ( [] 
+               , [ BodyStmt bResult (XVar uInput) ]
+               , [] )
 
-        return nest1
+ | OpSeriesOfRateVec{} <- op
+ = do   let tK           = opInputRate    op
+        let tA           = opElemType     op
+        let bS           = opResultSeries op
+        let uInput       = opInputRateVec op
+        let Just uS      = takeSubstBoundOfBind                   bS
+        let Just tP      = procTypeOfSeriesType   (typeOfBind     bS)
+        let Just bResult = elemBindOfSeriesBind                   bS
 
+        -- Convert the RateVec to a series
+        let starts
+                = [ StartStmt bS
+                        (xSeriesOfRateVec tP tK tA (XVar uInput)) ]
+
+        -- Body expressions that take the next element from each input series.
+        let bodies
+                = [ BodyStmt bResult
+                        (xNext tP tK tA (XVar uS) (XVar (UIx 0))) ]
+
+        return ( starts
+               , bodies
+               , [] )
+
+
+ | OpSeriesOfArgument{} <- op
+ = do   let tK           = opInputRate    op
+        let tA           = opElemType     op
+        let bS           = opResultSeries op
+        let Just uS      = takeSubstBoundOfBind                   bS
+        let Just tP      = procTypeOfSeriesType   (typeOfBind     bS)
+        let Just bResult = elemBindOfSeriesBind                   bS
+
+        -- Body expressions that take the next element from each input series.
+        -- Could be different to RateVec above, since could be from other source?
+        let bodies
+                = [ BodyStmt bResult
+                        (xNext tP tK tA (XVar uS) (XVar (UIx 0))) ]
+
+        return ( []
+               , bodies
+               , [] )
+
+
  -- Rep -----------------------------------------
  | OpRep{}      <- op
- = do   let tK          = opOutputRate op
-
-        -- Make a binder for the replicated element.
+ = do   -- Make a binder for the replicated element.
         let BName nResult _ = opResultSeries op
         let nVal        = NameVarMod nResult "val"
         let uVal        = UName nVal
@@ -109,16 +106,14 @@
 
         -- Evaluate the expression to be replicated once, 
         -- before the main loop.
-        let Just nest1
-                = insertStarts nest0 tK
-                $ [ StartStmt bVal (opInputExp op) ]
+        let starts
+                = [ StartStmt bVal (opInputExp op) ]
 
         -- Use the expression for each iteration of the loop.
-        let Just nest2
-                = insertBody nest1 tK
-                $ [ BodyStmt bResult (XVar uVal) ]
+        let bodies
+                = [ BodyStmt bResult (XVar uVal) ]
 
-        return nest2
+        return (starts, bodies, [])
 
  -- Reps ----------------------------------------
  | OpReps{}     <- op
@@ -128,113 +123,102 @@
         -- Set the result to point to the input element.
         let Just bResult = elemBindOfSeriesBind   (opResultSeries op)
 
-        let Just nest1
-                = insertBody nest0 (opOutputRate op)
-                $ [ BodyStmt    bResult
+        let bodies
+                = [ BodyStmt    bResult
                                 (XVar uInput)]
 
-        return nest1
+        return ([], bodies, [])
 
  -- Indices --------------------------------------
  | OpIndices{}  <- op
  = do   
-        -- In a segment context the variable ^1 is the index into
+        -- In a segment context the variable ^0 is the index into
         -- the current segment.
         let Just bResult = elemBindOfSeriesBind   (opResultSeries op)
 
-        let Just nest1
-                = insertBody nest0 (opOutputRate op)
-                $ [ BodyStmt    bResult
-                                (XVar (UIx 1)) ]
+        let bodies
+                = [ BodyStmt    bResult
+                                (XVar (UIx 0)) ]
 
-        return nest1
+        return ([], bodies, [])
 
  -- Fill -----------------------------------------
  | OpFill{} <- op
- = do   let tK          = opInputRate op
-
-        -- Get bound of the input element.
+ = do   -- Get bound of the input element.
         let Just uInput = elemBoundOfSeriesBound (opInputSeries op)
 
         -- Write the current element to the vector.
         let UName nVec  = opTargetVector op
-        let Just nest1      
-                = insertBody nest0 tK 
-                $ [ BodyVecWrite 
+
+        let index
+                | Just n <- getAcc fills nVec 
+                = xRead tNat 
+                $ XVar $ UName $ NameVarMod n "count"
+                | otherwise
+                = XVar $ UIx 0
+
+        let bodies
+                = [ BodyVecWrite 
                         nVec                    -- destination vector
                         (opElemType op)         -- series elem type
-                        (XVar (UIx 0))          -- index
+                        index                   -- index
                         (XVar uInput) ]         -- value
 
-        -- If the length of the vector corresponds to a guarded rate then it
-        -- was constructed in a filter context. After the process completes, 
-        -- we know how many elements were written so we can truncate the
-        -- vector down to its final length.
-        let Just nest2
-                | nestContainsGuardedRate nest1 tK
-                = insertEnds nest1 tK
-                $ [ EndVecTrunc 
-                        nVec                    -- destination vector
-                        (opElemType op)         -- series element type
-                        tK ]                    -- rate of source series
-
+        let inc
+                | Just n <- getAcc fills nVec 
+                , n == nVec
+                = [ BodyAccWrite
+                        (NameVarMod n "count")
+                        tNat
+                        (xIncrement index) ]
                 | otherwise
-                = Just nest1
+                = []
 
-        return nest2
+        return ([], bodies ++ inc, [])
 
  -- Gather ---------------------------------------
  | OpGather{} <- op
- = do   
-        let tK          = opInputRate op
-
-        -- Bind for result element.
+ = do   -- Bind for result element.
         let Just bResult = elemBindOfSeriesBind (opResultBind op)
 
         -- Bound of source index.
         let Just uIndex  = elemBoundOfSeriesBound (opSourceIndices op)
+        let buf          = xBufOfRateVec (opVectorRate op) (opElemType op)
+                                         (XVar $ opSourceVector op)
 
         -- Read from the vector.
-        let Just nest1  = insertBody nest0 tK
-                        $ [ BodyStmt bResult
+        let bodies      = [ BodyStmt bResult
                                 (xReadVector 
                                         (opElemType op)
-                                        (XVar $ opSourceVector op)
+                                        buf
                                         (XVar $ uIndex)) ]
 
-        return nest1
+        return ([], bodies, [])
  
  -- Scatter --------------------------------------
  | OpScatter{} <- op
- = do   
-        let tK          = opInputRate op
-
-        -- Bound of source index.
+ = do   -- Bound of source index.
         let Just uIndex = elemBoundOfSeriesBound (opSourceIndices op)
 
         -- Bound of source elements.
         let Just uElem  = elemBoundOfSeriesBound (opSourceElems op)
 
         -- Read from vector.
-        let Just nest1  = insertBody nest0 tK
-                        $ [ BodyStmt (BNone tUnit)
+        let bodies      = [ BodyStmt (BNone tUnit)
                                 (xWriteVector
                                         (opElemType op)
-                                        (XVar $ opTargetVector op)
+                                        (XVar $ bufOfVectorName $ opTargetVector op)
                                         (XVar $ uIndex) (XVar $ uElem)) ]
 
         -- Bind final unit value.
-        let Just nest2  = insertEnds nest1 tK
-                        $ [ EndStmt     (opResultBind op)
+        let ends        = [ EndStmt     (opResultBind op)
                                         xUnit ]
 
-        return nest2
+        return ([], bodies, ends)
 
  -- Maps -----------------------------------------
  | OpMap{} <- op
- = do   let tK          = opInputRate op
-
-        -- Bind for the result element.
+ = do   -- Bind for the result element.
         let Just bResult = elemBindOfSeriesBind (opResultSeries op)
 
         -- Binds for all the input elements.
@@ -250,11 +234,10 @@
                                 | b <- opWorkerParams op
                                 | u <- usInput ]
 
-        let Just nest1  
-                = insertBody nest0 tK
-                $ [ BodyStmt bResult xBody ]
+        let bodies
+                = [ BodyStmt bResult xBody ]
 
-        return nest1
+        return ([], bodies, [])
 
  -- Pack ----------------------------------------
  | OpPack{}     <- op
@@ -264,27 +247,39 @@
         -- Set the result to point to the input element
         let Just bResult = elemBindOfSeriesBind  (opResultSeries op)
 
-        let Just nest1
-                = insertBody nest0 (opOutputRate op)
-                $ [ BodyStmt    bResult
+        let bodies
+                = [ BodyStmt    bResult
                                 (XVar uInput)]
 
-        return nest1
+        return ([], bodies, [])
 
+ -- Generate -------------------------------------
+ | OpGenerate{} <- op
+ = do   -- Bind for the result element.
+        let Just bResult = elemBindOfSeriesBind (opResultSeries op)
+
+        -- Apply loop index into the worker body.
+        let xBody
+                = XApp   ( XLam (opWorkerParamIndex op)
+                                (opWorkerBody       op))
+                         (XVar (UIx 0))          -- index
+
+        let bodies
+                = [ BodyStmt bResult xBody ]
+
+        return ([], bodies, [])
+
 -- Reduce --------------------------------------
  | OpReduce{} <- op
- = do   let tK          = opInputRate op
-
-        -- Initialize the accumulator.
+ = do   -- Initialize the accumulator.
         let UName nResult = opTargetRef op
         let nAcc          = NameVarMod nResult "acc"
         let tAcc          = typeOfBind (opWorkerParamAcc op)
 
         let nAccInit      = NameVarMod nResult "init"
 
-        let Just nest1
-                = insertStarts nest0 tK
-                $ [ StartStmt (BName nAccInit tAcc)
+        let starts
+                = [ StartStmt (BName nAccInit tAcc)
                               (xRead tAcc (XVar $ opTargetRef op))
                   , StartAcc   nAcc tAcc (XVar (UName nAccInit)) ]
 
@@ -305,9 +300,8 @@
                         x2
                        
         -- Update the accumulator in the loop body.
-        let Just nest2
-                = insertBody nest1 tK
-                $ [ BodyAccRead  nAcc tAcc bAccVal
+        let bodies
+                = [ BodyAccRead  nAcc tAcc bAccVal
                   , BodyAccWrite nAcc tAcc 
                         (xBody  (XVar uAccVal) 
                                 (XVar uInput)) ]
@@ -315,16 +309,22 @@
         -- Read back the final value after the loop has finished and
         -- write it to the destination.
         let nAccRes     = NameVarMod nResult "res"
-        let Just nest3      
-                = insertEnds nest2 tK
-                $ [ EndAcc   nAccRes tAcc nAcc 
+        let ends
+                = [ EndAcc   nAccRes tAcc nAcc 
                   , EndStmt  (BNone tUnit)
                              (xWrite tAcc (XVar $ opTargetRef op)
                                           (XVar $ UName nAccRes)) ]
 
-        return nest3
+        return (starts, bodies, ends)
 
  -- Unsupported ----------------------------------
  | otherwise
  = Left $ ErrorUnsupported op
+
+-- | Build an expression that increments a natural.
+xIncrement :: Exp a Name -> Exp a Name
+xIncrement xx
+        = xApps (XVar (UPrim (NamePrimArith PrimArithAdd) 
+                             (typePrimArith PrimArithAdd)))
+                  [ XType tNat, xx, XCon (dcNat 1) ]
 
diff --git a/DDC/Core/Flow/Transform/Slurp.hs b/DDC/Core/Flow/Transform/Slurp.hs
--- a/DDC/Core/Flow/Transform/Slurp.hs
+++ b/DDC/Core/Flow/Transform/Slurp.hs
@@ -4,8 +4,10 @@
         , isSeriesOperator
         , isVectorOperator)
 where
+import DDC.Core.Flow.Transform.Slurp.Context
 import DDC.Core.Flow.Transform.Slurp.Operator
 import DDC.Core.Flow.Transform.Slurp.Error
+import DDC.Core.Flow.Transform.Slurp.Resize
 import DDC.Core.Flow.Prim
 import DDC.Core.Flow.Context
 import DDC.Core.Flow.Process
@@ -15,18 +17,18 @@
 import DDC.Core.Module
 import qualified DDC.Type.Env           as Env
 import DDC.Type.Env                     (TypeEnv)
-import Data.List
+import qualified Data.Map               as Map
 
 
 -- | Slurp stream processes from the top level of a module.
-slurpProcesses :: Module () Name -> Either Error [Process]
+slurpProcesses :: Module () Name -> Either Error [Either Process (Bind Name, Exp () Name)]
 slurpProcesses mm
  = slurpProcessesX (deannotate (const Nothing) $ moduleBody mm)
 
 
 -- | Slurp stream processes from a module body.
 --   A module consists of some let-bindings wrapping a unit data constructor.
-slurpProcessesX :: Exp () Name   -> Either Error [Process]
+slurpProcessesX :: Exp () Name   -> Either Error [Either Process (Bind Name, Exp () Name)]
 slurpProcessesX xx
  = case xx of
         -- Slurp processes definitions from the let-bindings.
@@ -42,7 +44,7 @@
 
 
 -- | Slurp stream processes from the top-level let expressions.
-slurpProcessesLts :: Lets () Name -> Either Error [Process]
+slurpProcessesLts :: Lets () Name -> Either Error [Either Process (Bind Name, Exp () Name)]
 slurpProcessesLts (LRec binds)
  = sequence [slurpProcessLet b x | (b, x) <- binds]
 
@@ -58,50 +60,60 @@
 slurpProcessLet 
         :: Bind Name            -- ^ Binder for the whole process.
         -> Exp () Name          -- ^ Expression of body.
-        -> Either Error Process
+        -> Either Error (Either Process (Bind Name, Exp () Name))
 
 slurpProcessLet (BName n t) xx
 
  -- We assume that all type params come before the value params.
- | (snd $ takeTFunAllArgResult t) == tProcess
+ | Just (NameTyConFlow TyConFlowProcess, [tProc, tLoopRate])
+        <- takePrimTyConApps $ snd $ takeTFunAllArgResult t
  , Just (fbs, xBody)    <- takeXLamFlags xx
  = let  
-        -- Split binders into type and value binders.
-        (fbts, fbvs)    = partition fst fbs
-
-        -- Type binders.
-        bts             = map snd fbts
-        tsRate          = filter (\b -> typeOfBind b == kRate) bts
-
-        -- Create contexts for all the parameter rate variables.
-        ctxParam        = map (ContextRate . TVar . UName)
-                        $ map (\(BName nRate _) -> nRate)
-                        $ tsRate
-
         -- Value binders.
-        bvs             = map snd fbvs
+        bvs             = map snd
+                        $ filter (not.fst)
+                        $ fbs
 
         -- Slurp the body of the process.
    in do
-        (ctxLocal, ops) 
-                <- slurpProcessX Env.empty xBody
+        let series = slurpSeriesArguments bvs Map.empty
+        ctx       <- slurpProcessX Env.empty series Map.empty xBody
 
-        return  $ Process
+        return  $ Left
+                $ Process
                 { processName          = n
-                , processParamTypes    = bts
-                , processParamValues   = bvs
+                , processProcType      = tProc
+                , processLoopRate      = tLoopRate
+                , processParamFlags    = fbs
 
-                -- Note that the parameter contexts needs to come first
-                -- so they are scheduled before the local contexts, which
-                -- are inside 
-                , processContexts      = ctxParam ++ ctxLocal
+                , processContext       = ctx }
 
-                , processOperators     = ops }
+slurpProcessLet b xx
+ = return $ Right (b, xx)
 
-slurpProcessLet _ xx
- = Left (ErrorBadProcess xx)
 
+slurpSeriesArguments :: [BindF] -> Map.Map Name Context -> Map.Map Name Context
+slurpSeriesArguments [] e
+   = e
+slurpSeriesArguments (b:bs) e
+ | BName n t <- b
+ , Just (NameTyConFlow TyConFlowSeries
+        , [_P, tK, tA] )
+       <- takePrimTyConApps t
+ = let op          = OpSeriesOfArgument
+                   { opResultSeries        = b
+                   , opInputRate           = tK
+                   , opElemType            = tA }
 
+       context     = ContextRate
+                   { contextRate           = tK
+                   , contextOps            = [op]
+                   , contextInner          = [] }
+    in slurpSeriesArguments bs (Map.insert n context e)
+ | otherwise
+ =      slurpSeriesArguments bs e
+
+
 -------------------------------------------------------------------------------
 -- | Slurp stream operators from the body of a function and add them to 
 --   the provided loop nest. 
@@ -113,41 +125,34 @@
 --
 slurpProcessX 
         :: TypeEnv Name         -- ^ Process type environment.
+        -> Map.Map Name Context -- ^ Contexts of in-scope
+        -> Map.Map Name Resize  -- ^ Resizes of in-scope
         -> ExpF                 -- ^ A sequence of non-recursive let-bindings.
-        -> Either Error
-                ( [Context]     --   Nested contexts created by this process.
-                , [Operator])   --   Series operators in this binding.
+        -> Either Error Context
 
-slurpProcessX tenv xx
+slurpProcessX tenv ctxs rs xx
  | XLet (LLet b x) xMore        <- xx
  = do   
         -- Slurp operators from the binding.
-        (ctxHere, opsHere)      <- slurpBindingX tenv b x
+        (ctxs', rs')            <- slurpBindingX tenv ctxs rs b x
 
         -- If this binding defined a process then add it do the environment.
         let tenv'
-                | typeOfBind b == tProcess = Env.extend b tenv
-                | otherwise                = tenv
+                | isProcessType $ typeOfBind b  = Env.extend b tenv
+                | otherwise                     = tenv
 
         -- Slurp the rest of the process using the new environment.
-        (ctxMore, opsMore)      <- slurpProcessX tenv' xMore
-
-        return  ( ctxHere ++ ctxMore
-                , opsHere ++ opsMore)
+        slurpProcessX tenv' ctxs' rs' xMore
 
 -- Slurp a process ending.
-slurpProcessX tenv xx
+slurpProcessX tenv ctxs _rs xx
  -- The process ends with a variable that has Process# type.
  | XVar u       <- xx
  , Just t       <- Env.lookup u tenv
- , t == tProcess
- = return ([], [])                
-
- -- The process ends by joining two existing processes.
- -- We assume that the overall expression is well typed.
- | Just (NameOpSeries OpSeriesJoin, [_, _])     
-                <- takeXPrimApps xx
- = return ([], [])
+ , isProcessType t
+ , UName u'     <- u
+ , Just c       <- Map.lookup u' ctxs
+ = return c
 
  -- Process finishes with some expression that doesn't look like it 
  -- actually defines a value of type Process#.
@@ -159,89 +164,121 @@
 -- | Slurp stream operators from a let-binding.
 slurpBindingX 
         :: TypeEnv Name         -- ^ Process type environment.
+        -> Map.Map Name Context -- ^ Contexts of in-scope
+        -> Map.Map Name Resize  -- ^ Resizes of in-scope
         -> BindF                -- ^ Binder to assign result to.
         -> ExpF                 -- ^ Right of the binding.
         -> Either 
                 Error
-                ( [Context]     --   Nested contexts created by this binding.
-                , [Operator])   --   Series operators in this binding.
+                ( Map.Map Name Context
+                , Map.Map Name Resize )
 
 
 -- Decend into more let bindings.
 -- We get these when entering into a nested context.
-slurpBindingX tenv b1 xx
+slurpBindingX tenv ctxs rs b1 xx
  | XLet (LLet b2 x2) xMore      <- xx
  = do   
         -- Slurp operators from the binding.
-        (ctxHere, opsHere)      <- slurpBindingX tenv b2 x2
+        (ctxs', rs')            <- slurpBindingX tenv ctxs rs b2 x2
 
         -- If this binding defined a process then add it to the environement.
         let tenv'
-                | typeOfBind b2 == tProcess = Env.extend b2 tenv
-                | otherwise                 = tenv
+                | isProcessType $ typeOfBind b2 = Env.extend b2 tenv
+                | otherwise                     = tenv
 
         -- Slurp the rest of the process using the new environment.
-        (ctxMore, opsMore)      <- slurpBindingX tenv' b1 xMore
+        slurpBindingX tenv' ctxs' rs' b1 xMore
 
-        return  ( ctxHere ++ ctxMore
-                , opsHere ++ opsMore)
 
+-- Slurp a series#
+-- This creates a new context
+slurpBindingX _tenv ctxs rs b@(BName n _)
+ (   takeXPrimApps 
+  -> Just ( NameOpSeries OpSeriesSeriesOfRateVec
+          , [ XType _tProc
+            , XType tK
+            , XType tA
+            , XVar vec]))
+ = do
+        let op          = OpSeriesOfRateVec
+                        { opResultSeries        = b
+                        , opInputRate           = tK
+                        , opInputRateVec        = vec 
+                        , opElemType            = tA }
 
+        let context     = ContextRate
+                        { contextRate           = tK
+                        , contextOps            = [op]
+                        , contextInner          = [] }
+
+        let ctxs' = Map.insert n context ctxs 
+
+        return (ctxs', rs)
+
+
 -- Slurp a mkSel1#
 -- This creates a nested selector context.
-slurpBindingX tenv b 
+slurpBindingX tenv ctxs rs (BName n _)
  (   takeXPrimApps 
   -> Just ( NameOpSeries (OpSeriesMkSel 1)
-          , [ XType tK1
-            , XVar uFlags
-            , XLAM (BName nR kR) (XLam bSel xBody)]))
+          , [ XType tProc
+            , XType tK1
+            , XType _
+            , XVar  uFlags@(UName nFlags)
+
+            , XLAM         (BName nR kR)
+             (XLam    bSel@(BName nSel _)
+                      xBody)]))
  | kR == kRate
  = do
-        (ctxInner, osInner)
-                <- slurpBindingX tenv b xBody
+        flagsContext   <- lookupOrDie nFlags ctxs
 
-        -- Add an intermediate edge from the flags variable to its use. 
-        -- This is needed for the case when the flags series is one of the
-        -- parameters to the process, because the intermediate OpId forces 
-        -- the scheduler to add the  flags_elem = next [k] flags_series 
-        -- statement.
-        let UName nFlags = uFlags
         let nFlagsUse   = NameVarMod nFlags "use"
-        let uFlagsUse   = UName nFlagsUse
-        let bFlagsUse   = BName nFlagsUse (tSeries tK1 tBool)
+        let bFlagsUse   = BName nFlagsUse (tSeries tProc tK1 tBool)
 
         let opId        = OpId
                         { opResultSeries        = bFlagsUse
                         , opInputRate           = tK1
-                        , opInputSeries         = uFlags 
+                        , opInputSeries         = uFlags
                         , opElemType            = tBool }
 
         let context     = ContextSelect
                         { contextOuterRate      = tK1
                         , contextInnerRate      = TVar (UName nR)
-                        , contextFlags          = uFlagsUse
-                        , contextSelector       = bSel }
+                        , contextFlags          = uFlags
+                        , contextSelector       = bSel
+                        , contextOps            = [opId]
+                        , contextInner          = [] }
 
-        return (context : ctxInner, opId : osInner)
+        context'       <- insertContext context  flagsContext
+        let ctxsInner   = Map.insert nSel context' ctxs
+        selProc <- slurpProcessX tenv ctxsInner rs xBody
 
+        let ctxsOuter   = Map.insert n selProc ctxs
+        return (ctxsOuter, rs)
 
--- Slurp a mkSegd#.
--- This creates a segmented context.
-slurpBindingX tenv b
+
+-- Slurp a mkSel1#
+-- This creates a nested selector context.
+slurpBindingX tenv ctxs rs (BName n _)
  (   takeXPrimApps 
   -> Just ( NameOpSeries OpSeriesMkSegd
-          , [ XType tK1
-            , XVar  uLens
-            , XLAM  (BName nK2 kR) (XLam bSegd xBody)]))
+          , [ XType tProc
+            , XType tK1
+            , XVar  uLens@(UName nLens)
+
+            , XLAM          (BName nR    kR)
+             (XLam    bSegd@(BName nSegd _)
+                      xBody)]))
  | kR == kRate
- = do   
-        (ctxInner, osInner)
-                <- slurpBindingX tenv b xBody
+ = do
+        lensContext    <- lookupOrDie nLens ctxs
 
-        let UName nLens = uLens
+        -- Introduce new series with name of segd,
+        -- as copy of lens series
         let nLensUse    = NameVarMod nLens "use"
-        let uLensUse    = UName nLensUse
-        let bLensUse    = BName nLensUse (tSeries tK1 tNat)
+        let bLensUse    = BName nLensUse (tSeries tProc tK1 tNat)
 
         let opId        = OpId
                         { opResultSeries        = bLensUse
@@ -251,34 +288,114 @@
 
         let context     = ContextSegment
                         { contextOuterRate      = tK1
-                        , contextInnerRate      = TVar (UName nK2)
-                        , contextLens           = uLensUse
-                        , contextSegd           = bSegd }
+                        , contextInnerRate      = TVar (UName nR)
+                        , contextLens           = uLens
+                        , contextSegd           = bSegd
+                        , contextOps            = [opId]
+                        , contextInner          = [] }
 
-        return (context : ctxInner, opId : osInner)
+        context'       <- insertContext context  lensContext
+        let ctxsInner   = Map.insert nSegd context' ctxs
+        segProc <- slurpProcessX tenv ctxsInner rs xBody
 
+        let ctxsOuter   = Map.insert n segProc ctxs
+        return (ctxsOuter, rs)
 
+
 -- Slurp a series operator that doesn't introduce a new context.
-slurpBindingX _ b xx
- | Just op      <- slurpOperator b xx
- = return ([], [op])
+slurpBindingX _ ctxs rs b@(BName n _) xx
+ | Just (ins, k,op)  <- slurpOperator b xx
+ = do   ins'           <- mapM (flip lookupOrDie ctxs) ins
 
--- Slurp a process ending.
-slurpBindingX tenv _ xx
- -- The process ends with a variable that has Process# type.
- | XVar u       <- xx
- , Just t       <- Env.lookup u tenv
- , t == tProcess
- = return ([], [])                
+        let ctx         = ContextRate
+                        { contextRate           = k
+                        , contextOps            = [op]
+                        , contextInner          = [] }
 
+        let go []     c = insertContext ctx c
+            go (i:is) c = insertContext c i >>= go is
+
+        context'       <- case reverse ins' of
+                           (i:is) -> go is i
+                           []     -> return ctx
+
+        let ctxs'       = Map.insert n context' ctxs
+        return (ctxs', rs)
+
+-- Slurp an append operator
+slurpBindingX _ ctxs rs b@(BName n _) xx
+ | Just (NameOpSeries OpSeriesAppend
+        , [ XType _P, XType tK1, XType tK2, XType tA
+          , XVar (UName nIn1), XVar (UName nIn2) ] ) 
+                                <- takeXPrimApps xx
+ = do   in1            <- lookupOrDie nIn1 ctxs
+        in2            <- lookupOrDie nIn2 ctxs
+
+        let opId iN iK  = OpId
+                        { opResultSeries        = b
+                        , opInputRate           = iK
+                        , opInputSeries         = UName iN
+                        , opElemType            = tA }
+        let idCtx iN iK  = ContextRate
+                        { contextRate           = iK
+                        , contextOps            = [opId iN iK]
+                        , contextInner          = [] }
+
+        in1'           <- insertContext (idCtx nIn1 tK1) in1
+        in2'           <- insertContext (idCtx nIn2 tK2) in2
+
+        let ctx         = ContextAppend
+                        { contextRate1          = tK1
+                        , contextInner1         = in1'
+                        , contextRate2          = tK2
+                        , contextInner2         = in2' }
+
+
+        let ctxs'       = Map.insert n ctx ctxs
+        return (ctxs', rs)
+
+
+-- Slurp a Resize
+slurpBindingX _ ctxs rs (BName n _) xx
+ | Just rr <- seqEitherMaybe $ slurpResize rs xx
+ = do   r  <- rr
+        return (ctxs, Map.insert n r rs)
+
+
+-- Slurp a process join or resize
+slurpBindingX _tenv ctxs rs (BName n _) xx
+ -- Just a plain variable, try to look it up in the environments
+ | XVar  u      <- xx
+ , UName var    <- u
+ = case (Map.lookup var ctxs, Map.lookup var rs) of
+    (Just c', _) -> return (Map.insert n c' ctxs, rs)
+    (_, Just r') -> return (ctxs, Map.insert n r' rs)
+    (Nothing, Nothing)
+     -> Left (ErrorNotInContext var)
+
  -- The process ends by joining two existing processes.
  -- We assume that the overall expression is well typed.
- | Just (NameOpSeries OpSeriesJoin, [_, _])     
+ | Just (NameOpSeries OpSeriesJoin, [_, _, XVar (UName a), XVar (UName b)])
                 <- takeXPrimApps xx
- = return ([], [])
+ = do   a' <- lookupOrDie a ctxs
+        b' <- lookupOrDie b ctxs
+        m' <- mergeContexts a' b'
+        let ctxs' = Map.insert n m' ctxs
+        return (ctxs', rs)
 
+ -- The process ends by joining two existing processes.
+ -- We assume that the overall expression is well typed.
+ | Just (NameOpSeries OpSeriesResizeProc, [_, _, _, XVar (UName r), XVar (UName c)])
+                <- takeXPrimApps xx
+ = do   r' <- lookupOrDie r rs
+        c' <- lookupOrDie c ctxs
+        m' <- resizeContext r' c'
+        let ctxs' = Map.insert n m' ctxs
+        return (ctxs', rs)
+
+
  -- Process finishes with some expression that doesn't look like it 
  -- actually defines a value of type Process#.
- | otherwise
+slurpBindingX _ _ _ _ xx
  = Left (ErrorBadOperator xx)
 
diff --git a/DDC/Core/Flow/Transform/Slurp/Context.hs b/DDC/Core/Flow/Transform/Slurp/Context.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Slurp/Context.hs
@@ -0,0 +1,287 @@
+
+module DDC.Core.Flow.Transform.Slurp.Context
+    ( insertContext
+    , mergeContexts
+    , resizeContext )
+where
+import DDC.Core.Flow.Context
+import DDC.Core.Flow.Transform.Slurp.Error
+import DDC.Core.Flow.Transform.Slurp.Resize
+import DDC.Core.Flow.Prim
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
+import Data.List     (nub)
+
+
+-- "embed" is to be pushed inside "into"
+-- only one of "embed" or "into" can contain inner contexts;
+-- otherwise, no promises are made about merging these
+insertContext
+        :: Context
+        -> Context
+        -> Either Error Context
+insertContext embed into
+ = case into of
+    ContextRate{}
+     -> case embed of
+         ContextRate{}
+          | contextRate into == contextRate embed
+          -> dropops
+          | otherwise
+          -> descend
+
+         ContextSelect{}
+          -> descendorpush (contextRate into == contextOuterRate embed)
+
+         ContextSegment{}
+          -> descendorpush (contextRate into == contextOuterRate embed)
+
+         ContextAppend{}
+          -> app into embed
+
+
+    ContextSelect{}
+     -> case embed of
+         ContextRate{}
+          | contextInnerRate into == contextRate embed
+          -> dropops
+          | otherwise
+          -> descend
+
+         ContextSelect{}
+          | contextOuterRate into == contextOuterRate embed
+          , contextInnerRate into == contextInnerRate embed
+          , contextFlags     into == contextFlags     embed
+          , contextSelector  into == contextSelector  embed
+          -> dropops
+          | otherwise
+          -> descendorpush (contextInnerRate into == contextOuterRate embed)
+
+         ContextSegment{}
+          -> descendorpush (contextInnerRate into == contextOuterRate embed)
+
+         ContextAppend{}
+          -> app into embed
+
+
+    ContextSegment{}
+     -> case embed of
+         ContextRate{}
+          | contextInnerRate into == contextRate embed
+          -> dropops
+          | otherwise
+          -> descend
+
+         ContextSelect{}
+          -> descendorpush (contextInnerRate into == contextOuterRate embed)
+
+         ContextSegment{}
+          | contextOuterRate into == contextOuterRate embed
+          , contextInnerRate into == contextInnerRate embed
+          , contextLens      into == contextLens      embed
+          , contextSegd      into == contextSegd      embed
+          -> dropops
+          | otherwise
+          -> descendorpush (contextInnerRate into == contextOuterRate embed)
+
+         ContextAppend{}
+          -> app into embed
+
+
+    ContextAppend{}
+     -> app embed into
+
+ where
+  descend =
+   case tryInserts embed (contextInner into) of
+    Nothing -> Left (ErrorCannotMergeContext embed into)
+    Just cs -> return into { contextInner = cs }
+
+  dropops =
+   let ops' = contextOps   into ++ contextOps   embed
+   in  return
+         into { contextOps   = nub ops'
+              , contextInner = mergeLists (contextInner into) (contextInner embed) }
+
+  pushinner =
+   return
+       into { contextInner = mergeLists (contextInner into) [embed] }
+
+  descendorpush p =
+   case descend of
+    Right v
+     -> return v
+    Left e
+     | p
+     -> pushinner
+     | otherwise
+     -> Left e
+
+  app splittee injectee
+   = do (ls, rs) <- splitContextIntoApps splittee
+        ls'      <- insertContext ls (contextInner1 injectee)
+        rs'      <- insertContext rs (contextInner2 injectee)
+        return $ injectee
+                 { contextInner1 = ls'
+                 , contextInner2 = rs' }
+
+mergeLists :: [Context] -> [Context] -> [Context]
+mergeLists lefts []
+ = lefts
+mergeLists lefts (right:rest)
+ = case mergeAny [] lefts right of
+    Nothing  -> mergeLists (lefts ++ [right]) rest
+    Just ls' -> mergeLists ls' rest
+ where
+  mergeAny _ [] _
+   = Nothing
+  mergeAny pres (l:ls) r
+   = case insertContext l r of
+      Right l' -> Just (pres ++ [l'] ++ ls)
+      Left _   -> mergeAny (pres ++ [l]) ls r 
+
+
+
+tryInserts :: Context -> [Context] -> Maybe [Context]
+tryInserts embed intos
+ = go intos []
+ where
+  go [] _
+   = Nothing
+  go (i:is) rs
+    = case insertContext embed i of
+       Right c' -> Just  (rs ++ [c'] ++ is)
+       Left _   -> go is (rs ++ [i])
+
+
+-- cannot split appends.
+-- but only called by insertContext, which does not take appends anyway.
+splitContextIntoApps :: Context -> Either Error (Context,Context)
+splitContextIntoApps ctx
+ = case ctx of
+    ContextRate{}
+     | Just (tl, tr) <- takeAppend $ contextRate ctx
+     -> do      (lis, ris) <- unzip <$> mapM splitContextIntoApps (contextInner ctx)
+                return ( ctx { contextRate      = tl
+                             , contextInner     = lis }
+                       , ctx { contextRate      = tr
+                             , contextInner     = ris } )
+
+    ContextSelect{}
+     | Just (tl, tr) <- takeAppend $ contextOuterRate ctx
+     -> do      (lis, ris) <- unzip <$> mapM splitContextIntoApps (contextInner ctx)
+                return ( ctx { contextOuterRate  = tl
+                             , contextInner      = lis }
+                       , ctx { contextOuterRate  = tr
+                             , contextInner      = ris } )
+
+    ContextSegment{}
+     | Just (tl, tr) <- takeAppend $ contextOuterRate ctx
+     -> do      (lis, ris) <- unzip <$> mapM splitContextIntoApps (contextInner ctx)
+                return ( ctx { contextOuterRate  = tl
+                             , contextInner      = lis }
+                       , ctx { contextOuterRate  = tr
+                             , contextInner      = ris } )
+
+    ContextAppend{}
+     ->         return ( contextInner1 ctx
+                       , contextInner2 ctx )
+
+    _
+     -> -- Left (ErrorCannotSplitContext ctx) 
+        return (ctx, ctx)
+
+
+ where
+
+
+mergeContexts :: Context -> Context -> Either Error Context
+mergeContexts a b
+ = insertContext b a
+
+resizeContext :: Resize -> Context -> Either Error Context
+resizeContext resize ctx
+ = case resize of
+    Id _    
+     -> return ctx
+    AppL a b
+     -> return
+         ContextAppend
+         { contextRate1  = a
+         , contextInner1 = wrapCtx b ctx
+         , contextRate2  = b
+         , contextInner2 = emptyCtx a
+         }
+
+    AppR a b
+     -> return
+         ContextAppend
+         { contextRate1  = a
+         , contextInner1 = emptyCtx a
+         , contextRate2  = b
+         , contextInner2 = wrapCtx b ctx
+         }
+
+    App _ k' _ l' ls rs
+     | ContextAppend{} <- ctx
+     -> do  in1 <- resizeContext ls (contextInner1 ctx)
+            in2 <- resizeContext rs (contextInner2 ctx)
+            return
+             ContextAppend
+             { contextRate1  = k'
+             , contextInner1 = in1
+             , contextRate2  = l'
+             , contextInner2 = in2 }
+     | otherwise
+     -> Left (ErrorCannotResizeContext ctx)
+
+    Sel1 _ _k _ r
+     -> do  ctx' <- resizeContext r ctx
+            return $ ctx'
+
+    Segd _ _k _ r
+     -> do  ctx' <- resizeContext r ctx
+            return $ ctx'
+
+    Cross _ k _ r
+     -> do  ctx' <- resizeContext r ctx
+            return $ wrapCtx k ctx'
+            
+            
+
+
+emptyCtx :: Type Name -> Context
+emptyCtx k
+ = ContextRate
+ { contextRate  = k
+ , contextInner = []
+ , contextOps   = [] }
+
+wrapCtx :: Type Name -> Context -> Context
+wrapCtx k ctx
+ = case ctx of
+   ContextRate{}
+    | contextRate ctx == k
+    -> ctx
+
+   ContextAppend{}
+    | Just (l,r) <- takeAppend k
+    , contextRate1 ctx == l
+    , contextRate2 ctx == r
+    -> ctx
+    
+   _
+    | otherwise
+    -> ContextRate
+       { contextRate  = k
+       , contextInner = [ctx]
+       , contextOps   = [] }
+
+takeAppend ty
+ | Just (NameTyConFlow TyConFlowRateAppend, [tK, tL])
+          <- takePrimTyConApps ty
+ = Just (tK, tL)
+ | otherwise
+ = Nothing
+
+
diff --git a/DDC/Core/Flow/Transform/Slurp/Error.hs b/DDC/Core/Flow/Transform/Slurp/Error.hs
--- a/DDC/Core/Flow/Transform/Slurp/Error.hs
+++ b/DDC/Core/Flow/Transform/Slurp/Error.hs
@@ -1,11 +1,13 @@
 
 module DDC.Core.Flow.Transform.Slurp.Error
-        (Error (..))
+        ( Error (..) )
 where
 import DDC.Core.Flow.Exp
 import DDC.Core.Flow.Prim
 import DDC.Core.Transform.Annotate
 import DDC.Core.Pretty
+import DDC.Core.Flow.Context
+import DDC.Core.Flow.Process.Pretty ()
 
 
 -- | Things that can go wrong when slurping a process spec from
@@ -16,6 +18,19 @@
 
         -- | Invalid operator definition in process.
         | ErrorBadOperator (Exp () Name)
+
+        -- | A series, process or resize is not bound locally,
+        -- so is not in context
+        | ErrorNotInContext Name
+
+        -- | Cannot merge contexts
+        | ErrorCannotMergeContext Context Context
+
+        -- | Cannot split contexts
+        | ErrorCannotSplitContext Context
+
+        -- | Cannot resize a non-append
+        | ErrorCannotResizeContext Context
         deriving Show
 
 
@@ -31,3 +46,29 @@
          -> vcat [ text "Bad series operator."
                  , empty
                  , ppr (annotate () x) ]
+
+        ErrorNotInContext n
+         -> vcat [ text "Referenced name not in context."
+                 , text "All Series, Processes and Resizes must be locally bound"
+                 , empty
+                 , ppr n ]
+
+        ErrorCannotMergeContext c1 c2
+         -> vcat [ text "Cannot merge contexts"
+                 , empty
+                 , text "Embed:"
+                 , ppr c1
+                 , empty
+                 , text "Into:"
+                 , ppr c2 ]
+
+        ErrorCannotSplitContext c
+         -> vcat [ text "Cannot split context into its append parts"
+                 , empty
+                 , ppr c]
+
+        ErrorCannotResizeContext c
+         -> vcat [ text "Cannot resize append context, because it's not an append"
+                 , empty
+                 , ppr c]
+
diff --git a/DDC/Core/Flow/Transform/Slurp/Operator.hs b/DDC/Core/Flow/Transform/Slurp/Operator.hs
--- a/DDC/Core/Flow/Transform/Slurp/Operator.hs
+++ b/DDC/Core/Flow/Transform/Slurp/Operator.hs
@@ -7,7 +7,7 @@
 import DDC.Core.Flow.Process.Operator
 import DDC.Core.Flow.Exp
 import DDC.Core.Flow.Prim
-import DDC.Core.Compounds.Simple
+import DDC.Core.Exp.Simple.Compounds
 import DDC.Core.Pretty                  ()
 import Control.Monad
 
@@ -17,120 +17,156 @@
 slurpOperator 
         :: Bind Name 
         -> Exp () Name 
-        -> Maybe Operator
+        -> Maybe ([Name], Type Name, Operator)
+        -- name of contexts to insert into, rate, operator
 
 slurpOperator bResult xx
  
  -- Rep -----------------------------------------
  | Just ( NameOpSeries OpSeriesRep
-        , [ XType tK1, XType tA, xVal])
+        , [ XType _P, XType tK1, XType tA, xVal])
                                 <- takeXPrimApps xx
- = Just $ OpRep
+ = Just ( []
+        , tK1
+        , OpRep
         { opResultSeries        = bResult
         , opOutputRate          = tK1
         , opElemType            = tA
-        , opInputExp            = xVal }
+        , opInputExp            = xVal } )
 
  -- Reps ----------------------------------------
  | Just ( NameOpSeries OpSeriesReps
-        , [ XType tK1, XType tK2, XType tA, XVar uSegd, XVar uS ])
+        , [ XType _P, XType tK1, XType tK2, XType tA, XVar uSegd@(UName nSegd), XVar uS@(UName nS) ])
                                 <- takeXPrimApps xx
- = Just $ OpReps
+ = Just ( [nSegd, nS]
+        , tK2
+        , OpReps
         { opResultSeries        = bResult
         , opInputRate           = tK1
         , opOutputRate          = tK2
         , opElemType            = tA
         , opSegdBound           = uSegd
-        , opInputSeries         = uS }
+        , opInputSeries         = uS } )
 
  -- Indices -------------------------------------
  | Just ( NameOpSeries OpSeriesIndices
-        , [ XType tK1, XType tK2, XVar uSegd])
+        , [ XType _P, XType tK1, XType tK2, XVar uSegd@(UName nSegd)])
                                 <- takeXPrimApps xx
- = Just $ OpIndices
+ = Just ( [nSegd]
+        , tK2
+        , OpIndices
         { opResultSeries        = bResult
         , opInputRate           = tK1
         , opOutputRate          = tK2 
-        , opSegdBound           = uSegd }
+        , opSegdBound           = uSegd } )
 
  -- Fill ----------------------------------------
  | Just ( NameOpSeries OpSeriesFill
-        , [ XType tK, XType tA, XVar uV, XVar uS ])
+        , [ XType _P, XType tK, XType tA, XVar uV, XVar uS@(UName nS) ])
                                 <- takeXPrimApps xx
- = Just $ OpFill
+ = Just ( [nS]
+        , tK
+        , OpFill
         { opResultBind          = bResult
         , opTargetVector        = uV
         , opInputRate           = tK 
         , opInputSeries         = uS
-        , opElemType            = tA }
+        , opElemType            = tA } )
 
 
  -- Gather --------------------------------------
  | Just ( NameOpSeries OpSeriesGather
-        , [ XType tK, XType tA, XVar uV, XVar uS ])
+        , [ XType _P, XType tK1, XType tK2, XType tA, XVar uV, XVar uS@(UName nS) ])
                                 <- takeXPrimApps xx
- = Just $ OpGather
+ = Just ( [nS]
+        , tK2
+        , OpGather
         { opResultBind          = bResult
         , opSourceVector        = uV
+        , opVectorRate          = tK1
         , opSourceIndices       = uS
-        , opInputRate           = tK
-        , opElemType            = tA }
+        , opInputRate           = tK2
+        , opElemType            = tA } )
 
 
  -- Scatter -------------------------------------
  | Just ( NameOpSeries OpSeriesScatter
-        , [ XType tK, XType tA, XVar uV, XVar uIndices, XVar uElems ])
+        , [ XType _P, XType tK, XType tA, XVar uV, XVar uIndices@(UName nIndices), XVar uElems@(UName nElems) ])
                                 <- takeXPrimApps xx
- = Just $ OpScatter
+ = Just ( [nIndices, nElems]
+        , tK
+        , OpScatter
         { opResultBind          = bResult
         , opTargetVector        = uV
         , opSourceIndices       = uIndices
         , opSourceElems         = uElems
         , opInputRate           = tK
-        , opElemType            = tA }
+        , opElemType            = tA } )
 
 
  -- Map -----------------------------------------
  | Just (NameOpSeries (OpSeriesMap n), xs) 
                                 <- takeXPrimApps xx
  , n >= 1
- , XType tR : xsArgs2   <- xs
+ , XType _P : XType tR : xsArgs2   <- xs
  , (xsA, xsArgs3)       <- splitAt (n + 1) xsArgs2
  , tsA                  <- [ t | XType t <- xsA ]
  , length tsA      == n + 1
  , xWorker : xsSeries   <- xsArgs3
- , usSeries             <- [ u | XVar u  <- xsSeries ]
+ , usSeries             <- [ u  | XVar  u  <- xsSeries ]
+ , nsSeries             <- [ un | UName un <- usSeries ]
  , length usSeries == n
  , Just (psIn, xBody)           <- takeXLams xWorker
  , length psIn     == n
- = Just $ OpMap
+ = Just ( nsSeries
+        , tR
+        , OpMap
         { opArity               = n
         , opResultSeries        = bResult
         , opInputRate           = tR
         , opInputSeriess        = usSeries
         , opWorkerParams        = psIn
-        , opWorkerBody          = xBody }
+        , opWorkerBody          = xBody } )
 
 
  -- Pack ----------------------------------------
  | Just ( NameOpSeries OpSeriesPack
-        , [ XType tRateInput, XType tRateOutput, XType tElem
-          , _xSel, (XVar uSeries) ])    <- takeXPrimApps xx
- = Just $ OpPack
+        , [ XType _P
+          , XType tRateInput, XType tRateOutput
+          , XType tElem
+          , XVar (UName nSel), XVar uSeries@(UName nSeries) ])    <- takeXPrimApps xx
+ = Just ( [nSel, nSeries]
+        , tRateOutput
+        , OpPack
         { opResultSeries        = bResult
         , opInputRate           = tRateInput
         , opInputSeries         = uSeries
         , opOutputRate          = tRateOutput 
-        , opElemType            = tElem }
+        , opElemType            = tElem } )
 
 
+ -- Generate ------------------------------------
+ | Just ( NameOpSeries OpSeriesGenerate
+        , [ XType _P, XType tK, XType _, xWorker ])
+                                <- takeXPrimApps xx
+ , Just ([bIx], xBody)          <- takeXLams xWorker
+ = Just ( []
+        , tK
+        , OpGenerate
+        { opResultSeries        = bResult
+        , opOutputRate          = tK
+        , opWorkerParamIndex    = bIx
+        , opWorkerBody          = xBody } )
+
  -- Reduce --------------------------------------
  | Just ( NameOpSeries OpSeriesReduce
-        , [ XType tK, XType _
-          , XVar uRef, xWorker, xZ, XVar uS ])
+        , [ XType _P, XType tK, XType _
+          , XVar uRef, xWorker, xZ, XVar uS@(UName nS) ])
                                 <- takeXPrimApps xx
  , Just ([bAcc, bElem], xBody)  <- takeXLams xWorker
- = Just $ OpReduce
+ = Just ( [nS]
+        , tK
+        , OpReduce
         { opResultBind          = bResult
         , opTargetRef           = uRef
         , opInputRate           = tK
@@ -138,7 +174,7 @@
         , opZero                = xZ
         , opWorkerParamAcc      = bAcc
         , opWorkerParamElem     = bElem
-        , opWorkerBody          = xBody }
+        , opWorkerBody          = xBody } )
 
  | otherwise
  = Nothing
diff --git a/DDC/Core/Flow/Transform/Slurp/Resize.hs b/DDC/Core/Flow/Transform/Slurp/Resize.hs
new file mode 100644
--- /dev/null
+++ b/DDC/Core/Flow/Transform/Slurp/Resize.hs
@@ -0,0 +1,120 @@
+
+module DDC.Core.Flow.Transform.Slurp.Resize
+    ( Resize(..)
+    , slurpResize
+    , lookupOrDie
+    , seqEitherMaybe )
+where
+import DDC.Core.Flow.Transform.Slurp.Error
+import DDC.Core.Flow.Prim
+import DDC.Core.Exp.Simple.Compounds
+import DDC.Core.Exp.Simple.Exp
+import qualified Data.Map               as Map
+
+type Ty = Type Name
+
+data Resize
+ = Id    Ty
+ | AppL  Ty Ty
+ | AppR  Ty Ty
+ | App   Ty Ty Ty Ty Resize Resize 
+ | Sel1  Ty Ty Ty      Resize
+ | Segd  Ty Ty Ty      Resize
+ | Cross Ty Ty Ty      Resize
+ deriving Show
+
+slurpResize
+    :: Map.Map Name Resize
+    -> Exp ()  Name
+    -> Either Error (Maybe Resize)
+
+slurpResize rs xx
+
+ | Just ( NameOpSeries OpSeriesResizeId
+        , [ _, tK ] )
+                <- takeXPrimApps xx
+ = return (Id <$> nameOfType tK)
+
+ | Just ( NameOpSeries OpSeriesResizeAppL
+        , [ _, tK, tL ] )
+                <- takeXPrimApps xx
+ = return (AppL <$> nameOfType tK <*> nameOfType tL)
+
+ | Just ( NameOpSeries OpSeriesResizeAppR
+        , [ _, tK, tL ] )
+                <- takeXPrimApps xx
+ = return (AppR         <$> nameOfType tK <*> nameOfType tL)
+
+ | Just ( NameOpSeries OpSeriesResizeApp
+        , [ _, tK, tK', tL, tL'
+          , XVar (UName rL)
+          , XVar (UName rR) ] )
+                <- takeXPrimApps xx
+ = do   rL'     <- lookupOrDie rL rs
+        rR'     <- lookupOrDie rR rs
+        return (App     <$> nameOfType tK <*> nameOfType tK'
+                        <*> nameOfType tL <*> nameOfType tL'
+                        <*> Just rL'      <*> Just rR')
+
+ | Just ( NameOpSeries OpSeriesResizeSel1
+        , [ _, tJ, tK, tL
+          , _
+          , XVar (UName r) ] )
+                <- takeXPrimApps xx
+ = do   r'      <- lookupOrDie r rs
+        return (Sel1    <$> nameOfType tJ <*> nameOfType tK
+                        <*> nameOfType tL
+                        <*> Just r')
+
+ | Just ( NameOpSeries OpSeriesResizeSegd
+        , [ _, tJ, tK, tL
+          , _
+          , XVar (UName r) ] )
+                <- takeXPrimApps xx
+ = do   r'      <- lookupOrDie r rs
+        return (Segd    <$> nameOfType tJ <*> nameOfType tK
+                        <*> nameOfType tL
+                        <*> Just r')
+
+
+ | Just ( NameOpSeries OpSeriesResizeCross
+        , [ _, tJ, tK, tL
+          , _
+          , XVar (UName r) ] )
+                <- takeXPrimApps xx
+ = do   r'      <- lookupOrDie r rs
+        return (Cross   <$> nameOfType tJ <*> nameOfType tK
+                        <*> nameOfType tL
+                        <*> Just r')
+
+
+
+ | otherwise
+ = return Nothing
+
+
+nameOfType :: Exp () Name -> Maybe (Type Name)
+
+nameOfType (XType t)
+ = Just t
+
+nameOfType _
+ = Nothing
+
+
+lookupOrDie
+    :: Name
+    -> Map.Map Name v
+    -> Either Error v
+lookupOrDie n m
+ = case Map.lookup n m of
+    Just v  -> return v
+    Nothing -> Left $ ErrorNotInContext n
+
+seqEitherMaybe :: Either a (Maybe b) -> Maybe (Either a b)
+seqEitherMaybe x
+ = case x of
+   Left a         -> Just (Left a)
+   Right Nothing  -> Nothing
+   Right (Just b) -> Just (Right b)
+
diff --git a/DDC/Core/Flow/Transform/Thread.hs b/DDC/Core/Flow/Transform/Thread.hs
--- a/DDC/Core/Flow/Transform/Thread.hs
+++ b/DDC/Core/Flow/Transform/Thread.hs
@@ -10,11 +10,10 @@
 import DDC.Core.Flow.Compounds
 import DDC.Core.Flow.Profile
 import DDC.Core.Flow.Prim
-import DDC.Core.Compounds       as C
-import DDC.Core.Exp
+import DDC.Core.Exp.Annot               as C
 import DDC.Core.Transform.Thread
 import DDC.Core.Transform.Reannotate
-import DDC.Core.Check           (AnTEC (..))
+import DDC.Core.Check                   (AnTEC (..))
 import qualified DDC.Core.Check         as Check
 
 
@@ -143,13 +142,13 @@
         -- vread#  :: [a : Data]. Vector# a -> Nat# -> World# -> T2# World# a
         NameOpStore (OpStoreReadVector _)
          -> Just $ tForall kData
-                 $ \tA -> tA `tFun` tVector tA `tFun` tNat
+                 $ \tA -> tA `tFun` tBuffer tA `tFun` tNat
                         `tFun` tWorld `tFun` (tTuple2 tWorld tA)
 
         -- vwrite# :: [a : Data]. Vector# a -> Nat# -> a -> World# -> World#
         NameOpStore (OpStoreWriteVector _)
          -> Just $ tForall kData
-                 $ \tA -> tA `tFun` tVector tA `tFun` tNat `tFun` tA
+                 $ \tA -> tA `tFun` tBuffer tA `tFun` tNat `tFun` tA
                         `tFun` tWorld `tFun` tWorld
 
         -- vtrunc# :: [a : Data]. Nat# -> Vector# a -> World# -> World#
@@ -162,17 +161,19 @@
         -- next#  :: [k : Rate]. [a : Data]
         --        .  Series# k a -> Int# -> World# -> (World#, a)
         NameOpConcrete (OpConcreteNext 1)
-         -> Just $ tForalls [kRate, kData]
-                 $ \[tK, tA] -> tSeries tK tA `tFun` tInt
-                                `tFun` tWorld `tFun` (tTuple2 tWorld tA)
+         -> Just $ tForalls [kProc, kRate, kData]
+                 $ \[tP, tK, tA]
+                        ->     tSeries tP tK tA `tFun` tInt
+                        `tFun` tWorld `tFun` (tTuple2 tWorld tA)
 
         -- nextN# :: [k : Rate]. [a : Data]
         --        .  Series# k a -> Int# -> World# -> (World#, a)
         NameOpConcrete (OpConcreteNext c)
          | c >= 2
-         -> Just $ tForalls [kRate, kData]
-                 $ \[tK, tA] -> tSeries (tDown c tK) tA `tFun` tInt 
-                                `tFun` tWorld `tFun` (tTuple2 tWorld (tVec c tA))
+         -> Just $ tForalls [kProc, kRate, kData]
+                 $ \[tP, tK, tA]
+                        ->     tSeries tP (tDown c tK) tA `tFun` tInt 
+                        `tFun` tWorld `tFun` (tTuple2 tWorld (tVec c tA))
 
         -- Control -----------------------------
         -- loopn#  :: [k : Rate]. RateNat# k
@@ -186,9 +187,8 @@
 
         -- guard#
         NameOpControl OpControlGuard
-         -> Just $ tRef tNat
-                        `tFun` tBool
-                        `tFun` (tNat  `tFun` tWorld `tFun` tWorld)
+         -> Just $             tBool
+                        `tFun` (tUnit  `tFun` tWorld `tFun` tWorld)
                         `tFun` tWorld `tFun` tWorld
 
         -- split#  :: [k : Rate]. RateNat# k
diff --git a/DDC/Core/Flow/Transform/Wind.hs b/DDC/Core/Flow/Transform/Wind.hs
--- a/DDC/Core/Flow/Transform/Wind.hs
+++ b/DDC/Core/Flow/Transform/Wind.hs
@@ -28,12 +28,12 @@
         , windModule)
 where
 import DDC.Core.Module
-import DDC.Core.Exp
 import DDC.Core.Flow
 import DDC.Core.Flow.Prim
-import DDC.Core.Compounds
+import DDC.Core.Exp.Annot
+import DDC.Core.Transform.TransformModX
 import DDC.Core.Flow.Compounds  
-        (tNat, dcNat, dcTupleN, dcBool, tTupleN)
+        (tNat, dcNat, dcTupleN, dcBool, tTupleN, kRate)
 import qualified Data.Map       as Map
 import Data.Map                 (Map)
 
@@ -104,12 +104,8 @@
 
         -- | We're currently in the body of a guard.
         | ContextGuard
-        { -- | Name of the entry counter,
-          --   the number of times this guard has matched.
-          contextGuardCounter   :: Name
-
-          -- | Whether we're in the matching or non-matching branch.
-        , contextGuardFlag      :: Bool }
+        { -- | Whether we're in the matching or non-matching branch.
+          contextGuardFlag      :: Bool }
         deriving Show
 
 
@@ -167,17 +163,7 @@
 
 -- If we're inside the true branch of a guard then update
 -- the associated entry counter for the guard.
-slurpArgUpdates a refMap args (ContextGuard nCounter flag : more)
- | flag == True
- = let  
-        update []               = []
-        update ((n, x) : args')
-         | n == nCounter        = (n, xIncrement a x) : update args'
-         | otherwise            = (n, x)              : update args'
-
-   in   slurpArgUpdates a refMap (update args) more
-
- | otherwise
+slurpArgUpdates a refMap args (ContextGuard _flag : more)
  =      slurpArgUpdates a refMap args more
 
 slurpArgUpdates _ _ _   (ContextLoop{} : _)
@@ -206,31 +192,20 @@
 
 -------------------------------------------------------------------------------
 -- | Apply the wind transform to a single module.
+-- Only apply wind to top-level let binds with Forall (k : Rate)...,
+-- as that seems like a good indication that something is a lowered series.
 windModule :: Module () Name -> Module () Name
 windModule m
- = let  body'   = windModuleBodyX (moduleBody m)
-   in   m { moduleBody = body' }
-
-
--- | Do winding in the body of a module.
-windModuleBodyX :: Exp () Name -> Exp () Name
-windModuleBodyX xx
- = case xx of
-        XLet a (LLet b x1) x2
-         -> let x1'     = windBodyX refMapZero [] x1
-                x2'     = windModuleBodyX x2
-            in  XLet a (LLet b x1') x2'
-
-        XLet a (LRec bxs) x2
-         -> let bxs'    = [(b, windBodyX refMapZero [] x) | (b, x) <- bxs]
-                x2'     = windModuleBodyX x2
-            in  XLet a (LRec bxs') x2'
-
-        XLet a lts x2
-         -> let x2'     = windModuleBodyX x2
-            in  XLet a lts x2'
+ = transformModLet check m
+ where
+  check b x
+   | t             <- typeOfBind   b
+   , Just (bs, _)  <- takeTForalls t
+   , elem kRate $ map typeOfBind bs
+   = windBodyX refMapZero [] x
 
-        _ -> xx
+   | otherwise
+   = x
 
 
 -------------------------------------------------------------------------------
@@ -395,21 +370,15 @@
         -- Detect guard combinator.
         XLet a (LLet (BNone _) x) x2
          | Just ( NameOpControl OpControlGuard
-                , [ XVar _ (UName nCountRef)
-                  , xFlag
-                  , XLam _ bCount xBody ])       <- takeXPrimApps x
+                , [ xFlag
+                  , XLam _ _unit xBody ])       <- takeXPrimApps x
          -> let 
-                Just infoCount  = lookupRefInfo refMap nCountRef
-
-                Just nCount     = nameOfRefInfo infoCount
-
                 context' = context
                          ++ [ ContextGuard
-                                { contextGuardCounter = nCountRef
-                                , contextGuardFlag    = True }  ]
+                                { contextGuardFlag    = True }  ]
 
-                xBody'  = XLet a (LLet bCount (XVar a (UName nCount)))
-                        $ windBodyX refMap context' xBody
+                xBody'  = -- XLet a (LLet bCount (XVar a (UName nCount)))
+                          windBodyX refMap context' xBody
 
             in  XCase a xFlag 
                         [ AAlt (PData (dcBool True) []) xBody'
diff --git a/ddc-core-flow.cabal b/ddc-core-flow.cabal
--- a/ddc-core-flow.cabal
+++ b/ddc-core-flow.cabal
@@ -1,5 +1,5 @@
 Name:           ddc-core-flow
-Version:        0.4.1.3
+Version:        0.4.2.1
 License:        MIT
 License-file:   LICENSE
 Author:         The Disciplined Disciple Compiler Strike Force
@@ -30,29 +30,43 @@
 
 Library
   Build-Depends: 
-        base            >= 4.6 && < 4.8,
+        base            >= 4.6 && < 4.9,
         array           >= 0.4 && < 0.6,
-        deepseq         == 1.3.*,
+        deepseq         >= 1.3 && < 1.5,
         containers      == 0.5.*,
+        limp            == 0.3.2.*,
+        limp-cbc        == 0.3.2.*,
         transformers    == 0.4.*,
-        mtl             == 2.2.*,
-        ddc-base        == 0.4.1.*,
-        ddc-core        == 0.4.1.*,
-        ddc-core-salt   == 0.4.1.*,
-        ddc-core-simpl  == 0.4.1.*
+        mtl             == 2.2.1.*,
+        ddc-base        == 0.4.2.*,
+        ddc-core        == 0.4.2.*,
+        ddc-core-salt   == 0.4.2.*,
+        ddc-core-simpl  == 0.4.2.*,
+        ddc-core-tetra  == 0.4.2.*
 
   Exposed-modules:
 
+        DDC.Core.Flow.Convert.Base
+        DDC.Core.Flow.Convert.Exp
+        DDC.Core.Flow.Convert.Type
+
         DDC.Core.Flow.Process.Operator
         DDC.Core.Flow.Process.Process
 
-        DDC.Core.Flow.Transform.Rates.Constraints
+        DDC.Core.Flow.Transform.Rates.Clusters.Base
+        DDC.Core.Flow.Transform.Rates.Clusters.Greedy
+        DDC.Core.Flow.Transform.Rates.Clusters.Linear
+        DDC.Core.Flow.Transform.Rates.Clusters
+        DDC.Core.Flow.Transform.Rates.CnfFromExp
+        DDC.Core.Flow.Transform.Rates.Combinators
         DDC.Core.Flow.Transform.Rates.Fail
         DDC.Core.Flow.Transform.Rates.Graph
         DDC.Core.Flow.Transform.Rates.SeriesOfVector
+        DDC.Core.Flow.Transform.Rates.SizeInference
 
         DDC.Core.Flow.Transform.Concretize
         DDC.Core.Flow.Transform.Extract
+        DDC.Core.Flow.Transform.Forward
         DDC.Core.Flow.Transform.Melt
         DDC.Core.Flow.Transform.Schedule
         DDC.Core.Flow.Transform.Slurp
@@ -61,6 +75,7 @@
 
         DDC.Core.Flow.Compounds
         DDC.Core.Flow.Context
+        DDC.Core.Flow.Convert
         DDC.Core.Flow.Env
         DDC.Core.Flow.Exp
         DDC.Core.Flow.Lower
@@ -71,6 +86,9 @@
         DDC.Core.Flow
 
   Other-modules:
+        DDC.Core.Flow.Context.Base
+        DDC.Core.Flow.Context.FillPath
+
         DDC.Core.Flow.Process.Pretty
         
         DDC.Core.Flow.Prim.Base
@@ -93,8 +111,10 @@
         DDC.Core.Flow.Transform.Schedule.Nest
         DDC.Core.Flow.Transform.Schedule.Scalar
 
+        DDC.Core.Flow.Transform.Slurp.Context
         DDC.Core.Flow.Transform.Slurp.Error
         DDC.Core.Flow.Transform.Slurp.Operator
+        DDC.Core.Flow.Transform.Slurp.Resize
 
 
   GHC-options:
@@ -114,4 +134,4 @@
         DeriveDataTypeable
         ViewPatterns
         FlexibleInstances
-        
+        BangPatterns