vectorise: Put it out of its misery

Poor DPH and its vectoriser have long been languishing; sadly it seems there is
little chance that the effort will be rekindled. Every few years we discuss
what to do with this mass of code and at least once we have agreed that it
should be archived on a branch and removed from `master`. Here we do just that,
eliminating heaps of dead code in the process.

Here we drop the ParallelArrays extension, the vectoriser, and the `vector` and
`primitive` submodules.

Test Plan: Validate

Reviewers: simonpj, simonmar, hvr, goldfire, alanz

Reviewed By: simonmar

Subscribers: goldfire, rwbarton, thomie, mpickering, carter

Differential Revision: https://phabricator.haskell.org/D4761

4 files changed, 0 insertions, 1186 deletions

diff --git a/compiler/vectorise/Vectorise/Generic/Description.hs b/compiler/vectorise/Vectorise/Generic/Description.hs
deleted file mode 100644
index 483e96f712..0000000000
--- a/compiler/vectorise/Vectorise/Generic/Description.hs
+++ /dev/null
@@ -1,294 +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 GhcPrelude
-
-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 d24f989161..0000000000
--- a/compiler/vectorise/Vectorise/Generic/PADict.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-
-module Vectorise.Generic.PADict
-  ( buildPADict
-  ) where
-
-import GhcPrelude
-
-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 34163d17f6..0000000000
--- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs
+++ /dev/null
@@ -1,586 +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 GhcPrelude
-
-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 29e6bc86ed..0000000000
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ /dev/null
@@ -1,178 +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 GhcPrelude
-
-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 $ mkDataTyConRhs [data_con]
-
-
-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
-      let univ_tvbs = mkTyVarBinders Specified tvs
-          tag_map = mkTyConTagMap repr_tc
-      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
-                            tvs
-                            []                     -- no existentials
-                            univ_tvbs
-                            []                     -- no eq spec
-                            []                     -- no context
-                            comp_tys
-                            (mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
-                            repr_tc
-                            tag_map
-  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 $ mkDataTyConRhs [data_con]
-
-
-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
-      let univ_tvbs = mkTyVarBinders Specified tvs
-          tag_map = mkTyConTagMap repr_tc
-      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
-                            tvs
-                            []                     -- no existentials
-                            univ_tvbs
-                            []                     -- no eq spec
-                            []                     -- no context
-                            comp_tys
-                            (mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
-                            repr_tc
-                            tag_map
-  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])
--}