update to current master againwip/T13904

4 files changed, 0 insertions, 1170 deletions

diff --git a/compiler/vectorise/Vectorise/Generic/Description.hs b/compiler/vectorise/Vectorise/Generic/Description.hs
deleted file mode 100644
index 78a8f2c192..0000000000
--- a/compiler/vectorise/Vectorise/Generic/Description.hs
+++ /dev/null
@@ -1,292 +0,0 @@
--- |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
-  , 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 multi-selector             (eg Sel2s)
-               , repr_sels_ty   :: Type
-
-               -- | Function to get the length of a Sels of this type.
-               , repr_selsLength_v :: CoreExpr
-
-               -- | 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.
---
-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.
-           psum_tc      <- pdataReprTyConExact  sum_tc
-           psums_tc     <- pdatasReprTyConExact sum_tc
-
-           sel_ty       <- builtin (selTy      arity)
-           sels_ty      <- builtin (selsTy     arity)
-           selsLength_v <- builtin (selsLength arity)
-           return $ Sum
-                  { repr_sum_tc         = sum_tc
-                  , repr_psum_tc        = psum_tc
-                  , repr_psums_tc       = psums_tc
-                  , repr_sel_ty         = sel_ty
-                  , repr_sels_ty        = sels_ty
-                  , repr_selsLength_v   = selsLength_v
-                  , 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.
-           ptup_tc      <- pdataReprTyConExact  tup_tc
-           ptups_tc     <- pdatasReprTyConExact tup_tc
-
-           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)   = mkWrapType 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 selsty selsLength 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_sels_ty      = " <> ppr selsty
-                        , text "repr_selsLength_v = " <> ppr selsLength
-                        , 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.
-
--}
-
diff --git a/compiler/vectorise/Vectorise/Generic/PADict.hs b/compiler/vectorise/Vectorise/Generic/PADict.hs
deleted file mode 100644
index 5b7748a499..0000000000
--- a/compiler/vectorise/Vectorise/Generic/PADict.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-
-module Vectorise.Generic.PADict
-  ( buildPADict
-  ) where
-
-import Vectorise.Monad
-import Vectorise.Builtins
-import Vectorise.Generic.Description
-import Vectorise.Generic.PAMethods ( buildPAScAndMethods )
-import Vectorise.Utils
-
-import BasicTypes
-import CoreSyn
-import CoreUtils
-import CoreUnfold
-import Module
-import TyCon
-import CoAxiom
-import Type
-import Id
-import Var
-import Name
-import FastString
-
-
--- |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.
---
--- @Recall the definition:
---    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
---
--- Example:
---    df :: forall a. PR (PRepr a) -> PA a -> PA (T a)
---    df = /\a. \(c:PR (PRepr a)) (d:PA a). MkPA c ($PR_df a d) ($toPRepr a d) ...
---    $dPR_df :: forall a. PA a -> PR (PRepr (T a))
---    $dPR_df = ....
---    $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.
-        -> CoAxiom Unbranched
-                        -- ^ Coercion between the type and
-                        --     its 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_ax 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 find it in
-                                  -- the envt; they don't include the silent superclass args yet
-   do { mod <- liftDs getModule
-      ; let dfun_name = mkLocalisedOccName mod mkPADFunOcc vect_tc_name
-
-          -- The superclass dictionary is a (silent) argument if the tycon is polymorphic...
-      ; let mk_super_ty = do { r <- mkPReprType inst_ty
-                             ; pr_cls <- builtin prClass
-                             ; return $ mkClassPred pr_cls [r]
-                             }
-      ; super_tys  <- sequence [mk_super_ty | not (null tvs)]
-      ; super_args <- mapM (newLocalVar (fsLit "pr")) super_tys
-      ; let val_args = super_args ++ args
-            all_args = tvs ++ val_args
-
-          -- ...it is constant otherwise
-      ; super_consts <- sequence [prDictOfPReprInstTyCon inst_ty prepr_ax [] | null tvs]
-
-          -- Get ids for each of the methods in the dictionary, including superclass
-      ; paMethodBuilders <- buildPAScAndMethods
-      ; method_ids       <- mapM (method val_args dfun_name) paMethodBuilders
-
-          -- Expression to build the dictionary.
-      ; pa_dc  <- builtin paDataCon
-      ; let dict = mkLams all_args (mkConApp pa_dc con_args)
-            con_args = Type inst_ty
-                     : map Var super_args  -- the superclass dictionary is either
-                    ++ super_consts        -- lambda-bound or constant
-                    ++ map (method_call val_args) method_ids
-
-          -- Build the type of the dictionary function.
-      ; pa_cls <- builtin paClass
-      ; let dfun_ty = mkInvForAllTys tvs
-                    $ mkFunTys (map varType val_args)
-                               (mkClassPred pa_cls [inst_ty])
-
-          -- Set the unfolding for the inliner.
-      ; raw_dfun <- newExportedVar dfun_name dfun_ty
-      ; let dfun_unf = mkDFunUnfolding all_args pa_dc con_args
-            dfun = raw_dfun `setIdUnfolding`  dfun_unf
-                            `setInlinePragma` dfunInlinePragma
-
-          -- Add the new binding to the top-level environment.
-      ; hoistBinding dfun dict
-      ; return dfun
-      }
-  where
-    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_ax 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` mkInlineUnfoldingWithArity
-                                         (length args) body
-                      `setInlinePragma` alwaysInlinePragma
-           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
deleted file mode 100644
index d480ea926b..0000000000
--- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs
+++ /dev/null
@@ -1,584 +0,0 @@
-
--- | 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 FamInstEnv
-import MkCore            ( mkWildCase, mkCoreLet )
-import TyCon
-import CoAxiom
-import Type
-import OccName
-import Coercion
-import MkId
-import FamInst
-import TysPrim( intPrimTy )
-
-import DynFlags
-import FastString
-import MonadUtils
-import Control.Monad
-import Outputable
-
-
-buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
-buildPReprTyCon orig_tc vect_tc repr
- = do name      <- mkLocalisedName mkPReprTyConOcc (tyConName orig_tc)
-      rhs_ty    <- sumReprType repr
-      prepr_tc  <- builtin preprTyCon
-      let axiom = mkSingleCoAxiom Nominal name tyvars [] prepr_tc instTys rhs_ty
-      liftDs $ newFamInst SynFamilyInst axiom
-  where
-    tyvars = tyConTyVars vect_tc
-    instTys = [mkTyConApp vect_tc . mkTyVarTys $ tyConTyVars vect_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
-        -> CoAxiom Unbranched
-                        -- ^ Coercion to the representation TyCon
-        -> TyCon        -- ^ 'PData'  TyCon
-        -> TyCon        -- ^ 'PDatas' TyCon
-        -> SumRepr      -- ^ Description of generic representation.
-        -> VM CoreExpr  -- ^ Instance function.
-
-
-buildPAScAndMethods :: VM [(String, PAInstanceBuilder)]
-buildPAScAndMethods
- = return [ ("toPRepr",       buildToPRepr)
-          , ("fromPRepr",     buildFromPRepr)
-          , ("toArrPRepr",    buildToArrPRepr)
-          , ("fromArrPRepr",  buildFromArrPRepr)
-          , ("toArrPReprs",   buildToArrPReprs)
-          , ("fromArrPReprs", buildFromArrPReprs)]
-
-
--- buildToPRepr ---------------------------------------------------------------
--- | Build the 'toRepr' method of the PA class.
-buildToPRepr :: PAInstanceBuilder
-buildToPRepr vect_tc repr_ax _ _ 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 = wrapTypeUnbranchedFamInstBody repr_ax 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)  = wrapNewTypeBodyOfWrap expr ty
-
-
--- buildFromPRepr -------------------------------------------------------------
-
--- |Build the 'fromPRepr' method of the PA class.
---
-buildFromPRepr :: PAInstanceBuilder
-buildFromPRepr vect_tc repr_ax _ _ repr
-  = do
-      arg_ty <- mkPReprType res_ty
-      arg <- newLocalVar (fsLit "x") arg_ty
-
-      result <- from_sum (unwrapTypeUnbranchedFamInstScrut repr_ax 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)  = unwrapNewTypeBodyOfWrap expr ty
-
-
--- buildToArrRepr -------------------------------------------------------------
-
--- |Build the 'toArrRepr' method of the PA class.
---
-buildToArrPRepr :: PAInstanceBuilder
-buildToArrPRepr vect_tc repr_co 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 co           = mkAppCo pdata_co
-                       $ mkSymCo
-                       $ mkUnbranchedAxInstCo Nominal 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, mkCast result co)]
-  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
-
-    to_comp expr (Keep _ _) = return expr
-    to_comp expr (Wrap ty)  = wrapNewTypeBodyOfPDataWrap expr ty
-
-
--- buildFromArrPRepr ----------------------------------------------------------
-
--- |Build the 'fromArrPRepr' method for the PA class.
---
-buildFromArrPRepr :: PAInstanceBuilder
-buildFromArrPRepr vect_tc repr_co 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 co           = mkAppCo pdata_co
-                       $ mkUnbranchedAxInstCo Nominal repr_co var_tys []
-
-      let scrut        = mkCast (Var arg) co
-
-      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 { expr' <- unwrapNewTypeBodyOfPDataWrap expr ty
-                                         ; return (res, [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 repr_co _ 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
-
-    -- Coercion to case between the (PRepr a) type and its instance.
-    pdatas_co <- mkBuiltinCo pdatasTyCon
-    let co           = mkAppCo pdatas_co
-                     $ mkSymCo
-                     $ mkUnbranchedAxInstCo Nominal 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, mkCast result co)]
-
- 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
-        -- We can't convert data types with no data.
-        -- See Note: [Empty PDatas].
-        EmptySum        -> do dflags <- getDynFlags
-                              return ([], errorEmptyPDatas dflags el_ty)
-        UnarySum r      -> do dflags <- getDynFlags
-                              to_con (errorEmptyPDatas dflags el_ty) r
-
-        Sum{}
-         -> do  let psums_tc     = repr_psums_tc ss
-                let [psums_con]  = tyConDataCons psums_tc
-                sels             <- newLocalVar (fsLit "sels") (repr_sels_ty ss)
-
-                -- Take the number of selectors to serve as the length of
-                -- and PDatas Void arrays in the product. See Note [Empty PDatas].
-                let xSums        =  App (repr_selsLength_v ss) (Var sels)
-
-                xSums_var <- newLocalVar (fsLit "xsum") intPrimTy
-
-                (vars, exprs)    <- mapAndUnzipM (to_con xSums_var) (repr_cons ss)
-                return ( sels : concat vars
-                       , wrapFamInstBody psums_tc (repr_con_tys ss)
-                         $ mkCoreLet (NonRec xSums_var xSums)
-                                 -- mkCoreLet ensures that the let/app invariant holds
-                         $ mkConApp psums_con
-                         $ map Type (repr_con_tys ss) ++ (Var sels : exprs))
-
-    to_prod xSums ss
-     = case ss of
-        EmptyProd
-         -> do  pvoids  <- builtin pvoidsVar
-                return ([], App (Var pvoids) (Var xSums) )
-
-        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 xSums (ConRepr _ r)
-        = to_prod xSums r
-
-    to_comp expr (Keep _ _) = return expr
-    to_comp expr (Wrap ty)  = wrapNewTypeBodyOfPDatasWrap expr ty
-
-
--- buildFromArrPReprs ---------------------------------------------------------
-buildFromArrPReprs :: PAInstanceBuilder
-buildFromArrPReprs vect_tc repr_co _ pdatas_tc r
- = do
-    -- 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 coercion between PRepr and the instance type
-    pdatas_co <- mkBuiltinCo pdatasTyCon
-    let co           = mkAppCo pdatas_co
-                     $ mkUnbranchedAxInstCo Nominal repr_co var_tys []
-
-    let scrut        = mkCast (Var varg) co
-
-    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
-    -- The element type of the argument.
-    --  eg: 'Tree a b'.
-    ty_args      = mkTyVarTys $ tyConTyVars vect_tc
-    el_ty        = mkTyConApp vect_tc ty_args
-
-    var_tys      = mkTyVarTys $ tyConTyVars vect_tc
-    [pdatas_con] = tyConDataCons pdatas_tc
-
-    from_sum res_ty res expr ss
-     = case ss of
-        -- We can't convert data types with no data.
-        -- See Note: [Empty PDatas].
-        EmptySum        -> do dflags <- getDynFlags
-                              return (res, errorEmptyPDatas dflags el_ty)
-        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 "sels") (repr_sels_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 { expr' <- unwrapNewTypeBodyOfPDatasWrap expr ty
-                                         ; return (res, [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)
-
-
--- Notes ----------------------------------------------------------------------
-{-
-Note [Empty PDatas]
-~~~~~~~~~~~~~~~~~~~
-We don't support "empty" data types like the following:
-
-  data Empty0
-  data Empty1 = MkEmpty1
-  data Empty2 = MkEmpty2 Empty0
-  ...
-
-There is no parallel data associcated with these types, so there is no where
-to store the length of the PDatas array with our standard representation.
-
-Enumerations like the following are ok:
-  data Bool = True | False
-
-The native and generic representations are:
-  type instance (PDatas Bool)        = VPDs:Bool Sels2
-  type instance (PDatas (Repr Bool)) = PSum2s Sels2 (PDatas Void) (PDatas Void)
-
-To take the length of a (PDatas Bool) we take the length of the contained Sels2.
-When converting a (PDatas Bool) to a (PDatas (Repr Bool)) we use this length to
-initialise the two (PDatas Void) arrays.
-
-However, with this:
-  data Empty1 = MkEmpty1
-
-The native and generic representations would be:
-  type instance (PDatas Empty1)        = VPDs:Empty1
-  type instance (PDatas (Repr Empty1)) = PVoids Int
-
-The 'Int' argument of PVoids is supposed to store the length of the PDatas
-array. When converting the (PDatas Empty1) to a (PDatas (Repr Empty1)) we
-need to come up with a value for it, but there isn't one.
-
-To fix this we'd need to add an Int field to VPDs:Empty1 as well, but that's
-too much hassle and there's no point running a parallel computation on no
-data anyway.
--}
-errorEmptyPDatas :: DynFlags -> Type -> a
-errorEmptyPDatas dflags tc
-    = cantVectorise dflags "Vectorise.PAMethods"
-    $ vcat  [ text "Cannot vectorise data type with no parallel data " <> quotes (ppr tc)
-            , text "Data types to be vectorised must contain at least one constructor"
-            , text "with at least one field." ]
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
deleted file mode 100644
index 4560c83e8b..0000000000
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ /dev/null
@@ -1,168 +0,0 @@
-
--- | 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 Vectorise.Env( GlobalEnv( global_fam_inst_env ) )
-
-import BasicTypes ( SourceText(..) )
-import BuildTyCl
-import DataCon
-import TyCon
-import Type
-import FamInst
-import FamInstEnv
-import TcMType
-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 FamInst
-buildPDataTyCon orig_tc vect_tc repr
- = fixV $ \fam_inst ->
-   do let repr_tc = dataFamInstRepTyCon fam_inst
-      name' <- mkLocalisedName mkPDataTyConOcc orig_name
-      rhs   <- buildPDataTyConRhs orig_name vect_tc repr_tc repr
-      pdata <- builtin pdataTyCon
-      buildDataFamInst name' pdata vect_tc rhs
- where
-    orig_name = tyConName orig_tc
-
-buildDataFamInst :: Name -> TyCon -> TyCon -> AlgTyConRhs -> VM FamInst
-buildDataFamInst name' fam_tc vect_tc rhs
- = do { axiom_name <- mkDerivedName mkInstTyCoOcc name'
-
-      ; (_, tyvars') <- liftDs $ freshenTyVarBndrs tyvars
-      ; let ax       = mkSingleCoAxiom Representational axiom_name tyvars' [] fam_tc pat_tys rep_ty
-            tys'     = mkTyVarTys tyvars'
-            rep_ty   = mkTyConApp rep_tc tys'
-            pat_tys  = [mkTyConApp vect_tc tys']
-            rep_tc   = mkAlgTyCon name'
-                           (mkTyConBindersPreferAnon tyvars' liftedTypeKind)
-                           liftedTypeKind
-                           (map (const Nominal) tyvars')
-                           Nothing
-                           []          -- no stupid theta
-                           rhs
-                           (DataFamInstTyCon ax fam_tc pat_tys)
-                           False       -- not GADT syntax
-      ; liftDs $ newFamInst (DataFamilyInst rep_tc) ax }
- where
-    tyvars    = tyConTyVars 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 repr_sel_ty mkPDataType repr
-      fam_envs  <- readGEnv global_fam_inst_env
-      rep_nm    <- liftDs $ newTyConRepName dc_name
-      liftDs $ buildDataCon fam_envs dc_name
-                            False                  -- not infix
-                            rep_nm
-                            (map (const no_bang) comp_tys)
-                            (Just $ map (const HsLazy) comp_tys)
-                            []                     -- no field labels
-                            (mkTyVarBinders Specified tvs)
-                            []                     -- no existentials
-                            []                     -- no eq spec
-                            []                     -- no context
-                            comp_tys
-                            (mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
-                            repr_tc
-  where
-    no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict
-
-
--- buildPDatasTyCon -----------------------------------------------------------
--- | Build the PDatas instance tycon for a given type constructor.
-buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
-buildPDatasTyCon orig_tc vect_tc repr
- = fixV $ \fam_inst ->
-   do let repr_tc = dataFamInstRepTyCon fam_inst
-      name'       <- mkLocalisedName mkPDatasTyConOcc orig_name
-      rhs         <- buildPDatasTyConRhs orig_name vect_tc repr_tc repr
-      pdatas     <- builtin pdatasTyCon
-      buildDataFamInst name' pdatas vect_tc rhs
- where
-    orig_name = tyConName orig_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 repr_sels_ty mkPDatasType repr
-      fam_envs <- readGEnv global_fam_inst_env
-      rep_nm   <- liftDs $ newTyConRepName dc_name
-      liftDs $ buildDataCon fam_envs dc_name
-                            False                  -- not infix
-                            rep_nm
-                            (map (const no_bang) comp_tys)
-                            (Just $ map (const HsLazy) comp_tys)
-                            []                     -- no field labels
-                            (mkTyVarBinders Specified tvs)
-                            []                     -- no existentials
-                            []                     -- no eq spec
-                            []                     -- no context
-                            comp_tys
-                            (mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
-                            repr_tc
-  where
-     no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict
-
-
--- Utils ----------------------------------------------------------------------
--- | Flatten a SumRepr into a list of data constructor types.
-mkSumTys
-        :: (SumRepr -> Type)
-        -> (Type -> VM Type)
-        -> SumRepr
-        -> VM [Type]
-
-mkSumTys repr_selX_ty mkTc repr
- = sum_tys repr
- where
-    sum_tys EmptySum      = return []
-    sum_tys (UnarySum r)  = con_tys r
-    sum_tys d@(Sum { repr_cons   = cons })
-      = liftM (repr_selX_ty d :) (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])
--}