Merge /Users/benl/devel/ghc/ghc-head-devel

Conflicts:
	compiler/vectorise/Vectorise/Type/PRepr.hs

10 files changed, 1133 insertions, 311 deletions

diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs
index 13ab890425..4ed351d120 100644
--- a/compiler/vectorise/Vectorise/Builtins/Base.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Base.hs
@@ -73,6 +73,7 @@ data Builtins
         { parrayTyCon          :: TyCon                     -- ^ PArray
         , parray_PrimTyCons    :: NameEnv TyCon             -- ^ PArray_Int# etc.
         , pdataTyCon           :: TyCon                     -- ^ PData
+        , pdatasTyCon          :: TyCon                     -- ^ PDatas
         , prClass              :: Class                     -- ^ PR
         , prTyCon              :: TyCon                     -- ^ PR
         , preprTyCon           :: TyCon                     -- ^ PRepr
@@ -96,6 +97,7 @@ data Builtins
         , sumTyCons            :: Array Int TyCon           -- ^ Sum2 .. Sum3
         , wrapTyCon            :: TyCon                     -- ^ Wrap
         , pvoidVar             :: Var                       -- ^ pvoid
+        , pvoidsVar            :: Var                       -- ^ pvoids
         , closureTyCon         :: TyCon                     -- ^ :->
         , closureVar           :: Var                       -- ^ closure
         , liftedClosureVar     :: Var                       -- ^ liftedClosure
@@ -118,19 +120,19 @@ parray_PrimTyCon :: TyCon -> Builtins -> TyCon
 parray_PrimTyCon tc bi = lookupEnvBuiltin "parray_PrimTyCon" (parray_PrimTyCons bi) (tyConName tc)
 
 selTy :: Int -> Builtins -> Type
-selTy = indexBuiltin "selTy" selTys
+selTy           = indexBuiltin "selTy" selTys
 
 selReplicate :: Int -> Builtins -> CoreExpr
-selReplicate = indexBuiltin "selReplicate" selReplicates 
+selReplicate    = indexBuiltin "selReplicate" selReplicates 
 
 selTags :: Int -> Builtins -> CoreExpr
-selTags   = indexBuiltin "selTags" selTagss
+selTags         = indexBuiltin "selTags" selTagss
 
 selElements :: Int -> Int -> Builtins -> CoreExpr
 selElements i j = indexBuiltin "selElements" selElementss (i, j)
 
 sumTyCon :: Int -> Builtins -> TyCon
-sumTyCon = indexBuiltin "sumTyCon" sumTyCons
+sumTyCon        = indexBuiltin "sumTyCon" sumTyCons
 
 prodTyCon :: Int -> Builtins -> TyCon
 prodTyCon n _
@@ -171,8 +173,8 @@ scalarZip = indexBuiltin "scalarZip" scalarZips
 closureCtrFun :: Int -> Builtins -> Var
 closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
 
--- Get an element from one of the arrays of `Builtins`. Panic if the indexed thing is not in the array.
---
+-- | Get an element from one of the arrays of `Builtins`.
+--   Panic if the indexed thing is not in the array.
 indexBuiltin :: (Ix i, Outputable i) 
              => String                   -- ^ Name of the selector we've used, for panic messages.
              -> (Builtins -> Array i a)  -- ^ Field selector for the `Builtins`.
@@ -192,8 +194,8 @@ indexBuiltin fn f i bi
     , text "and ask what you can do to help (it might involve some GHC hacking)."])
   where xs = f bi
 
--- Get an entry from one of a 'NameEnv' of `Builtins`. Panic if the named item is not in the array.
---
+
+-- | Get an entry from one of a 'NameEnv' of `Builtins`. Panic if the named item is not in the array.
 lookupEnvBuiltin :: String                    -- Function name for error messages
                  -> NameEnv a                 -- Name environment
                  -> Name                      -- Index into the name environment
diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
index 6c26f099d7..1d48aa369b 100644
--- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
@@ -36,17 +36,19 @@ initBuiltins
       ; let parray_PrimTyCons = mkNameEnv (zip aLL_DPH_PRIM_TYCONS parray_tcs)
 
           -- 'PData': type family mapping array element types to array representation types
-      ; pdataTyCon <- externalTyCon (fsLit "PData")
+          -- Not all backends use `PDatas`.
+      ; pdataTyCon  <- externalTyCon (fsLit "PData")
+      ; pdatasTyCon <- externalTyCon (fsLit "PDatas")
 
           -- 'PR': class of basic array operators operating on 'PData' types
-      ; prClass <- externalClass (fsLit "PR")
+      ; prClass     <- externalClass (fsLit "PR")
       ; let prTyCon     = classTyCon prClass
 
           -- 'PRepr': type family mapping element types to representation types
       ; preprTyCon  <- externalTyCon (fsLit "PRepr")
 
           -- 'PA': class of basic operations on arrays (parametrised by the element type)
-      ; paClass <- externalClass (fsLit "PA")
+      ; paClass     <- externalClass (fsLit "PA")
       ; let paTyCon     = classTyCon paClass
             [paDataCon] = tyConDataCons paTyCon
             paPRSel     = classSCSelId paClass 0
@@ -75,34 +77,35 @@ initBuiltins
       ; scalarClass <- externalClass (fsLit "Scalar")
 
           -- N-ary maps ('zipWith' family)
