vectoriser: comments to PRepr and get PDatas TyCon from environment

5 files changed, 277 insertions, 112 deletions

diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index 5efb5d1df4..451a9dafc6 100644
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -23,7 +23,9 @@ module DsMonad (
         getDOptsDs, getGhcModeDs, doptDs, woptDs,
         dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon, dsLookupDataCon,
         
-        PArrBuiltin(..), dsLookupDPHRdrEnv, dsInitPArrBuiltin,
+        PArrBuiltin(..), 
+        dsLookupDPHRdrEnv, dsLookupDPHRdrEnv_maybe,
+        dsInitPArrBuiltin,
 
         DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
 
@@ -63,6 +65,7 @@ import FastString
 import Maybes
 
 import Data.IORef
+import Control.Monad
 \end{code}
 
 %************************************************************************
@@ -416,20 +419,29 @@ dsLookupDataCon name
 \end{code}
 
 \begin{code}
--- Look up a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
---
+
+
+-- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
+--  Panic if there isn't one, or if it is defined multiple times.
 dsLookupDPHRdrEnv :: OccName -> DsM Name
 dsLookupDPHRdrEnv occ
+  = liftM (fromMaybe (pprPanic nameNotFound (ppr occ)))
+  $ dsLookupDPHRdrEnv_maybe occ
+  where nameNotFound  = "Name not found in 'Data.Array.Parallel' or 'Data.Array.Parallel.Prim':"
+
+-- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim',
+--  returning `Nothing` if it's not defined. Panic if it's defined multiple times.
+dsLookupDPHRdrEnv_maybe :: OccName -> DsM (Maybe Name)
+dsLookupDPHRdrEnv_maybe occ
   = do { env <- ds_dph_env <$> getGblEnv
        ; let gres = lookupGlobalRdrEnv env occ
        ; case gres of
-           []    -> pprPanic nameNotFound (ppr occ)
-           [gre] -> return $ gre_name gre
+           []    -> return $ Nothing
+           [gre] -> return $ Just $ gre_name gre
            _     -> pprPanic multipleNames (ppr occ)
        }
-  where
-    nameNotFound  = "Name not found in 'Data.Array.Parallel' or 'Data.Array.Parallel.Prim':"
-    multipleNames = "Multiple definitions in 'Data.Array.Parallel' and 'Data.Array.Parallel.Prim':"
+  where multipleNames = "Multiple definitions in 'Data.Array.Parallel' and 'Data.Array.Parallel.Prim':"
+
 
 -- Populate 'ds_parr_bi' from 'ds_dph_env'.
 --
diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs
index 13ab890425..2d0931bc2f 100644
--- a/compiler/vectorise/Vectorise/Builtins/Base.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Base.hs
@@ -73,6 +73,10 @@ data Builtins
         { parrayTyCon          :: TyCon                     -- ^ PArray
         , parray_PrimTyCons    :: NameEnv TyCon             -- ^ PArray_Int# etc.
         , pdataTyCon           :: TyCon                     -- ^ PData
+
+        , pdatasTyCon          :: Maybe TyCon    
+        -- ^ PDatas. Not all lifted backends use 'PDatas', so it might not be defined.
+
         , prClass              :: Class                     -- ^ PR
         , prTyCon              :: TyCon                     -- ^ PR
         , preprTyCon           :: TyCon                     -- ^ PRepr
@@ -118,19 +122,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 +175,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 +196,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..55123ef407 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@(Just _) <- externalTyCon_maybe (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,34 @@ 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")
 
           -- 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 +117,7 @@ initBuiltins
                { parrayTyCon          = parrayTyCon
                , parray_PrimTyCons    = parray_PrimTyCons
                , pdataTyCon           = pdataTyCon
+               , pdatasTyCon          = pdatasTyCon
                , preprTyCon           = preprTyCon
                , prClass              = prClass
                , prTyCon              = prTyCon
@@ -199,32 +202,42 @@ 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 a 'TyCon' in 'Data.Array.Parallel.Prim', given its name.
+--  Return 'Nothing' if there isn't one.
+externalTyCon_maybe :: FastString -> DsM (Maybe TyCon)
+externalTyCon_maybe fs
+ = do   mName   <- dsLookupDPHRdrEnv_maybe (mkTcOccFS fs)
+        case mName of
+         Nothing        -> return Nothing
+         Just name      -> liftM Just $ dsLookupTyCon 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/Type/Repr.hs b/compiler/vectorise/Vectorise/Type/Repr.hs
index 2fd788432c..5f7d3ebfc8 100644
--- a/compiler/vectorise/Vectorise/Type/Repr.hs
+++ b/compiler/vectorise/Vectorise/Type/Repr.hs
@@ -1,5 +1,5 @@
--- |Compute the representation type for data type constructors.
 
+-- | Compute the generic representation type for data types.
 module Vectorise.Type.Repr ( 
   CompRepr (..), ProdRepr (..), ConRepr (..), SumRepr (..),
   tyConRepr, sumReprType, conReprType, prodReprType, compReprType, compOrigType
@@ -14,94 +14,214 @@ import DataCon
 import TyCon
 import Type
 import Control.Monad
+import Outputable
 
 
-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.
+-- | Describes the generic representation of a data 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 type 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)
+               --   Not all lifted backends use `PDatas`.
+               , repr_psums_tc  :: Maybe TyCon
+
+               -- | Type of selector (eg Sel2)
+               , repr_sel_ty    :: Type
+
+               -- | Type of each data constructor.
+               , repr_con_tys   :: [Type]
+
+               -- | Representation types of each data constructor.
+               , repr_cons      :: [ConRepr]
+               }
+
+data ConRepr  
+        = ConRepr 
+                { repr_dc       :: DataCon
+                , repr_prod     :: ProdRepr 
+                }
+
+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 CompRepr
+        = Keep Type
+               CoreExpr     -- PR dictionary for the type
+        | Wrap Type
+
+
+-- | Determine the representation type of a data type constructor.
 --
 tyConRepr :: TyCon -> VM SumRepr
-tyConRepr tc = sum_repr (tyConDataCons tc)
+tyConRepr tc 
+  = do  result  <- sum_repr (tyConDataCons tc)
+        {-pprTrace "tyConRepr" (ppr result)-} 
+        return result
+
   where
+    -- Build the representation type for a data type with the given constructors.
+    sum_repr :: [DataCon] -> VM SumRepr
     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))
+    sum_repr cons  
+     = do  let arity    = length cons
+           rs           <- mapM con_repr cons
+           tys          <- mapM conReprType rs
+           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 (liftM fst) $ pdatasReprTyCon_maybe 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
+                  }
 