-      ; scalar_map  <- externalVar (fsLit "scalar_map")
-      ; scalar_zip2 <- externalVar (fsLit "scalar_zipWith")
-      ; scalar_zips <- mapM externalVar (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
-      ; let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS) (scalar_map : scalar_zip2 : scalar_zips)
+      ; scalar_map       <- externalVar (fsLit "scalar_map")
+      ; scalar_zip2      <- externalVar (fsLit "scalar_zipWith")
+      ; scalar_zips      <- mapM externalVar (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
+      ; let scalarZips   = listArray (1, mAX_DPH_SCALAR_ARGS) (scalar_map : scalar_zip2 : scalar_zips)
 
           -- Types and functions for generic type representations
-      ; voidTyCon   <- externalTyCon (fsLit "Void")
-      ; voidVar     <- externalVar (fsLit "void")
-      ; fromVoidVar <- externalVar (fsLit "fromVoid")
-      ; sum_tcs     <- mapM externalTyCon (numbered "Sum" 2 mAX_DPH_SUM)
-      ; let sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
-      ; wrapTyCon   <- externalTyCon (fsLit "Wrap")
-      ; pvoidVar    <- externalVar (fsLit "pvoid")
+      ; voidTyCon        <- externalTyCon (fsLit "Void")
+      ; voidVar          <- externalVar   (fsLit "void")
+      ; fromVoidVar      <- externalVar   (fsLit "fromVoid")
+      ; sum_tcs          <- mapM externalTyCon (numbered "Sum" 2 mAX_DPH_SUM)
+      ; let sumTyCons    = listArray (2, mAX_DPH_SUM) sum_tcs
+      ; wrapTyCon        <- externalTyCon (fsLit "Wrap")
+      ; pvoidVar         <- externalVar   (fsLit "pvoid")
+      ; pvoidsVar        <- externalVar   (fsLit "pvoids")
 
           -- Types and functions for closure conversion
       ; closureTyCon     <- externalTyCon (fsLit ":->")
-      ; closureVar       <- externalVar (fsLit "closure")
-      ; liftedClosureVar <- externalVar (fsLit "liftedClosure")
-      ; applyVar         <- externalVar (fsLit "$:")
-      ; liftedApplyVar   <- externalVar (fsLit "liftedApply")
+      ; closureVar       <- externalVar   (fsLit "closure")
+      ; liftedClosureVar <- externalVar   (fsLit "liftedClosure")
+      ; applyVar         <- externalVar   (fsLit "$:")
+      ; liftedApplyVar   <- externalVar   (fsLit "liftedApply")
       ; closures         <- mapM externalVar (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
       ; let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
 
           -- Types and functions for selectors
-      ; sel_tys        <- mapM externalType (numbered "Sel" 2 mAX_DPH_SUM)
-      ; sel_replicates <- mapM externalFun (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
-      ; sel_tags       <- mapM externalFun (numbered "tagsSel" 2 mAX_DPH_SUM)
-      ; sel_elements   <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
+      ; sel_tys          <- mapM externalType (numbered "Sel" 2 mAX_DPH_SUM)
+      ; sel_replicates   <- mapM externalFun  (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
+      ; sel_tags         <- mapM externalFun  (numbered "tagsSel" 2 mAX_DPH_SUM)
+      ; sel_elements     <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
       ; let selTys        = listArray (2, mAX_DPH_SUM) sel_tys
             selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
             selTagss      = listArray (2, mAX_DPH_SUM) sel_tags
@@ -115,6 +118,7 @@ initBuiltins
                { parrayTyCon          = parrayTyCon
                , parray_PrimTyCons    = parray_PrimTyCons
                , pdataTyCon           = pdataTyCon
+               , pdatasTyCon          = pdatasTyCon
                , preprTyCon           = preprTyCon
                , prClass              = prClass
                , prTyCon              = prTyCon
@@ -138,6 +142,7 @@ initBuiltins
                , sumTyCons            = sumTyCons
                , wrapTyCon            = wrapTyCon
                , pvoidVar             = pvoidVar
+               , pvoidsVar            = pvoidsVar
                , closureTyCon         = closureTyCon
                , closureVar           = closureVar
                , liftedClosureVar     = liftedClosureVar
@@ -181,7 +186,7 @@ initBuiltinVars (Builtins { })
 
     preludeDataCons :: [(DataCon, FastString)]
     preludeDataCons
-      = [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..3]]
+      = [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..5]]
       where
         mk_tup n name = (tupleCon BoxedTuple n, name)
 
@@ -199,32 +204,32 @@ initBuiltinTyCons bi
              : []
 
 
--- Auxilliary look up functions ----------------
+-- Auxilliary look up functions -----------------------------------------------
 
--- Lookup a variable given its name and the module that contains it.
---
+-- |Lookup a variable given its name and the module that contains it.
 externalVar :: FastString -> DsM Var
 externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
 
--- Like `externalVar` but wrap the `Var` in a `CoreExpr`.
---
+
+-- |Like `externalVar` but wrap the `Var` in a `CoreExpr`.
 externalFun :: FastString -> DsM CoreExpr
 externalFun fs = Var <$> externalVar fs
 
--- Lookup a 'TyCon' in 'Data.Array.Parallel.Prim', given its name.
---
+
+-- |Lookup a 'TyCon' in 'Data.Array.Parallel.Prim', given its name.
+--  Panic if there isn't one.
 externalTyCon :: FastString -> DsM TyCon
 externalTyCon fs = dsLookupDPHRdrEnv (mkTcOccFS fs) >>= dsLookupTyCon
 
--- Lookup some `Type` in 'Data.Array.Parallel.Prim', given its name.
---
+
+-- |Lookup some `Type` in 'Data.Array.Parallel.Prim', given its name.
 externalType :: FastString -> DsM Type
 externalType fs
  = do  tycon <- externalTyCon fs
        return $ mkTyConApp tycon []
 
--- Lookup a 'Class' in 'Data.Array.Parallel.Prim', given its name.
---
+
+-- |Lookup a 'Class' in 'Data.Array.Parallel.Prim', given its name.
 externalClass :: FastString -> DsM Class
 externalClass fs 
   = do { tycon <- dsLookupDPHRdrEnv (mkClsOccFS fs) >>= dsLookupTyCon
diff --git a/compiler/vectorise/Vectorise/Generic/Description.hs b/compiler/vectorise/Vectorise/Generic/Description.hs
new file mode 100644
index 0000000000..8a60d57f79
--- /dev/null
+++ b/compiler/vectorise/Vectorise/Generic/Description.hs
@@ -0,0 +1,279 @@
+
+-- | Compute a description of the generic representation that we use for 
+--   a user defined data type.
+--
+--   During vectorisation, we generate a PRepr and PA instance for each user defined
+--   data type. The PA dictionary contains methods to convert the user type to and
+--   from our generic representation. This module computes a description of what
+--   that generic representation is.
+--
+module Vectorise.Generic.Description ( 
+  CompRepr (..), ProdRepr (..), ConRepr (..), SumRepr (..),
+  tyConRepr, sumReprType, conReprType, prodReprType, compReprType, compOrigType
+) where
+
+import Vectorise.Utils
+import Vectorise.Monad
+import Vectorise.Builtins
+
+import CoreSyn
+import DataCon
+import TyCon
+import Type
+import Control.Monad
+import Outputable
+
+
+-- | Describes the generic representation of a data type.
+--   If the data type has multiple constructors then we bundle them
+--   together into a generic sum type.
+data SumRepr 
+        =  -- | Data type has no data constructors.
+           EmptySum
+
+        -- | Data type has a single constructor.
+        | UnarySum ConRepr
+
+        -- | Data type has multiple constructors.
+        | Sum  { -- | Representation tycon for the sum (eg Sum2)
+                 repr_sum_tc    :: TyCon
+
+               -- | PData version of the sum tycon     (eg PDataSum2)
+               --   This TyCon doesn't appear explicitly in the source program.
+               --   See Note [PData TyCons].
+               , repr_psum_tc   :: TyCon
+
+               -- | PDatas version of the sum tycon    (eg PDatasSum2)
+               , repr_psums_tc  :: TyCon
+
+               -- | Type of the selector (eg Sel2)
+               , repr_sel_ty    :: Type
+
+               -- | Type of each data constructor.
+               , repr_con_tys   :: [Type]
+
+               -- | Generic representation types of each data constructor.
+               , repr_cons      :: [ConRepr]
+               }
+
+
+-- | Describes the representation type of a data constructor.
+data ConRepr  
+        = ConRepr 
+                { repr_dc       :: DataCon
+                , repr_prod     :: ProdRepr 
+                }
+
+-- | Describes the representation type of the fields \/ components of a constructor.
+--   If the data constructor has multiple fields then we bundle them 
+--   together into a generic product type.
+data ProdRepr 
+        = -- | Data constructor has no fields.
+          EmptyProd
+
+        -- | Data constructor has a single field.
+        | UnaryProd CompRepr
+
+        -- | Data constructor has several fields.
+        | Prod { -- | Representation tycon for the product (eg Tuple2)
+                 repr_tup_tc   :: TyCon
+
+                 -- | PData  version of the product tycon  (eg PDataTuple2)
+               , repr_ptup_tc  :: TyCon
+
+                 -- | PDatas version of the product tycon  (eg PDatasTuple2s)
+                 --   Not all lifted backends use `PDatas`.
+               , repr_ptups_tc :: TyCon
+
+                 -- | Types of each field.
+               , repr_comp_tys :: [Type]
+
+                 -- | Generic representation types for each field.
+               , repr_comps    :: [CompRepr]
+               }
+
+
+-- | Describes the representation type of a data constructor field.
+data CompRepr
+        = Keep Type
+               CoreExpr     -- PR dictionary for the type
+        | Wrap Type
+
+
+-------------------------------------------------------------------------------
+
+-- | Determine the generic representation of a data type, given its tycon.
+--   The `TyCon` contains a description of the whole data type.
+tyConRepr :: TyCon -> VM SumRepr
+tyConRepr tc 
+  = sum_repr (tyConDataCons tc)
+  where
+    -- Build the representation type for a data type with the given constructors.
+    -- The representation types for each individual constructor are bundled
+    -- together into a generic sum type.
+    sum_repr :: [DataCon] -> VM SumRepr
+    sum_repr []    = return EmptySum
+    sum_repr [con] = liftM UnarySum (con_repr con)
+    sum_repr cons  
+     = do  let arity    = length cons
+           rs           <- mapM con_repr cons
+           tys          <- mapM conReprType rs
+
+           -- Get the 'Sum' tycon of this arity (eg Sum2).
+           sum_tc       <- builtin (sumTyCon arity)
+           
+           -- Get the 'PData' and 'PDatas' tycons for the sum.
+           let sumapp   = mkTyConApp sum_tc tys
+           psum_tc      <- liftM fst $ pdataReprTyCon  sumapp
+           psums_tc     <- liftM fst $ pdatasReprTyCon sumapp
+           
+           sel_ty       <- builtin (selTy arity)
+           return $ Sum 
+                  { repr_sum_tc   = sum_tc
+                  , repr_psum_tc  = psum_tc
+                  , repr_psums_tc = psums_tc
+                  , repr_sel_ty   = sel_ty
+                  , repr_con_tys  = tys
+                  , repr_cons     = rs
+                  }
+
+    -- Build the representation type for a single data constructor.
+    con_repr con   = liftM (ConRepr con) (prod_repr (dataConRepArgTys con))
+
+    -- Build the representation type for the fields of a data constructor.
+    -- The representation types for each individual field are bundled
+    -- together into a generic product type.
+    prod_repr :: [Type] -> VM ProdRepr
+    prod_repr []   = return EmptyProd
+    prod_repr [ty] = liftM UnaryProd (comp_repr ty)
+    prod_repr tys  
+     = do  let arity    = length tys
+           rs           <- mapM comp_repr tys
+           tys'         <- mapM compReprType rs
+
+           -- Get the Prod \/ Tuple tycon of this arity (eg Tuple2)
+           tup_tc       <- builtin (prodTyCon arity)
+
+           -- Get the 'PData' and 'PDatas' tycons for the product.
+           let prodapp  = mkTyConApp tup_tc tys'
+           ptup_tc      <- liftM fst $ pdataReprTyCon  prodapp
+           ptups_tc     <- liftM fst $ pdatasReprTyCon prodapp
+           
+           return $ Prod 
+                  { repr_tup_tc   = tup_tc
+                  , repr_ptup_tc  = ptup_tc
+                  , repr_ptups_tc = ptups_tc
+                  , repr_comp_tys = tys'
+                  , repr_comps    = rs
+                  }
+    
+    -- Build the representation type for a single data constructor field.
+    comp_repr ty = liftM (Keep ty) (prDictOfReprType ty)
+                   `orElseV` return (Wrap ty)
+
+
+-- | Yield the type of this sum representation.
+sumReprType :: SumRepr -> VM Type
+sumReprType EmptySum     = voidType
+sumReprType (UnarySum r) = conReprType r
+sumReprType (Sum { repr_sum_tc  = sum_tc, repr_con_tys = tys })
+  = return $ mkTyConApp sum_tc tys
+
+
+-- | Yield the type of this constructor representation.
+conReprType :: ConRepr -> VM Type
+conReprType (ConRepr _ r) = prodReprType r
+
+
+-- | Yield the type of of this product representation.
+prodReprType :: ProdRepr -> VM Type
+prodReprType EmptyProd     = voidType
+prodReprType (UnaryProd r) = compReprType r
+prodReprType (Prod { repr_tup_tc = tup_tc, repr_comp_tys = tys })
+  = return $ mkTyConApp tup_tc tys
+
+
+-- | Yield the type of this data constructor field \/ component representation.
+compReprType :: CompRepr -> VM Type
+compReprType (Keep ty _) = return ty
+compReprType (Wrap ty)
+  = do  wrap_tc <- builtin wrapTyCon
+        return $ mkTyConApp wrap_tc [ty]
+       
+
+-- Yield the original component type of a data constructor component representation.
+compOrigType :: CompRepr -> Type
+compOrigType (Keep ty _) = ty
+compOrigType (Wrap ty)   = ty
+
+
+-- Outputable instances -------------------------------------------------------
+instance Outputable SumRepr where
+ ppr ss
+  = case ss of
+        EmptySum
+         -> text "EmptySum"
+
+        UnarySum con
+         -> sep [text "UnarySum", ppr con]
+
+        Sum sumtc psumtc psumstc selty contys cons
+         -> text "Sum" $+$ braces (nest 4 
+                $ sep   [ text "repr_sum_tc   = " <> ppr sumtc
+                        , text "repr_psum_tc  = " <> ppr psumtc
+                        , text "repr_psums_tc = " <> ppr psumstc
+                        , text "repr_sel_ty   = " <> ppr selty
+                        , text "repr_con_tys  = " <> ppr contys
+                        , text "repr_cons     = " <> ppr cons])
+
+
+instance Outputable ConRepr where
+ ppr (ConRepr dc pr)
+        = text "ConRepr" $+$ braces (nest 4
+                $ sep   [ text "repr_dc      = " <> ppr dc
+                        , text "repr_prod    = " <> ppr pr])
+
+
+instance Outputable ProdRepr where
+ ppr ss
+  = case ss of
+        EmptyProd
+         -> text "EmptyProd"
+         
+        UnaryProd cr
+         -> sep [text "UnaryProd", ppr cr]
+         
+        Prod tuptcs ptuptcs ptupstcs comptys comps
+         -> sep [text "Prod", ppr tuptcs, ppr ptuptcs, ppr ptupstcs, ppr comptys, ppr comps]
+
+
+instance Outputable CompRepr where
+ ppr ss
+  = case ss of
+        Keep t ce
+         -> text "Keep" $+$ sep [ppr t, ppr ce]
+        
+        Wrap t
+         -> sep [text "Wrap", ppr t]
+
+
+-- Notes ----------------------------------------------------------------------
+{-
+Note [PData TyCons]
+~~~~~~~~~~~~~~~~~~~
+When PData is a type family, the compiler generates a type constructor for each
+instance, which is named after the family and instance type. This type
+constructor does not appear in the source program. Rather, it is implicitly
+defined by the data instance. For example with:
+
+  data family PData a
+
+  data instance PData (Sum2 a b)
+        = PSum2  U.Sel2
+                 (PData a)
+                 (PData b)
+
+The type constructor corresponding to the instance will be named 'PDataSum2',
+and this is what we will get in the repr_psum_tc field of SumRepr.Sum.
+
+-}
\ No newline at end of file
diff --git a/compiler/vectorise/Vectorise/Type/PADict.hs b/compiler/vectorise/Vectorise/Generic/PADict.hs
index e1aa6eab95..0af5fe0776 100644
--- a/compiler/vectorise/Vectorise/Type/PADict.hs
+++ b/compiler/vectorise/Vectorise/Generic/PADict.hs
@@ -1,12 +1,12 @@
 
-module Vectorise.Type.PADict
+module Vectorise.Generic.PADict
   ( buildPADict
   ) where
 
 import Vectorise.Monad
 import Vectorise.Builtins
-import Vectorise.Type.Repr
-import Vectorise.Type.PRepr ( buildPAScAndMethods )
+import Vectorise.Generic.Description
+import Vectorise.Generic.PAMethods ( buildPAScAndMethods )
 import Vectorise.Utils
 
 import BasicTypes
@@ -20,21 +20,12 @@ import Id
 import Var
 import Name
 
--- debug                = False
--- dtrace s x   = if debug then pprTrace "Vectoris.Type.PADict" s x else x
 
 -- |Build the PA dictionary function for some type and hoist it to top level.
 --
--- The PA dictionary holds fns that convert values to and from their vectorised representations.
+--  The PA dictionary holds fns that convert values to and from their vectorised representations.
 --
-buildPADict
-  :: TyCon  -- ^ tycon of the type being vectorised.
-  -> TyCon  -- ^ tycon of the type used for the vectorised representation.
-  -> TyCon  -- ^ PRepr instance tycon
-  -> SumRepr  -- ^ representation used for the type being vectorised.
-  -> VM Var -- ^ name of the top-level dictionary function.
-
--- Recall the definition:
+-- @Recall the definition:
 --    class class PR (PRepr a) => PA a where
 --      toPRepr      :: a -> PRepr a
 --      fromPRepr    :: PRepr a -> a
@@ -49,8 +40,17 @@ buildPADict
 --    $toRepr :: forall a. PA a -> T a -> PRepr (T a)
 --    $toPRepr = ...
 -- The "..." stuff is filled in by buildPAScAndMethods
+-- @
+--
+buildPADict
+        :: TyCon        -- ^ tycon of the type being vectorised.
+        -> TyCon        -- ^ tycon of the type used for the vectorised representation.
+        -> TyCon        -- ^ PData  instance tycon
+        -> TyCon        -- ^ PDatas instance tycon
+        -> SumRepr      -- ^ representation used for the type being vectorised.
+        -> VM Var       -- ^ name of the top-level dictionary function.
 
-buildPADict vect_tc prepr_tc arr_tc repr
+buildPADict vect_tc prepr_tc pdata_tc pdatas_tc repr
  = polyAbstract tvs $ \args ->    -- The args are the dictionaries we lambda
                                   -- abstract over; and they are put in the
                                   -- envt, so when we need a (PA a) we can 
@@ -59,7 +59,8 @@ buildPADict vect_tc prepr_tc arr_tc repr
       ; let dfun_name = mkLocalisedOccName mod mkPADFunOcc vect_tc_name
       
           -- Get ids for each of the methods in the dictionary, including superclass
-      ; method_ids <- mapM (method args dfun_name) buildPAScAndMethods
+      ; paMethodBuilders <- buildPAScAndMethods
+      ; method_ids       <- mapM (method args dfun_name) paMethodBuilders
 
           -- Expression to build the dictionary.
       ; pa_dc  <- builtin paDataCon
@@ -86,23 +87,21 @@ buildPADict vect_tc prepr_tc arr_tc repr
       ; return dfun
       }
   where
-    tvs       = tyConTyVars vect_tc
-    arg_tys   = mkTyVarTys tvs
-    inst_ty   = mkTyConApp vect_tc arg_tys
-
+    tvs          = tyConTyVars vect_tc
+    arg_tys      = mkTyVarTys tvs
+    inst_ty      = mkTyConApp vect_tc arg_tys
     vect_tc_name = getName vect_tc
 
     method args dfun_name (name, build)
-      = localV
-      $ do
-          expr     <- build vect_tc prepr_tc arr_tc repr
-          let body = mkLams (tvs ++ args) expr
-          raw_var  <- newExportedVar (method_name dfun_name name) (exprType body)
-          let var  = raw_var
+     = localV
+     $ do  expr     <- build vect_tc prepr_tc pdata_tc pdatas_tc repr
+           let body = mkLams (tvs ++ args) expr
+           raw_var  <- newExportedVar (method_name dfun_name name) (exprType body)
+           let var  = raw_var
                       `setIdUnfolding` mkInlineUnfolding (Just (length args)) body
                       `setInlinePragma` alwaysInlinePragma
-          hoistBinding var body
-          return var
+           hoistBinding var body
+           return var
 
     method_call args id        = mkApps (Var id) (map Type arg_tys ++ map Var args)
     method_name dfun_name name = mkVarOcc $ occNameString dfun_name ++ ('$' : name)
diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
new file mode 100644
index 0000000000..6330dddf64
--- /dev/null
+++ b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
@@ -0,0 +1,544 @@
+
+-- | Generate methods for the PA class.
+--
+--   TODO: there is a large amount of redundancy here between the 
+--   a, PData a, and PDatas a forms. See if we can factor some of this out.
+--
+module Vectorise.Generic.PAMethods
+  ( buildPReprTyCon
+  , buildPAScAndMethods 
+  ) where
+
+import Vectorise.Utils
+import Vectorise.Monad
+import Vectorise.Builtins
+import Vectorise.Generic.Description
+import CoreSyn
+import CoreUtils
+import MkCore            ( mkWildCase )
+import TyCon
+import Type
+import BuildTyCl
+import OccName
+import Coercion
+import MkId
+
+import FastString
+import MonadUtils
+import Control.Monad
+
+
+buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPReprTyCon orig_tc vect_tc repr
+ = do name      <- mkLocalisedName mkPReprTyConOcc (tyConName orig_tc)
+      rhs_ty    <- sumReprType repr
+      prepr_tc  <- builtin preprTyCon
+      liftDs    $  buildSynTyCon name
+                             tyvars
+                             (SynonymTyCon rhs_ty)
+                             (typeKind rhs_ty)
+                             NoParentTyCon
+                             (Just $ mk_fam_inst prepr_tc vect_tc)
+  where
+    tyvars = tyConTyVars vect_tc
+
+
+mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
+mk_fam_inst fam_tc arg_tc
+  = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
+
+
+
+-- buildPAScAndMethods --------------------------------------------------------
+
+-- | This says how to build the PR superclass and methods of PA
+--   Recall the definition of the PA class:
+--
+--   @
+--    class class PR (PRepr a) => PA a where
+--      toPRepr       :: a                -> PRepr a
+--      fromPRepr     :: PRepr a          -> a
+--
+--      toArrPRepr    :: PData a          -> PData (PRepr a)
+--      fromArrPRepr  :: PData (PRepr a)  -> PData a
+--
+--      toArrPReprs   :: PDatas a         -> PDatas (PRepr a)
+--      fromArrPReprs :: PDatas (PRepr a) -> PDatas a
+--   @
+--
+type PAInstanceBuilder
+        =  TyCon        -- ^ Vectorised TyCon 
+        -> TyCon        -- ^ Representation TyCon
+        -> TyCon        -- ^ 'PData'  TyCon
+        -> TyCon        -- ^ 'PDatas' TyCon
+        -> SumRepr      -- ^ Description of generic representation.
+        -> VM CoreExpr  -- ^ Instance function.
+
+
+buildPAScAndMethods :: VM [(String, PAInstanceBuilder)]
+buildPAScAndMethods
+ = return [ ("PR",            buildPRDict)
+          , ("toPRepr",       buildToPRepr)
+          , ("fromPRepr",     buildFromPRepr)
+          , ("toArrPRepr",    buildToArrPRepr)
+          , ("fromArrPRepr",  buildFromArrPRepr)
+          , ("toArrPReprs",   buildToArrPReprs)
+          , ("fromArrPReprs", buildFromArrPReprs)]
+
+
+buildPRDict :: PAInstanceBuilder
+buildPRDict vect_tc prepr_tc _ _ _
+  = prDictOfPReprInstTyCon inst_ty prepr_tc arg_tys
+  where
+    arg_tys = mkTyVarTys (tyConTyVars vect_tc)
+    inst_ty = mkTyConApp vect_tc arg_tys
+
+
+-- buildToPRepr ---------------------------------------------------------------
+-- | Build the 'toRepr' method of the PA class.
+buildToPRepr :: PAInstanceBuilder
+buildToPRepr vect_tc repr_tc _ _ repr
+ = do let arg_ty = mkTyConApp vect_tc ty_args
+
+      -- Get the representation type of the argument.
+      res_ty <- mkPReprType arg_ty
+
+      -- Var to bind the argument
+      arg    <- newLocalVar (fsLit "x") arg_ty
+
+      -- Build the expression to convert the argument to the generic representation.
+      result <- to_sum (Var arg) arg_ty res_ty repr
+
+      return $ Lam arg result
+  where
+    ty_args        = mkTyVarTys (tyConTyVars vect_tc)
+
+    wrap_repr_inst = wrapFamInstBody repr_tc ty_args
+
+    -- CoreExp to convert the given argument to the generic representation.
+    -- We start by doing a case branch on the possible data constructors.
+    to_sum :: CoreExpr -> Type -> Type -> SumRepr -> VM CoreExpr
+    to_sum _ _ _ EmptySum
+     = do void <- builtin voidVar
+          return $ wrap_repr_inst $ Var void
+
+    to_sum arg arg_ty res_ty (UnarySum r)
+     = do (pat, vars, body) <- con_alt r
+          return $ mkWildCase arg arg_ty res_ty
+                   [(pat, vars, wrap_repr_inst body)]
+
+    to_sum arg arg_ty res_ty (Sum { repr_sum_tc  = sum_tc
+                                  , repr_con_tys = tys
+                                  , repr_cons    =  cons })
+     = do alts <- mapM con_alt cons
+          let alts' = [(pat, vars, wrap_repr_inst
+                                   $ mkConApp sum_con (map Type tys ++ [body]))
+                        | ((pat, vars, body), sum_con)
+                            <- zip alts (tyConDataCons sum_tc)]
+          return $ mkWildCase arg arg_ty res_ty alts'
+
+    con_alt (ConRepr con r)
+     = do (vars, body) <- to_prod r
+          return (DataAlt con, vars, body)
+
+    -- CoreExp to convert data constructor fields to the generic representation.
+    to_prod :: ProdRepr -> VM ([Var], CoreExpr)
+    to_prod EmptyProd
+     = do void <- builtin voidVar
+          return ([], Var void)
+
+    to_prod (UnaryProd comp)
+     = do var  <- newLocalVar (fsLit "x") (compOrigType comp)
+          body <- to_comp (Var var) comp
+          return ([var], body)
+
+    to_prod (Prod { repr_tup_tc   = tup_tc
+                  , repr_comp_tys = tys
+                  , repr_comps    = comps })
+     = do vars  <- newLocalVars (fsLit "x") (map compOrigType comps)
+          exprs <- zipWithM to_comp (map Var vars) comps
+          let [tup_con] = tyConDataCons tup_tc
+          return (vars, mkConApp tup_con (map Type tys ++ exprs))
+
+    -- CoreExp to convert a data constructor component to the generic representation.
+    to_comp :: CoreExpr -> CompRepr -> VM CoreExpr
+    to_comp expr (Keep _ _) = return expr
+    to_comp expr (Wrap ty)  
+     = do wrap_tc <- builtin wrapTyCon
+          return $ wrapNewTypeBody wrap_tc [ty] expr
+
+
+-- buildFromPRepr -------------------------------------------------------------
+-- | Build the 'fromPRepr' method of the PA class.
+buildFromPRepr :: PAInstanceBuilder
+buildFromPRepr vect_tc repr_tc _ _ repr
+  = do
+      arg_ty <- mkPReprType res_ty
+      arg <- newLocalVar (fsLit "x") arg_ty
+
+      result <- from_sum (unwrapFamInstScrut repr_tc ty_args (Var arg))
+                         repr
+      return $ Lam arg result
+  where
+    ty_args = mkTyVarTys (tyConTyVars vect_tc)
+    res_ty  = mkTyConApp vect_tc ty_args
+
+    from_sum _ EmptySum
+     = do dummy <- builtin fromVoidVar
+          return $ Var dummy `App` Type res_ty
+
+    from_sum expr (UnarySum r) = from_con expr r
+    from_sum expr (Sum { repr_sum_tc  = sum_tc
+                       , repr_con_tys = tys
+                       , repr_cons    = cons })
+     = do vars  <- newLocalVars (fsLit "x") tys
+          es    <- zipWithM from_con (map Var vars) cons
+          return $ mkWildCase expr (exprType expr) res_ty
+                   [(DataAlt con, [var], e)
+                      | (con, var, e) <- zip3 (tyConDataCons sum_tc) vars es]
+
+    from_con expr (ConRepr con r)
+      = from_prod expr (mkConApp con $ map Type ty_args) r
+
+    from_prod _ con EmptyProd = return con
+    from_prod expr con (UnaryProd r)
+     = do e <- from_comp expr r
+          return $ con `App` e
+     
+    from_prod expr con (Prod { repr_tup_tc   = tup_tc
+                             , repr_comp_tys = tys
+                             , repr_comps    = comps
+                             })
+     = do vars <- newLocalVars (fsLit "y") tys
+          es   <- zipWithM from_comp (map Var vars) comps
+          let [tup_con] = tyConDataCons tup_tc
+          return $ mkWildCase expr (exprType expr) res_ty
+                   [(DataAlt tup_con, vars, con `mkApps` es)]
+
+    from_comp expr (Keep _ _) = return expr
+    from_comp expr (Wrap ty)
+      = do
+          wrap <- builtin wrapTyCon
+          return $ unwrapNewTypeBody wrap [ty] expr
+
+
+-- buildToArrRepr -------------------------------------------------------------
+-- | Build the 'toArrRepr' method of the PA class.
+buildToArrPRepr :: PAInstanceBuilder
+buildToArrPRepr vect_tc prepr_tc pdata_tc _ r
+ = do arg_ty <- mkPDataType el_ty
+      res_ty <- mkPDataType =<< mkPReprType el_ty
+      arg    <- newLocalVar (fsLit "xs") arg_ty
+
+      pdata_co <- mkBuiltinCo pdataTyCon
+      let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
+          co           = mkAppCo pdata_co
+                       . mkSymCo
+                       $ mkAxInstCo repr_co ty_args
+
+          scrut   = unwrapFamInstScrut pdata_tc ty_args (Var arg)
+
+      (vars, result) <- to_sum r
+
+      return . Lam arg
+             $ mkWildCase scrut (mkTyConApp pdata_tc ty_args) res_ty
+               [(DataAlt pdata_dc, vars, mkCoerce co result)]
+  where
+    ty_args    = mkTyVarTys $ tyConTyVars vect_tc
+    el_ty      = mkTyConApp vect_tc ty_args
+    [pdata_dc] = tyConDataCons pdata_tc
+
+    to_sum ss
+     = case ss of
+        EmptySum    -> builtin pvoidVar >>= \pvoid -> return ([], Var pvoid) 
+        UnarySum r  -> to_con r
+        Sum{}
+         -> do  let psum_tc     =  repr_psum_tc ss
+                let [psum_con]  =  tyConDataCons psum_tc
+                (vars, exprs)   <- mapAndUnzipM to_con (repr_cons ss)
+                sel             <- newLocalVar (fsLit "sel") (repr_sel_ty ss)
+                return ( sel : concat vars
+                       , wrapFamInstBody psum_tc (repr_con_tys ss)
+                         $ mkConApp psum_con 
+                         $ map Type (repr_con_tys ss) ++ (Var sel : exprs))
+
+    to_prod ss
+     = case ss of
+        EmptyProd    -> builtin pvoidVar >>= \pvoid -> return ([], Var pvoid)
+        UnaryProd r
+         -> do  pty  <- mkPDataType (compOrigType r)
+                var  <- newLocalVar (fsLit "x") pty
+                expr <- to_comp (Var var) r
+                return ([var], expr)
+        Prod{}
+         -> do  let [ptup_con]  = tyConDataCons (repr_ptup_tc ss)
+                ptys   <- mapM (mkPDataType . compOrigType) (repr_comps ss)
+                vars   <- newLocalVars (fsLit "x") ptys
+                exprs  <- zipWithM to_comp (map Var vars) (repr_comps ss)
+                return ( vars
+                       , wrapFamInstBody (repr_ptup_tc ss) (repr_comp_tys ss)
+                         $ mkConApp ptup_con
+                         $ map Type (repr_comp_tys ss) ++ exprs)
+
+    to_con (ConRepr _ r)    = to_prod r
+
+    -- FIXME: this is bound to be wrong!
+    to_comp expr (Keep _ _) = return expr
+    to_comp expr (Wrap ty)
+      = do
+          wrap_tc  <- builtin wrapTyCon
+          (pwrap_tc, _) <- pdataReprTyCon (mkTyConApp wrap_tc [ty])
+          return $ wrapNewTypeBody pwrap_tc [ty] expr
+
+
+-- buildFromArrPRepr ----------------------------------------------------------
+-- | Build the 'fromArrPRepr' method for the PA class.
+buildFromArrPRepr :: PAInstanceBuilder
+buildFromArrPRepr vect_tc prepr_tc pdata_tc _ r
+ = do arg_ty <- mkPDataType =<< mkPReprType el_ty
+      res_ty <- mkPDataType el_ty
+      arg    <- newLocalVar (fsLit "xs") arg_ty
+
+      pdata_co <- mkBuiltinCo pdataTyCon
+      let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
+      let co           = mkAppCo pdata_co
+                       $ mkAxInstCo repr_co var_tys
+
+      let scrut        = mkCoerce co (Var arg)
+
+      let mk_result args
+            = wrapFamInstBody pdata_tc var_tys
+            $ mkConApp pdata_con
+            $ map Type var_tys ++ args
+
+      (expr, _) <- fixV $ \ ~(_, args) ->
+                     from_sum res_ty (mk_result args) scrut r
+
+      return $ Lam arg expr
+ where
+    var_tys     = mkTyVarTys $ tyConTyVars vect_tc
+    el_ty       = mkTyConApp vect_tc var_tys
+    [pdata_con] = tyConDataCons pdata_tc
+
+    from_sum res_ty res expr ss
+     = case ss of
+        EmptySum    -> return (res, [])
+        UnarySum r  -> from_con res_ty res expr r
+        Sum {}
+         -> do  let psum_tc    =  repr_psum_tc ss
+                let [psum_con] =  tyConDataCons psum_tc
+                sel            <- newLocalVar (fsLit "sel") (repr_sel_ty ss)
+                ptys           <- mapM mkPDataType (repr_con_tys ss)
+                vars           <- newLocalVars (fsLit "xs") ptys
+                (res', args)   <- fold from_con res_ty res (map Var vars) (repr_cons ss)
+                let scrut      =  unwrapFamInstScrut psum_tc (repr_con_tys ss) expr
+                let body       =  mkWildCase scrut (exprType scrut) res_ty
+                                    [(DataAlt psum_con, sel : vars, res')]
+                return (body, Var sel : args)
+
+    from_prod res_ty res expr ss
+     = case ss of
+        EmptyProd   -> return (res, [])
+        UnaryProd r -> from_comp res_ty res expr r
+        Prod {}
+         -> do  let ptup_tc    =  repr_ptup_tc ss
+                let [ptup_con] =  tyConDataCons ptup_tc
+                ptys           <- mapM mkPDataType (repr_comp_tys ss)
+                vars           <- newLocalVars (fsLit "ys") ptys
+                (res', args)   <- fold from_comp res_ty res (map Var vars) (repr_comps ss)
+                let scrut      =  unwrapFamInstScrut ptup_tc (repr_comp_tys ss) expr
+                let body       =  mkWildCase scrut (exprType scrut) res_ty
+                                    [(DataAlt ptup_con, vars, res')]
+                return (body, args)      
+
+    from_con res_ty res expr (ConRepr _ r) = from_prod res_ty res expr r
+
+    from_comp _ res expr (Keep _ _) = return (res, [expr])
+    from_comp _ res expr (Wrap ty)
+     = do wrap_tc       <- builtin wrapTyCon
+          (pwrap_tc, _) <- pdataReprTyCon (mkTyConApp wrap_tc [ty])
+          return (res, [unwrapNewTypeBody pwrap_tc [ty]
+                        $ unwrapFamInstScrut pwrap_tc [ty] expr])
+
+    fold f res_ty res exprs rs
+      = foldrM f' (res, []) (zip exprs rs)
+      where
+        f' (expr, r) (res, args) 
+         = do (res', args') <- f res_ty res expr r
+              return (res', args' ++ args)
+
+
+-- buildToArrPReprs -----------------------------------------------------------
+-- | Build the 'toArrPReprs' instance for the PA class.
+--   This converts a PData of elements into the generic representation.
+buildToArrPReprs :: PAInstanceBuilder
+buildToArrPReprs vect_tc prepr_tc _ pdatas_tc r
+ = do
+    -- The argument type of the instance.
+    --  eg: 'PDatas (Tree a b)'
+    arg_ty    <- mkPDatasType el_ty
+
+    -- The result type. 
+    --  eg: 'PDatas (PRepr (Tree a b))'
+    res_ty    <- mkPDatasType =<< mkPReprType el_ty
+
+    -- Variable to bind the argument to the instance
+    -- eg: (xss :: PDatas (Tree a b))
+    varg      <- newLocalVar (fsLit "xss") arg_ty
+
+    -- Coersion to case between the (PRepr a) type and its instance.
+    pdatas_co <- mkBuiltinCo pdatasTyCon
+    let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
+    let co           = mkAppCo pdatas_co
+                     . mkSymCo
+                     $ mkAxInstCo repr_co ty_args
+
+    let scrut        = unwrapFamInstScrut pdatas_tc ty_args (Var varg)
+    (vars, result)  <- to_sum r
+
+    return  $ Lam varg
+            $ mkWildCase scrut (mkTyConApp pdatas_tc ty_args) res_ty
+                    [(DataAlt pdatas_dc, vars, mkCoerce co result)]        
+
+ where
+    -- The element type of the argument.
+    --  eg: 'Tree a b'.
+    ty_args = mkTyVarTys $ tyConTyVars vect_tc
+    el_ty   = mkTyConApp vect_tc ty_args
+        
+    -- PDatas data constructor
+    [pdatas_dc] = tyConDataCons pdatas_tc
+         
+    to_sum ss
+     = case ss of       -- BROKEN: should be
+        EmptySum    -> builtin pvoidVar >>= \pvoid -> return ([], Var pvoid) 
+        UnarySum r  -> to_con r
+        Sum{}
+          -> do let psums_tc     = repr_psums_tc ss
+                let [psums_con]  = tyConDataCons psums_tc
+                (vars, exprs)   <- mapAndUnzipM to_con (repr_cons ss)
+                sel             <- newLocalVar (fsLit "sel") (repr_sel_ty ss) -- BROKEN: should be vector
+                return ( sel : concat vars
+                       , wrapFamInstBody psums_tc (repr_con_tys ss)
+                         $ mkConApp psums_con 
+                         $ map Type (repr_con_tys ss) ++ (Var sel : exprs))        
+
+    to_prod ss
+     = case ss of       -- BROKEN: should be pvoids
+        EmptyProd    -> builtin pvoidVar >>= \pvoid -> return ([], Var pvoid)
+        UnaryProd r
+         -> do  pty  <- mkPDatasType (compOrigType r)
+                var  <- newLocalVar (fsLit "x") pty
+                expr <- to_comp (Var var) r
+                return ([var], expr)
+        Prod{}
+         -> do  let [ptups_con]  = tyConDataCons (repr_ptups_tc ss)
+                ptys   <- mapM (mkPDatasType . compOrigType) (repr_comps ss)
+                vars   <- newLocalVars (fsLit "x") ptys
+                exprs  <- zipWithM to_comp (map Var vars) (repr_comps ss)
+                return ( vars
+                       , wrapFamInstBody (repr_ptups_tc ss) (repr_comp_tys ss)
+                         $ mkConApp ptups_con
+                         $ map Type (repr_comp_tys ss) ++ exprs)
+
+    to_con (ConRepr _ r)    = to_prod r
+
+    -- FIXME: this is bound to be wrong!
+    to_comp expr (Keep _ _) = return expr
+    to_comp expr (Wrap ty)
+     = do wrap_tc       <- builtin wrapTyCon
+          (pwrap_tc, _) <- pdatasReprTyCon (mkTyConApp wrap_tc [ty])
+          return $ wrapNewTypeBody pwrap_tc [ty] expr
+
+
+-- buildFromArrPReprs ---------------------------------------------------------
+buildFromArrPReprs :: PAInstanceBuilder
+buildFromArrPReprs vect_tc prepr_tc _ pdatas_tc r
+ = do   
+    -- The element type of the argument.
+    --  eg: 'Tree a b'.
+    let ty_args = mkTyVarTys $ tyConTyVars vect_tc
+    let el_ty   = mkTyConApp vect_tc ty_args
+
+    -- The argument type of the instance.
+    --  eg: 'PDatas (PRepr (Tree a b))'
+    arg_ty      <- mkPDatasType =<< mkPReprType el_ty
+
+    -- The result type. 
+    --  eg: 'PDatas (Tree a b)'
+    res_ty      <- mkPDatasType el_ty
+        
+    -- Variable to bind the argument to the instance
+    -- eg: (xss :: PDatas (PRepr (Tree a b)))
+    varg        <- newLocalVar (fsLit "xss") arg_ty
+        
+    -- Build the coersion between PRepr and the instance type
+    pdatas_co <- mkBuiltinCo pdatasTyCon
+    let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
+    let co           = mkAppCo pdatas_co
+                     $ mkAxInstCo repr_co var_tys
+
+    let scrut        = mkCoerce co (Var varg)
+
+    let mk_result args
+            = wrapFamInstBody pdatas_tc var_tys
+            $ mkConApp pdatas_con
+            $ map Type var_tys ++ args
+
+    (expr, _) <- fixV $ \ ~(_, args) ->
+                     from_sum res_ty (mk_result args) scrut r
+
+    return $ Lam varg expr
+ where
+    var_tys      = mkTyVarTys $ tyConTyVars vect_tc
+    el_ty        = mkTyConApp vect_tc var_tys
+    [pdatas_con] = tyConDataCons pdatas_tc
+
+    from_sum res_ty res expr ss
+     = case ss of
+        EmptySum    -> return (res, [])
+        UnarySum r  -> from_con res_ty res expr r
+        Sum {}
+         -> do  let psums_tc    =  repr_psums_tc ss
+                let [psums_con] =  tyConDataCons psums_tc
+                sel             <- newLocalVar (fsLit "sel") (repr_sel_ty ss)
+                ptys            <- mapM mkPDatasType (repr_con_tys ss)
+                vars            <- newLocalVars (fsLit "xs") ptys
+                (res', args)    <- fold from_con res_ty res (map Var vars) (repr_cons ss)
+                let scrut       =  unwrapFamInstScrut psums_tc (repr_con_tys ss) expr
+                let body        =  mkWildCase scrut (exprType scrut) res_ty
+                                    [(DataAlt psums_con, sel : vars, res')]
+                return (body, Var sel : args)
+
+    from_prod res_ty res expr ss
+     = case ss of
+        EmptyProd   -> return (res, [])
+        UnaryProd r -> from_comp res_ty res expr r
+        Prod {}
+         -> do  let ptups_tc    =  repr_ptups_tc ss
+                let [ptups_con] =  tyConDataCons ptups_tc
+                ptys            <- mapM mkPDatasType (repr_comp_tys ss)
+                vars            <- newLocalVars (fsLit "ys") ptys
+                (res', args)    <- fold from_comp res_ty res (map Var vars) (repr_comps ss)
+                let scrut       =  unwrapFamInstScrut ptups_tc (repr_comp_tys ss) expr
+                let body        =  mkWildCase scrut (exprType scrut) res_ty
+                                    [(DataAlt ptups_con, vars, res')]
+                return (body, args)      
+
+    from_con res_ty res expr (ConRepr _ r)
+        = from_prod res_ty res expr r
+
+    from_comp _ res expr (Keep _ _) = return (res, [expr])
+    from_comp _ res expr (Wrap ty)
+     = do wrap_tc        <- builtin wrapTyCon
+          (pwraps_tc, _) <- pdatasReprTyCon (mkTyConApp wrap_tc [ty])
+          return (res, [unwrapNewTypeBody pwraps_tc [ty]
+                        $ unwrapFamInstScrut pwraps_tc [ty] expr])
+
+    fold f res_ty res exprs rs
+      = foldrM f' (res, []) (zip exprs rs)
+      where
+        f' (expr, r) (res, args) 
+         = do (res', args') <- f res_ty res expr r
+              return (res', args' ++ args)
+
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
new file mode 100644
index 0000000000..f10afff972
--- /dev/null
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -0,0 +1,151 @@
+
+-- | Build instance tycons for the PData and PDatas type families.
+--
+--   TODO: the PData and PDatas cases are very similar.
+--   We should be able to factor out the common parts.
+module Vectorise.Generic.PData
+  ( buildPDataTyCon
+  , buildPDatasTyCon ) 
+where
+
+import Vectorise.Monad
+import Vectorise.Builtins
+import Vectorise.Generic.Description
+import Vectorise.Utils
+
+import BasicTypes
+import BuildTyCl
+import DataCon
+import TyCon
+import Type
+import Name
+import Util
+import MonadUtils
+import Control.Monad
+
+
+-- buildPDataTyCon ------------------------------------------------------------
+-- | Build the PData instance tycon for a given type constructor.
+buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPDataTyCon orig_tc vect_tc repr 
+ = fixV $ \repr_tc ->
+ do name' <- mkLocalisedName mkPDataTyConOcc orig_name
+    rhs   <- buildPDataTyConRhs orig_name vect_tc repr_tc repr
+    pdata <- builtin pdataTyCon
+
+    liftDs $ buildAlgTyCon name'
+                           tyvars
+                           []          -- no stupid theta
+                           rhs
+                           rec_flag    -- FIXME: is this ok?
+                           False       -- not GADT syntax
+                           NoParentTyCon
+                           (Just $ mk_fam_inst pdata vect_tc)
+ where
+    orig_name = tyConName orig_tc
+    tyvars    = tyConTyVars vect_tc
+    rec_flag  = boolToRecFlag (isRecursiveTyCon vect_tc)
+
+
+buildPDataTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
+buildPDataTyConRhs orig_name vect_tc repr_tc repr
+ = do data_con <- buildPDataDataCon orig_name vect_tc repr_tc repr
+      return $ DataTyCon { data_cons = [data_con], is_enum = False }
+
+
+buildPDataDataCon :: Name -> TyCon -> TyCon -> SumRepr -> VM DataCon
+buildPDataDataCon orig_name vect_tc repr_tc repr
+ = do let tvs   = tyConTyVars vect_tc
+      dc_name   <- mkLocalisedName mkPDataDataConOcc orig_name
+      comp_tys  <- mkSumTys mkPDataType repr
+
+      liftDs $ buildDataCon dc_name
+                            False                  -- not infix
+                            (map (const HsNoBang) comp_tys)
+                            []                     -- no field labels
+                            tvs
+                            []                     -- no existentials
+                            []                     -- no eq spec
+                            []                     -- no context
+                            comp_tys
+                            (mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
+                            repr_tc
+
+
+-- buildPDatasTyCon -----------------------------------------------------------
+-- | Build the PDatas instance tycon for a given type constructor.
+buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPDatasTyCon orig_tc vect_tc repr 
+ = fixV $ \repr_tc ->
+ do name'       <- mkLocalisedName mkPDatasTyConOcc orig_name
+    rhs         <- buildPDatasTyConRhs orig_name vect_tc repr_tc repr
+    pdatas      <- builtin pdatasTyCon
+
+    liftDs $ buildAlgTyCon name'
+                           tyvars
+                           []          -- no stupid theta
+                           rhs
+                           rec_flag    -- FIXME: is this ok?
+                           False       -- not GADT syntax
+                           NoParentTyCon
+                           (Just $ mk_fam_inst pdatas vect_tc)
+ where
+    orig_name = tyConName   orig_tc
+    tyvars    = tyConTyVars vect_tc
+    rec_flag  = boolToRecFlag (isRecursiveTyCon vect_tc)
+
+
+buildPDatasTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
+buildPDatasTyConRhs orig_name vect_tc repr_tc repr
+ = do data_con <- buildPDatasDataCon orig_name vect_tc repr_tc repr
+      return $ DataTyCon { data_cons = [data_con], is_enum = False }
+
+
+buildPDatasDataCon :: Name -> TyCon -> TyCon -> SumRepr -> VM DataCon
+buildPDatasDataCon orig_name vect_tc repr_tc repr
+ = do let tvs   = tyConTyVars vect_tc
+      dc_name        <- mkLocalisedName mkPDatasDataConOcc orig_name
+
+      comp_tys  <- mkSumTys mkPDatasType repr
+
+      liftDs $ buildDataCon dc_name
+                            False                  -- not infix
+                            (map (const HsNoBang) comp_tys)
+                            []                     -- no field labels
+                            tvs
+                            []                     -- no existentials
+                            []                     -- no eq spec
+                            []                     -- no context
+                            comp_tys
+                            (mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
+                            repr_tc
+
+
+-- Utils ----------------------------------------------------------------------
+-- | Flatten a SumRepr into a list of data constructor types.
+mkSumTys 
+        :: (Type -> VM Type)
+        -> SumRepr
+        -> VM [Type]
+
+mkSumTys mkTc repr
+ = sum_tys repr
+ where
+    sum_tys EmptySum      = return []
+    sum_tys (UnarySum r)  = con_tys r
+    sum_tys (Sum { repr_sel_ty = sel_ty
+                 , repr_cons   = cons })
+      = liftM (sel_ty :) (concatMapM con_tys cons)
+
+    con_tys (ConRepr _ r)  = prod_tys r
+
+    prod_tys EmptyProd     = return []
+    prod_tys (UnaryProd r) = liftM singleton (comp_ty r)
+    prod_tys (Prod { repr_comps = comps }) = mapM comp_ty comps
+
+    comp_ty r = mkTc (compOrigType r)
+
+
+mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
+mk_fam_inst fam_tc arg_tc
+  = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 042d127258..674536a1d5 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -15,10 +15,10 @@ import Vectorise.Monad
 import Vectorise.Builtins
 import Vectorise.Type.TyConDecl
 import Vectorise.Type.Classify
-import Vectorise.Type.PADict
-import Vectorise.Type.PData
-import Vectorise.Type.PRepr
-import Vectorise.Type.Repr
+import Vectorise.Generic.PADict
+import Vectorise.Generic.PAMethods
+import Vectorise.Generic.PData
+import Vectorise.Generic.Description
 import Vectorise.Utils
 
 import CoreSyn
@@ -39,7 +39,7 @@ import FastString
 import MonadUtils
 import Control.Monad
 import Data.List
-
+import Data.Maybe
 
 -- Note [Pragmas to vectorise tycons]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -212,10 +212,12 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
 
            -- Build 'PRepr' and 'PData' instance type constructors and family instances for all
            -- type constructors with vectorised representations.
-       ; reprs     <- mapM tyConRepr vect_tcs
-       ; repr_tcs  <- zipWith3M buildPReprTyCon orig_tcs vect_tcs reprs
-       ; pdata_tcs <- zipWith3M buildPDataTyCon orig_tcs vect_tcs reprs
-       ; let inst_tcs  = repr_tcs ++ pdata_tcs
+       ; reprs      <- mapM tyConRepr vect_tcs
+       ; repr_tcs   <- zipWith3M buildPReprTyCon  orig_tcs vect_tcs reprs
+       ; pdata_tcs  <- zipWith3M buildPDataTyCon  orig_tcs vect_tcs reprs
+       ; pdatas_tcs <- zipWith3M buildPDatasTyCon orig_tcs vect_tcs reprs
+
+       ; let inst_tcs  = repr_tcs ++ pdata_tcs ++ pdatas_tcs
              fam_insts = map mkLocalFamInst inst_tcs
        ; updGEnv $ extendFamEnv fam_insts
 
@@ -225,11 +227,12 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
        ; (_, binds) <- fixV $ \ ~(dfuns, _) ->
            do { defTyConPAs (zipLazy vect_tcs dfuns)
               ; dfuns <- sequence 
-                      $  zipWith4 buildTyConBindings
+                      $  zipWith5 buildTyConBindings
                                   orig_tcs
                                   vect_tcs
                                   repr_tcs
                                   pdata_tcs
+                                  pdatas_tcs
 
               ; binds <- takeHoisted
               ; return (dfuns, binds)
@@ -241,14 +244,13 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
        }
 
 
--- Helpers -------------------
-
-buildTyConBindings :: TyCon -> TyCon -> TyCon -> TyCon -> VM Var
-buildTyConBindings orig_tc vect_tc prepr_tc pdata_tc
- = do { vectDataConWorkers orig_tc vect_tc pdata_tc
-      ; repr <- tyConRepr vect_tc
-      ; buildPADict vect_tc prepr_tc pdata_tc repr
-      }
+-- Helpers --------------------------------------------------------------------
+buildTyConBindings :: TyCon -> TyCon -> TyCon -> TyCon -> TyCon -> VM Var
+buildTyConBindings orig_tc vect_tc prepr_tc pdata_tc pdatas_tc
+ = do   vectDataConWorkers orig_tc vect_tc pdata_tc
+        repr <- tyConRepr vect_tc
+        buildPADict vect_tc prepr_tc pdata_tc pdatas_tc repr
+      
 
 vectDataConWorkers :: TyCon -> TyCon -> TyCon -> VM ()
 vectDataConWorkers orig_tc vect_tc arr_tc
diff --git a/compiler/vectorise/Vectorise/Type/PData.hs b/compiler/vectorise/Vectorise/Type/PData.hs
deleted file mode 100644
index f8e5a93000..0000000000
--- a/compiler/vectorise/Vectorise/Type/PData.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-
-module Vectorise.Type.PData
-  ( buildPDataTyCon
-  ) 
-where
-
-import Vectorise.Monad
-import Vectorise.Builtins
-import Vectorise.Type.Repr
-import Vectorise.Utils
-
-import BasicTypes
-import BuildTyCl
-import DataCon
-import TyCon
-import Type
-import Name
-import Util
-import MonadUtils
-import Control.Monad
-
-
-buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
-buildPDataTyCon orig_tc vect_tc repr = fixV $ \repr_tc ->
-  do
-    name' <- mkLocalisedName mkPDataTyConOcc orig_name
-    rhs   <- buildPDataTyConRhs orig_name vect_tc repr_tc repr
-    pdata <- builtin pdataTyCon
-
-    liftDs $ buildAlgTyCon name'
-                           tyvars
-                           []          -- no stupid theta
-                           rhs
-                           rec_flag    -- FIXME: is this ok?
-                           False       -- not GADT syntax
-                           NoParentTyCon
-                           (Just $ mk_fam_inst pdata vect_tc)
-  where
-    orig_name = tyConName orig_tc
-    tyvars = tyConTyVars vect_tc
-    rec_flag = boolToRecFlag (isRecursiveTyCon vect_tc)
-
-
-buildPDataTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
-buildPDataTyConRhs orig_name vect_tc repr_tc repr
-  = do
-      data_con <- buildPDataDataCon orig_name vect_tc repr_tc repr
-      return $ DataTyCon { data_cons = [data_con], is_enum = False }
-
-buildPDataDataCon :: Name -> TyCon -> TyCon -> SumRepr -> VM DataCon
-buildPDataDataCon orig_name vect_tc repr_tc repr
-  = do
-      dc_name  <- mkLocalisedName mkPDataDataConOcc orig_name
-      comp_tys <- sum_tys repr
-
-      liftDs $ buildDataCon dc_name
-                            False                  -- not infix
-                            (map (const HsNoBang) comp_tys)
-                            []                     -- no field labels
-                            tvs
-                            []                     -- no existentials
-                            []                     -- no eq spec
-                            []                     -- no context
-                            comp_tys
-                            (mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
-                            repr_tc
-  where
-    tvs   = tyConTyVars vect_tc
-
-    sum_tys EmptySum = return []
-    sum_tys (UnarySum r) = con_tys r
-    sum_tys (Sum { repr_sel_ty = sel_ty
-                 , repr_cons   = cons })
-      = liftM (sel_ty :) (concatMapM con_tys cons)
-
-    con_tys (ConRepr _ r) = prod_tys r
-
-    prod_tys EmptyProd = return []
-    prod_tys (UnaryProd r) = liftM singleton (comp_ty r)
-    prod_tys (Prod { repr_comps = comps }) = mapM comp_ty comps
-
-    comp_ty r = mkPDataType (compOrigType r)
-
-
-mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
-mk_fam_inst fam_tc arg_tc
-  = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
diff --git a/compiler/vectorise/Vectorise/Type/Repr.hs b/compiler/vectorise/Vectorise/Type/Repr.hs
deleted file mode 100644
index 2fd788432c..0000000000
--- a/compiler/vectorise/Vectorise/Type/Repr.hs
+++ /dev/null
@@ -1,107 +0,0 @@
--- |Compute the representation type for data type constructors.
-
-module Vectorise.Type.Repr ( 
-  CompRepr (..), ProdRepr (..), ConRepr (..), SumRepr (..),
-  tyConRepr, sumReprType, conReprType, prodReprType, compReprType, compOrigType
-) where
-
-import Vectorise.Utils
-import Vectorise.Monad
-import Vectorise.Builtins
-
-import CoreSyn
-import DataCon
-import TyCon
-import Type
-import Control.Monad
-
-
-data CompRepr = Keep Type
-                     CoreExpr     -- PR dictionary for the type
-              | Wrap Type
-
-data ProdRepr = EmptyProd
-              | UnaryProd CompRepr
-              | Prod { repr_tup_tc   :: TyCon  -- representation tuple tycon
-                     , repr_ptup_tc  :: TyCon  -- PData representation tycon
-                     , repr_comp_tys :: [Type] -- representation types of
-                     , repr_comps    :: [CompRepr]          -- components
-                     }
-data ConRepr  = ConRepr DataCon ProdRepr
-
-data SumRepr  = EmptySum
-              | UnarySum ConRepr
-              | Sum  { repr_sum_tc   :: TyCon  -- representation sum tycon
-                     , repr_psum_tc  :: TyCon  -- PData representation tycon
-                     , repr_sel_ty   :: Type   -- type of selector
-                     , repr_con_tys  :: [Type] -- representation types of
-                     , repr_cons     :: [ConRepr]           -- components
-                     }
-
--- |Determine the representation type of a data type constructor.
---
-tyConRepr :: TyCon -> VM SumRepr
-tyConRepr tc = sum_repr (tyConDataCons tc)
-  where
-    sum_repr []    = return EmptySum
-    sum_repr [con] = liftM UnarySum (con_repr con)
-    sum_repr cons  = do
-                       rs     <- mapM con_repr cons
-                       sum_tc <- builtin (sumTyCon arity)
-                       tys    <- mapM conReprType rs
-                       (psum_tc, _) <- pdataReprTyCon (mkTyConApp sum_tc tys)
-                       sel_ty <- builtin (selTy arity)
-                       return $ Sum { repr_sum_tc  = sum_tc
-                                    , repr_psum_tc = psum_tc
-                                    , repr_sel_ty  = sel_ty
-                                    , repr_con_tys = tys
-                                    , repr_cons    = rs
-                                    }
-      where
-        arity = length cons
-
-    con_repr con = liftM (ConRepr con) (prod_repr (dataConRepArgTys con))
-
-    prod_repr []   = return EmptyProd
-    prod_repr [ty] = liftM UnaryProd (comp_repr ty)
-    prod_repr tys  = do
-                       rs <- mapM comp_repr tys
-                       tup_tc <- builtin (prodTyCon arity)
-                       tys'    <- mapM compReprType rs
-                       (ptup_tc, _) <- pdataReprTyCon (mkTyConApp tup_tc tys')
-                       return $ Prod { repr_tup_tc   = tup_tc
-                                     , repr_ptup_tc  = ptup_tc
-                                     , repr_comp_tys = tys'
-                                     , repr_comps    = rs
-                                     }
-      where
-        arity = length tys
-    
-    comp_repr ty = liftM (Keep ty) (prDictOfReprType ty)
-                   `orElseV` return (Wrap ty)
-
-sumReprType :: SumRepr -> VM Type
-sumReprType EmptySum = voidType
-sumReprType (UnarySum r) = conReprType r
-sumReprType (Sum { repr_sum_tc  = sum_tc, repr_con_tys = tys })
-  = return $ mkTyConApp sum_tc tys
-
-conReprType :: ConRepr -> VM Type
-conReprType (ConRepr _ r) = prodReprType r
-
-prodReprType :: ProdRepr -> VM Type
-prodReprType EmptyProd = voidType
-prodReprType (UnaryProd r) = compReprType r
-prodReprType (Prod { repr_tup_tc = tup_tc, repr_comp_tys = tys })
-  = return $ mkTyConApp tup_tc tys
-
-compReprType :: CompRepr -> VM Type
-compReprType (Keep ty _) = return ty
-compReprType (Wrap ty)
-  = do { wrap_tc <- builtin wrapTyCon
-       ; return $ mkTyConApp wrap_tc [ty]
-       }
-
-compOrigType :: CompRepr -> Type
-compOrigType (Keep ty _) = ty
-compOrigType (Wrap ty) = ty
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index cea4749839..c4dfe5c96b 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -11,13 +11,12 @@ module Vectorise.Utils.Base (
   mkPReprType,
   mkPArrayType, splitPrimTyCon,
   mkPArray,
-  mkPDataType,
+  mkPDataType,  mkPDatasType,
   mkBuiltinCo,
   mkVScrut,
 
-  -- preprSynTyCon,
-  pdataReprTyCon,
-  pdataReprDataCon,
+  pdataReprTyCon,   pdatasReprTyCon,
+  pdataReprDataCon, pdatasReprDataCon,
   prDFunOfTyCon
 ) where
 
@@ -67,36 +66,38 @@ dataConTagZ :: DataCon -> Int
 dataConTagZ con = dataConTag con - fIRST_TAG
 
 
+-- Type Construction ----------------------------------------------------------
+-- | Make an application of a builtin type constructor to some arguments.
 mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type
 mkBuiltinTyConApp get_tc tys
-  = do
-      tc <- builtin get_tc
+ = do tc     <- builtin get_tc
       return $ mkTyConApp tc tys
 
 
 mkBuiltinTyConApps :: (Builtins -> TyCon) -> [Type] -> Type -> VM Type
 mkBuiltinTyConApps get_tc tys ty
-  = do
-      tc <- builtin get_tc
+ = do tc     <- builtin get_tc
       return $ foldr (mk tc) ty tys
   where
     mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
 
 
+-- | Make an application of the 'Wrap' type constructor.
 mkWrapType :: Type -> VM Type
-mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty]
+mkWrapType ty  = mkBuiltinTyConApp wrapTyCon [ty]
 
 
+-- | Make an application of the closure type constructor.
 mkClosureTypes :: [Type] -> Type -> VM Type
 mkClosureTypes = mkBuiltinTyConApps closureTyCon
 
 
+-- | Make an application of the 'PRepr' type constructor.
 mkPReprType :: Type -> VM Type
 mkPReprType ty = mkBuiltinTyConApp preprTyCon [ty]
 
 
--- |Wrap a type into 'PArray', treating unboxed types specially.
---
+-- | Wrap a type into 'PArray', treating unboxed types specially.
 mkPArrayType :: Type -> VM Type
 mkPArrayType ty
   | Just tycon <- splitPrimTyCon ty
@@ -105,8 +106,18 @@ mkPArrayType ty
        }
 mkPArrayType ty = mkBuiltinTyConApp parrayTyCon [ty]
 
+
+-- | Make an appliction of the 'PData' tycon to some argument.
+mkPDataType :: Type -> VM Type
+mkPDataType ty  = mkBuiltinTyConApp pdataTyCon [ty]
+
+
+-- | Make an application of the 'PDatas' tycon to some argument.
+mkPDatasType :: Type -> VM Type
+mkPDatasType ty = mkBuiltinTyConApp pdatasTyCon [ty]
+
+
 -- |Checks if a type constructor is defined in 'GHC.Prim' (e.g., 'Int#'); if so, returns it.
---
 splitPrimTyCon :: Type -> Maybe TyCon
 splitPrimTyCon ty
   | Just (tycon, []) <- splitTyConApp_maybe ty
@@ -115,22 +126,30 @@ splitPrimTyCon ty
   | otherwise = Nothing
 
 
-------
-mkPArray :: Type -> CoreExpr -> CoreExpr -> VM CoreExpr
-mkPArray ty len dat = do
-                        tc <- builtin parrayTyCon
-                        let [dc] = tyConDataCons tc
-                        return $ mkConApp dc [Type ty, len, dat]
 
-mkPDataType :: Type -> VM Type
-mkPDataType ty = mkBuiltinTyConApp pdataTyCon [ty]
+-- CoreExpr Construction ------------------------------------------------------
+-- | Make an application of the 'PArray' data constructor.
+mkPArray 
+        :: Type         -- ^ Element type
+        -> CoreExpr     -- ^ 'Int'   for the array length.
+        -> CoreExpr     -- ^ 'PData' for the array data.
+        -> VM CoreExpr
 
+mkPArray ty len dat 
+ = do   tc <- builtin parrayTyCon
+        let [dc] = tyConDataCons tc
+        return $ mkConApp dc [Type ty, len, dat]
+
+
+-- Coercion Construction -----------------------------------------------------
+-- | Make a coersion to some builtin type.
 mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion
 mkBuiltinCo get_tc
-  = do
-      tc <- builtin get_tc
+ = do tc     <- builtin get_tc
       return $ mkTyConAppCo tc []
 
+
+-------------------------------------------------------------------------------
 mkVScrut :: VExpr -> VM (CoreExpr, CoreExpr, TyCon, [Type])
 mkVScrut (ve, le)
   = do
@@ -139,18 +158,33 @@ mkVScrut (ve, le)
   where
     ty = exprType ve
 
--- preprSynTyCon :: Type -> VM (TyCon, [Type])
--- preprSynTyCon ty = builtin preprTyCon >>= (`lookupFamInst` [ty])
 
+-- | Get the PData tycon that represents this type.
+--   This tycon does not appear explicitly in the source program.
+--   See Note [PData TyCons] in Vectorise.PRepr
+--
+--   @pdataReprTyCon {Sum2} = {PDataSum2}@
+--
 pdataReprTyCon :: Type -> VM (TyCon, [Type])
-pdataReprTyCon ty = builtin pdataTyCon >>= (`lookupFamInst` [ty])
+pdataReprTyCon ty
+        = builtin pdataTyCon >>= (`lookupFamInst` [ty])
 
 pdataReprDataCon :: Type -> VM (DataCon, [Type])
 pdataReprDataCon ty
-  = do
-      (tc, arg_tys) <- pdataReprTyCon ty
-      let [dc] = tyConDataCons tc
-      return (dc, arg_tys)
+ = do   (tc, arg_tys) <- pdataReprTyCon ty
+        let [dc] = tyConDataCons tc
+        return (dc, arg_tys)
+
+pdatasReprTyCon :: Type -> VM (TyCon, [Type])
+pdatasReprTyCon ty
+        = builtin pdatasTyCon >>= (`lookupFamInst` [ty])
+
+pdatasReprDataCon :: Type -> VM (DataCon, [Type])
+pdatasReprDataCon ty
+ = do   (tc, arg_tys) <- pdatasReprTyCon ty
+        let [dc] = tyConDataCons tc
+        return (dc, arg_tys)
+
 
 prDFunOfTyCon :: TyCon -> VM CoreExpr
 prDFunOfTyCon tycon