+    con_repr con   = liftM (ConRepr con) (prod_repr (dataConRepArgTys con))
+
+    prod_repr :: [Type] -> VM ProdRepr
     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
+    prod_repr tys  
+     = do  let arity    = length tys
+           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
+                  }
     
     comp_repr ty = liftM (Keep ty) (prDictOfReprType ty)
                    `orElseV` return (Wrap ty)
 
+
 sumReprType :: SumRepr -> VM Type
-sumReprType EmptySum = voidType
+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 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]
-       }
+  = do  wrap_tc <- builtin wrapTyCon
+        return $ mkTyConApp wrap_tc [ty]
+       
 
 compOrigType :: CompRepr -> Type
 compOrigType (Keep ty _) = ty
-compOrigType (Wrap 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 comptys comps
+         -> sep [text "Prod", ppr tuptcs, ppr ptuptcs, 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/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index cea4749839..f2b3f802cb 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -15,8 +15,8 @@ module Vectorise.Utils.Base (
   mkBuiltinCo,
   mkVScrut,
 
-  -- preprSynTyCon,
   pdataReprTyCon,
+  pdatasReprTyCon_maybe,
   pdataReprDataCon,
   prDFunOfTyCon
 ) where
@@ -139,11 +139,27 @@ 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])
+
+
+-- | Get the PDatas tycon that represents this type, if there is one.
+--   Not all backends use 'PDatas', so there might not be one.
+pdatasReprTyCon_maybe :: Type -> VM (Maybe (TyCon, [Type]))
+pdatasReprTyCon_maybe ty
+ = do   mtc     <- builtin pdatasTyCon
+        case mtc of
+         Nothing        -> return Nothing
+         Just tc        -> liftM Just $ lookupFamInst tc [ty]
+
 
 pdataReprDataCon :: Type -> VM (DataCon, [Type])
 pdataReprDataCon ty