update to current master againwip/T13904

29 files changed, 0 insertions, 6693 deletions

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
deleted file mode 100644
index 2e09adbbbe..0000000000
--- a/compiler/vectorise/Vectorise.hs
+++ /dev/null
@@ -1,356 +0,0 @@
--- Main entry point to the vectoriser.  It is invoked iff the option '-fvectorise' is passed.
---
--- This module provides the function 'vectorise', which vectorises an entire (desugared) module.
--- It vectorises all type declarations and value bindings.  It also processes all VECTORISE pragmas
--- (aka vectorisation declarations), which can lead to the vectorisation of imported data types
--- and the enrichment of imported functions with vectorised versions.
-
-module Vectorise ( vectorise )
-where
-
-import Vectorise.Type.Env
-import Vectorise.Type.Type
-import Vectorise.Convert
-import Vectorise.Utils.Hoisting
-import Vectorise.Exp
-import Vectorise.Env
-import Vectorise.Monad
-
-import HscTypes hiding      ( MonadThings(..) )
-import CoreUnfold           ( mkInlineUnfoldingWithArity )
-import PprCore
-import CoreSyn
-import CoreMonad            ( CoreM, getHscEnv )
-import Type
-import Id
-import DynFlags
-import Outputable
-import Util                 ( zipLazy )
-import MonadUtils
-
-import Control.Monad
-
-
--- |Vectorise a single module.
---
-vectorise :: ModGuts -> CoreM ModGuts
-vectorise guts
- = do { hsc_env <- getHscEnv
-      ; liftIO $ vectoriseIO hsc_env guts
-      }
-
--- Vectorise a single monad, given the dynamic compiler flags and HscEnv.
---
-vectoriseIO :: HscEnv -> ModGuts -> IO ModGuts
-vectoriseIO hsc_env guts
- = do {   -- Get information about currently loaded external packages.
-      ; eps <- hscEPS hsc_env
-
-          -- Combine vectorisation info from the current module, and external ones.
-      ; let info = hptVectInfo hsc_env `plusVectInfo` eps_vect_info eps
-
-          -- Run the main VM computation.
-      ; Just (info', guts') <- initV hsc_env guts info (vectModule guts)
-      ; return (guts' { mg_vect_info = info' })
-      }
-
--- Vectorise a single module, in the VM monad.
---
-vectModule :: ModGuts -> VM ModGuts
-vectModule guts@(ModGuts { mg_tcs        = tycons
-                         , mg_binds      = binds
-                         , mg_fam_insts  = fam_insts
-                         , mg_vect_decls = vect_decls
-                         })
- = do { dumpOptVt Opt_D_dump_vt_trace "Before vectorisation" $
-          pprCoreBindings binds
-
-          -- Pick out all 'VECTORISE [SCALAR] type' and 'VECTORISE class' pragmas
-      ; let ty_vect_decls  = [vd | vd@(VectType _ _ _) <- vect_decls]
-            cls_vect_decls = [vd | vd@(VectClass _)    <- vect_decls]
-
-          -- Vectorise the type environment.  This will add vectorised
-          -- type constructors, their representations, and the
-          -- corresponding data constructors.  Moreover, we produce
-          -- bindings for dfuns and family instances of the classes
-          -- and type families used in the DPH library to represent
-          -- array types.
-      ; (new_tycons, new_fam_insts, tc_binds) <- vectTypeEnv tycons ty_vect_decls cls_vect_decls
-
-          -- Family instance environment for /all/ home-package modules including those instances
-          -- generated by 'vectTypeEnv'.
-      ; (_, fam_inst_env) <- readGEnv global_fam_inst_env
-
-          -- Vectorise all the top level bindings and VECTORISE declarations on imported identifiers
-          -- NB: Need to vectorise the imported bindings first (local bindings may depend on them).
-      ; let impBinds = [(imp_id, expr) | Vect imp_id expr <- vect_decls, isGlobalId imp_id]
-      ; binds_imp <- mapM vectImpBind impBinds
-      ; binds_top <- mapM vectTopBind binds
-
-      ; return $ guts { mg_tcs          = tycons ++ new_tycons
-                        -- we produce no new classes or instances, only new class type constructors
-                        -- and dfuns
-                      , mg_binds        = Rec tc_binds : (binds_top ++ binds_imp)
-                      , mg_fam_inst_env = fam_inst_env
-                      , mg_fam_insts    = fam_insts ++ new_fam_insts
-                      }
-      }
-
--- Try to vectorise a top-level binding.  If it doesn't vectorise, or if it is entirely scalar, then
--- omit vectorisation of that binding.
---
--- For example, for the binding
---
--- @
---    foo :: Int -> Int
---    foo = \x -> x + x
--- @
---
--- we get
--- @
---    foo  :: Int -> Int
---    foo  = \x -> vfoo $: x
---
---    v_foo :: Closure void vfoo lfoo
---    v_foo = closure vfoo lfoo void
---
---    vfoo :: Void -> Int -> Int
---    vfoo = ...
---
---    lfoo :: PData Void -> PData Int -> PData Int
---    lfoo = ...
--- @
---
--- @vfoo@ is the "vectorised", or scalar, version that does the same as the original function foo,
--- but takes an explicit environment.
---
--- @lfoo@ is the "lifted" version that works on arrays.
---
--- @v_foo@ combines both of these into a `Closure` that also contains the environment.
---
--- The original binding @foo@ is rewritten to call the vectorised version present in the closure.
---
--- Vectorisation may be suppressed by annotating a binding with a 'NOVECTORISE' pragma.  If this
--- pragma is used in a group of mutually recursive bindings, either all or no binding must have
--- the pragma.  If only some bindings are annotated, a fatal error is being raised. (In the case of
--- scalar bindings, we only omit vectorisation if all bindings in a group are scalar.)
---
--- FIXME: Once we support partial vectorisation, we may be able to vectorise parts of a group, or
---   we may emit a warning and refrain from vectorising the entire group.
---
-vectTopBind :: CoreBind -> VM CoreBind
-vectTopBind b@(NonRec var expr)
-  = do
-    { traceVt "= Vectorise non-recursive top-level variable" (ppr var)
-
-    ; (hasNoVect, vectDecl) <- lookupVectDecl var
-    ; if hasNoVect
-      then do
-      {   -- 'NOVECTORISE' pragma => leave this binding as it is
-      ; traceVt "NOVECTORISE" $ ppr var
-      ; return b
-      }
-      else do
-    { vectRhs <- case vectDecl of
-        Just (_, expr') ->
-            -- 'VECTORISE' pragma => just use the provided vectorised rhs
-          do
-          { traceVt "VECTORISE" $ ppr var
-          ; addGlobalParallelVar var
-          ; return $ Just (False, inlineMe, expr')
-          }
-        Nothing         ->
-            -- no pragma => standard vectorisation of rhs
-          do
-          { traceVt "[Vanilla]" $ ppr var <+> char '=' <+> ppr expr
-          ; vectTopExpr var expr
-          }
-    ; hs <- takeHoisted -- make sure we clean those out (even if we skip)
-    ; case vectRhs of
-      { Nothing ->
-          -- scalar binding => leave this binding as it is
-          do
-          { traceVt "scalar binding [skip]" $ ppr var
-          ; return b
-          }
-      ; Just (parBind, inline, expr') -> do
-    {
-       -- vanilla case => create an appropriate top-level binding & add it to the vectorisation map
-    ; when parBind $
-        addGlobalParallelVar var
-    ; var' <- vectTopBinder var inline expr'
-
-        -- We replace the original top-level binding by a value projected from the vectorised
-        -- closure and add any newly created hoisted top-level bindings.
-    ; cexpr <- tryConvert var var' expr
-    ; return . Rec $ (var, cexpr) : (var', expr') : hs
-    } } } }
-    `orElseErrV`
-    do
-    { emitVt "  Could NOT vectorise top-level binding" $ ppr var
-    ; return b
-    }
-vectTopBind b@(Rec binds)
-  = do
-    { traceVt "= Vectorise recursive top-level variables" $ ppr vars
-
-    ; vectDecls <- mapM lookupVectDecl vars
-    ; let hasNoVects = map fst vectDecls
-    ; if and hasNoVects
-      then do
-      {   -- 'NOVECTORISE' pragmas => leave this entire binding group as it is
-      ; traceVt "NOVECTORISE" $ ppr vars
-      ; return b
-      }
-      else do
-    { if or hasNoVects
-      then do
-        {   -- Inconsistent 'NOVECTORISE' pragmas => bail out
-        ; dflags <- getDynFlags
-        ; cantVectorise dflags noVectoriseErr (ppr b)
-        }
-      else do
-    { traceVt "[Vanilla]" $ vcat [ppr var <+> char '=' <+> ppr expr | (var, expr) <- binds]
-
-       -- For all bindings *with* a pragma, just use the pragma-supplied vectorised expression
-    ; newBindsWPragma  <- concat <$>
-                          sequence [ vectTopBindAndConvert bind inlineMe expr'
-                                   | (bind, (_, Just (_, expr'))) <- zip binds vectDecls]
-
-        -- Standard vectorisation of all rhses that are *without* a pragma.
-        -- NB: The reason for 'fixV' is rather subtle: 'vectTopBindAndConvert' adds entries for
-        --     the bound variables in the recursive group to the vectorisation map, which in turn
-        --     are needed by 'vectPolyExprs' (unless it returns 'Nothing').
-    ; let bindsWOPragma = [bind | (bind, (_, Nothing)) <- zip binds vectDecls]
-    ; (newBinds, _) <- fixV $
-        \ ~(_, exprs') ->
-          do
-          {   -- Create appropriate top-level bindings, enter them into the vectorisation map, and
-              -- vectorise the right-hand sides
-          ; newBindsWOPragma <- concat <$>
-                                sequence [vectTopBindAndConvert bind inline expr
-                                         | (bind, ~(inline, expr)) <- zipLazy bindsWOPragma exprs']
-                                         -- irrefutable pattern and 'zipLazy' to tie the knot;
-                                         -- hence, can't use 'zipWithM'
-          ; vectRhses <- vectTopExprs bindsWOPragma
-          ; hs <- takeHoisted -- make sure we clean those out (even if we skip)
-
-          ; case vectRhses of
-              Nothing ->
-                -- scalar bindings => skip all bindings except those with pragmas and retract the
-                --   entries into the vectorisation map for the scalar bindings
-                do
-                { traceVt "scalar bindings [skip]" $ ppr vars
-                ; mapM_ (undefGlobalVar . fst) bindsWOPragma
-                ; return (bindsWOPragma ++ newBindsWPragma, exprs')
-                }
-              Just (parBind, exprs') ->
-                -- vanilla case => record parallel variables and return the final bindings
-                do
-                { when parBind $
-                    mapM_ addGlobalParallelVar vars
-                ; return (newBindsWOPragma ++ newBindsWPragma ++ hs, exprs')
-                }
-          }
-    ; return $ Rec newBinds
-    } } }
-    `orElseErrV`
-    do
-    { emitVt "  Could NOT vectorise top-level bindings" $ ppr vars
-    ; return b
-    }
-  where
-    vars = map fst binds
-    noVectoriseErr = "NOVECTORISE must be used on all or no bindings of a recursive group"
-
-    -- Replace the original top-level bindings by a values projected from the vectorised
-    -- closures and add any newly created hoisted top-level bindings to the group.
-    vectTopBindAndConvert (var, expr) inline expr'
-      = do
-        { var'  <- vectTopBinder var inline expr'
-        ; cexpr <- tryConvert var var' expr
-        ; return [(var, cexpr), (var', expr')]
-        }
-
--- Add a vectorised binding to an imported top-level variable that has a VECTORISE pragma
--- in this module.
---
--- RESTRICTION: Currently, we cannot use the pragma for mutually recursive definitions.
---
-vectImpBind :: (Id, CoreExpr) -> VM CoreBind
-vectImpBind (var, expr)
-  = do
-    { traceVt "= Add vectorised binding to imported variable" (ppr var)
-
-    ; var' <- vectTopBinder var inlineMe expr
-    ; return $ NonRec var' expr
-    }
-
--- |Make the vectorised version of this top level binder, and add the mapping between it and the
--- original to the state. For some binder @foo@ the vectorised version is @$v_foo@
---
--- NOTE: 'vectTopBinder' *MUST* be lazy in inline and expr because of how it is used inside of
---       'fixV' in 'vectTopBind'.
---
-vectTopBinder :: Var      -- ^ Name of the binding.
-              -> Inline   -- ^ Whether it should be inlined, used to annotate it.
-              -> CoreExpr -- ^ RHS of binding, used to set the 'Unfolding' of the returned 'Var'.
-              -> VM Var   -- ^ Name of the vectorised binding.
-vectTopBinder var inline expr
- = do {   -- Vectorise the type attached to the var.
-      ; vty  <- vectType (idType var)
-
-          -- If there is a vectorisation declaration for this binding, make sure its type matches
-      ; (_, vectDecl) <- lookupVectDecl var
-      ; case vectDecl of
-          Nothing             -> return ()
-          Just (vdty, _)
-            | eqType vty vdty -> return ()
-            | otherwise       ->
-              do
-              { dflags <- getDynFlags
-              ; cantVectorise dflags ("Type mismatch in vectorisation pragma for " ++ showPpr dflags var) $
-                  (text "Expected type" <+> ppr vty)
-                  $$
-                  (text "Inferred type" <+> ppr vdty)
-              }
-          -- Make the vectorised version of binding's name, and set the unfolding used for inlining
-      ; var' <- liftM (`setIdUnfolding` unfolding)
-                $  mkVectId var vty
-
-          -- Add the mapping between the plain and vectorised name to the state.
-      ; defGlobalVar var var'
-
-      ; return var'
-    }
-  where
-    unfolding = case inline of
-                  Inline arity -> mkInlineUnfoldingWithArity arity expr
-                  DontInline   -> noUnfolding
-{-
-!!!TODO: dfuns and unfoldings:
-           -- Do not inline the dfun; instead give it a magic DFunFunfolding
-           -- See Note [ClassOp/DFun selection]
-           -- See also note [Single-method classes]
-        dfun_id_w_fun
-           | isNewTyCon class_tc
-           = dfun_id `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 }
-           | otherwise
-           = dfun_id `setIdUnfolding`  mkDFunUnfolding dfun_ty dfun_args
-                     `setInlinePragma` dfunInlinePragma
- -}
-
--- |Project out the vectorised version of a binding from some closure, or return the original body
--- if that doesn't work.
---
-tryConvert :: Var       -- ^Name of the original binding (eg @foo@)
-           -> Var       -- ^Name of vectorised version of binding (eg @$vfoo@)
-           -> CoreExpr  -- ^The original body of the binding.
-           -> VM CoreExpr
-tryConvert var vect_var rhs
-  = fromVect (idType var) (Var vect_var)
-    `orElseErrV`
-    do
-    { emitVt "  Could NOT call vectorised from original version" $ ppr var <+> dcolon <+> ppr (idType var)
-    ; return rhs
-    }
diff --git a/compiler/vectorise/Vectorise/Builtins.hs b/compiler/vectorise/Vectorise/Builtins.hs
deleted file mode 100644
index 7fe5b2cecc..0000000000
--- a/compiler/vectorise/Vectorise/Builtins.hs
+++ /dev/null
@@ -1,35 +0,0 @@
--- Types and functions declared in 'Data.Array.Parallel.Prim' and used by the vectoriser.
---
--- The @Builtins@ structure holds the name of all the things in 'Data.Array.Parallel.Prim' that
--- appear in code generated by the vectoriser.
-
-module Vectorise.Builtins (
-  -- * Restrictions
-  mAX_DPH_SCALAR_ARGS,
-
-  -- * Builtins
-  Builtins(..),
-
-  -- * Wrapped selectors
-  selTy, selsTy,
-  selReplicate,
-  selTags,
-  selElements,
-  selsLength,
-  sumTyCon,
-  prodTyCon,
-  prodDataCon,
-  replicatePD_PrimVar,
-  emptyPD_PrimVar,
-  packByTagPD_PrimVar,
-  combinePDVar,
-  combinePD_PrimVar,
-  scalarZip,
-  closureCtrFun,
-
-  -- * Initialisation
-  initBuiltins, initBuiltinVars,
-) where
-
-import Vectorise.Builtins.Base
-import Vectorise.Builtins.Initialise
diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs
deleted file mode 100644
index 4837bde208..0000000000
--- a/compiler/vectorise/Vectorise/Builtins/Base.hs
+++ /dev/null
@@ -1,217 +0,0 @@
--- |Builtin types and functions used by the vectoriser. These are all defined in
--- 'Data.Array.Parallel.Prim'.
-
-module Vectorise.Builtins.Base (
-  -- * Hard config
-  mAX_DPH_PROD,
-  mAX_DPH_SUM,
-  mAX_DPH_COMBINE,
-  mAX_DPH_SCALAR_ARGS,
-  aLL_DPH_PRIM_TYCONS,
-
-  -- * Builtins
-  Builtins(..),
-
-  -- * Projections
-  selTy, selsTy,
-  selReplicate,
-  selTags,
-  selElements,
-  selsLength,
-  sumTyCon,
-  prodTyCon,
-  prodDataCon,
-  replicatePD_PrimVar,
-  emptyPD_PrimVar,
-  packByTagPD_PrimVar,
-  combinePDVar,
-  combinePD_PrimVar,
-  scalarZip,
-  closureCtrFun
-) where
-
-import TysPrim
-import BasicTypes
-import Class
-import CoreSyn
-import TysWiredIn hiding (sumTyCon)
-import Type
-import TyCon
-import DataCon
-import NameEnv
-import Name
-import Outputable
-
-import Data.Array
-
-
--- Cardinality of the various families of types and functions exported by the DPH library.
-
-mAX_DPH_PROD :: Int
-mAX_DPH_PROD = 5
-
-mAX_DPH_SUM :: Int
-mAX_DPH_SUM = 2
-
-mAX_DPH_COMBINE :: Int
-mAX_DPH_COMBINE = 2
-
-mAX_DPH_SCALAR_ARGS :: Int
-mAX_DPH_SCALAR_ARGS = 8
-
--- Types from 'GHC.Prim' supported by DPH
---
-aLL_DPH_PRIM_TYCONS :: [Name]
-aLL_DPH_PRIM_TYCONS = map tyConName [intPrimTyCon, {- floatPrimTyCon, -} doublePrimTyCon]
-
-
--- |Holds the names of the types and functions from 'Data.Array.Parallel.Prim' that are used by the
--- vectoriser.
---
-data Builtins
-        = Builtins
-        { parrayTyCon          :: TyCon                     -- ^ PArray
-        , pdataTyCon           :: TyCon                     -- ^ PData
-        , pdatasTyCon          :: TyCon                     -- ^ PDatas
-        , prClass              :: Class                     -- ^ PR
-        , prTyCon              :: TyCon                     -- ^ PR
-        , preprTyCon           :: TyCon                     -- ^ PRepr
-        , paClass              :: Class                     -- ^ PA
-        , paTyCon              :: TyCon                     -- ^ PA
-        , paDataCon            :: DataCon                   -- ^ PA
-        , paPRSel              :: Var                       -- ^ PA
-        , replicatePDVar       :: Var                       -- ^ replicatePD
-        , replicatePD_PrimVars :: NameEnv Var               -- ^ replicatePD_Int# etc.
-        , emptyPDVar           :: Var                       -- ^ emptyPD
-        , emptyPD_PrimVars     :: NameEnv Var               -- ^ emptyPD_Int# etc.
-        , packByTagPDVar       :: Var                       -- ^ packByTagPD
-        , packByTagPD_PrimVars :: NameEnv Var               -- ^ packByTagPD_Int# etc.
-        , combinePDVars        :: Array Int Var             -- ^ combinePD
-        , combinePD_PrimVarss  :: Array Int (NameEnv Var)   -- ^ combine2PD_Int# etc.
-        , scalarClass          :: Class                     -- ^ Scalar
-        , scalarZips           :: Array Int Var             -- ^ map, zipWith, zipWith3
-        , voidTyCon            :: TyCon                     -- ^ Void
-        , voidVar              :: Var                       -- ^ void
-        , fromVoidVar          :: Var                       -- ^ fromVoid
-        , sumTyCons            :: Array Int TyCon           -- ^ Sum2 .. Sum3
-        , wrapTyCon            :: TyCon                     -- ^ Wrap
-        , pvoidVar             :: Var                       -- ^ pvoid
-        , pvoidsVar            :: Var                       -- ^ pvoids
-        , closureTyCon         :: TyCon                     -- ^ :->
-        , closureVar           :: Var                       -- ^ closure
-        , liftedClosureVar     :: Var                       -- ^ liftedClosure
-        , applyVar             :: Var                       -- ^ $:
-        , liftedApplyVar       :: Var                       -- ^ liftedApply
-        , closureCtrFuns       :: Array Int Var             -- ^ closure1 .. closure3
-        , selTys               :: Array Int Type            -- ^ Sel2
-        , selsTys              :: Array Int Type            -- ^ Sels2
-        , selsLengths          :: Array Int CoreExpr        -- ^ lengthSels2
-        , selReplicates        :: Array Int CoreExpr        -- ^ replicate2
-        , selTagss             :: Array Int CoreExpr        -- ^ tagsSel2
-        , selElementss         :: Array (Int, Int) CoreExpr -- ^ elementsSel2_0 .. elementsSel_2_1
-        , liftingContext       :: Var                       -- ^ lc
-        }
-
-
--- Projections ----------------------------------------------------------------
--- We use these wrappers instead of indexing the `Builtin` structure directly
--- because they give nicer panic messages if the indexed thing cannot be found.
-
-selTy :: Int -> Builtins -> Type
-selTy           = indexBuiltin "selTy" selTys
-
-selsTy :: Int -> Builtins -> Type
-selsTy          = indexBuiltin "selsTy" selsTys
-
-selsLength :: Int -> Builtins -> CoreExpr
-selsLength      = indexBuiltin "selLength" selsLengths
-
-selReplicate :: Int -> Builtins -> CoreExpr
-selReplicate    = indexBuiltin "selReplicate" selReplicates
-
-selTags :: Int -> Builtins -> CoreExpr
-selTags         = indexBuiltin "selTags" selTagss
-
-selElements :: Int -> Int -> Builtins -> CoreExpr
-selElements i j = indexBuiltin "selElements" selElementss (i, j)
-
-sumTyCon :: Int -> Builtins -> TyCon
-sumTyCon        = indexBuiltin "sumTyCon" sumTyCons
-
-prodTyCon :: Int -> Builtins -> TyCon
-prodTyCon n _
-  | n >= 2 && n <= mAX_DPH_PROD
-  = tupleTyCon Boxed n
-  | otherwise
-  = pprPanic "prodTyCon" (ppr n)
-
-prodDataCon :: Int -> Builtins -> DataCon
-prodDataCon n bi
- = case tyConDataCons (prodTyCon n bi) of
-    [con] -> con
-    _ -> pprPanic "prodDataCon" (ppr n)
-
-replicatePD_PrimVar :: TyCon -> Builtins -> Var
-replicatePD_PrimVar tc bi
-  = lookupEnvBuiltin "replicatePD_PrimVar" (replicatePD_PrimVars bi) (tyConName tc)
-
-emptyPD_PrimVar :: TyCon -> Builtins -> Var
-emptyPD_PrimVar tc bi
-  = lookupEnvBuiltin "emptyPD_PrimVar" (emptyPD_PrimVars bi) (tyConName tc)
-
-packByTagPD_PrimVar :: TyCon -> Builtins -> Var
-packByTagPD_PrimVar tc bi
-  = lookupEnvBuiltin "packByTagPD_PrimVar" (packByTagPD_PrimVars bi) (tyConName tc)
-
-combinePDVar :: Int -> Builtins -> Var
-combinePDVar = indexBuiltin "combinePDVar" combinePDVars
-
-combinePD_PrimVar :: Int -> TyCon -> Builtins -> Var
-combinePD_PrimVar i tc bi
-  = lookupEnvBuiltin "combinePD_PrimVar"
-      (indexBuiltin "combinePD_PrimVar" combinePD_PrimVarss i bi) (tyConName tc)
-
-scalarZip :: Int -> Builtins -> Var
-scalarZip = indexBuiltin "scalarZip" scalarZips
-
-closureCtrFun :: Int -> Builtins -> Var
-closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
-
--- | Get an element from one of the arrays of `Builtins`.
---   Panic if the indexed thing is not in the array.
-indexBuiltin :: (Ix i, Outputable i)
-             => String                   -- ^ Name of the selector we've used, for panic messages.
-             -> (Builtins -> Array i a)  -- ^ Field selector for the `Builtins`.
-             -> i                        -- ^ Index into the array.
-             -> Builtins
-             -> a
-indexBuiltin fn f i bi
-  | inRange (bounds xs) i = xs ! i
-  | otherwise
-  = pprSorry "Vectorise.Builtins.indexBuiltin"
-    (vcat [ text ""
-    , text "DPH builtin function '" <> text fn <> text "' of size '" <> ppr i <>
-      text "' is not yet implemented."
-    , text "This function does not appear in your source program, but it is needed"
-    , text "to compile your code in the backend. This is a known, current limitation"
-    , text "of DPH. If you want it to work, you should send mail to ghc-commits@haskell.org"
-    , text "and ask what you can do to help (it might involve some GHC hacking)."])
-  where xs = f bi
-
-
--- | Get an entry from one of a 'NameEnv' of `Builtins`. Panic if the named item is not in the array.
-lookupEnvBuiltin :: String                    -- Function name for error messages
-                 -> NameEnv a                 -- Name environment
-                 -> Name                      -- Index into the name environment
-                 -> a
-lookupEnvBuiltin fn env n
-  | Just r <- lookupNameEnv env n = r
-  | otherwise
-  = pprSorry "Vectorise.Builtins.lookupEnvBuiltin"
-    (vcat [ text ""
-    , text "DPH builtin function '" <> text fn <> text "_" <> ppr n <>
-      text "' is not yet implemented."
-    , text "This function does not appear in your source program, but it is needed"
-    , text "to compile your code in the backend. This is a known, current limitation"
-    , text "of DPH. If you want it to work, you should send mail to ghc-commits@haskell.org"
-    , text "and ask what you can do to help (it might involve some GHC hacking)."])
diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
deleted file mode 100644
index 73cedc4c53..0000000000
--- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs
+++ /dev/null
@@ -1,232 +0,0 @@
--- Set up the data structures provided by 'Vectorise.Builtins'.
-
-module Vectorise.Builtins.Initialise (
-  -- * Initialisation
-  initBuiltins, initBuiltinVars
-) where
-
-import Vectorise.Builtins.Base
-
-import BasicTypes
-import TysPrim
-import DsMonad
-import TysWiredIn
-import DataCon
-import TyCon
-import Class
-import CoreSyn
-import Type
-import NameEnv
-import Name
-import Id
-import FastString
-import Outputable
-
-import Control.Monad
-import Data.Array
-
-
--- |Create the initial map of builtin types and functions.
---
-initBuiltins :: DsM Builtins
-initBuiltins
- = do {   -- 'PArray: representation type for parallel arrays
-      ; parrayTyCon <- externalTyCon (fsLit "PArray")
-
-          -- 'PData': type family mapping array element types to array representation types
-          -- Not all backends use `PDatas`.
-      ; pdataTyCon  <- externalTyCon (fsLit "PData")
-      ; pdatasTyCon <- externalTyCon (fsLit "PDatas")
-
-          -- 'PR': class of basic array operators operating on 'PData' types
-      ; prClass     <- externalClass (fsLit "PR")
-      ; let prTyCon     = classTyCon prClass
-
-          -- 'PRepr': type family mapping element types to representation types
-      ; preprTyCon  <- externalTyCon (fsLit "PRepr")
-
-          -- 'PA': class of basic operations on arrays (parametrised by the element type)
-      ; paClass     <- externalClass (fsLit "PA")
-      ; let paTyCon     = classTyCon paClass
-            [paDataCon] = tyConDataCons paTyCon
-            paPRSel     = classSCSelId paClass 0
-
-          -- Functions on array representations
-      ; replicatePDVar <- externalVar (fsLit "replicatePD")
-      ; replicate_vars <- mapM externalVar (suffixed "replicatePA" aLL_DPH_PRIM_TYCONS)
-      ; emptyPDVar     <- externalVar (fsLit "emptyPD")
-      ; empty_vars     <- mapM externalVar (suffixed "emptyPA" aLL_DPH_PRIM_TYCONS)
-      ; packByTagPDVar <- externalVar (fsLit "packByTagPD")
-      ; packByTag_vars <- mapM externalVar (suffixed "packByTagPA" aLL_DPH_PRIM_TYCONS)
-      ; let combineNamesD = [("combine" ++ show i ++ "PD") | i <- [2..mAX_DPH_COMBINE]]
-      ; let combineNamesA = [("combine" ++ show i ++ "PA") | i <- [2..mAX_DPH_COMBINE]]
-      ; combines       <- mapM externalVar (map mkFastString combineNamesD)
-      ; combines_vars  <- mapM (mapM externalVar) $
-                            map (\name -> suffixed name aLL_DPH_PRIM_TYCONS) combineNamesA
-      ; let replicatePD_PrimVars = mkNameEnv (zip aLL_DPH_PRIM_TYCONS replicate_vars)
-            emptyPD_PrimVars     = mkNameEnv (zip aLL_DPH_PRIM_TYCONS empty_vars)
-            packByTagPD_PrimVars = mkNameEnv (zip aLL_DPH_PRIM_TYCONS packByTag_vars)
-            combinePDVars        = listArray (2, mAX_DPH_COMBINE) combines
-            combinePD_PrimVarss  = listArray (2, mAX_DPH_COMBINE)
-                                     [ mkNameEnv (zip aLL_DPH_PRIM_TYCONS vars)
-                                     | vars <- combines_vars]
-
-          -- 'Scalar': class moving between plain unboxed arrays and 'PData' representations
-      ; scalarClass <- externalClass (fsLit "Scalar")
-
-          -- N-ary maps ('zipWith' family)
-      ; scalar_map       <- externalVar (fsLit "scalar_map")
-      ; scalar_zip2      <- externalVar (fsLit "scalar_zipWith")
-      ; scalar_zips      <- mapM externalVar (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
-      ; let scalarZips   = listArray (1, mAX_DPH_SCALAR_ARGS)
-                                     (scalar_map : scalar_zip2 : scalar_zips)
-
-          -- Types and functions for generic type representations
-      ; voidTyCon        <- externalTyCon (fsLit "Void")
-      ; voidVar          <- externalVar   (fsLit "void")
-      ; fromVoidVar      <- externalVar   (fsLit "fromVoid")
-      ; sum_tcs          <- mapM externalTyCon (numbered "Sum" 2 mAX_DPH_SUM)
-      ; let sumTyCons    = listArray (2, mAX_DPH_SUM) sum_tcs
-      ; wrapTyCon        <- externalTyCon (fsLit "Wrap")
-      ; pvoidVar         <- externalVar   (fsLit "pvoid")
-      ; pvoidsVar        <- externalVar   (fsLit "pvoids#")
-
-          -- Types and functions for closure conversion
-      ; closureTyCon     <- externalTyCon (fsLit ":->")
-      ; closureVar       <- externalVar   (fsLit "closure")
-      ; liftedClosureVar <- externalVar   (fsLit "liftedClosure")
-      ; applyVar         <- externalVar   (fsLit "$:")
-      ; liftedApplyVar   <- externalVar   (fsLit "liftedApply")
-      ; closures         <- mapM externalVar (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
-      ; let closureCtrFuns = listArray (1, mAX_DPH_SCALAR_ARGS) closures
-
-          -- Types and functions for selectors
-      ; sel_tys          <- mapM externalType (numbered "Sel"  2 mAX_DPH_SUM)
-      ; sels_tys         <- mapM externalType (numbered "Sels" 2 mAX_DPH_SUM)
-      ; sels_length      <- mapM externalFun  (numbered_hash "lengthSels"   2 mAX_DPH_SUM)
-      ; sel_replicates   <- mapM externalFun  (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
-      ; sel_tags         <- mapM externalFun  (numbered "tagsSel" 2 mAX_DPH_SUM)
-      ; sel_elements     <- mapM mk_elements [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
-      ; let selTys        = listArray (2, mAX_DPH_SUM) sel_tys
-            selsTys       = listArray (2, mAX_DPH_SUM) sels_tys
-            selsLengths   = listArray (2, mAX_DPH_SUM) sels_length
-            selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
-            selTagss      = listArray (2, mAX_DPH_SUM) sel_tags
-            selElementss  = array     ((2, 0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_elements
-
-          -- Distinct local variable
-      ; liftingContext  <- liftM (\u -> mkSysLocalOrCoVar (fsLit "lc") u intPrimTy) newUnique
-
-      ; return $ Builtins
-               { parrayTyCon          = parrayTyCon
-               , pdataTyCon           = pdataTyCon
-               , pdatasTyCon          = pdatasTyCon
-               , preprTyCon           = preprTyCon
-               , prClass              = prClass
-               , prTyCon              = prTyCon
-               , paClass              = paClass
-               , paTyCon              = paTyCon
-               , paDataCon            = paDataCon
-               , paPRSel              = paPRSel
-               , replicatePDVar       = replicatePDVar
-               , replicatePD_PrimVars = replicatePD_PrimVars
-               , emptyPDVar           = emptyPDVar
-               , emptyPD_PrimVars     = emptyPD_PrimVars
-               , packByTagPDVar       = packByTagPDVar
-               , packByTagPD_PrimVars = packByTagPD_PrimVars
-               , combinePDVars        = combinePDVars
-               , combinePD_PrimVarss  = combinePD_PrimVarss
-               , scalarClass          = scalarClass
-               , scalarZips           = scalarZips
-               , voidTyCon            = voidTyCon
-               , voidVar              = voidVar
-               , fromVoidVar          = fromVoidVar
-               , sumTyCons            = sumTyCons
-               , wrapTyCon            = wrapTyCon
-               , pvoidVar             = pvoidVar
-               , pvoidsVar            = pvoidsVar
-               , closureTyCon         = closureTyCon
-               , closureVar           = closureVar
-               , liftedClosureVar     = liftedClosureVar
-               , applyVar             = applyVar
-               , liftedApplyVar       = liftedApplyVar
-               , closureCtrFuns       = closureCtrFuns
-               , selTys               = selTys
-               , selsTys              = selsTys
-               , selsLengths          = selsLengths
-               , selReplicates        = selReplicates
-               , selTagss             = selTagss
-               , selElementss         = selElementss
-               , liftingContext       = liftingContext
-               }
-      }
-  where
-    suffixed :: String -> [Name] -> [FastString]
-    suffixed pfx ns = [mkFastString (pfx ++ "_" ++ (occNameString . nameOccName) n) | n <- ns]
-
-    -- Make a list of numbered strings in some range, eg foo3, foo4, foo5
-    numbered :: String -> Int -> Int -> [FastString]
-    numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
-
-    numbered_hash :: String -> Int -> Int -> [FastString]
-    numbered_hash pfx m n = [mkFastString (pfx ++ show i ++ "#") | i <- [m..n]]
-
-    mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
-    mk_elements (i,j)
-      = do { v <- externalVar $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
-           ; return ((i, j), Var v)
-           }
-
--- |Get the mapping of names in the Prelude to names in the DPH library.
---
-initBuiltinVars :: Builtins -> DsM [(Var, Var)]
--- FIXME: must be replaced by VECTORISE pragmas!!!
-initBuiltinVars (Builtins { })
-  = do
-      cvars <- mapM externalVar cfs
-      return $ zip (map dataConWorkId cons) cvars
-  where
-    (cons, cfs) = unzip preludeDataCons
-
-    preludeDataCons :: [(DataCon, FastString)]
-    preludeDataCons
-      = [mk_tup n (mkFastString $ "tup" ++ show n) | n <- [2..5]]
-      where
-        mk_tup n name = (tupleDataCon Boxed n, name)
-
-
--- Auxiliary look up functions -----------------------------------------------
-
--- |Lookup a variable given its name and the module that contains it.
-externalVar :: FastString -> DsM Var
-externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
-
-
--- |Like `externalVar` but wrap the `Var` in a `CoreExpr`.
-externalFun :: FastString -> DsM CoreExpr
-externalFun fs = Var <$> externalVar fs
-
-
--- |Lookup a 'TyCon' in 'Data.Array.Parallel.Prim', given its name.
---  Panic if there isn't one.
-externalTyCon :: FastString -> DsM TyCon
-externalTyCon fs = dsLookupDPHRdrEnv (mkTcOccFS fs) >>= dsLookupTyCon
-
-
--- |Lookup some `Type` in 'Data.Array.Parallel.Prim', given its name.
-externalType :: FastString -> DsM Type
-externalType fs
- = do  tycon <- externalTyCon fs
-       return $ mkTyConApp tycon []
-
-
--- |Lookup a 'Class' in 'Data.Array.Parallel.Prim', given its name.
-externalClass :: FastString -> DsM Class
-externalClass fs
-  = do { tycon <- dsLookupDPHRdrEnv (mkClsOccFS fs) >>= dsLookupTyCon
-       ; case tyConClass_maybe tycon of
-           Nothing  -> pprPanic "Vectorise.Builtins.Initialise" $
-                         text "Data.Array.Parallel.Prim." <>
-                         ftext fs <+> text "is not a type class"
-           Just cls -> return cls
-       }
diff --git a/compiler/vectorise/Vectorise/Convert.hs b/compiler/vectorise/Vectorise/Convert.hs
deleted file mode 100644
index b3b70986e5..0000000000
--- a/compiler/vectorise/Vectorise/Convert.hs
+++ /dev/null
@@ -1,105 +0,0 @@
-module Vectorise.Convert
-  ( fromVect
-  )
-where
-
-import Vectorise.Monad
-import Vectorise.Builtins
-import Vectorise.Type.Type
-
-import CoreSyn
-import TyCon
-import Type
-import TyCoRep
-import NameSet
-import FastString
-import Outputable
-
-import Control.Applicative
-import Prelude -- avoid redundant import warning due to AMP
-
--- |Convert a vectorised expression such that it computes the non-vectorised equivalent of its
--- value.
---
--- For functions, we eta expand the function and convert the arguments and result:
-
--- For example
--- @
---    \(x :: Double) ->
---    \(y :: Double) ->
---    ($v_foo $: x) $: y
--- @
---
--- We use the type of the original binding to work out how many outer lambdas to add.
---
-fromVect :: Type        -- ^ The type of the original binding.
-         -> CoreExpr    -- ^ Expression giving the closure to use, eg @$v_foo@.
-         -> VM CoreExpr
-
--- Convert the type to the core view if it isn't already.
---
-fromVect ty expr
-  | Just ty' <- coreView ty
-  = fromVect ty' expr
-
--- For each function constructor in the original type we add an outer
--- lambda to bind the parameter variable, and an inner application of it.
-fromVect (FunTy arg_ty res_ty) expr
-  = do
-      arg     <- newLocalVar (fsLit "x") arg_ty
-      varg    <- toVect arg_ty (Var arg)
-      varg_ty <- vectType arg_ty
-      vres_ty <- vectType res_ty
-      apply   <- builtin applyVar
-      body    <- fromVect res_ty
-               $ Var apply `mkTyApps` [varg_ty, vres_ty] `mkApps` [expr, varg]
-      return $ Lam arg body
-
--- If the type isn't a function, then we can't current convert it unless the type is scalar (i.e.,
--- is identical to the non-vectorised version).
---
-fromVect ty expr
-  = identityConv ty >> return expr
-
--- Convert an expression such that it evaluates to the vectorised equivalent of the value of the
--- original expression.
---
--- WARNING: Currently only works for the scalar types, where the vectorised value coincides with the
---          original one.
---
-toVect :: Type -> CoreExpr -> VM CoreExpr
-toVect ty expr = identityConv ty >> return expr
-
--- |Check that the type is neutral under type vectorisation — i.e., all involved type constructor
--- are not altered by vectorisation as they contain no parallel arrays.
---
-identityConv :: Type -> VM ()
-identityConv ty
-  | Just ty' <- coreView ty
-  = identityConv ty'
-identityConv (TyConApp tycon tys)
-  = do { mapM_ identityConv tys
-       ; identityConvTyCon tycon
-       }
-identityConv (LitTy {})      = noV $ text "identityConv: not sure about literal types under vectorisation"
-identityConv (TyVarTy {})    = noV $ text "identityConv: type variable changes under vectorisation"
-identityConv (AppTy {})      = noV $ text "identityConv: type appl. changes under vectorisation"
-identityConv (FunTy {})      = noV $ text "identityConv: function type changes under vectorisation"
-identityConv (ForAllTy {})   = noV $ text "identityConv: quantified type changes under vectorisation"
-identityConv (CastTy {})     = noV $ text "identityConv: not sure about casted types under vectorisation"
-identityConv (CoercionTy {}) = noV $ text "identityConv: not sure about coercions under vectorisation"
-
--- |Check that this type constructor is not changed by vectorisation — i.e., it does not embed any
--- parallel arrays.
---
-identityConvTyCon :: TyCon -> VM ()
-identityConvTyCon tc
-  = do
-    { isParallel <- (tyConName tc `elemNameSet`) <$> globalParallelTyCons
-    ; parray     <- builtin parrayTyCon
-    ; if isParallel && not (tc == parray)
-      then noV idErr
-      else return ()
-    }
-  where
-    idErr = text "identityConvTyCon: type constructor contains parallel arrays" <+> ppr tc
diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs
deleted file mode 100644
index 8f1a0a0662..0000000000
--- a/compiler/vectorise/Vectorise/Env.hs
+++ /dev/null
@@ -1,238 +0,0 @@
-module Vectorise.Env (
-  Scope(..),
-
-  -- * Local Environments
-  LocalEnv(..),
-  emptyLocalEnv,
-
-  -- * Global Environments
-  GlobalEnv(..),
-  initGlobalEnv,
-  extendImportedVarsEnv,
-  extendFamEnv,
-  setPAFunsEnv,
-  setPRFunsEnv,
-  modVectInfo
-) where
-
-import HscTypes
-import InstEnv
-import FamInstEnv
-import CoreSyn
-import Type
-import Class
-import TyCon
-import DataCon
-import VarEnv
-import VarSet
-import Var
-import NameSet
-import Name
-import NameEnv
-import FastString
-import UniqDFM
-import UniqSet
-
-
-import Data.Maybe
-
-
--- |Indicates what scope something (a variable) is in.
---
-data Scope a b
-        = Global a
-        | Local  b
-
-
--- LocalEnv -------------------------------------------------------------------
-
--- |The local environment.
---
-data LocalEnv
-        = LocalEnv
-        { local_vars      :: VarEnv (Var, Var)
-          -- ^Mapping from local variables to their vectorised and lifted versions.
-
-        , local_tyvars     :: [TyVar]
-          -- ^In-scope type variables.
-
-        , local_tyvar_pa   :: VarEnv CoreExpr
-          -- ^Mapping from tyvars to their PA dictionaries.
-
-        , local_bind_name  :: FastString
-          -- ^Local binding name. This is only used to generate better names for hoisted
-          -- expressions.
-        }
-
--- |Create an empty local environment.
---
-emptyLocalEnv :: LocalEnv
-emptyLocalEnv = LocalEnv
-                { local_vars      = emptyVarEnv
-                , local_tyvars    = []
-                , local_tyvar_pa  = emptyVarEnv
-                , local_bind_name = fsLit "fn"
-                }
-
-
--- GlobalEnv ------------------------------------------------------------------
-
--- |The global environment: entities that exist at top-level.
---
-data GlobalEnv
-        = GlobalEnv
-        { global_vect_avoid           :: Bool
-          -- ^'True' implies to avoid vectorisation as far as possible.
-
-        , global_vars                 :: VarEnv Var
-          -- ^Mapping from global variables to their vectorised versions — aka the /vectorisation
-          -- map/.
-
-        , global_parallel_vars        :: DVarSet
-          -- ^The domain of 'global_vars'.
-          --
-          -- This information is not redundant as it is impossible to extract the domain from a
-          -- 'VarEnv' (which is keyed on uniques alone). Moreover, we have mapped variables that
-          -- do not involve parallelism — e.g., the workers of vectorised, but scalar data types.
-          -- In addition, workers of parallel data types that we could not vectorise also need to
-          -- be tracked.
-
-        , global_vect_decls           :: VarEnv (Maybe (Type, CoreExpr))
-          -- ^Mapping from global variables that have a vectorisation declaration to the right-hand
-          -- side of that declaration and its type and mapping variables that have NOVECTORISE
-          -- declarations to 'Nothing'.
-
-        , global_tycons               :: NameEnv TyCon
-          -- ^Mapping from TyCons to their vectorised versions. The vectorised version will be
-          -- identical to the original version if it is not changed by vectorisation. In any case,
-          -- if a tycon appears in the domain of this mapping, it was successfully vectorised.
-
-        , global_parallel_tycons      :: NameSet
-          -- ^Type constructors whose definition directly or indirectly includes a parallel type,
-          -- such as '[::]'.
-          --
-          -- NB: This information is not redundant as some types have got a mapping in
-          --     'global_tycons' (to a type other than themselves) and are still not parallel. An
-          --     example is '(->)'. Moreover, some types have *not* got a mapping in 'global_tycons'
-          --     (because they couldn't be vectorised), but still contain parallel types.
-
-        , global_datacons             :: NameEnv DataCon
-          -- ^Mapping from DataCons to their vectorised versions.
-
-        , global_pa_funs              :: NameEnv Var
-          -- ^Mapping from TyCons to their PA dfuns.
-
-        , global_pr_funs              :: NameEnv Var
-          -- ^Mapping from TyCons to their PR dfuns.
-
-        , global_inst_env             :: InstEnvs
-          -- ^External package inst-env & home-package inst-env for class instances.
-
-        , global_fam_inst_env         :: FamInstEnvs
-          -- ^External package inst-env & home-package inst-env for family instances.
-
-        , global_bindings             :: [(Var, CoreExpr)]
-          -- ^Hoisted bindings — temporary storage for toplevel bindings during code gen.
-        }
-
--- |Create an initial global environment.
---
--- We add scalar variables and type constructors identified by vectorisation pragmas already here
--- to the global table, so that we can query scalarness during vectorisation, and especially, when
--- vectorising the scalar entities' definitions themselves.
---
-initGlobalEnv :: Bool
-              -> VectInfo
-              -> [CoreVect]
-              -> InstEnvs
-              -> FamInstEnvs
-              -> GlobalEnv
-initGlobalEnv vectAvoid info vectDecls instEnvs famInstEnvs
-  = GlobalEnv
-  { global_vect_avoid           = vectAvoid
-  , global_vars                 = mapVarEnv snd $ udfmToUfm $ vectInfoVar info
-  , global_vect_decls           = mkVarEnv vects
-  , global_parallel_vars        = vectInfoParallelVars info
-  , global_parallel_tycons      = vectInfoParallelTyCons info
-  , global_tycons               = mapNameEnv snd $ vectInfoTyCon info
-  , global_datacons             = mapNameEnv snd $ vectInfoDataCon info
-  , global_pa_funs              = emptyNameEnv
-  , global_pr_funs              = emptyNameEnv
-  , global_inst_env             = instEnvs
-  , global_fam_inst_env         = famInstEnvs
-  , global_bindings             = []
-  }
-  where
-    vects         = [(var, Just (ty, exp)) | Vect   var   exp@(Var rhs_var) <- vectDecls
-                                           , let ty = varType rhs_var] ++
-                                        -- FIXME: we currently only allow RHSes consisting of a
-                                        --   single variable to be able to obtain the type without
-                                        --   inference — see also 'TcBinds.tcVect'
-                    [(var, Nothing)        | NoVect var                     <- vectDecls]
-
-
--- Operators on Global Environments -------------------------------------------
-
--- |Extend the list of global variables in an environment.
---
-extendImportedVarsEnv :: [(Var, Var)] -> GlobalEnv -> GlobalEnv
-extendImportedVarsEnv ps genv
-  = genv { global_vars = extendVarEnvList (global_vars genv) ps }
-
--- |Extend the list of type family instances.
---
-extendFamEnv :: [FamInst] -> GlobalEnv -> GlobalEnv
-extendFamEnv new genv
-  = genv { global_fam_inst_env = (g_fam_inst, extendFamInstEnvList l_fam_inst new) }
-  where (g_fam_inst, l_fam_inst) = global_fam_inst_env genv
-
--- |Set the list of PA functions in an environment.
---
-setPAFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
-setPAFunsEnv ps genv = genv { global_pa_funs = mkNameEnv ps }
-
--- |Set the list of PR functions in an environment.
---
-setPRFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
-setPRFunsEnv ps genv = genv { global_pr_funs = mkNameEnv ps }
-
--- |Compute vectorisation information that goes into 'ModGuts' (and is stored in interface files).
--- The incoming 'vectInfo' is that from the 'HscEnv' and 'EPS'.  The outgoing one contains only the
--- declarations for the currently compiled module; this includes variables, type constructors, and
--- data constructors referenced in VECTORISE pragmas, even if they are defined in an imported
--- module.
---
--- The variables explicitly include class selectors and dfuns.
---
-modVectInfo :: GlobalEnv -> [Id] -> [TyCon] -> [CoreVect]-> VectInfo -> VectInfo
-modVectInfo env mg_ids mg_tyCons vectDecls info
-  = info
-    { vectInfoVar            = mk_denv ids     (global_vars     env)
-    , vectInfoTyCon          = mk_env tyCons   (global_tycons   env)
-    , vectInfoDataCon        = mk_env dataCons (global_datacons env)
-    , vectInfoParallelVars   = (global_parallel_vars   env `minusDVarSet`  vectInfoParallelVars   info)
-                               `udfmIntersectUFM` (getUniqSet $ mkVarSet ids)
-    , vectInfoParallelTyCons =  global_parallel_tycons env `minusNameSet` vectInfoParallelTyCons info
-    }
-  where
-    vectIds         = [id    | Vect     id    _   <- vectDecls] ++
-                      [id    | VectInst id        <- vectDecls]
-    vectTypeTyCons  = [tycon | VectType _ tycon _ <- vectDecls] ++
-                      [tycon | VectClass tycon    <- vectDecls]
-    vectDataCons    = concatMap tyConDataCons vectTypeTyCons
-    ids             = mg_ids ++ vectIds ++ dataConIds ++ selIds
-    tyCons          = mg_tyCons ++ vectTypeTyCons
-    dataCons        = concatMap tyConDataCons mg_tyCons ++ vectDataCons
-    dataConIds      = map dataConWorkId dataCons
-    selIds          = concat [ classAllSelIds cls
-                             | tycon <- tyCons
-                             , cls <- maybeToList . tyConClass_maybe $ tycon]
-
-    -- Produce an entry for every declaration that is mentioned in the domain of the 'inspectedEnv'
-    mk_env decls inspectedEnv = mkNameEnv $ mk_assoc_env decls inspectedEnv
-    mk_denv decls inspectedEnv = listToUDFM $ mk_assoc_env decls inspectedEnv
-    mk_assoc_env decls inspectedEnv
-      = [(name, (decl, to))
-        | decl     <- decls
-        , let name = getName decl
-        , Just to  <- [lookupNameEnv inspectedEnv name]]
diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
deleted file mode 100644
index f4c1361d74..0000000000
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ /dev/null
@@ -1,1257 +0,0 @@
-{-# LANGUAGE CPP, TupleSections #-}
-
--- |Vectorisation of expressions.
-
-module Vectorise.Exp
-  (   -- * Vectorise right-hand sides of toplevel bindings
-    vectTopExpr
-  , vectTopExprs
-  , vectScalarFun
-  , vectScalarDFun
-  )
-where
-
-#include "HsVersions.h"
-
-import Vectorise.Type.Type
-import Vectorise.Var
-import Vectorise.Convert
-import Vectorise.Vect
-import Vectorise.Env
-import Vectorise.Monad
-import Vectorise.Builtins
-import Vectorise.Utils
-
-import CoreUtils
-import MkCore
-import CoreSyn
-import CoreFVs
-import Class
-import DataCon
-import TyCon
-import TcType
-import Type
-import TyCoRep
-import Var
-import VarEnv
-import VarSet
-import NameSet
-import Id
-import BasicTypes( isStrongLoopBreaker )
-import Literal
-import TysPrim
-import Outputable
-import FastString
-import DynFlags
-import Util
-
-import Control.Monad
-import Data.Maybe
-import Data.List
-
-
--- Main entry point to vectorise expressions -----------------------------------
-
--- |Vectorise a polymorphic expression that forms a *non-recursive* binding.
---
--- Return 'Nothing' if the expression is scalar; otherwise, the first component of the result
--- (which is of type 'Bool') indicates whether the expression is parallel (i.e., whether it is
--- tagged as 'VIParr').
---
--- We have got the non-recursive case as a special case as it doesn't require to compute
--- vectorisation information twice.
---
-vectTopExpr :: Var -> CoreExpr -> VM (Maybe (Bool, Inline, CoreExpr))
-vectTopExpr var expr
-  = do
-    { exprVI <- encapsulateScalars <=< vectAvoidInfo emptyVarSet . freeVars $ expr
-    ; if isVIEncaps exprVI
-      then
-        return Nothing
-      else do
-      { vExpr <- closedV $
-                   inBind var $
-                     vectAnnPolyExpr False exprVI
-      ; inline <- computeInline exprVI
-      ; return $ Just (isVIParr exprVI, inline, vectorised vExpr)
-      }
-    }
-
--- Compute the inlining hint for the right-hand side of a top-level binding.
---
-computeInline :: CoreExprWithVectInfo -> VM Inline
-computeInline ((_, VIDict), _)     = return $ DontInline
-computeInline (_, AnnTick _ expr)  = computeInline expr
-computeInline expr@(_, AnnLam _ _) = Inline <$> polyArity tvs
-  where
-    (tvs, _) = collectAnnTypeBinders expr
-computeInline _expr                = return $ DontInline
-
--- |Vectorise a recursive group of top-level polymorphic expressions.
---
--- Return 'Nothing' if the expression group is scalar; otherwise, the first component of the result
--- (which is of type 'Bool') indicates whether the expressions are parallel (i.e., whether they are
--- tagged as 'VIParr').
---
-vectTopExprs :: [(Var, CoreExpr)] -> VM (Maybe (Bool, [(Inline, CoreExpr)]))
-vectTopExprs binds
-  = do
-    { exprVIs <- mapM (vectAvoidAndEncapsulate emptyVarSet) exprs
-    ; if all isVIEncaps exprVIs
-        -- if all bindings are scalar => don't vectorise this group of bindings
-      then return Nothing
-      else do
-      {   -- non-scalar bindings need to be vectorised
-      ; let areVIParr = any isVIParr exprVIs
-      ; revised_exprVIs <- if not areVIParr
-                             -- if no binding is parallel => 'exprVIs' is ready for vectorisation
-                           then return exprVIs
-                             -- if any binding is parallel => recompute the vectorisation info
-                           else mapM (vectAvoidAndEncapsulate (mkVarSet vars)) exprs
-
-      ; vExprs <- zipWithM vect vars revised_exprVIs
-      ; return $ Just (areVIParr, vExprs)
-      }
-    }
-  where
-    (vars, exprs) = unzip binds
-
-    vectAvoidAndEncapsulate pvs = encapsulateScalars <=< vectAvoidInfo pvs . freeVars
-
-    vect var exprVI
-      = do
-        { vExpr  <- closedV $
-                      inBind var $
-                        vectAnnPolyExpr (isStrongLoopBreaker $ idOccInfo var) exprVI
-        ; inline <- computeInline exprVI
-        ; return (inline, vectorised vExpr)
-        }
-
--- |Vectorise a polymorphic expression annotated with vectorisation information.
---
--- The special case of dictionary functions is currently handled separately. (Would be neater to
--- integrate them, though!)
---
-vectAnnPolyExpr :: Bool -> CoreExprWithVectInfo -> VM VExpr
-vectAnnPolyExpr loop_breaker (_, AnnTick tickish expr)
-    -- traverse through ticks
-  = vTick tickish <$> vectAnnPolyExpr loop_breaker expr
-vectAnnPolyExpr loop_breaker expr
-  | isVIDict expr
-    -- special case the right-hand side of dictionary functions
-  = (, undefined) <$> vectDictExpr (deAnnotate expr)
-  | otherwise
-    -- collect and vectorise type abstractions; then, descent into the body
-  = polyAbstract tvs $ \args ->
-      mapVect (mkLams $ tvs ++ args) <$> vectFnExpr False loop_breaker mono
-  where
-    (tvs, mono) = collectAnnTypeBinders expr
-
--- Encapsulate every purely sequential subexpression of a (potentially) parallel expression into a
--- lambda abstraction over all its free variables followed by the corresponding application to those
--- variables.  We can, then, avoid the vectorisation of the ensapsulated subexpressions.
---
--- Preconditions:
---
--- * All free variables and the result type must be /simple/ types.
--- * The expression is sufficiently complex (to warrant special treatment).  For now, that is
---   every expression that is not constant and contains at least one operation.
---
---
--- The user has an option to choose between aggressive and minimal vectorisation avoidance. With
--- minimal vectorisation avoidance, we only encapsulate individual scalar operations. With
--- aggressive vectorisation avoidance, we encapsulate subexpression that are as big as possible.
---
-encapsulateScalars :: CoreExprWithVectInfo -> VM CoreExprWithVectInfo
-encapsulateScalars ce@(_, AnnType _ty)
-  = return ce
-encapsulateScalars ce@((_, VISimple), AnnVar _v)
-      -- NB: diverts from the paper: encapsulate scalar variables (including functions)
-  = liftSimpleAndCase ce
-encapsulateScalars ce@(_, AnnVar _v)
-  = return ce
-encapsulateScalars ce@(_, AnnLit _)
-  = return ce
-encapsulateScalars ((fvs, vi), AnnTick tck expr)
-  = do
-    { encExpr <- encapsulateScalars expr
-    ; return ((fvs, vi), AnnTick tck encExpr)
-    }
-encapsulateScalars ce@((fvs, vi), AnnLam bndr expr)
-  = do
-    { vectAvoid <- isVectAvoidanceAggressive
-    ; varsS     <- allScalarVarTypeSet fvs
-        -- NB: diverts from the paper: we need to check the scalarness of bound variables as well,
-        --     as 'vectScalarFun' will handle them just the same as those introduced for the 'fvs'
-        --     by encapsulation.
-    ; bndrsS    <- allScalarVarType bndrs
-    ; case (vi, vectAvoid && varsS && bndrsS) of
-        (VISimple, True) -> liftSimpleAndCase ce
-        _                -> do
-                            { encExpr <- encapsulateScalars expr
-                            ; return ((fvs, vi), AnnLam bndr encExpr)
-                            }
-    }
-  where
-    (bndrs, _) = collectAnnBndrs ce
-encapsulateScalars ce@((fvs, vi), AnnApp ce1 ce2)
-  = do
-    { vectAvoid <- isVectAvoidanceAggressive
-    ; varsS     <- allScalarVarTypeSet fvs
-    ; case (vi, (vectAvoid || isSimpleApplication ce) && varsS) of
-        (VISimple, True) -> liftSimpleAndCase ce
-        _                -> do
-                            { encCe1 <- encapsulateScalars ce1
-                            ; encCe2 <- encapsulateScalars ce2
-                            ; return ((fvs, vi), AnnApp encCe1 encCe2)
-                            }
-    }
-  where
-    isSimpleApplication :: CoreExprWithVectInfo -> Bool
-    isSimpleApplication (_, AnnTick _ ce)                 = isSimpleApplication ce
-    isSimpleApplication (_, AnnCast ce _)                 = isSimpleApplication ce
-    isSimpleApplication ce                  | isSimple ce = True
-    isSimpleApplication (_, AnnApp ce1 ce2)               = isSimple ce1 && isSimpleApplication ce2
-    isSimpleApplication _                                 = False
-    --
-    isSimple :: CoreExprWithVectInfo -> Bool
-    isSimple (_, AnnType {})   = True
-    isSimple (_, AnnVar  {})   = True
-    isSimple (_, AnnLit  {})   = True
-    isSimple (_, AnnTick _ ce) = isSimple ce
-    isSimple (_, AnnCast ce _) = isSimple ce
-    isSimple _                 = False
-encapsulateScalars ce@((fvs, vi), AnnCase scrut bndr ty alts)
-  = do
-    { vectAvoid <- isVectAvoidanceAggressive
-    ; varsS     <- allScalarVarTypeSet fvs
-    ; case (vi, vectAvoid && varsS) of
-        (VISimple, True) -> liftSimpleAndCase ce
-        _                -> do
-                            { encScrut <- encapsulateScalars scrut
-                            ; encAlts  <- mapM encAlt alts
-                            ; return ((fvs, vi), AnnCase encScrut bndr ty encAlts)
-                            }
-    }
-  where
-    encAlt (con, bndrs, expr) = (con, bndrs,) <$> encapsulateScalars expr
-encapsulateScalars ce@((fvs, vi), AnnLet (AnnNonRec bndr expr1) expr2)
-  = do
-    { vectAvoid <- isVectAvoidanceAggressive
-    ; varsS     <- allScalarVarTypeSet fvs
-    ; case (vi, vectAvoid && varsS) of
-        (VISimple, True) -> liftSimpleAndCase ce
-        _                -> do
-                            { encExpr1 <- encapsulateScalars expr1
-                            ; encExpr2 <- encapsulateScalars expr2
-                            ; return ((fvs, vi), AnnLet (AnnNonRec bndr encExpr1) encExpr2)
-                            }
-    }
-encapsulateScalars ce@((fvs, vi), AnnLet (AnnRec binds) expr)
-  = do
-    { vectAvoid <- isVectAvoidanceAggressive
-    ; varsS     <- allScalarVarTypeSet fvs
-    ; case (vi, vectAvoid && varsS) of
-        (VISimple, True) -> liftSimpleAndCase ce
-        _                -> do
-                            { encBinds <- mapM encBind binds
-                            ; encExpr  <- encapsulateScalars expr
-                            ; return ((fvs, vi), AnnLet (AnnRec encBinds) encExpr)
-                            }
-    }
- where
-   encBind (bndr, expr) = (bndr,) <$> encapsulateScalars expr
-encapsulateScalars ((fvs, vi), AnnCast expr coercion)
-  = do
-    { encExpr <- encapsulateScalars expr
-    ; return ((fvs, vi), AnnCast encExpr coercion)
-    }
-encapsulateScalars _
-  = panic "Vectorise.Exp.encapsulateScalars: unknown constructor"
-
--- Lambda-lift the given simple expression and apply it to the abstracted free variables.
---
--- If the expression is a case expression scrutinising anything, but a scalar type, then lift
--- each alternative individually.
---
-liftSimpleAndCase :: CoreExprWithVectInfo -> VM CoreExprWithVectInfo
-liftSimpleAndCase aexpr@((fvs, _vi), AnnCase expr bndr t alts)
-  = do
-    { vi <- vectAvoidInfoTypeOf expr
-    ; if (vi == VISimple)
-      then
-        liftSimple aexpr  -- if the scrutinee is scalar, we need no special treatment
-      else do
-      { alts' <- mapM (\(ac, bndrs, aexpr) -> (ac, bndrs,) <$> liftSimpleAndCase aexpr) alts
-      ; return ((fvs, vi), AnnCase expr bndr t alts')
-      }
-    }
-liftSimpleAndCase aexpr = liftSimple aexpr
-
-liftSimple :: CoreExprWithVectInfo -> VM CoreExprWithVectInfo
-liftSimple ((fvs, vi), AnnVar v)
-  | v `elemDVarSet` fvs               -- special case to avoid producing: (\v -> v) v
-  && not (isToplevel v)               --   NB: if 'v' not free or is toplevel, we must get the 'VIEncaps'
-  = return $ ((fvs, vi), AnnVar v)
-liftSimple aexpr@((fvs_orig, VISimple), expr)
-  = do
-    { let liftedExpr = mkAnnApps (mkAnnLams (reverse vars) fvs expr) vars
-
-    ; traceVt "encapsulate:" $ ppr (deAnnotate aexpr) $$ text "==>" $$ ppr (deAnnotate liftedExpr)
-
-    ; return $ liftedExpr
-    }
-  where
-    vars = dVarSetElems fvs
-    fvs  = filterDVarSet (not . isToplevel) fvs_orig -- only include 'Id's that are not toplevel
-
-    mkAnnLams :: [Var] -> DVarSet -> AnnExpr' Var (DVarSet, VectAvoidInfo) -> CoreExprWithVectInfo
-    mkAnnLams []     fvs expr = ASSERT(isEmptyDVarSet fvs)
-                                ((emptyDVarSet, VIEncaps), expr)
-    mkAnnLams (v:vs) fvs expr = mkAnnLams vs (fvs `delDVarSet` v) (AnnLam v ((fvs, VIEncaps), expr))
-
-    mkAnnApps :: CoreExprWithVectInfo -> [Var] -> CoreExprWithVectInfo
-    mkAnnApps aexpr []     = aexpr
-    mkAnnApps aexpr (v:vs) = mkAnnApps (mkAnnApp aexpr v) vs
-
-    mkAnnApp :: CoreExprWithVectInfo -> Var -> CoreExprWithVectInfo
-    mkAnnApp aexpr@((fvs, _vi), _expr) v
-      = ((fvs `extendDVarSet` v, VISimple), AnnApp aexpr ((unitDVarSet v, VISimple), AnnVar v))
-liftSimple aexpr
-  = pprPanic "Vectorise.Exp.liftSimple: not simple" $ ppr (deAnnotate aexpr)
-
-isToplevel :: Var -> Bool
-isToplevel v | isId v    = case realIdUnfolding v of
-                             NoUnfolding                     -> False
-                             BootUnfolding                   -> False
-                             OtherCon      {}                -> True
-                             DFunUnfolding {}                -> True
-                             CoreUnfolding {uf_is_top = top} -> top
-             | otherwise = False
-
--- |Vectorise an expression.
---
-vectExpr :: CoreExprWithVectInfo -> VM VExpr
-
-vectExpr aexpr
-    -- encapsulated expression of functional type => try to vectorise as a scalar subcomputation
-  | (isFunTy . annExprType $ aexpr) && isVIEncaps aexpr
-  = vectFnExpr True False aexpr
-    -- encapsulated constant => vectorise as a scalar constant
-  | isVIEncaps aexpr
-  = traceVt "vectExpr (encapsulated constant):" (ppr . deAnnotate $ aexpr) >>
-    vectConst (deAnnotate aexpr)
-
-vectExpr (_, AnnVar v)
-  = vectVar v
-
-vectExpr (_, AnnLit lit)
-  = vectConst $ Lit lit
-
-vectExpr aexpr@(_, AnnLam _ _)
-  = traceVt "vectExpr [AnnLam]:" (ppr . deAnnotate $ aexpr) >>
-    vectFnExpr True False aexpr
-
-  -- SPECIAL CASE: Vectorise/lift 'patError @ ty err' by only vectorising/lifting the type 'ty';
-  --   its only purpose is to abort the program, but we need to adjust the type to keep CoreLint
-  --   happy.
--- FIXME: can't be do this with a VECTORISE pragma on 'pAT_ERROR_ID' now?
-vectExpr (_, AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType ty)) err)
-  | v == pAT_ERROR_ID
-  = do
-    { (vty, lty) <- vectAndLiftType ty
-    ; return (mkCoreApps (Var v) [Type (getRuntimeRep "vectExpr" vty), Type vty, err'], mkCoreApps (Var v) [Type lty, err'])
-    }
-  where
-    err' = deAnnotate err
-
-  -- type application (handle multiple consecutive type applications simultaneously to ensure the
-  -- PA dictionaries are put at the right places)
-vectExpr e@(_, AnnApp _ arg)
-  | isAnnTypeArg arg
-  = vectPolyApp e
-
-  -- Lifted literal
-vectExpr (_, AnnApp (_, AnnVar v) (_, AnnLit lit))
-  | Just _con <- isDataConId_maybe v
-  = do
-    { let vexpr = App (Var v) (Lit lit)
-    ; lexpr <- liftPD vexpr
-    ; return (vexpr, lexpr)
-    }
-
-  -- value application (dictionary or user value)
-vectExpr e@(_, AnnApp fn arg)
-  | isPredTy arg_ty   -- dictionary application (whose result is not a dictionary)
-  = vectPolyApp e
-  | otherwise         -- user value
-  = do
-    {   -- vectorise the types
-    ; varg_ty <- vectType arg_ty
-    ; vres_ty <- vectType res_ty
-
-        -- vectorise the function and argument expression
-    ; vfn  <- vectExpr fn
-    ; varg <- vectExpr arg
-
-        -- the vectorised function is a closure; apply it to the vectorised argument
-    ; mkClosureApp varg_ty vres_ty vfn varg
-    }
-  where
-    (arg_ty, res_ty) = splitFunTy . exprType $ deAnnotate fn
-
-vectExpr (_, AnnCase scrut bndr ty alts)
-  | Just (tycon, ty_args) <- splitTyConApp_maybe scrut_ty
-  , isAlgTyCon tycon
-  = vectAlgCase tycon ty_args scrut bndr ty alts
-  | otherwise
-  = do
-    { dflags <- getDynFlags
-    ; cantVectorise dflags "Can't vectorise expression (no algebraic type constructor)" $
-        ppr scrut_ty
-    }
-  where
-    scrut_ty = exprType (deAnnotate scrut)
-
-vectExpr (_, AnnLet (AnnNonRec bndr rhs) body)
-  = do
-    { traceVt "let binding (non-recursive)" Outputable.empty
-    ; vrhs <- localV $
-                inBind bndr $
-                  vectAnnPolyExpr False rhs
-    ; traceVt "let body (non-recursive)" Outputable.empty
-    ; (vbndr, vbody) <- vectBndrIn bndr (vectExpr body)
-    ; return $ vLet (vNonRec vbndr vrhs) vbody
-    }
-
-vectExpr (_, AnnLet (AnnRec bs) body)
-  = do
-    { (vbndrs, (vrhss, vbody)) <- vectBndrsIn bndrs $ do
-                                  { traceVt "let bindings (recursive)" Outputable.empty
-                                  ; vrhss <- zipWithM vect_rhs bndrs rhss
-                                  ; traceVt "let body (recursive)" Outputable.empty
-                                  ; vbody <- vectExpr body
-                                  ; return (vrhss, vbody)
-                                  }
-    ; return $ vLet (vRec vbndrs vrhss) vbody
-    }
-  where
-    (bndrs, rhss) = unzip bs
-
-    vect_rhs bndr rhs = localV $
-                          inBind bndr $
-                            vectAnnPolyExpr (isStrongLoopBreaker $ idOccInfo bndr) rhs
-
-vectExpr (_, AnnTick tickish expr)
-  = vTick tickish <$> vectExpr expr
-
-vectExpr (_, AnnType ty)
-  = vType <$> vectType ty
-
-vectExpr e
-  = do
-    { dflags <- getDynFlags
-    ; cantVectorise dflags "Can't vectorise expression (vectExpr)" $ ppr (deAnnotate e)
-    }
-
--- |Vectorise an expression that *may* have an outer lambda abstraction. If the expression is marked
--- as encapsulated ('VIEncaps'), vectorise it as a scalar computation (using a generalised scalar
--- zip).
---
--- We do not handle type variables at this point, as they will already have been stripped off by
--- 'vectPolyExpr'. We also only have to worry about one set of dictionary arguments as we (1) only
--- deal with Haskell 2011 and (2) class selectors are vectorised elsewhere.
---
-vectFnExpr :: Bool                  -- ^If we process the RHS of a binding, whether that binding
-                                    --  should be inlined
-           -> Bool                  -- ^Whether the binding is a loop breaker
-           -> CoreExprWithVectInfo  -- ^Expression to vectorise; must have an outer `AnnLam`
-           -> VM VExpr
-vectFnExpr inline loop_breaker aexpr@(_ann, AnnLam bndr body)
-    -- predicate abstraction: leave as a normal abstraction, but vectorise the predicate type
-  | isId bndr
-    && isPredTy (idType bndr)
-  = do
-    { vBndr <- vectBndr bndr
-    ; vbody <- vectFnExpr inline loop_breaker body
-    ; return $ mapVect (mkLams [vectorised vBndr]) vbody
-    }
-    -- encapsulated non-predicate abstraction: vectorise as a scalar computation
-  | isId bndr && isVIEncaps aexpr
-  = vectScalarFun . deAnnotate $ aexpr
-    -- non-predicate abstraction: vectorise as a non-scalar computation
-  | isId bndr
-  = vectLam inline loop_breaker aexpr
-  | otherwise
-  = do
-    { dflags <- getDynFlags
-    ; cantVectorise dflags "Vectorise.Exp.vectFnExpr: Unexpected type lambda" $
-        ppr (deAnnotate aexpr)
-    }
-vectFnExpr _ _ aexpr
-    -- encapsulated function: vectorise as a scalar computation
-  | (isFunTy . annExprType $ aexpr) && isVIEncaps aexpr
-  = vectScalarFun . deAnnotate $ aexpr
-  | otherwise
-    -- not an abstraction: vectorise as a non-scalar vanilla expression
-    -- NB: we can get here due to the recursion in the first case above and from 'vectAnnPolyExpr'
-  = vectExpr aexpr
-
--- |Vectorise type and dictionary applications.
---
--- These are always headed by a variable (as we don't support higher-rank polymorphism), but may
--- involve two sets of type variables and dictionaries. Consider,
---
--- > class C a where
--- >   m :: D b => b -> a
---
--- The type of 'm' is 'm :: forall a. C a => forall b. D b => b -> a'.
---
-vectPolyApp :: CoreExprWithVectInfo -> VM VExpr
-vectPolyApp e0
-  = case e4 of
-      (_, AnnVar var)
-        -> do {   -- get the vectorised form of the variable
-              ; vVar <- lookupVar var
-              ; traceVt "vectPolyApp of" (ppr var)
-
-                  -- vectorise type and dictionary arguments
-              ; vDictsOuter <- mapM vectDictExpr (map deAnnotate dictsOuter)
-              ; vDictsInner <- mapM vectDictExpr (map deAnnotate dictsInner)
-              ; vTysOuter   <- mapM vectType     tysOuter
-              ; vTysInner   <- mapM vectType     tysInner
-
-              ; let reconstructOuter v = (`mkApps` vDictsOuter) <$> polyApply v vTysOuter
-
-              ; case vVar of
-                  Local (vv, lv)
-                    -> do { MASSERT( null dictsInner )    -- local vars cannot be class selectors
-                          ; traceVt "  LOCAL" (text "")
-                          ; (,) <$> reconstructOuter (Var vv) <*> reconstructOuter (Var lv)
-                          }
-                  Global vv
-                    | isDictComp var                      -- dictionary computation
-                    -> do {   -- in a dictionary computation, the innermost, non-empty set of
-                              -- arguments are non-vectorised arguments, where no 'PA'dictionaries
-                              -- are needed for the type variables
-                          ; ve <- if null dictsInner
-                                  then
-                                    return $ Var vv `mkTyApps` vTysOuter `mkApps` vDictsOuter
-                                  else
-                                    reconstructOuter
-                                      (Var vv `mkTyApps` vTysInner `mkApps` vDictsInner)
-                          ; traceVt "  GLOBAL (dict):" (ppr ve)
-                          ; vectConst ve
-                          }
-                    | otherwise                           -- non-dictionary computation
-                    -> do { MASSERT( null dictsInner )
-                          ; ve <- reconstructOuter (Var vv)
-                          ; traceVt "  GLOBAL (non-dict):" (ppr ve)
-                          ; vectConst ve
-                          }
-              }
-      _ -> pprSorry "Cannot vectorise programs with higher-rank types:" (ppr . deAnnotate $ e0)
-  where
-    -- if there is only one set of variables or dictionaries, it will be the outer set
-    (e1, dictsOuter) = collectAnnDictArgs e0
-    (e2, tysOuter)   = collectAnnTypeArgs e1
-    (e3, dictsInner) = collectAnnDictArgs e2
-    (e4, tysInner)   = collectAnnTypeArgs e3
-    --
-    isDictComp var = (isJust . isClassOpId_maybe $ var) || isDFunId var
-
--- |Vectorise the body of a dfun.
---
--- Dictionary computations are special for the following reasons.  The application of dictionary
--- functions are always saturated, so there is no need to create closures.  Dictionary computations
--- don't depend on array values, so they are always scalar computations whose result we can
--- replicate (instead of executing them in parallel).
---
--- NB: To keep things simple, we are not rewriting any of the bindings introduced in a dictionary
---     computation.  Consequently, the variable case needs to deal with cases where binders are
---     in the vectoriser environments and where that is not the case.
---
-vectDictExpr :: CoreExpr -> VM CoreExpr
-vectDictExpr (Var var)
-  = do { mb_scope <- lookupVar_maybe var
-       ; case mb_scope of
-           Nothing                -> return $ Var var   -- binder from within the dict. computation
-           Just (Local (vVar, _)) -> return $ Var vVar  -- local vectorised variable
-           Just (Global vVar)     -> return $ Var vVar  -- global vectorised variable
-       }
-vectDictExpr (Lit lit)
-  = pprPanic "Vectorise.Exp.vectDictExpr: literal in dictionary computation" (ppr lit)
-vectDictExpr (Lam bndr e)
-  = Lam bndr <$> vectDictExpr e
-vectDictExpr (App fn arg)
-  = App <$> vectDictExpr fn <*> vectDictExpr arg
-vectDictExpr (Case e bndr ty alts)
-  = Case <$> vectDictExpr e <*> pure bndr <*> vectType ty <*> mapM vectDictAlt alts
-  where
-    vectDictAlt (con, bs, e) = (,,) <$> vectDictAltCon con <*> pure bs <*> vectDictExpr e
-    --
-    vectDictAltCon (DataAlt datacon) = DataAlt <$> maybeV dataConErr (lookupDataCon datacon)
-      where
-        dataConErr = text "Cannot vectorise data constructor:" <+> ppr datacon
-    vectDictAltCon (LitAlt lit)      = return $ LitAlt lit
-    vectDictAltCon DEFAULT           = return DEFAULT
-vectDictExpr (Let bnd body)
-  = Let <$> vectDictBind bnd <*> vectDictExpr body
-  where
-    vectDictBind (NonRec bndr e) = NonRec bndr <$> vectDictExpr e
-    vectDictBind (Rec bnds)      = Rec <$> mapM (\(bndr, e) -> (bndr,) <$> vectDictExpr e) bnds
-vectDictExpr e@(Cast _e _coe)
-  = pprSorry "Vectorise.Exp.vectDictExpr: cast" (ppr e)
-vectDictExpr (Tick tickish e)
-  = Tick tickish <$> vectDictExpr e
-vectDictExpr (Type ty)
-  = Type <$> vectType ty
-vectDictExpr (Coercion coe)
-  = pprSorry "Vectorise.Exp.vectDictExpr: coercion" (ppr coe)
-
--- |Vectorise an expression of functional type, where all arguments and the result are of primitive
--- types (i.e., 'Int', 'Float', 'Double' etc., which have instances of the 'Scalar' type class) and
--- which does not contain any subcomputations that involve parallel arrays.  Such functionals do not
--- require the full blown vectorisation transformation; instead, they can be lifted by application
--- of a member of the zipWith family (i.e., 'map', 'zipWith', zipWith3', etc.)
---
--- Dictionary functions are also scalar functions (as dictionaries themselves are not vectorised,
--- instead they become dictionaries of vectorised methods).  We treat them differently, though see
--- "Note [Scalar dfuns]" in 'Vectorise'.
---
-vectScalarFun :: CoreExpr -> VM VExpr
-vectScalarFun expr
-  = do
-    { traceVt "vectScalarFun:" (ppr expr)
-    ; let (arg_tys, res_ty) = splitFunTys (exprType expr)
-    ; mkScalarFun arg_tys res_ty expr
-    }
-
--- Generate code for a scalar function by generating a scalar closure.  If the function is a
--- dictionary function, vectorise it as dictionary code.
---
-mkScalarFun :: [Type] -> Type -> CoreExpr -> VM VExpr
-mkScalarFun arg_tys res_ty expr
-  | isPredTy res_ty
-  = do { vExpr <- vectDictExpr expr
-       ; return (vExpr, unused)
-       }
-  | otherwise
-  = do { traceVt "mkScalarFun: " $ ppr expr $$ text "  ::" <+>
-                                   ppr (mkFunTys arg_tys res_ty)
-
-       ; fn_var  <- hoistExpr (fsLit "fn") expr DontInline
-       ; zipf    <- zipScalars arg_tys res_ty
-       ; clo     <- scalarClosure arg_tys res_ty (Var fn_var) (zipf `App` Var fn_var)
-       ; clo_var <- hoistExpr (fsLit "clo") clo DontInline
-       ; lclo    <- liftPD (Var clo_var)
-       ; return (Var clo_var, lclo)
-       }
-  where
-    unused = error "Vectorise.Exp.mkScalarFun: we don't lift dictionary expressions"
-
--- |Vectorise a dictionary function that has a 'VECTORISE SCALAR instance' pragma.
---
--- In other words, all methods in that dictionary are scalar functions — to be vectorised with
--- 'vectScalarFun'.  The dictionary "function" itself may be a constant, though.
---
--- NB: You may think that we could implement this function guided by the structure of the Core
---     expression of the right-hand side of the dictionary function.  We cannot proceed like this as
---     'vectScalarDFun' must also work for *imported* dfuns, where we don't necessarily have access
---     to the Core code of the unvectorised dfun.
---
--- Here an example — assume,
---
--- > class Eq a where { (==) :: a -> a -> Bool }
--- > instance (Eq a, Eq b) => Eq (a, b) where { (==) = ... }
--- > {-# VECTORISE SCALAR instance Eq (a, b) }
---
--- The unvectorised dfun for the above instance has the following signature:
---
--- > $dEqPair :: forall a b. Eq a -> Eq b -> Eq (a, b)
---
--- We generate the following (scalar) vectorised dfun (liberally using TH notation):
---
--- > $v$dEqPair :: forall a b. V:Eq a -> V:Eq b -> V:Eq (a, b)
--- > $v$dEqPair = /\a b -> \dEqa :: V:Eq a -> \dEqb :: V:Eq b ->
--- >                D:V:Eq $(vectScalarFun True recFns
--- >                         [| (==) @(a, b) ($dEqPair @a @b $(unVect dEqa) $(unVect dEqb)) |])
---
--- NB:
--- * '(,)' vectorises to '(,)' — hence, the type constructor in the result type remains the same.
--- * We share the '$(unVect di)' sub-expressions between the different selectors, but duplicate
---   the application of the unvectorised dfun, to enable the dictionary selection rules to fire.
---
-vectScalarDFun :: Var        -- ^ Original dfun
-               -> VM CoreExpr
-vectScalarDFun var
-  = do {   -- bring the type variables into scope
-       ; mapM_ defLocalTyVar tvs
-
-           -- vectorise dictionary argument types and generate variables for them
-       ; vTheta     <- mapM vectType theta
-       ; vThetaBndr <- mapM (newLocalVar (fsLit "vd")) vTheta
-       ; let vThetaVars = varsToCoreExprs vThetaBndr
-
-           -- vectorise superclass dictionaries and methods as scalar expressions
-       ; thetaVars  <- mapM (newLocalVar (fsLit "d")) theta
-       ; thetaExprs <- zipWithM unVectDict theta vThetaVars
-       ; let thetaDictBinds = zipWith NonRec thetaVars thetaExprs
-             dict           = Var var `mkTyApps` (mkTyVarTys tvs) `mkVarApps` thetaVars
-             scsOps         = map (\selId -> varToCoreExpr selId `mkTyApps` tys `mkApps` [dict])
-                                  selIds
-       ; vScsOps <- mapM (\e -> vectorised <$> vectScalarFun e) scsOps
-
-           -- vectorised applications of the class-dictionary data constructor
-       ; Just vDataCon <- lookupDataCon dataCon
-       ; vTys          <- mapM vectType tys
-       ; let vBody = thetaDictBinds `mkLets` mkCoreConApps vDataCon (map Type vTys ++ vScsOps)
-
-       ; return $ mkLams (tvs ++ vThetaBndr) vBody
-       }
-  where
-    ty                   = varType var
-    (tvs, theta, pty)    = tcSplitSigmaTy  ty        -- 'theta' is the instance context
-    (cls, tys)           = tcSplitDFunHead pty       -- 'pty' is the instance head
-    selIds               = classAllSelIds cls
-    dataCon              = classDataCon cls
-
--- Build a value of the dictionary before vectorisation from original, unvectorised type and an
--- expression computing the vectorised dictionary.
---
--- Given the vectorised version of a dictionary 'vd :: V:C vt1..vtn', generate code that computes
--- the unvectorised version, thus:
---
--- > D:C op1 .. opm
--- > where
--- >   opi = $(fromVect opTyi [| vSeli @vt1..vtk vd |])
---
--- where 'opTyi' is the type of the i-th superclass or op of the unvectorised dictionary.
---
-unVectDict :: Type -> CoreExpr -> VM CoreExpr
-unVectDict ty e
-  = do { vTys <- mapM vectType tys
-       ; let meths = map (\sel -> Var sel `mkTyApps` vTys `mkApps` [e]) selIds
-       ; scOps <- zipWithM fromVect methTys meths
-       ; return $ mkCoreConApps dataCon (map Type tys ++ scOps)
-       }
-  where
-    (tycon, tys) = splitTyConApp ty
-    Just dataCon = isDataProductTyCon_maybe tycon
-    Just cls     = tyConClass_maybe tycon
-    methTys      = dataConInstArgTys dataCon tys
-    selIds       = classAllSelIds cls
-
--- Vectorise an 'n'-ary lambda abstraction by building a set of 'n' explicit closures.
---
--- All non-dictionary free variables go into the closure's environment, whereas the dictionary
--- variables are passed explicit (as conventional arguments) into the body during closure
--- construction.
---
-vectLam :: Bool                 -- ^ Should the RHS of a binding be inlined?
-        -> Bool                 -- ^ Whether the binding is a loop breaker.
-        -> CoreExprWithVectInfo -- ^ Body of abstraction.
-        -> VM VExpr
-vectLam inline loop_breaker expr@((fvs, _vi), AnnLam _ _)
- = do { traceVt "fully vectorise a lambda expression" (ppr . deAnnotate $ expr)
-
-      ; let (bndrs, body) = collectAnnValBinders expr
-
-          -- grab the in-scope type variables
-      ; tyvars <- localTyVars
-
-          -- collect and vectorise all /local/ free variables
-      ; vfvs <- readLEnv $ \env ->
-                  [ (var, fromJust mb_vv)
-                  | var <- dVarSetElems fvs
-                  , let mb_vv = lookupVarEnv (local_vars env) var
-                  , isJust mb_vv         -- its local == is in local var env
-                  ]
-          -- separate dictionary from non-dictionary variables in the free variable set
-      ; let (vvs_dict, vvs_nondict)     = partition (isPredTy . varType . fst) vfvs
-            (_fvs_dict, vfvs_dict)      = unzip vvs_dict
-            (fvs_nondict, vfvs_nondict) = unzip vvs_nondict
-
-          -- compute the type of the vectorised closure
-      ; arg_tys <- mapM (vectType . idType) bndrs
-      ; res_ty  <- vectType (exprType $ deAnnotate body)
-
-      ; let arity      = length fvs_nondict + length bndrs
-            vfvs_dict' = map vectorised vfvs_dict
-      ; buildClosures tyvars vfvs_dict' vfvs_nondict arg_tys res_ty
-        . hoistPolyVExpr tyvars vfvs_dict' (maybe_inline arity)
-        $ do {   -- generate the vectorised body of the lambda abstraction
-             ; lc              <- builtin liftingContext
-             ; (vbndrs, vbody) <- vectBndrsIn (fvs_nondict ++ bndrs) $ vectExpr body
-
-             ; vbody' <- break_loop lc res_ty vbody
-             ; return $ vLams lc vbndrs vbody'
-             }
-      }
-  where
-    maybe_inline n | inline    = Inline n
-                   | otherwise = DontInline
-
-    -- If this is the body of a binding marked as a loop breaker, add a recursion termination test
-    -- to the /lifted/ version of the function body.  The termination tests checks if the lifting
-    -- context is empty.  If so, it returns an empty array of the (lifted) result type instead of
-    -- executing the function body.  This is the test from the last line (defining \mathcal{L}')
-    -- in Figure 6 of HtM.
-    break_loop lc ty (ve, le)
-      | loop_breaker
-      = do { dflags <- getDynFlags
-           ; empty <- emptyPD ty
-           ; lty   <- mkPDataType ty
-           ; return (ve, mkWildCase (Var lc) intPrimTy lty
-                           [(DEFAULT, [], le),
-                            (LitAlt (mkMachInt dflags 0), [], empty)])
-           }
-      | otherwise = return (ve, le)
-vectLam _ _ _ = panic "Vectorise.Exp.vectLam: not a lambda"
-
--- Vectorise an algebraic case expression.
---
--- We convert
---
---   case e :: t of v { ... }
---
--- to
---
---   V:    let v' = e in case v' of _ { ... }
---   L:    let v' = e in case v' `cast` ... of _ { ... }
---
---   When lifting, we have to do it this way because v must have the type
---   [:V(T):] but the scrutinee must be cast to the representation type. We also
---   have to handle the case where v is a wild var correctly.
---
-
--- FIXME: this is too lazy...is it?
-vectAlgCase :: TyCon -> [Type] -> CoreExprWithVectInfo -> Var -> Type
-            -> [(AltCon, [Var], CoreExprWithVectInfo)]
-            -> VM VExpr
-vectAlgCase _tycon _ty_args scrut bndr ty [(DEFAULT, [], body)]
-  = do
-    { traceVt "scrutinee (DEFAULT only)" Outputable.empty
-    ; vscrut         <- vectExpr scrut
-    ; (vty, lty)     <- vectAndLiftType ty
-    ; traceVt "alternative body (DEFAULT only)" Outputable.empty
-    ; (vbndr, vbody) <- vectBndrIn bndr (vectExpr body)
-    ; return $ vCaseDEFAULT vscrut vbndr vty lty vbody
-    }
-vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt _, [], body)]
-  = do
-    { traceVt "scrutinee (one shot w/o binders)" Outputable.empty
-    ; vscrut         <- vectExpr scrut
-    ; (vty, lty)     <- vectAndLiftType ty
-    ; traceVt "alternative body (one shot w/o binders)" Outputable.empty
-    ; (vbndr, vbody) <- vectBndrIn bndr (vectExpr body)
-    ; return $ vCaseDEFAULT vscrut vbndr vty lty vbody
-    }
-vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt dc, bndrs, body)]
-  = do
-    { traceVt "scrutinee (one shot w/ binders)" Outputable.empty
-    ; vexpr      <- vectExpr scrut
-    ; (vty, lty) <- vectAndLiftType ty
-    ; traceVt "alternative body (one shot w/ binders)" Outputable.empty
-    ; (vbndr, (vbndrs, (vect_body, lift_body)))
-        <- vect_scrut_bndr
-         . vectBndrsIn bndrs
-         $ vectExpr body
-    ; let (vect_bndrs, lift_bndrs) = unzip vbndrs
-    ; (vscrut, lscrut, pdata_dc) <- pdataUnwrapScrut (vVar vbndr)
-    ; vect_dc <- maybeV dataConErr (lookupDataCon dc)
-
-    ; let vcase = mk_wild_case vscrut vty vect_dc  vect_bndrs vect_body
-          lcase = mk_wild_case lscrut lty pdata_dc lift_bndrs lift_body
-
-    ; return $ vLet (vNonRec vbndr vexpr) (vcase, lcase)
-    }
-  where
-    vect_scrut_bndr | isDeadBinder bndr = vectBndrNewIn bndr (fsLit "scrut")
-                    | otherwise         = vectBndrIn bndr
-
-    mk_wild_case expr ty dc bndrs body
-      = mkWildCase expr (exprType expr) ty [(DataAlt dc, bndrs, body)]
-
-    dataConErr = (text "vectAlgCase: data constructor not vectorised" <+> ppr dc)
-
-vectAlgCase tycon _ty_args scrut bndr ty alts
-  = do
-    { traceVt "scrutinee (general case)" Outputable.empty
-    ; vexpr <- vectExpr scrut
-
-    ; vect_tc     <- vectTyCon tycon
-    ; (vty, lty)  <- vectAndLiftType ty
-
-    ; let arity = length (tyConDataCons vect_tc)
-    ; sel_ty <- builtin (selTy arity)
-    ; sel_bndr <- newLocalVar (fsLit "sel") sel_ty
-    ; let sel = Var sel_bndr
-
-    ; traceVt "alternatives' body (general case)" Outputable.empty
-    ; (vbndr, valts) <- vect_scrut_bndr
-                      $ mapM (proc_alt arity sel vty lty) alts'
-    ; let (vect_dcs, vect_bndrss, lift_bndrss, vbodies) = unzip4 valts
-
-    ; (vect_scrut, lift_scrut, pdata_dc) <- pdataUnwrapScrut (vVar vbndr)
-
-    ; let (vect_bodies, lift_bodies) = unzip vbodies
-
-    ; vdummy <- newDummyVar (exprType vect_scrut)
-    ; ldummy <- newDummyVar (exprType lift_scrut)
-    ; let vect_case = Case vect_scrut vdummy vty
-                           (zipWith3 mk_vect_alt vect_dcs vect_bndrss vect_bodies)
-
-    ; lc <- builtin liftingContext
-    ; lbody <- combinePD vty (Var lc) sel lift_bodies
-    ; let lift_case = Case lift_scrut ldummy lty
-                           [(DataAlt pdata_dc, sel_bndr : concat lift_bndrss,
-                             lbody)]
-
-    ; return . vLet (vNonRec vbndr vexpr)
-             $ (vect_case, lift_case)
-    }
-  where
-    vect_scrut_bndr | isDeadBinder bndr = vectBndrNewIn bndr (fsLit "scrut")
-                    | otherwise         = vectBndrIn bndr
-
-    alts' = sortBy (\(alt1, _, _) (alt2, _, _) -> cmp alt1 alt2) alts
-
-    cmp (DataAlt dc1) (DataAlt dc2) = dataConTag dc1 `compare` dataConTag dc2
-    cmp DEFAULT       DEFAULT       = EQ
-    cmp DEFAULT       _             = LT
-    cmp _             DEFAULT       = GT
-    cmp _             _             = panic "vectAlgCase/cmp"
-
-    proc_alt arity sel _ lty (DataAlt dc, bndrs, body@((fvs_body, _), _))
-      = do
-          dflags <- getDynFlags
-          vect_dc <- maybeV dataConErr (lookupDataCon dc)
-          let ntag = dataConTagZ vect_dc
-              tag  = mkDataConTag dflags vect_dc
-              fvs  = fvs_body `delDVarSetList` bndrs
-
-          sel_tags  <- liftM (`App` sel) (builtin (selTags arity))
-          lc        <- builtin liftingContext
-          elems     <- builtin (selElements arity ntag)
-
-          (vbndrs, vbody)
-            <- vectBndrsIn bndrs
-             . localV
-             $ do
-               { binds    <- mapM (pack_var (Var lc) sel_tags tag)
-                           . filter isLocalId
-                           $ dVarSetElems fvs
-               ; traceVt "case alternative:" (ppr . deAnnotate $ body)
-               ; (ve, le) <- vectExpr body
-               ; return (ve, Case (elems `App` sel) lc lty
-                             [(DEFAULT, [], (mkLets (concat binds) le))])
-               }
-                 -- empty    <- emptyPD vty
-                 -- return (ve, Case (elems `App` sel) lc lty
-                 --             [(DEFAULT, [], Let (NonRec flags_var flags_expr)
-                 --                             $ mkLets (concat binds) le),
-                 --               (LitAlt (mkMachInt 0), [], empty)])
-          let (vect_bndrs, lift_bndrs) = unzip vbndrs
-          return (vect_dc, vect_bndrs, lift_bndrs, vbody)
-      where
-        dataConErr = (text "vectAlgCase: data constructor not vectorised" <+> ppr dc)
-
-    proc_alt _ _ _ _ _ = panic "vectAlgCase/proc_alt"
-
-    mk_vect_alt vect_dc bndrs body = (DataAlt vect_dc, bndrs, body)
-
-      -- Pack a variable for a case alternative context *if* the variable is vectorised. If it
-      -- isn't, ignore it as scalar variables don't need to be packed.
-    pack_var len tags t v
-      = do
-        { r <- lookupVar_maybe v
-        ; case r of
-            Just (Local (vv, lv)) ->
-              do
-              { lv'  <- cloneVar lv
-              ; expr <- packByTagPD (idType vv) (Var lv) len tags t
-              ; updLEnv (\env -> env { local_vars = extendVarEnv (local_vars env) v (vv, lv') })
-              ; return [(NonRec lv' expr)]
-              }
-            _ -> return []
-        }
-
-
--- Support to compute information for vectorisation avoidance ------------------
-
--- Annotation for Core AST nodes that describes how they should be handled during vectorisation
--- and especially if vectorisation of the corresponding computation can be avoided.
---
-data VectAvoidInfo = VIParr       -- tree contains parallel computations
-                   | VISimple     -- result type is scalar & no parallel subcomputation
-                   | VIComplex    -- any result type, no parallel subcomputation
-                   | VIEncaps     -- tree encapsulated by 'liftSimple'
-                   | VIDict       -- dictionary computation (never parallel)
-                   deriving (Eq, Show)
-
--- Core expression annotated with free variables and vectorisation-specific information.
---
-type CoreExprWithVectInfo = AnnExpr Id (DVarSet, VectAvoidInfo)
-
--- Yield the type of an annotated core expression.
---
-annExprType :: AnnExpr Var ann -> Type
-annExprType = exprType . deAnnotate
-
--- Project the vectorisation information from an annotated Core expression.
---
-vectAvoidInfoOf :: CoreExprWithVectInfo -> VectAvoidInfo
-vectAvoidInfoOf ((_, vi), _) = vi
-
--- Is this a 'VIParr' node?
---
-isVIParr :: CoreExprWithVectInfo -> Bool
-isVIParr = (== VIParr) . vectAvoidInfoOf
-
--- Is this a 'VIEncaps' node?
---
-isVIEncaps :: CoreExprWithVectInfo -> Bool
-isVIEncaps = (== VIEncaps) . vectAvoidInfoOf
-
--- Is this a 'VIDict' node?
---
-isVIDict :: CoreExprWithVectInfo -> Bool
-isVIDict = (== VIDict) . vectAvoidInfoOf
-
--- 'VIParr' if either argument is 'VIParr'; otherwise, the first argument.
---
-unlessVIParr :: VectAvoidInfo -> VectAvoidInfo -> VectAvoidInfo
-unlessVIParr _  VIParr = VIParr
-unlessVIParr vi _      = vi
-
--- 'VIParr' if either arguments vectorisation information is 'VIParr'; otherwise, the vectorisation
--- information of the first argument is produced.
---
-unlessVIParrExpr :: VectAvoidInfo -> CoreExprWithVectInfo -> VectAvoidInfo
-infixl `unlessVIParrExpr`
-unlessVIParrExpr e1 e2 = e1 `unlessVIParr` vectAvoidInfoOf e2
-
--- Compute Core annotations to determine for which subexpressions we can avoid vectorisation.
---
--- * The first argument is the set of free, local variables whose evaluation may entail parallelism.
---
-vectAvoidInfo :: VarSet -> CoreExprWithFVs -> VM CoreExprWithVectInfo
-vectAvoidInfo pvs ce@(_, AnnVar v)
-  = do
-    { gpvs <- globalParallelVars
-    ; vi <- if v `elemVarSet` pvs || v `elemDVarSet` gpvs
-            then return VIParr
-            else vectAvoidInfoTypeOf ce
-    ; viTrace ce vi []
-    ; when (vi == VIParr) $
-        traceVt "  reason:" $ if v `elemVarSet` pvs  then text "local"  else
-                              if v `elemDVarSet` gpvs then text "global" else text "parallel type"
-
-    ; return ((fvs, vi), AnnVar v)
-    }
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo _pvs ce@(_, AnnLit lit)
-  = do
-    { vi <- vectAvoidInfoTypeOf ce
-    ; viTrace ce vi []
-    ; return ((fvs, vi), AnnLit lit)
-    }
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo pvs ce@(_, AnnApp e1 e2)
-  = do
-    { ceVI <- vectAvoidInfoTypeOf ce
-    ; eVI1 <- vectAvoidInfo pvs e1
-    ; eVI2 <- vectAvoidInfo pvs e2
-    ; let vi = ceVI `unlessVIParrExpr` eVI1 `unlessVIParrExpr` eVI2
-    -- ; viTrace ce vi [eVI1, eVI2]
-    ; return ((fvs, vi), AnnApp eVI1 eVI2)
-    }
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo pvs ce@(_, AnnLam var body)
-  = do
-    { bodyVI <- vectAvoidInfo pvs body
-    ; varVI  <- vectAvoidInfoType $ varType var
-    ; let vi = vectAvoidInfoOf bodyVI `unlessVIParr` varVI
-    -- ; viTrace ce vi [bodyVI]
-    ; return ((fvs, vi), AnnLam var bodyVI)
-    }
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo pvs ce@(_, AnnLet (AnnNonRec var e) body)
-  = do
-    { ceVI       <- vectAvoidInfoTypeOf ce
-    ; eVI        <- vectAvoidInfo pvs e
-    ; isScalarTy <- isScalar $ varType var
-    ; (bodyVI, vi) <- if isVIParr eVI && not isScalarTy
-        then do -- binding is parallel
-        { bodyVI <- vectAvoidInfo (pvs `extendVarSet` var) body
-        ; return (bodyVI, VIParr)
-        }
-        else do -- binding doesn't affect parallelism
-        { bodyVI <- vectAvoidInfo pvs body
-        ; return (bodyVI, ceVI `unlessVIParrExpr` bodyVI)
-        }
-    -- ; viTrace ce vi [eVI, bodyVI]
-    ; return ((fvs, vi), AnnLet (AnnNonRec var eVI) bodyVI)
-    }
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo pvs ce@(_, AnnLet (AnnRec bnds) body)
-  = do
-    { ceVI         <- vectAvoidInfoTypeOf ce
-    ; bndsVI       <- mapM (vectAvoidInfoBnd pvs) bnds
-    ; parrBndrs    <- map fst <$> filterM isVIParrBnd bndsVI
-    ; if not . null $ parrBndrs
-      then do         -- body may trigger parallelism via at least one binding
-        { new_pvs <- filterM ((not <$>) . isScalar . varType) parrBndrs
-        ; let extendedPvs = pvs `extendVarSetList` new_pvs
-        ; bndsVI <- mapM (vectAvoidInfoBnd extendedPvs) bnds
-        ; bodyVI <- vectAvoidInfo extendedPvs body
-        -- ; viTrace ce VIParr (map snd bndsVI ++ [bodyVI])
-        ; return ((fvs, VIParr), AnnLet (AnnRec bndsVI) bodyVI)
-        }
-      else do         -- demanded bindings cannot trigger parallelism
-        { bodyVI <- vectAvoidInfo pvs body
-        ; let vi = ceVI `unlessVIParrExpr` bodyVI
-        -- ; viTrace ce vi (map snd bndsVI ++ [bodyVI])
-        ; return ((fvs, vi), AnnLet (AnnRec bndsVI) bodyVI)
-        }
-    }
-  where
-    fvs = freeVarsOf ce
-    vectAvoidInfoBnd pvs (var, e) = (var,) <$> vectAvoidInfo pvs e
-
-    isVIParrBnd (var, eVI)
-      = do
-        { isScalarTy <- isScalar (varType var)
-        ; return $ isVIParr eVI && not isScalarTy
-        }
-
-vectAvoidInfo pvs ce@(_, AnnCase e var ty alts)
-  = do
-    { ceVI           <- vectAvoidInfoTypeOf ce
-    ; eVI            <- vectAvoidInfo pvs e
-    ; altsVI         <- mapM (vectAvoidInfoAlt (isVIParr eVI)) alts
-    ; let alteVIs = [eVI | (_, _, eVI) <- altsVI]
-          vi      =  foldl unlessVIParrExpr ceVI (eVI:alteVIs)  -- NB: same effect as in the paper
-    -- ; viTrace ce vi (eVI : alteVIs)
-    ; return ((fvs, vi), AnnCase eVI var ty altsVI)
-    }
-  where
-    fvs = freeVarsOf ce
-    vectAvoidInfoAlt scrutIsPar (con, bndrs, e)
-      = do
-        { allScalar <- allScalarVarType bndrs
-        ; let altPvs | scrutIsPar && not allScalar = pvs `extendVarSetList` bndrs
-                     | otherwise                   = pvs
-        ; (con, bndrs,) <$> vectAvoidInfo altPvs e
-        }
-
-vectAvoidInfo pvs ce@(_, AnnCast e (fvs_ann, ann))
-  = do
-    { eVI <- vectAvoidInfo pvs e
-    ; return ((fvs, vectAvoidInfoOf eVI), AnnCast eVI ((freeVarsOfAnn fvs_ann, VISimple), ann))
-    }
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo pvs ce@(_, AnnTick tick e)
-  = do
-    { eVI <- vectAvoidInfo pvs e
-    ; return ((fvs, vectAvoidInfoOf eVI), AnnTick tick eVI)
-    }
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo _pvs ce@(_, AnnType ty)
-  = return ((fvs, VISimple), AnnType ty)
-  where
-    fvs = freeVarsOf ce
-
-vectAvoidInfo _pvs ce@(_, AnnCoercion coe)
-  = return ((fvs, VISimple), AnnCoercion coe)
-  where
-    fvs = freeVarsOf ce
-
--- Compute vectorisation avoidance information for a type.
---
-vectAvoidInfoType :: Type -> VM VectAvoidInfo
-vectAvoidInfoType ty
-  | isPredTy ty
-  = return VIDict
-  | Just (arg, res) <- splitFunTy_maybe ty
-  = do
-    { argVI <- vectAvoidInfoType arg
-    ; resVI <- vectAvoidInfoType res
-    ; case (argVI, resVI) of
-        (VISimple, VISimple) -> return VISimple   -- NB: diverts from the paper: scalar functions
-        (_       , VIDict)   -> return VIDict
-        _                    -> return $ VIComplex `unlessVIParr` argVI `unlessVIParr` resVI
-    }
-  | otherwise
-  = do
-    { parr <- maybeParrTy ty
-    ; if parr
-      then return VIParr
-      else do
-    { scalar <- isScalar ty
-    ; if scalar
-      then return VISimple
-      else return VIComplex
-    } }
-
--- Compute vectorisation avoidance information for the type of a Core expression (with FVs).
---
-vectAvoidInfoTypeOf :: AnnExpr Var ann -> VM VectAvoidInfo
-vectAvoidInfoTypeOf = vectAvoidInfoType . annExprType
-
--- Checks whether the type might be a parallel array type.
---
-maybeParrTy :: Type -> VM Bool
-maybeParrTy ty
-    -- looking through newtypes
-  | Just ty'      <- coreView ty
-  = (== VIParr) <$> vectAvoidInfoType ty'
-    -- decompose constructor applications
-  | Just (tc, ts) <- splitTyConApp_maybe ty
-  = do
-    { isParallel <- (tyConName tc `elemNameSet`) <$> globalParallelTyCons
-    ; if isParallel
-      then return True
-      else or <$> mapM maybeParrTy ts
-    }
-  -- must be a Named ForAllTy because anon ones respond to splitTyConApp_maybe
-maybeParrTy (ForAllTy _ ty) = maybeParrTy ty
-maybeParrTy _               = return False
-
--- Are the types of all variables in the 'Scalar' class or toplevel variables?
---
--- NB: 'liftSimple' does not abstract over toplevel variables.
---
-allScalarVarType :: [Var] -> VM Bool
-allScalarVarType vs = and <$> mapM isScalarOrToplevel vs
-  where
-    isScalarOrToplevel v | isToplevel v = return True
-                         | otherwise    = isScalar (varType v)
-
--- Are the types of all variables in the set in the 'Scalar' class or toplevel variables?
---
-allScalarVarTypeSet :: DVarSet -> VM Bool
-allScalarVarTypeSet = allScalarVarType . dVarSetElems
-
--- Debugging support
---
-viTrace :: CoreExprWithFVs -> VectAvoidInfo -> [CoreExprWithVectInfo] -> VM ()
-viTrace ce vi vTs
-  = traceVt ("vect info: " ++ show vi ++ "[" ++
-             (concat $ map ((++ " ") . show . vectAvoidInfoOf) vTs) ++ "]")
-            (ppr $ deAnnotate ce)
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])
--}
diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs
deleted file mode 100644
index ac8b87a0dc..0000000000
--- a/compiler/vectorise/Vectorise/Monad.hs
+++ /dev/null
@@ -1,194 +0,0 @@
-module Vectorise.Monad (
-  module Vectorise.Monad.Base,
-  module Vectorise.Monad.Naming,
-  module Vectorise.Monad.Local,
-  module Vectorise.Monad.Global,
-  module Vectorise.Monad.InstEnv,
-  initV,
-
-  -- * Builtins
-  liftBuiltinDs,
-  builtin,
-  builtins,
-
-  -- * Variables
-  lookupVar,
-  lookupVar_maybe,
-  addGlobalParallelVar,
-  addGlobalParallelTyCon,
-) where
-
-import Vectorise.Monad.Base
-import Vectorise.Monad.Naming
-import Vectorise.Monad.Local
-import Vectorise.Monad.Global
-import Vectorise.Monad.InstEnv
-import Vectorise.Builtins
-import Vectorise.Env
-
-import CoreSyn
-import TcRnMonad
-import DsMonad
-import HscTypes hiding ( MonadThings(..) )
-import DynFlags
-import InstEnv
-import Class
-import TyCon
-import NameSet
-import VarSet
-import VarEnv
-import Var
-import Id
-import Name
-import ErrUtils
-import Outputable
-import Module
-
-import Control.Monad (join)
-
--- |Run a vectorisation computation.
---
-initV :: HscEnv
-      -> ModGuts
-      -> VectInfo
-      -> VM a
-      -> IO (Maybe (VectInfo, a))
-initV hsc_env guts info thing_inside
-  = do { dumpIfVtTrace "Incoming VectInfo" (ppr info)
-
-       ; (_, res) <- initDsWithModGuts hsc_env guts go
-       ; case join res of
-           Nothing
-             -> dumpIfVtTrace "Vectorisation FAILED!" empty
-           Just (info', _)
-             -> dumpIfVtTrace "Outgoing VectInfo" (ppr info')
-
-       ; return $ join res
-       }
-  where
-    dflags = hsc_dflags hsc_env
-
-    dumpIfVtTrace = dumpIfSet_dyn dflags Opt_D_dump_vt_trace
-
-    bindsToIds (NonRec v _)   = [v]
-    bindsToIds (Rec    binds) = map fst binds
-
-    ids = concatMap bindsToIds (mg_binds guts)
-
-    go
-      = do {   -- set up tables of builtin entities
-           ; builtins        <- initBuiltins
-           ; builtin_vars    <- initBuiltinVars builtins
-
-               -- set up class and type family envrionments
-           ; eps <- liftIO $ hscEPS hsc_env
-           ; let famInstEnvs = (eps_fam_inst_env eps, mg_fam_inst_env guts)
-                 instEnvs    = InstEnvs (eps_inst_env     eps)
-                                        (mg_inst_env     guts)
-                                        (mkModuleSet (dep_orphs (mg_deps guts)))
-                 builtin_pas = initClassDicts instEnvs (paClass builtins)  -- grab all 'PA' and..
-                 builtin_prs = initClassDicts instEnvs (prClass builtins)  -- ..'PR' class instances
-
-               -- construct the initial global environment
-           ; let genv = extendImportedVarsEnv builtin_vars
-                        . setPAFunsEnv        builtin_pas
-                        . setPRFunsEnv        builtin_prs
-                        $ initGlobalEnv (gopt Opt_VectorisationAvoidance dflags)
-                                        info (mg_vect_decls guts) instEnvs famInstEnvs
-
-               -- perform vectorisation
-           ; r <- runVM thing_inside builtins genv emptyLocalEnv
-           ; case r of
-               Yes genv _ x -> return $ Just (new_info genv, x)
-               No reason    -> do { unqual <- mkPrintUnqualifiedDs
-                                  ; liftIO $
-                                      printOutputForUser dflags unqual $
-                                        mkDumpDoc "Warning: vectorisation failure:" reason
-                                  ; return Nothing
-                                  }
-           }
-
-    new_info genv = modVectInfo genv ids (mg_tcs guts) (mg_vect_decls guts) info
-
-    -- For a given DPH class, produce a mapping from type constructor (in head position) to the
-    -- instance dfun for that type constructor and class.  (DPH class instances cannot overlap in
-    -- head constructors.)
-    --
-    initClassDicts :: InstEnvs -> Class -> [(Name, Var)]
-    initClassDicts insts cls = map find $ classInstances insts cls
-      where
-        find i | [Just tc] <- instanceRoughTcs i = (tc, instanceDFunId i)
-               | otherwise                       = pprPanic invalidInstance (ppr i)
-
-    invalidInstance = "Invalid DPH instance (overlapping in head constructor)"
-
--- Builtins -------------------------------------------------------------------
-
--- |Lift a desugaring computation using the `Builtins` into the vectorisation monad.
---
-liftBuiltinDs :: (Builtins -> DsM a) -> VM a
-liftBuiltinDs p = VM $ \bi genv lenv -> do { x <- p bi; return (Yes genv lenv x)}
-
--- |Project something from the set of builtins.
---
-builtin :: (Builtins -> a) -> VM a
-builtin f = VM $ \bi genv lenv -> return (Yes genv lenv (f bi))
-
--- |Lift a function using the `Builtins` into the vectorisation monad.
---
-builtins :: (a -> Builtins -> b) -> VM (a -> b)
-builtins f = VM $ \bi genv lenv -> return (Yes genv lenv (`f` bi))
-
-
--- Var ------------------------------------------------------------------------
-
--- |Lookup the vectorised, and if local, also the lifted version of a variable.
---
--- * If it's in the global environment we get the vectorised version.
--- * If it's in the local environment we get both the vectorised and lifted version.
---
-lookupVar :: Var -> VM (Scope Var (Var, Var))
-lookupVar v
-  = do { mb_res <- lookupVar_maybe v
-       ; case mb_res of
-           Just x  -> return x
-           Nothing ->
-               do dflags <- getDynFlags
-                  dumpVar dflags v
-       }
-
-lookupVar_maybe :: Var -> VM (Maybe (Scope Var (Var, Var)))
-lookupVar_maybe v
- = do { r <- readLEnv $ \env -> lookupVarEnv (local_vars env) v
-      ; case r of
-          Just e  -> return $ Just (Local e)
-          Nothing -> fmap Global <$> (readGEnv $ \env -> lookupVarEnv (global_vars env) v)
-      }
-
-dumpVar :: DynFlags -> Var -> a
-dumpVar dflags var
-  | Just _    <- isClassOpId_maybe var
-  = cantVectorise dflags "ClassOpId not vectorised:" (ppr var)
-  | otherwise
-  = cantVectorise dflags "Variable not vectorised:" (ppr var)
-
-
--- Global parallel entities ----------------------------------------------------
-
--- |Mark the given variable as parallel — i.e., executing the associated code might involve
--- parallel array computations.
---
-addGlobalParallelVar :: Var -> VM ()
-addGlobalParallelVar var
-  = do { traceVt "addGlobalParallelVar" (ppr var)
-       ; updGEnv $ \env -> env{global_parallel_vars = extendDVarSet (global_parallel_vars env) var}
-       }
-
--- |Mark the given type constructor as parallel — i.e., its values might embed parallel arrays.
---
-addGlobalParallelTyCon :: TyCon -> VM ()
-addGlobalParallelTyCon tycon
-  = do { traceVt "addGlobalParallelTyCon" (ppr tycon)
-       ; updGEnv $ \env ->
-           env{global_parallel_tycons = extendNameSet (global_parallel_tycons env) (tyConName tycon)}
-       }
diff --git a/compiler/vectorise/Vectorise/Monad/Base.hs b/compiler/vectorise/Vectorise/Monad/Base.hs
deleted file mode 100644
index a612a9c1cc..0000000000
--- a/compiler/vectorise/Vectorise/Monad/Base.hs
+++ /dev/null
@@ -1,243 +0,0 @@
--- |The Vectorisation monad.
-
-module Vectorise.Monad.Base (
-  -- * The Vectorisation Monad
-  VResult(..),
-  VM(..),
-
-  -- * Lifting
-  liftDs,
-
-  -- * Error Handling
-  cantVectorise,
-  maybeCantVectorise,
-  maybeCantVectoriseM,
-
-  -- * Debugging
-  emitVt, traceVt, dumpOptVt, dumpVt,
-
-  -- * Control
-  noV, traceNoV,
-  ensureV, traceEnsureV,
-  onlyIfV,
-  tryV, tryErrV,
-  maybeV,  traceMaybeV,
-  orElseV, orElseErrV,
-  fixV,
-) where
-
-import Vectorise.Builtins
-import Vectorise.Env
-
-import DsMonad
-import TcRnMonad
-import ErrUtils
-import Outputable
-import DynFlags
-
-import Control.Monad
-
-
--- The Vectorisation Monad ----------------------------------------------------
-
--- |Vectorisation can either succeed with new envionment and a value, or return with failure
--- (including a description of the reason for failure).
---
-data VResult a
-  = Yes GlobalEnv LocalEnv a
-  | No  SDoc
-
-newtype VM a
-  = VM { runVM :: Builtins -> GlobalEnv -> LocalEnv -> DsM (VResult a) }
-
-instance Monad VM where
-  VM p >>= f = VM $ \bi genv lenv -> do
-                                       r <- p bi genv lenv
-                                       case r of
-                                         Yes genv' lenv' x -> runVM (f x) bi genv' lenv'
-                                         No reason         -> return $ No reason
-
-instance Applicative VM where
-  pure x = VM $ \_ genv lenv -> return (Yes genv lenv x)
-  (<*>) = ap
-
-instance Functor VM where
-  fmap = liftM
-
-instance MonadIO VM where
-  liftIO = liftDs . liftIO
-
-instance HasDynFlags VM where
-    getDynFlags = liftDs getDynFlags
-
--- Lifting --------------------------------------------------------------------
-
--- |Lift a desugaring computation into the vectorisation monad.
---
-liftDs :: DsM a -> VM a
-liftDs p = VM $ \_ genv lenv -> do { x <- p; return (Yes genv lenv x) }
-
-
--- Error Handling -------------------------------------------------------------
-
--- |Throw a `pgmError` saying we can't vectorise something.
---
-cantVectorise :: DynFlags -> String -> SDoc -> a
-cantVectorise dflags s d = pgmError
-                  . showSDoc dflags
-                  $ vcat [text "*** Vectorisation error ***",
-                          nest 4 $ sep [text s, nest 4 d]]
-
--- |Like `fromJust`, but `pgmError` on Nothing.
---
-maybeCantVectorise :: DynFlags -> String -> SDoc -> Maybe a -> a
-maybeCantVectorise dflags s d Nothing  = cantVectorise dflags s d
-maybeCantVectorise _ _ _ (Just x) = x
-
--- |Like `maybeCantVectorise` but in a `Monad`.
---
-maybeCantVectoriseM :: (Monad m, HasDynFlags m)
-                    => String -> SDoc -> m (Maybe a) -> m a
-maybeCantVectoriseM s d p
-  = do
-      r <- p
-      case r of
-        Just x  -> return x
-        Nothing ->
-            do dflags <- getDynFlags
-               cantVectorise dflags s d
-
-
--- Debugging ------------------------------------------------------------------
-
--- |Output a trace message if -ddump-vt-trace is active.
---
-emitVt :: String -> SDoc -> VM ()
-emitVt herald doc
-  = liftDs $ do
-      dflags <- getDynFlags
-      liftIO . printOutputForUser dflags alwaysQualify $
-        hang (text herald) 2 doc
-
--- |Output a trace message if -ddump-vt-trace is active.
---
-traceVt :: String -> SDoc -> VM ()
-traceVt herald doc
-  = liftDs $ traceOptIf Opt_D_dump_vt_trace $ hang (text herald) 2 doc
-
--- |Dump the given program conditionally.
---
-dumpOptVt :: DumpFlag -> String -> SDoc -> VM ()
-dumpOptVt flag header doc
-  = do { b <- liftDs $ doptM flag
-       ; if b
-         then dumpVt header doc
-         else return ()
-       }
-
--- |Dump the given program unconditionally.
---
-dumpVt :: String -> SDoc -> VM ()
-dumpVt header doc
-  = do { unqual <- liftDs mkPrintUnqualifiedDs
-       ; dflags <- liftDs getDynFlags
-       ; liftIO $ printOutputForUser dflags unqual (mkDumpDoc header doc)
-       }
-
-
--- Control --------------------------------------------------------------------
-
--- |Return some result saying we've failed.
---
-noV :: SDoc -> VM a
-noV reason = VM $ \_ _ _ -> return $ No reason
-
--- |Like `traceNoV` but also emit some trace message to stderr.
---
-traceNoV :: String -> SDoc -> VM a
-traceNoV s d = pprTrace s d $ noV d
-
--- |If `True` then carry on, otherwise fail.
---
-ensureV :: SDoc -> Bool -> VM ()
-ensureV reason  False = noV reason
-ensureV _reason True  = return ()
-
--- |Like `ensureV` but if we fail then emit some trace message to stderr.
---
-traceEnsureV :: String -> SDoc -> Bool -> VM ()
-traceEnsureV s d False = traceNoV s d
-traceEnsureV _ _ True  = return ()
-
--- |If `True` then return the first argument, otherwise fail.
---
-onlyIfV :: SDoc -> Bool -> VM a -> VM a
-onlyIfV reason b p = ensureV reason b >> p
-
--- |Try some vectorisation computaton.
---
--- If it succeeds then return `Just` the result; otherwise, return `Nothing` after emitting a
--- failure message.
---
-tryErrV :: VM a -> VM (Maybe a)
-tryErrV (VM p) = VM $ \bi genv lenv ->
-  do
-    r <- p bi genv lenv
-    case r of
-      Yes genv' lenv' x -> return (Yes genv' lenv' (Just x))
-      No reason         -> do { unqual <- mkPrintUnqualifiedDs
-                              ; dflags <- getDynFlags
-                              ; liftIO $
-                                  printInfoForUser dflags unqual $
-                                    text "Warning: vectorisation failure:" <+> reason
-                              ; return (Yes genv  lenv  Nothing)
-                              }
-
--- |Try some vectorisation computaton.
---
--- If it succeeds then return `Just` the result; otherwise, return `Nothing` without emitting a
--- failure message.
---
-tryV :: VM a -> VM (Maybe a)
-tryV (VM p) = VM $ \bi genv lenv ->
-  do
-    r <- p bi genv lenv
-    case r of
-      Yes genv' lenv' x -> return (Yes genv' lenv' (Just x))
-      No _reason        -> return (Yes genv  lenv  Nothing)
-
--- |If `Just` then return the value, otherwise fail.
---
-maybeV :: SDoc -> VM (Maybe a) -> VM a
-maybeV reason p = maybe (noV reason) return =<< p
-
--- |Like `maybeV` but emit a message to stderr if we fail.
---
-traceMaybeV :: String -> SDoc -> VM (Maybe a) -> VM a
-traceMaybeV s d p = maybe (traceNoV s d) return =<< p
-
--- |Try the first computation,
---
---   * if it succeeds then take the returned value,
---   * if it fails then run the second computation instead while emitting a failure message.
---
-orElseErrV :: VM a -> VM a -> VM a
-orElseErrV p q = maybe q return =<< tryErrV p
-
--- |Try the first computation,
---
---   * if it succeeds then take the returned value,
---   * if it fails then run the second computation instead without emitting a failure message.
---
-orElseV :: VM a -> VM a -> VM a
-orElseV p q = maybe q return =<< tryV p
-
--- |Fixpoint in the vectorisation monad.
---
-fixV :: (a -> VM a) -> VM a
-fixV f = VM (\bi genv lenv -> fixDs $ \r -> runVM (f (unYes r)) bi genv lenv )
-  where
-    -- NOTE: It is essential that we are lazy in r above so do not replace
-    --       calls to this function by an explicit case.
-    unYes (Yes _ _ x) = x
-    unYes (No reason) = pprPanic "Vectorise.Monad.Base.fixV: no result" reason
diff --git a/compiler/vectorise/Vectorise/Monad/Global.hs b/compiler/vectorise/Vectorise/Monad/Global.hs
deleted file mode 100644
index cd642f37b6..0000000000
--- a/compiler/vectorise/Vectorise/Monad/Global.hs
+++ /dev/null
@@ -1,237 +0,0 @@
--- Operations on the global state of the vectorisation monad.
-
-module Vectorise.Monad.Global (
-  readGEnv,
-  setGEnv,
-  updGEnv,
-
-  -- * Configuration
-  isVectAvoidanceAggressive,
-
-  -- * Vars
-  defGlobalVar, undefGlobalVar,
-
-  -- * Vectorisation declarations
-  lookupVectDecl,
-
-  -- * Scalars
-  globalParallelVars, globalParallelTyCons,
-
-  -- * TyCons
-  lookupTyCon,
-  defTyConName, defTyCon, globalVectTyCons,
-
-  -- * Datacons
-  lookupDataCon,
-  defDataCon,
-
-  -- * PA Dictionaries
-  lookupTyConPA,
-  defTyConPAs,
-
-  -- * PR Dictionaries
-  lookupTyConPR
-) where
-
-import Vectorise.Monad.Base
-import Vectorise.Env
-
-import CoreSyn
-import Type
-import TyCon
-import DataCon
-import DynFlags
-import NameEnv
-import NameSet
-import Name
-import VarEnv
-import VarSet
-import Var as Var
-import Outputable
-
-
--- Global Environment ---------------------------------------------------------
-
--- |Project something from the global environment.
---
-readGEnv :: (GlobalEnv -> a) -> VM a
-readGEnv f  = VM $ \_ genv lenv -> return (Yes genv lenv (f genv))
-
--- |Set the value of the global environment.
---
-setGEnv :: GlobalEnv -> VM ()
-setGEnv genv  = VM $ \_ _ lenv -> return (Yes genv lenv ())
-
--- |Update the global environment using the provided function.
---
-updGEnv :: (GlobalEnv -> GlobalEnv) -> VM ()
-updGEnv f = VM $ \_ genv lenv -> return (Yes (f genv) lenv ())
-
-
--- Configuration --------------------------------------------------------------
-
--- |Should we avoid as much vectorisation as possible?
---
--- Set by '-f[no]-vectorisation-avoidance'
---
-isVectAvoidanceAggressive :: VM Bool
-isVectAvoidanceAggressive = readGEnv global_vect_avoid
-
-
--- Vars -----------------------------------------------------------------------
-
--- |Add a mapping between a global var and its vectorised version to the state.
---
-defGlobalVar :: Var -> Var -> VM ()
-defGlobalVar v v'
-  = do { traceVt "add global var mapping:" (ppr v <+> text "-->" <+> ppr v')
-
-           -- check for duplicate vectorisation
-       ; currentDef <- readGEnv $ \env -> lookupVarEnv (global_vars env) v
-       ; case currentDef of
-           Just old_v' ->
-               do dflags <- getDynFlags
-                  cantVectorise dflags "Variable is already vectorised:" $
-                            ppr v <+> moduleOf v old_v'
-           Nothing     -> return ()
-
-       ; updGEnv  $ \env -> env { global_vars = extendVarEnv (global_vars env) v v' }
-       }
-  where
-    moduleOf var var' | var == var'
-                      = text "vectorises to itself"
-                      | Just mod <- nameModule_maybe (Var.varName var')
-                      = text "in module" <+> ppr mod
-                      | otherwise
-                      = text "in the current module"
-
--- |Remove the mapping of a variable in the vectorisation map.
---
-undefGlobalVar :: Var -> VM ()
-undefGlobalVar v
-  = do
-    { traceVt "REMOVING global var mapping:" (ppr v)
-    ; updGEnv  $ \env -> env { global_vars = delVarEnv (global_vars env) v }
-    }
-
-
--- Vectorisation declarations -------------------------------------------------
-
--- |Check whether a variable has a vectorisation declaration.
---
--- The first component of the result indicates whether the variable has a 'NOVECTORISE' declaration.
--- The second component contains the given type and expression in case of a 'VECTORISE' declaration.
---
-lookupVectDecl :: Var -> VM (Bool, Maybe (Type, CoreExpr))
-lookupVectDecl var
-  = readGEnv $ \env ->
-      case lookupVarEnv (global_vect_decls env) var of
-        Nothing -> (False, Nothing)
-        Just Nothing  -> (True, Nothing)
-        Just vectDecl -> (False, vectDecl)
-
-
--- Parallel entities -----------------------------------------------------------
-
--- |Get the set of global parallel variables.
---
-globalParallelVars :: VM DVarSet
-globalParallelVars = readGEnv global_parallel_vars
-
--- |Get the set of all parallel type constructors (those that may embed parallelism) including both
--- both those parallel type constructors declared in an imported module and those declared in the
--- current module.
---
-globalParallelTyCons :: VM NameSet
-globalParallelTyCons = readGEnv global_parallel_tycons
-
-
--- TyCons ---------------------------------------------------------------------
-
--- |Determine the vectorised version of a `TyCon`. The vectorisation map in the global environment
--- contains a vectorised version if the original `TyCon` embeds any parallel arrays.
---
-lookupTyCon :: TyCon -> VM (Maybe TyCon)
-lookupTyCon tc
-  = readGEnv $ \env -> lookupNameEnv (global_tycons env) (tyConName tc)
-
--- |Add a mapping between plain and vectorised `TyCon`s to the global environment.
---
--- The second argument is only to enable tracing for (mutually) recursively defined type
--- constructors, where we /must not/ pull at the vectorised type constructors (because that would
--- pull too early at the recursive knot).
---
-defTyConName :: TyCon -> Name -> TyCon -> VM ()
-defTyConName tc nameOfTc' tc'
-  = do { traceVt "add global tycon mapping:" (ppr tc <+> text "-->" <+> ppr nameOfTc')
-
-           -- check for duplicate vectorisation
-       ; currentDef <- readGEnv $ \env -> lookupNameEnv (global_tycons env) (tyConName tc)
-       ; case currentDef of
-           Just old_tc' ->
-               do dflags <- getDynFlags
-                  cantVectorise dflags "Type constructor or class is already vectorised:" $
-                            ppr tc <+> moduleOf tc old_tc'
-           Nothing     -> return ()
-
-       ; updGEnv $ \env ->
-           env { global_tycons = extendNameEnv (global_tycons env) (tyConName tc) tc' }
-       }
-  where
-    moduleOf tc tc' | tc == tc'
-                    = text "vectorises to itself"
-                    | Just mod <- nameModule_maybe (tyConName tc')
-                    = text "in module" <+> ppr mod
-                    | otherwise
-                    = text "in the current module"
-
--- |Add a mapping between plain and vectorised `TyCon`s to the global environment.
---
-defTyCon :: TyCon -> TyCon -> VM ()
-defTyCon tc tc' = defTyConName tc (tyConName tc') tc'
-
--- |Get the set of all vectorised type constructors.
---
-globalVectTyCons :: VM (NameEnv TyCon)
-globalVectTyCons = readGEnv global_tycons
-
-
--- DataCons -------------------------------------------------------------------
-
--- |Lookup the vectorised version of a `DataCon` from the global environment.
---
-lookupDataCon :: DataCon -> VM (Maybe DataCon)
-lookupDataCon dc
-  | isTupleTyCon (dataConTyCon dc)
-  = return (Just dc)
-  | otherwise
-  = readGEnv $ \env -> lookupNameEnv (global_datacons env) (dataConName dc)
-
--- |Add the mapping between plain and vectorised `DataCon`s to the global environment.
---
-defDataCon :: DataCon -> DataCon -> VM ()
-defDataCon dc dc' = updGEnv $ \env ->
-  env { global_datacons = extendNameEnv (global_datacons env) (dataConName dc) dc' }
-
-
--- 'PA' dictionaries ------------------------------------------------------------
-
--- |Lookup the 'PA' dfun of a vectorised type constructor in the global environment.
---
-lookupTyConPA :: TyCon -> VM (Maybe Var)
-lookupTyConPA tc
-  = readGEnv $ \env -> lookupNameEnv (global_pa_funs env) (tyConName tc)
-
--- |Associate vectorised type constructors with the dfun of their 'PA' instances in the global
--- environment.
---
-defTyConPAs :: [(TyCon, Var)] -> VM ()
-defTyConPAs ps = updGEnv $ \env ->
-  env { global_pa_funs = extendNameEnvList (global_pa_funs env)
-                                           [(tyConName tc, pa) | (tc, pa) <- ps] }
-
-
--- PR Dictionaries ------------------------------------------------------------
-
-lookupTyConPR :: TyCon -> VM (Maybe Var)
-lookupTyConPR tc = readGEnv $ \env -> lookupNameEnv (global_pr_funs env) (tyConName tc)
diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
deleted file mode 100644
index 64b7441235..0000000000
--- a/compiler/vectorise/Vectorise/Monad/InstEnv.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module Vectorise.Monad.InstEnv
-  ( existsInst
-  , lookupInst
-  , lookupFamInst
-  )
-where
-
-import Vectorise.Monad.Global
-import Vectorise.Monad.Base
-import Vectorise.Env
-
-import DynFlags
-import FamInstEnv
-import InstEnv
-import Class
-import Type
-import TyCon
-import Outputable
-import Util
-
-
-#include "HsVersions.h"
-
-
--- Check whether a unique class instance for a given class and type arguments exists.
---
-existsInst :: Class -> [Type] -> VM Bool
-existsInst cls tys
-  = do { instEnv <- readGEnv global_inst_env
-       ; return $ either (const False) (const True) (lookupUniqueInstEnv instEnv cls tys)
-       }
-
--- Look up the dfun of a class instance.
---
--- The match must be unique —i.e., match exactly one instance— but the
--- type arguments used for matching may be more specific than those of
--- the class instance declaration.  The found class instances must not have
--- any type variables in the instance context that do not appear in the
--- instances head (i.e., no flexi vars); for details for what this means,
--- see the docs at InstEnv.lookupInstEnv.
---
-lookupInst :: Class -> [Type] -> VM (DFunId, [Type])
-lookupInst cls tys
-  = do { instEnv <- readGEnv global_inst_env
-       ; case lookupUniqueInstEnv instEnv cls tys of
-           Right (inst, inst_tys) -> return (instanceDFunId inst, inst_tys)
-           Left  err              ->
-               do dflags <- getDynFlags
-                  cantVectorise dflags "Vectorise.Monad.InstEnv.lookupInst:" err
-       }
-
--- Look up a family instance.
---
--- The match must be unique - ie, match exactly one instance - but the
--- type arguments used for matching may be more specific than those of
--- the family instance declaration.
---
--- Return the family instance and its type instance.  For example, if we have
---
---  lookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
---
--- then we have a coercion (ie, type instance of family instance coercion)
---
---  :Co:R42T Int :: T [Int] ~ :R42T Int
---
--- which implies that :R42T was declared as 'data instance T [a]'.
---
-lookupFamInst :: TyCon -> [Type] -> VM FamInstMatch
-lookupFamInst tycon tys
-  = ASSERT( isOpenFamilyTyCon tycon )
-    do { instEnv <- readGEnv global_fam_inst_env
-       ; case lookupFamInstEnv instEnv tycon tys of
-           [match] -> return match
-           _other                ->
-             do dflags <- getDynFlags
-                cantVectorise dflags "Vectorise.Monad.InstEnv.lookupFamInst: not found: "
-                           (ppr $ mkTyConApp tycon tys)
-       }
diff --git a/compiler/vectorise/Vectorise/Monad/Local.hs b/compiler/vectorise/Vectorise/Monad/Local.hs
deleted file mode 100644
index 61f55ccd43..0000000000
--- a/compiler/vectorise/Vectorise/Monad/Local.hs
+++ /dev/null
@@ -1,100 +0,0 @@
-module Vectorise.Monad.Local
-  ( readLEnv
-  , setLEnv
-  , updLEnv
-  , localV
-  , closedV
-  , getBindName
-  , inBind
-  , lookupTyVarPA
-  , defLocalTyVar
-  , defLocalTyVarWithPA
-  , localTyVars
-  )
-where
-
-import Vectorise.Monad.Base
-import Vectorise.Env
-
-import CoreSyn
-import Name
-import VarEnv
-import Var
-import FastString
-
--- Local Environment ----------------------------------------------------------
-
--- |Project something from the local environment.
---
-readLEnv :: (LocalEnv -> a) -> VM a
-readLEnv f  = VM $ \_ genv lenv -> return (Yes genv lenv (f lenv))
-
--- |Set the local environment.
---
-setLEnv :: LocalEnv -> VM ()
-setLEnv lenv  = VM $ \_ genv _ -> return (Yes genv lenv ())
-
--- |Update the environment using the provided function.
---
-updLEnv :: (LocalEnv -> LocalEnv) -> VM ()
-updLEnv f  = VM $ \_ genv lenv -> return (Yes genv (f lenv) ())
-
--- |Perform a computation in its own local environment.
--- This does not alter the environment of the current state.
---
-localV :: VM a -> VM a
-localV p
-  = do
-    { env <- readLEnv id
-    ; x   <- p
-    ; setLEnv env
-    ; return x
-    }
-
--- |Perform a computation in an empty local environment.
---
-closedV :: VM a -> VM a
-closedV p
-  = do
-    { env <- readLEnv id
-    ; setLEnv (emptyLocalEnv { local_bind_name = local_bind_name env })
-    ; x   <- p
-    ; setLEnv env
-    ; return x
-    }
-
--- |Get the name of the local binding currently being vectorised.
---
-getBindName :: VM FastString
-getBindName = readLEnv local_bind_name
-
--- |Run a vectorisation computation in a local environment,
--- with this id set as the current binding.
---
-inBind :: Id -> VM a -> VM a
-inBind id p
-  = do updLEnv $ \env -> env { local_bind_name = occNameFS (getOccName id) }
-       p
-
--- |Lookup a PA tyvars from the local environment.
-lookupTyVarPA :: Var -> VM (Maybe CoreExpr)
-lookupTyVarPA tv
-   = readLEnv $ \env -> lookupVarEnv (local_tyvar_pa env) tv
-
--- |Add a tyvar to the local environment.
-defLocalTyVar :: TyVar -> VM ()
-defLocalTyVar tv = updLEnv $ \env ->
-  env { local_tyvars   = tv : local_tyvars env
-      , local_tyvar_pa = local_tyvar_pa env `delVarEnv` tv
-      }
-
--- |Add mapping between a tyvar and pa dictionary to the local environment.
-defLocalTyVarWithPA :: TyVar -> CoreExpr -> VM ()
-defLocalTyVarWithPA tv pa = updLEnv $ \env ->
-  env { local_tyvars   = tv : local_tyvars env
-      , local_tyvar_pa = extendVarEnv (local_tyvar_pa env) tv pa
-      }
-
--- |Get the set of tyvars from the local environment.
-localTyVars :: VM [TyVar]
-localTyVars = readLEnv (reverse . local_tyvars)
diff --git a/compiler/vectorise/Vectorise/Monad/Naming.hs b/compiler/vectorise/Vectorise/Monad/Naming.hs
deleted file mode 100644
index 0b46416ddb..0000000000
--- a/compiler/vectorise/Vectorise/Monad/Naming.hs
+++ /dev/null
@@ -1,130 +0,0 @@
--- |Computations in the vectorisation monad concerned with naming and fresh variable generation.
-
-module Vectorise.Monad.Naming
-  ( mkLocalisedName
-  , mkDerivedName
-  , mkVectId
-  , cloneVar
-  , newExportedVar
-  , newLocalVar
-  , newLocalVars
-  , newDummyVar
-  , newTyVar
-  , newCoVar
-  )
-where
-
-import Vectorise.Monad.Base
-
-import DsMonad
-import TcType
-import Type
-import Var
-import Module
-import Name
-import SrcLoc
-import MkId
-import Id
-import IdInfo( IdDetails(VanillaId) )
-import FastString
-
-import Control.Monad
-
-
--- Naming ---------------------------------------------------------------------
-
--- |Create a localised variant of a name, using the provided function to transform its `OccName`.
---
--- If the name external, encode the original name's module into the new 'OccName'.  The result is
--- always an internal system name.
---
-mkLocalisedName :: (Maybe String -> OccName -> OccName) -> Name -> VM Name
-mkLocalisedName mk_occ name
-  = do { mod <- liftDs getModule
-       ; u   <- liftDs newUnique
-       ; let occ_name = mkLocalisedOccName mod mk_occ name
-
-             new_name | isExternalName name = mkExternalName u mod occ_name (nameSrcSpan name)
-                      | otherwise           = mkSystemName   u     occ_name
-
-       ; return new_name }
-
-mkDerivedName :: (OccName -> OccName) -> Name -> VM Name
--- Similar to mkLocalisedName, but assumes the
--- incoming name is from this module.
--- Works on External names only
-mkDerivedName mk_occ name
-  = do { u   <- liftDs newUnique
-       ; return (mkExternalName u (nameModule name)
-                                  (mk_occ (nameOccName name))
-                                  (nameSrcSpan name)) }
-
--- |Produce the vectorised variant of an `Id` with the given vectorised type, while taking care that
--- vectorised dfun ids must be dfuns again.
---
--- Force the new name to be a system name and, if the original was an external name, disambiguate
--- the new name with the module name of the original.
---
-mkVectId :: Id -> Type -> VM Id
-mkVectId id ty
-  = do { name <- mkLocalisedName mkVectOcc (getName id)
-       ; let id' | isDFunId id     = MkId.mkDictFunId name tvs theta cls tys
-                 | isExportedId id = Id.mkExportedLocalId VanillaId name ty
-                 | otherwise       = Id.mkLocalIdOrCoVar name ty
-       ; return id'
-       }
-  where
-    -- Decompose a dictionary function signature: \forall tvs. theta -> cls tys
-    -- NB: We do *not* use closures '(:->)' for vectorised predicate abstraction as dictionary
-    --     functions are always fully applied.
-    (tvs, theta, pty) = tcSplitSigmaTy  ty
-    (cls, tys)        = tcSplitDFunHead pty
-
--- |Make a fresh instance of this var, with a new unique.
---
-cloneVar :: Var -> VM Var
-cloneVar var = liftM (setIdUnique var) (liftDs newUnique)
-
--- |Make a fresh exported variable with the given type.
---
-newExportedVar :: OccName -> Type -> VM Var
-newExportedVar occ_name ty
- = do mod <- liftDs getModule
-      u   <- liftDs newUnique
-
-      let name = mkExternalName u mod occ_name noSrcSpan
-
-      return $ Id.mkExportedLocalId VanillaId name ty
-
--- |Make a fresh local variable with the given type.
--- The variable's name is formed using the given string as the prefix.
---
-newLocalVar :: FastString -> Type -> VM Var
-newLocalVar fs ty
- = do u <- liftDs newUnique
-      return $ mkSysLocalOrCoVar fs u ty
-
--- |Make several fresh local variables with the given types.
--- The variable's names are formed using the given string as the prefix.
---
-newLocalVars :: FastString -> [Type] -> VM [Var]
-newLocalVars fs = mapM (newLocalVar fs)
-
--- |Make a new local dummy variable.
---
-newDummyVar :: Type -> VM Var
-newDummyVar = newLocalVar (fsLit "vv")
-
--- |Make a fresh type variable with the given kind.
--- The variable's name is formed using the given string as the prefix.
---
-newTyVar :: FastString -> Kind -> VM Var
-newTyVar fs k
- = do u <- liftDs newUnique
-      return $ mkTyVar (mkSysTvName u fs) k
-
--- |Make a fresh coercion variable with the given kind.
-newCoVar :: FastString -> Kind -> VM Var
-newCoVar fs k
-  = do u <- liftDs newUnique
-       return $ mkCoVar (mkSystemVarName u fs) k
diff --git a/compiler/vectorise/Vectorise/Type/Classify.hs b/compiler/vectorise/Vectorise/Type/Classify.hs
deleted file mode 100644
index ffe95f3cc4..0000000000
--- a/compiler/vectorise/Vectorise/Type/Classify.hs
+++ /dev/null
@@ -1,129 +0,0 @@
--- Extract from a list of type constructors those (1) which need to be vectorised and (2) those
--- that could be, but need not be vectorised (as a scalar representation is sufficient and more
--- efficient).  The type constructors that cannot be vectorised will be dropped.
---
--- A type constructor will only be vectorised if it is
---
--- (1) a data type constructor, with vanilla data constructors (i.e., data constructors admitted by
---     Haskell 98) and
--- (2) at least one of the type constructors that appears in its definition is also vectorised.
---
--- If (1) is met, but not (2), the type constructor may appear in vectorised code, but there is no
--- need to vectorise that type constructor itself.  This holds, for example, for all enumeration
--- types.  As '([::])' is being vectorised, any type constructor whose definition involves
--- '([::])', either directly or indirectly, will be vectorised.
-
-module Vectorise.Type.Classify
-  ( classifyTyCons
-  )
-where
-
-import NameSet
-import UniqSet
-import UniqFM
-import DataCon
-import TyCon
-import TyCoRep
-import qualified Type
-import PrelNames
-import Digraph
-
--- |From a list of type constructors, extract those that can be vectorised, returning them in two
--- sets, where the first result list /must be/ vectorised and the second result list /need not be/
--- vectorised. The third result list are those type constructors that we cannot convert (either
--- because they use language extensions or because they dependent on type constructors for which
--- no vectorised version is available).
---
--- NB: In order to be able to vectorise a type constructor, we require members of the depending set
---     (i.e., those type constructors that the current one depends on) to be vectorised only if they
---     are also parallel (i.e., appear in the second argument to the function).
---
--- The first argument determines the /conversion status/ of external type constructors as follows:
---
--- * tycons which have converted versions are mapped to 'True'
--- * tycons which are not changed by vectorisation are mapped to 'False'
--- * tycons which haven't been converted (because they can't or weren't vectorised) are not
---   elements of the map
---
-classifyTyCons :: UniqFM Bool                  -- ^type constructor vectorisation status
-               -> NameSet                      -- ^tycons involving parallel arrays
-               -> [TyCon]                      -- ^type constructors that need to be classified
-               -> ( [TyCon]                    -- to be converted
-                  , [TyCon]                    -- need not be converted (but could be)
-                  , [TyCon]                    -- involve parallel arrays (whether converted or not)
-                  , [TyCon]                    -- can't be converted
-                  )
-classifyTyCons convStatus parTyCons tcs = classify [] [] [] [] convStatus parTyCons (tyConGroups tcs)
-  where
-    classify conv keep par novect _  _   []               = (conv, keep, par, novect)
-    classify conv keep par novect cs pts ((tcs, ds) : rs)
-      | can_convert && must_convert
-      = classify (tcs ++ conv) keep (par ++ tcs_par) novect (cs `addListToUFM` [(tc, True)  | tc <- tcs]) pts' rs
-      | can_convert
-      = classify conv (tcs ++ keep) (par ++ tcs_par) novect (cs `addListToUFM` [(tc, False) | tc <- tcs]) pts' rs
-      | otherwise
-      = classify conv keep (par ++ tcs_par) (tcs ++ novect) cs pts' rs
-      where
-        refs = ds `delListFromUniqSet` tcs
-
-          -- the tycons that directly or indirectly depend on parallel arrays
-        tcs_par | uniqSetAny ((`elemNameSet` parTyCons) . tyConName) refs = tcs
-                | otherwise = []
-
-        pts' = pts `extendNameSetList` map tyConName tcs_par
-
-        can_convert  = (isEmptyUniqSet (filterUniqSet ((`elemNameSet` pts) . tyConName) (refs `uniqSetMinusUFM` cs))
-                        && all convertable tcs)
-                       || isShowClass tcs
-        must_convert = anyUFM id (intersectUFM_C const cs (getUniqSet refs))
-                       && (not . isShowClass $ tcs)
-
-        -- We currently admit Haskell 2011-style data and newtype declarations as well as type
-        -- constructors representing classes.
-        convertable tc
-          = (isDataTyCon tc || isNewTyCon tc) && all isVanillaDataCon (tyConDataCons tc)
-            || isClassTyCon tc
-
-        -- !!!FIXME: currently we allow 'Show' in vectorised code without actually providing a
-        --   vectorised definition (to be able to vectorise 'Num')
-        isShowClass [tc] = tyConName tc == showClassName
-        isShowClass _    = False
-
--- Used to group type constructors into mutually dependent groups.
---
-type TyConGroup = ([TyCon], UniqSet TyCon)
-
--- Compute mutually recursive groups of tycons in topological order.
---
-tyConGroups :: [TyCon] -> [TyConGroup]
-tyConGroups tcs = map mk_grp (stronglyConnCompFromEdgedVerticesUniq edges)
-  where
-    edges :: [ Node TyCon (TyCon, UniqSet TyCon) ]
-    edges = [DigraphNode (tc, ds) tc (nonDetEltsUniqSet ds) | tc <- tcs
-                                , let ds = tyConsOfTyCon tc]
-            -- It's OK to use nonDetEltsUniqSet here as
-            -- stronglyConnCompFromEdgedVertices is still deterministic even
-            -- if the edges are in nondeterministic order as explained in
-            -- Note [Deterministic SCC] in Digraph.
-
-    mk_grp (AcyclicSCC (tc, ds)) = ([tc], ds)
-    mk_grp (CyclicSCC els)       = (tcs, unionManyUniqSets dss)
-      where
-        (tcs, dss) = unzip els
-
--- |Collect the set of TyCons used by the representation of some data type.
---
-tyConsOfTyCon :: TyCon -> UniqSet TyCon
-tyConsOfTyCon = tyConsOfTypes . concatMap dataConRepArgTys . tyConDataCons
-
--- |Collect the set of TyCons that occur in these types.
---
-tyConsOfTypes :: [Type] -> UniqSet TyCon
-tyConsOfTypes = unionManyUniqSets . map tyConsOfType
-
--- |Collect the set of TyCons that occur in this type.
---
-tyConsOfType :: Type -> UniqSet TyCon
-tyConsOfType ty = filterUniqSet not_tuple_or_unlifted $ Type.tyConsOfType ty
-  where not_tuple_or_unlifted tc = not (isUnliftedTyCon tc || isTupleTyCon tc)
-
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
deleted file mode 100644
index 9526feddaf..0000000000
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ /dev/null
@@ -1,455 +0,0 @@
-{-# LANGUAGE CPP #-}
-
--- Vectorise a modules type and class declarations.
---
--- This produces new type constructors and family instances top be included in the module toplevel
--- as well as bindings for worker functions, dfuns, and the like.
-
-module Vectorise.Type.Env (
-  vectTypeEnv,
-) where
-
-#include "HsVersions.h"
-
-import Vectorise.Env
-import Vectorise.Vect
-import Vectorise.Monad
-import Vectorise.Builtins
-import Vectorise.Type.TyConDecl
-import Vectorise.Type.Classify
-import Vectorise.Generic.PADict
-import Vectorise.Generic.PAMethods
-import Vectorise.Generic.PData
-import Vectorise.Generic.Description
-import Vectorise.Utils
-
-import CoreSyn
-import CoreUtils
-import CoreUnfold
-import DataCon
-import TyCon
-import CoAxiom
-import Type
-import FamInstEnv
-import Id
-import MkId
-import NameEnv
-import NameSet
-import UniqFM
-import OccName
-import Unique
-
-import Util
-import Outputable
-import DynFlags
-import FastString
-import MonadUtils
-
-import Control.Monad
-import Data.Maybe
-import Data.List
-
-
--- Note [Pragmas to vectorise tycons]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- All imported type constructors that are not mapped to a vectorised type in the vectorisation map
--- (possibly because the defining module was not compiled with vectorisation) may be used in scalar
--- code encapsulated in vectorised code. If a such a type constructor 'T' is a member of the
--- 'Scalar' class (and hence also of 'PData' and 'PRepr'), it may also be used in vectorised code,
--- where 'T' represents itself, but the representation of 'T' still remains opaque in vectorised
--- code (i.e., it can only be used in scalar code).
---
--- An example is the treatment of 'Int'. 'Int's can be used in vectorised code and remain unchanged
--- by vectorisation.  However, the representation of 'Int' by the 'I#' data constructor wrapping an
--- 'Int#' is not exposed in vectorised code. Instead, computations involving the representation need
--- to be confined to scalar code.
---
--- VECTORISE pragmas for type constructors cover four different flavours of vectorising data type
--- constructors:
---
--- (1) Data type constructor 'T' that together with its constructors 'Cn' may be used in vectorised
---     code, where 'T' and the 'Cn' are automatically vectorised in the same manner as data types
---     declared in a vectorised module.  This includes the case where the vectoriser determines that
---     the original representation of 'T' may be used in vectorised code (as it does not embed any
---     parallel arrays.)  This case is for type constructors that are *imported* from a non-
---     vectorised module, but that we want to use with full vectorisation support.
---
---     An example is the treatment of 'Ordering' and '[]'.  The former remains unchanged by
---     vectorisation, whereas the latter is fully vectorised.
---
---     'PData' and 'PRepr' instances are automatically generated by the vectoriser.
---
---     Type constructors declared with {-# VECTORISE type T #-} are treated in this manner.
---
--- (2) Data type constructor 'T' that may be used in vectorised code, where 'T' is represented by an
---     explicitly given 'Tv', but the representation of 'T' is opaque in vectorised code (i.e., the
---     constructors of 'T' may not occur in vectorised code).
---
---     An example is the treatment of '[::]'. The type '[::]' can be used in vectorised code and is
---     vectorised to 'PArray'. However, the representation of '[::]' is not exposed in vectorised
---     code. Instead, computations involving the representation need to be confined to scalar code.
---
---     'PData' and 'PRepr' instances need to be explicitly supplied for 'T' (they are not generated
---     by the vectoriser).
---
---     Type constructors declared with {-# VECTORISE type T = Tv #-} are treated in this manner
---     manner. (The vectoriser never treats a type constructor automatically in this manner.)
---
--- (3) Data type constructor 'T' that does not contain any parallel arrays and has explicitly
---     provided 'PData' and 'PRepr' instances (and maybe also a 'Scalar' instance), which together
---     with the type's constructors 'Cn' may be used in vectorised code. The type 'T' and its
---     constructors 'Cn' are represented by themselves in vectorised code.
---
---     An example is 'Bool', which is represented by itself in vectorised code (as it cannot embed
---     any parallel arrays).  However, we do not want any automatic generation of class and family
---     instances, which is why Case (1) does not apply.
---
---     'PData' and 'PRepr' instances need to be explicitly supplied for 'T' (they are not generated
---     by the vectoriser).
---
---     Type constructors declared with {-# VECTORISE SCALAR type T #-} are treated in this manner.
---
--- (4) Data type constructor 'T' that does not contain any parallel arrays and that, in vectorised
---     code, is represented by an explicitly given 'Tv', but the representation of 'T' is opaque in
---     vectorised code and 'T' is regarded to be scalar — i.e., it may be used in encapsulated
---     scalar subcomputations.
---
---     An example is the treatment of '(->)'. Types '(->)' can be used in vectorised code and are
---     vectorised to '(:->)'.  However, the representation of '(->)' is not exposed in vectorised
---     code. Instead, computations involving the representation need to be confined to scalar code
---     and may be part of encapsulated scalar computations.
---
---     'PData' and 'PRepr' instances need to be explicitly supplied for 'T' (they are not generated
---     by the vectoriser).
---
---     Type constructors declared with {-# VECTORISE SCALAR type T = Tv #-} are treated in this
---     manner. (The vectoriser never treats a type constructor automatically in this manner.)
---
--- In addition, we have also got a single pragma form for type classes: {-# VECTORISE class C #-}.
--- It implies that the class type constructor may be used in vectorised code together with its data
--- constructor.  We generally produce a vectorised version of the data type and data constructor.
--- We do not generate 'PData' and 'PRepr' instances for class type constructors.  This pragma is the
--- default for all type classes declared in a vectorised module, but the pragma can also be used
--- explitly on imported classes.
-
--- Note [Vectorising classes]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- We vectorise classes essentially by just vectorising their desugared Core representation, but we
--- do generate a 'Class' structure along the way (see 'Vectorise.Type.TyConDecl.vectTyConDecl').
---
--- Here is an example illustrating the mapping — assume
---
---   class Num a where
---     (+) :: a -> a -> a
---
--- It desugars to
---
---   data Num a = D:Num { (+) :: a -> a -> a }
---
--- which we vectorise to
---
---  data V:Num a = D:V:Num { ($v+) :: PArray a :-> PArray a :-> PArray a }
---
--- while adding the following entries to the vectorisation map:
---
---   tycon  : Num   --> V:Num
---   datacon: D:Num --> D:V:Num
---   var    : (+) --> ($v+)
-
--- |Vectorise type constructor including class type constructors.
---
-vectTypeEnv :: [TyCon]                   -- Type constructors defined in this module
-            -> [CoreVect]                -- All 'VECTORISE [SCALAR] type' declarations in this module
-            -> [CoreVect]                -- All 'VECTORISE class' declarations in this module
-            -> VM ( [TyCon]              -- old TyCons ++ new TyCons
-                  , [FamInst]            -- New type family instances.
-                  , [(Var, CoreExpr)])   -- New top level bindings.
-vectTypeEnv tycons vectTypeDecls vectClassDecls
-  = do { traceVt "** vectTypeEnv" $ ppr tycons
-
-       ; let   -- {-# VECTORISE type T -#} (ONLY the imported tycons)
-             impVectTyCons          = (   [tycon | VectType False tycon Nothing <- vectTypeDecls]
-                                       ++ [tycon | VectClass tycon              <- vectClassDecls])
-                                      \\ tycons
-
-               -- {-# VECTORISE type T = Tv -#} (imported & local tycons with an /RHS/)
-             vectTyConsWithRHS      = [ (tycon, rhs)
-                                      | VectType False tycon (Just rhs) <- vectTypeDecls]
-
-               -- {-# VECTORISE SCALAR type T = Tv -#} (imported & local tycons with an /RHS/)
-             scalarTyConsWithRHS    = [ (tycon, rhs)
-                                      | VectType True  tycon (Just rhs) <- vectTypeDecls]
-
-               -- {-# VECTORISE SCALAR type T -#} (imported & local /scalar/ tycons without an RHS)
-             scalarTyConsNoRHS      = [tycon | VectType True tycon Nothing <- vectTypeDecls]
-
-               -- Check that is not a VECTORISE SCALAR tycon nor VECTORISE tycons with explicit rhs?
-             vectSpecialTyConNames  = mkNameSet . map tyConName $
-                                        scalarTyConsNoRHS ++
-                                        map fst (vectTyConsWithRHS ++ scalarTyConsWithRHS)
-             notVectSpecialTyCon tc = not $ (tyConName tc) `elemNameSet` vectSpecialTyConNames
-
-         -- Build a map containing all vectorised type constructor. If the vectorised type
-         -- constructor differs from the original one, then it is mapped to 'True'; if they are
-         -- both the same, then it maps to 'False'.
-       ; vectTyCons          <- globalVectTyCons
-       ; let vectTyConBase    = mapUFM_Directly isDistinct vectTyCons    -- 'True' iff tc /= V[[tc]]
-             isDistinct u tc  = u /= getUnique tc
-             vectTyConFlavour = vectTyConBase
-                                `plusNameEnv`
-                                mkNameEnv [ (tyConName tycon, True)
-                                          | (tycon, _) <- vectTyConsWithRHS ++ scalarTyConsWithRHS]
-                                `plusNameEnv`
-                                mkNameEnv [ (tyConName tycon, False)  -- original representation
-                                          | tycon <- scalarTyConsNoRHS]
-
-
-           -- Split the list of 'TyCons' into the ones (1) that we must vectorise and those (2)
-           -- that we could, but don't need to vectorise.  Type constructors that are not data
-           -- type constructors or use non-Haskell98 features are being dropped.  They may not
-           -- appear in vectorised code.  (We also drop the local type constructors appearing in a
-           -- VECTORISE SCALAR pragma or a VECTORISE pragma with an explicit right-hand side, as
-           -- these are being handled separately.  NB: Some type constructors may be marked SCALAR
-           -- /and/ have an explicit right-hand side.)
-           --
-           -- Furthermore, 'par_tcs' are those type constructors (converted or not) whose
-           -- definition, directly or indirectly, depends on parallel arrays. Finally, 'drop_tcs'
-           -- are all type constructors that cannot be vectorised.
-       ; parallelTyCons <- (`extendNameSetList` map (tyConName . fst) vectTyConsWithRHS) <$>
-                             globalParallelTyCons
-       ; let maybeVectoriseTyCons = filter notVectSpecialTyCon tycons ++ impVectTyCons
-             (conv_tcs, keep_tcs, par_tcs, drop_tcs)
-               = classifyTyCons vectTyConFlavour parallelTyCons maybeVectoriseTyCons
-
-       ; traceVt " known parallel : " $ ppr parallelTyCons
-       ; traceVt " VECT SCALAR    : " $ ppr (scalarTyConsNoRHS ++ map fst scalarTyConsWithRHS)
-       ; traceVt " VECT [class]   : " $ ppr impVectTyCons
-       ; traceVt " VECT with rhs  : " $ ppr (map fst (vectTyConsWithRHS ++ scalarTyConsWithRHS))
-       ; traceVt " -- after classification (local and VECT [class] tycons) --" Outputable.empty
-       ; traceVt " reuse          : " $ ppr keep_tcs
-       ; traceVt " convert        : " $ ppr conv_tcs
-
-           -- warn the user about unvectorised type constructors
-       ; let explanation    = text "(They use unsupported language extensions"
-                          $$  text "or depend on type constructors that are" <+>
-                              text "not vectorised)"
-             drop_tcs_nosyn = filter (not . isTypeFamilyTyCon) .
-                              filter (not . isTypeSynonymTyCon) $ drop_tcs
-       ; unless (null drop_tcs_nosyn) $
-           emitVt "Warning: cannot vectorise these type constructors:" $
-             pprQuotedList drop_tcs_nosyn $$ explanation
-
-       ; mapM_ addParallelTyConAndCons $ par_tcs ++ map fst vectTyConsWithRHS
-
-       ; let mapping =
-                    -- Type constructors that we found we don't need to vectorise and those
-                    -- declared VECTORISE SCALAR /without/ an explicit right-hand side, use the same
-                    -- representation in both unvectorised and vectorised code; they are not
-                    -- abstract.
-                  [(tycon, tycon, False) | tycon <- keep_tcs ++ scalarTyConsNoRHS]
-                    -- We do the same for type constructors declared VECTORISE SCALAR /without/
-                    -- an explicit right-hand side
-               ++ [(tycon, vTycon, True) | (tycon, vTycon) <- vectTyConsWithRHS ++ scalarTyConsWithRHS]
-       ; syn_tcs <- catMaybes <$> mapM defTyConDataCons mapping
-
-           -- Vectorise all the data type declarations that we can and must vectorise (enter the
-           -- type and data constructors into the vectorisation map on-the-fly.)
-       ; new_tcs <- vectTyConDecls conv_tcs
-
-       ; let dumpTc tc vTc = traceVt "---" (ppr tc <+> text "::" <+> ppr (dataConSig tc) $$
-                                            ppr vTc <+> text "::" <+> ppr (dataConSig vTc))
-             dataConSig tc | Just dc <- tyConSingleDataCon_maybe tc = dataConRepType dc
-                           | otherwise                              = panic "dataConSig"
-       ; zipWithM_ dumpTc (filter isClassTyCon conv_tcs) (filter isClassTyCon new_tcs)
-
-           -- We don't need new representation types for dictionary constructors. The constructors
-           -- are always fully applied, and we don't need to lift them to arrays as a dictionary
-           -- of a particular type always has the same value.
-       ; let orig_tcs = filter (not . isClassTyCon) $ keep_tcs ++ conv_tcs
-             vect_tcs = filter (not . isClassTyCon) $ keep_tcs ++ new_tcs
-
-           -- Build 'PRepr' and 'PData' instance type constructors and family instances for all
-           -- type constructors with vectorised representations.
-       ; reprs      <- mapM tyConRepr vect_tcs
-       ; repr_fis   <- zipWith3M buildPReprTyCon  orig_tcs vect_tcs reprs
-       ; pdata_fis  <- zipWith3M buildPDataTyCon  orig_tcs vect_tcs reprs
-       ; pdatas_fis <- zipWith3M buildPDatasTyCon orig_tcs vect_tcs reprs
-
-       ; let fam_insts  = repr_fis ++ pdata_fis ++ pdatas_fis
-             repr_axs   = map famInstAxiom repr_fis
-             pdata_tcs  = famInstsRepTyCons pdata_fis
-             pdatas_tcs = famInstsRepTyCons pdatas_fis
-
-       ; updGEnv $ extendFamEnv fam_insts
-
-           -- Generate workers for the vectorised data constructors, dfuns for the 'PA' instances of
-           -- the vectorised type constructors, and associate the type constructors with their dfuns
-           -- in the global environment.  We get back the dfun bindings (which we will subsequently
-           -- inject into the modules toplevel).
-       ; (_, binds) <- fixV $ \ ~(dfuns, _) ->
-           do { defTyConPAs (zipLazy vect_tcs dfuns)
-
-                  -- Query the 'PData' instance type constructors for type constructors that have a
-                  -- VECTORISE SCALAR type pragma without an explicit right-hand side (this is Item
-                  --  (3) of "Note [Pragmas to vectorise tycons]" above).
-              ; pdata_scalar_tcs <- mapM pdataReprTyConExact scalarTyConsNoRHS
-
-                  -- Build workers for all vectorised data constructors (except abstract ones)
-              ; sequence_ $
-                  zipWith3 vectDataConWorkers (orig_tcs  ++ scalarTyConsNoRHS)
-                                              (vect_tcs  ++ scalarTyConsNoRHS)
-                                              (pdata_tcs ++ pdata_scalar_tcs)
-
-                  -- Build a 'PA' dictionary for all type constructors (except abstract ones & those
-                  -- defined with an explicit right-hand side where the dictionary is user-supplied)
-              ; dfuns <- sequence $
-                           zipWith4 buildTyConPADict
-                                    vect_tcs
-                                    repr_axs
-                                    pdata_tcs
-                                    pdatas_tcs
-
-              ; binds <- takeHoisted
-              ; return (dfuns, binds)
-              }
-
-           -- Return the vectorised variants of type constructors as well as the generated instance
-           -- type constructors, family instances, and dfun bindings.
-       ; return ( new_tcs ++ pdata_tcs ++ pdatas_tcs ++ syn_tcs
-                , fam_insts, binds)
-       }
-  where
-    addParallelTyConAndCons tycon
-      = do
-        { addGlobalParallelTyCon tycon
-        ; mapM_ addGlobalParallelVar [ id | dc <- tyConDataCons tycon
-                                          , AnId id <- dataConImplicitTyThings dc ]
-                                          -- Ignoring the promoted tycon; hope that's ok
-        }
-
-    -- Add a mapping from the original to vectorised type constructor to the vectorisation map.
-    -- Unless the type constructor is abstract, also mappings from the original's data constructors
-    -- to the vectorised type's data constructors.
-    --
-    -- We have three cases: (1) original and vectorised type constructor are the same, (2) the
-    -- name of the vectorised type constructor is canonical (as prescribed by 'mkVectTyConOcc'), or
-    -- (3) the name is not canonical.  In the third case, we additionally introduce a type synonym
-    -- with the canonical name that is set equal to the non-canonical name (so that we find the
-    -- right type constructor when reading vectorisation information from interface files).
-    --
-    defTyConDataCons (origTyCon, vectTyCon, isAbstract)
-      = do
-        { canonName <- mkLocalisedName mkVectTyConOcc origName
-        ; if    origName == vectName                             -- Case (1)
-             || vectName == canonName                            -- Case (2)
-          then do
-          { defTyCon origTyCon vectTyCon                         -- T  --> vT
-          ; defDataCons                                          -- Ci --> vCi
-          ; return Nothing
-          }
-          else do                                                 -- Case (3)
-          { let synTyCon = mkSyn canonName (mkTyConTy vectTyCon)  -- type S = vT
-          ; defTyCon origTyCon synTyCon                           -- T  --> S
-          ; defDataCons                                           -- Ci --> vCi
-          ; return $ Just synTyCon
-          }
-        }
-      where
-        origName  = tyConName origTyCon
-        vectName  = tyConName vectTyCon
-
-        mkSyn canonName ty = buildSynTyCon canonName [] (typeKind ty) [] ty
-
-        defDataCons
-          | isAbstract = return ()
-          | otherwise
-          = do { MASSERT(tyConDataCons origTyCon `equalLength` tyConDataCons vectTyCon)
-               ; zipWithM_ defDataCon (tyConDataCons origTyCon) (tyConDataCons vectTyCon)
-               }
-
-
--- Helpers --------------------------------------------------------------------
-
-buildTyConPADict :: TyCon -> CoAxiom Unbranched -> TyCon -> TyCon -> VM Var
-buildTyConPADict vect_tc prepr_ax pdata_tc pdatas_tc
- = tyConRepr vect_tc >>= buildPADict vect_tc prepr_ax pdata_tc pdatas_tc
-
--- Produce a custom-made worker for the data constructors of a vectorised data type.  This includes
--- all data constructors that may be used in vectorised code — i.e., all data constructors of data
--- types with 'VECTORISE [SCALAR] type' pragmas with an explicit right-hand side.  Also adds a mapping
--- from the original to vectorised worker into the vectorisation map.
---
--- FIXME: It's not nice that we need create a special worker after the data constructors has
---   already been constructed.  Also, I don't think the worker is properly added to the data
---   constructor.  Seems messy.
-vectDataConWorkers :: TyCon -> TyCon -> TyCon -> VM ()
-vectDataConWorkers orig_tc vect_tc arr_tc
-  = do { traceVt "Building vectorised worker for datatype" (ppr orig_tc)
-
-       ; bs <- sequence
-             . zipWith3 def_worker  (tyConDataCons orig_tc) rep_tys
-             $ zipWith4 mk_data_con (tyConDataCons vect_tc)
-                                    rep_tys
-                                    (inits rep_tys)
-                                    (tail $ tails rep_tys)
-        ; mapM_ (uncurry hoistBinding) bs
-        }
-  where
-    tyvars   = tyConTyVars vect_tc
-    var_tys  = mkTyVarTys tyvars
-    ty_args  = map Type var_tys
-    res_ty   = mkTyConApp vect_tc var_tys
-
-    cons     = tyConDataCons vect_tc
-    arity    = length cons
-    [arr_dc] = tyConDataCons arr_tc
-
-    rep_tys  = map dataConRepArgTys $ tyConDataCons vect_tc
-
-    mk_data_con con tys pre post
-      = do dflags <- getDynFlags
-           liftM2 (,) (vect_data_con con)
-                      (lift_data_con tys pre post (mkDataConTag dflags con))
-
-    sel_replicate len tag
-      | arity > 1 = do
-                      rep <- builtin (selReplicate arity)
-                      return [rep `mkApps` [len, tag]]
-
-      | otherwise = return []
-
-    vect_data_con con = return $ mkConApp con ty_args
-    lift_data_con tys pre_tys post_tys tag
-      = do
-          len  <- builtin liftingContext
-          args <- mapM (newLocalVar (fsLit "xs"))
-                  =<< mapM mkPDataType tys
-
-          sel  <- sel_replicate (Var len) tag
-
-          pre   <- mapM emptyPD (concat pre_tys)
-          post  <- mapM emptyPD (concat post_tys)
-
-          return . mkLams (len : args)
-                 . wrapFamInstBody arr_tc var_tys
-                 . mkConApp arr_dc
-                 $ ty_args ++ sel ++ pre ++ map Var args ++ post
-
-    def_worker data_con arg_tys mk_body
-      = do
-          arity <- polyArity tyvars
-          body <- closedV
-                . inBind orig_worker
-                . polyAbstract tyvars $ \args ->
-                  liftM (mkLams (tyvars ++ args) . vectorised)
-                $ buildClosures tyvars [] [] arg_tys res_ty mk_body
-
-          raw_worker <- mkVectId orig_worker (exprType body)
-          let vect_worker = raw_worker `setIdUnfolding`
-                              mkInlineUnfoldingWithArity arity body
-          defGlobalVar orig_worker vect_worker
-          return (vect_worker, body)
-      where
-        orig_worker = dataConWorkId data_con
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
deleted file mode 100644
index 684754684b..0000000000
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ /dev/null
@@ -1,214 +0,0 @@
-
-module Vectorise.Type.TyConDecl (
-  vectTyConDecls
-) where
-
-import Vectorise.Type.Type
-import Vectorise.Monad
-import Vectorise.Env( GlobalEnv( global_fam_inst_env ) )
-import BuildTyCl( TcMethInfo, buildClass, buildDataCon, newTyConRepName )
-import OccName
-import Class
-import Type
-import TyCon
-import DataCon
-import DynFlags
-import BasicTypes( DefMethSpec(..) )
-import SrcLoc( SrcSpan, noSrcSpan )
-import Var
-import Name
-import Outputable
-import Util
-import Control.Monad
-
-
--- |Vectorise some (possibly recursively defined) type constructors.
---
-vectTyConDecls :: [TyCon] -> VM [TyCon]
-vectTyConDecls tcs = fixV $ \tcs' ->
-  do { names' <- mapM (mkLocalisedName mkVectTyConOcc . tyConName) tcs
-     ; mapM_ (uncurry (uncurry defTyConName)) (tcs `zip` names' `zipLazy` tcs')
-     ; zipWithM vectTyConDecl tcs names'
-     }
-
--- |Vectorise a single type constructor.
---
-vectTyConDecl :: TyCon -> Name -> VM TyCon
-vectTyConDecl tycon name'
-
-      -- Type constructor representing a type class
-  | Just cls <- tyConClass_maybe tycon
-  = do { unless (null $ classATs cls) $
-           do dflags <- getDynFlags
-              cantVectorise dflags "Associated types are not yet supported" (ppr cls)
-
-           -- vectorise superclass constraint (types)
-       ; theta' <- mapM vectType (classSCTheta cls)
-
-           -- vectorise method selectors
-       ; let opItems      = classOpItems cls
-             Just datacon = tyConSingleDataCon_maybe tycon
-             argTys       = dataConRepArgTys datacon                      -- all selector types
-             opTys        = drop (length argTys - length opItems) argTys  -- only method types
-       ; methods' <- sequence [ vectMethod id meth ty | ((id, meth), ty) <- zip opItems opTys]
-
-           -- construct the vectorised class (this also creates the class type constructors and its
-           -- data constructor)
-           --
-           -- NB: 'buildClass' attaches new quantifiers and dictionaries to the method types
-       ; cls' <- liftDs $
-                   buildClass
-                     name'                      -- new name: "V:Class"
-                     (tyConBinders tycon)       -- keep original kind
-                     (map (const Nominal) (tyConRoles tycon)) -- all role are N for safety
-                     (snd . classTvsFds $ cls)  -- keep the original functional dependencies
-                     (Just (
-                         theta',                 -- superclasses
-                         [],                     -- no associated types (for the moment)
-                         methods',               -- method info
-                         (classMinimalDef cls))) -- Inherit minimal complete definition from cls
-
-           -- the original dictionary constructor must map to the vectorised one
-       ; let tycon'        = classTyCon cls'
-             Just datacon  = tyConSingleDataCon_maybe tycon
-             Just datacon' = tyConSingleDataCon_maybe tycon'
-       ; defDataCon datacon datacon'
-
-           -- the original superclass and methods selectors must map to the vectorised ones
-       ; let selIds  = classAllSelIds cls
-             selIds' = classAllSelIds cls'
-       ; zipWithM_ defGlobalVar selIds selIds'
-
-           -- return the type constructor of the vectorised class
-       ; return tycon'
-       }
-
-       -- Regular algebraic type constructor — for now, Haskell 2011-style only
-  | isAlgTyCon tycon
-  = do { unless (all isVanillaDataCon (tyConDataCons tycon)) $
-           do dflags <- getDynFlags
-              cantVectorise dflags "Currently only Haskell 2011 datatypes are supported" (ppr tycon)
-
-           -- vectorise the data constructor of the class tycon
-       ; rhs' <- vectAlgTyConRhs tycon (algTyConRhs tycon)
-
-           -- keep the original GADT flags
-       ; let gadt_flag = isGadtSyntaxTyCon tycon
-
-           -- build the vectorised type constructor
-       ; tc_rep_name <- mkDerivedName mkTyConRepOcc name'
-       ; return $ mkAlgTyCon
-                    name'                   -- new name
-                    (tyConBinders tycon)
-                    (tyConResKind tycon)    -- keep original kind
-                    (map (const Nominal) (tyConRoles tycon)) -- all roles are N for safety
-                    Nothing
-                    []                      -- no stupid theta
-                    rhs'                    -- new constructor defs
-                    (VanillaAlgTyCon tc_rep_name)
-                    gadt_flag               -- whether in GADT syntax
-       }
-
-  -- some other crazy thing that we don't handle
-  | otherwise
-  = do dflags <- getDynFlags
-       cantVectorise dflags "Can't vectorise exotic type constructor" (ppr tycon)
-
--- |Vectorise a class method.  (Don't enter it into the vectorisation map yet.)
---
-vectMethod :: Id -> DefMethInfo -> Type -> VM TcMethInfo
-vectMethod id defMeth ty
- = do {   -- Vectorise the method type.
-      ; ty' <- vectType ty
-
-          -- Create a name for the vectorised method.
-      ; id' <- mkVectId id ty'
-
-      ; return  (Var.varName id', ty', defMethSpecOfDefMeth defMeth)
-      }
-
--- | Convert a `DefMethInfo` to a `DefMethSpec`, which discards the name field in
---   the `DefMeth` constructor of the `DefMeth`.
-defMethSpecOfDefMeth :: DefMethInfo -> Maybe (DefMethSpec (SrcSpan, Type))
-defMethSpecOfDefMeth Nothing = Nothing
-defMethSpecOfDefMeth (Just (_, VanillaDM))    = Just VanillaDM
-defMethSpecOfDefMeth (Just (_, GenericDM ty)) = Just (GenericDM (noSrcSpan, ty))
-
--- |Vectorise the RHS of an algebraic type.
---
-vectAlgTyConRhs :: TyCon -> AlgTyConRhs -> VM AlgTyConRhs
-vectAlgTyConRhs tc (AbstractTyCon {})
-  = do dflags <- getDynFlags
-       cantVectorise dflags "Can't vectorise imported abstract type" (ppr tc)
-vectAlgTyConRhs _tc (DataTyCon { data_cons = data_cons
-                               , is_enum   = is_enum
-                               })
-  = do { data_cons' <- mapM vectDataCon data_cons
-       ; zipWithM_ defDataCon data_cons data_cons'
-       ; return $ DataTyCon { data_cons = data_cons'
-                            , is_enum   = is_enum
-                            }
-       }
-
-vectAlgTyConRhs tc (TupleTyCon { data_con = con })
-  = vectAlgTyConRhs tc (DataTyCon { data_cons = [con], is_enum = False })
-    -- I'm not certain this is what you want to do for tuples,
-    -- but it's the behaviour we had before I refactored the
-    -- representation of AlgTyConRhs to add tuples
-
-vectAlgTyConRhs tc (SumTyCon { data_cons = cons })
-  = -- FIXME (osa): I'm pretty sure this is broken.. TupleTyCon case is probably
-    -- also broken when the tuple is unboxed.
-    vectAlgTyConRhs tc (DataTyCon { data_cons = cons
-                                  , is_enum = all (((==) 0) . dataConRepArity) cons })
-
-vectAlgTyConRhs tc (NewTyCon {})
-  = do dflags <- getDynFlags
-       cantVectorise dflags noNewtypeErr (ppr tc)
-  where
-    noNewtypeErr = "Vectorisation of newtypes not supported yet; please use a 'data' declaration"
-
--- |Vectorise a data constructor by vectorising its argument and return types..
---
-vectDataCon :: DataCon -> VM DataCon
-vectDataCon dc
-  | not . null $ ex_tvs
-  = do dflags <- getDynFlags
-       cantVectorise dflags "Can't vectorise constructor with existential type variables yet" (ppr dc)
-  | not . null $ eq_spec
-  = do dflags <- getDynFlags
-       cantVectorise dflags "Can't vectorise constructor with equality context yet" (ppr dc)
-  | not . null $ dataConFieldLabels dc
-  = do dflags <- getDynFlags
-       cantVectorise dflags "Can't vectorise constructor with labelled fields yet" (ppr dc)
-  | not . null $ theta
-  = do dflags <- getDynFlags
-       cantVectorise dflags "Can't vectorise constructor with constraint context yet" (ppr dc)
-  | otherwise
-  = do { name'   <- mkLocalisedName mkVectDataConOcc name
-       ; tycon'  <- vectTyCon tycon
-       ; arg_tys <- mapM vectType rep_arg_tys
-       ; let ret_ty = mkFamilyTyConApp tycon' (mkTyVarTys univ_tvs)
-       ; fam_envs  <- readGEnv global_fam_inst_env
-       ; rep_nm    <- liftDs $ newTyConRepName name'
-       ; liftDs $ buildDataCon fam_envs
-                    name'
-                    (dataConIsInfix dc)            -- infix if the original is
-                    rep_nm
-                    (dataConSrcBangs dc)           -- strictness as original constructor
-                    (Just $ dataConImplBangs dc)
-                    []                             -- no labelled fields for now
-                    univ_bndrs                     -- universally quantified vars
-                    []                             -- no existential tvs for now
-                    []                             -- no equalities for now
-                    []                             -- no context for now
-                    arg_tys                        -- argument types
-                    ret_ty                         -- return type
-                    tycon'                         -- representation tycon
-       }
-  where
-    name        = dataConName dc
-    rep_arg_tys = dataConRepArgTys dc
-    tycon       = dataConTyCon dc
-    (univ_tvs, ex_tvs, eq_spec, theta, _arg_tys, _res_ty) = dataConFullSig dc
-    univ_bndrs  = dataConUnivTyVarBinders dc
diff --git a/compiler/vectorise/Vectorise/Type/Type.hs b/compiler/vectorise/Vectorise/Type/Type.hs
deleted file mode 100644
index 88d3f565f3..0000000000
--- a/compiler/vectorise/Vectorise/Type/Type.hs
+++ /dev/null
@@ -1,87 +0,0 @@
--- Apply the vectorisation transformation to types. This is the \mathcal{L}_t scheme in HtM.
-
-module Vectorise.Type.Type
-  ( vectTyCon
-  , vectAndLiftType
-  , vectType
-  )
-where
-
-import Vectorise.Utils
-import Vectorise.Monad
-import Vectorise.Builtins
-import TcType
-import Type
-import TyCoRep
-import TyCon
-import Control.Monad
-import Control.Applicative
-import Data.Maybe
-import Outputable
-import Prelude -- avoid redundant import warning due to AMP
-
--- |Vectorise a type constructor. Unless there is a vectorised version (stripped of embedded
--- parallel arrays), the vectorised version is the same as the original.
---
-vectTyCon :: TyCon -> VM TyCon
-vectTyCon tc = maybe tc id <$> lookupTyCon tc
-
--- |Produce the vectorised and lifted versions of a type.
---
--- NB: Here we are limited to properly handle predicates at the toplevel only.  Anything embedded
---     in what is called the 'body_ty' below will end up as an argument to the type family 'PData'.
---
-vectAndLiftType :: Type -> VM (Type, Type)
-vectAndLiftType ty | Just ty' <- coreView ty = vectAndLiftType ty'
-vectAndLiftType ty
-  = do { padicts  <- liftM catMaybes $ mapM paDictArgType tyvars
-       ; vmono_ty <- vectType mono_ty
-       ; lmono_ty <- mkPDataType vmono_ty
-       ; return (abstractType tyvars (padicts ++ theta) vmono_ty,
-                 abstractType tyvars (padicts ++ theta) lmono_ty)
-       }
-  where
-    (tyvars, phiTy)  = splitForAllTys ty
-    (theta, mono_ty) = tcSplitPhiTy phiTy
-
--- |Vectorise a type.
---
--- For each quantified var we need to add a PA dictionary out the front of the type.
--- So          forall a.         C  a => a -> a
--- turns into  forall a. PA a => Cv a => a :-> a
---
-vectType :: Type -> VM Type
-vectType ty
-  | Just ty'  <- coreView ty
-  = vectType ty'
-vectType (TyVarTy tv)      = return $ TyVarTy tv
-vectType (LitTy l)         = return $ LitTy l
-vectType (AppTy ty1 ty2)   = AppTy <$> vectType ty1 <*> vectType ty2
-vectType (TyConApp tc tys) = TyConApp <$> vectTyCon tc <*> mapM vectType tys
-vectType (FunTy ty1 ty2)
-  | isPredTy ty1
-  = mkFunTy <$> vectType ty1 <*> vectType ty2   -- don't build a closure for dictionary abstraction
-  | otherwise
-  = TyConApp <$> builtin closureTyCon <*> mapM vectType [ty1, ty2]
-vectType ty@(ForAllTy {})
- = do {   -- strip off consecutive foralls
-      ; let (tyvars, tyBody) = splitForAllTys ty
-
-          -- vectorise the body
-      ; vtyBody <- vectType tyBody
-
-          -- make a PA dictionary for each of the type variables
-      ; dictsPA <- liftM catMaybes $ mapM paDictArgType tyvars
-
-          -- add the PA dictionaries after the foralls
-      ; return $ abstractType tyvars dictsPA vtyBody
-      }
-vectType ty@(CastTy {})
-  = pprSorry "Vectorise.Type.Type.vectType: CastTy" (ppr ty)
-vectType ty@(CoercionTy {})
-  = pprSorry "Vectorise.Type.Type.vectType: CoercionTy" (ppr ty)
-
--- |Add quantified vars and dictionary parameters to the front of a type.
---
-abstractType :: [TyVar] -> [Type] -> Type -> Type
-abstractType tyvars dicts = mkInvForAllTys tyvars . mkFunTys dicts
diff --git a/compiler/vectorise/Vectorise/Utils.hs b/compiler/vectorise/Vectorise/Utils.hs
deleted file mode 100644
index 733eeb9cfd..0000000000
--- a/compiler/vectorise/Vectorise/Utils.hs
+++ /dev/null
@@ -1,165 +0,0 @@
-module Vectorise.Utils (
-  module Vectorise.Utils.Base,
-  module Vectorise.Utils.Closure,
-  module Vectorise.Utils.Hoisting,
-  module Vectorise.Utils.PADict,
-  module Vectorise.Utils.Poly,
-
-  -- * Annotated Exprs
-  collectAnnTypeArgs,
-  collectAnnDictArgs,
-  collectAnnTypeBinders,
-  collectAnnValBinders,
-  isAnnTypeArg,
-
-  -- * PD Functions
-  replicatePD, emptyPD, packByTagPD,
-  combinePD, liftPD,
-
-  -- * Scalars
-  isScalar, zipScalars, scalarClosure,
-
-  -- * Naming
-  newLocalVar
-) where
-
-import Vectorise.Utils.Base
-import Vectorise.Utils.Closure
-import Vectorise.Utils.Hoisting
-import Vectorise.Utils.PADict
-import Vectorise.Utils.Poly
-import Vectorise.Monad
-import Vectorise.Builtins
-import CoreSyn
-import CoreUtils
-import Id
-import Type
-import Control.Monad
-
-
--- Annotated Exprs ------------------------------------------------------------
-
-collectAnnTypeArgs :: AnnExpr b ann -> (AnnExpr b ann, [Type])
-collectAnnTypeArgs expr = go expr []
-  where
-    go (_, AnnApp f (_, AnnType ty)) tys = go f (ty : tys)
-    go e                             tys = (e, tys)
-
-collectAnnDictArgs :: AnnExpr Var ann -> (AnnExpr Var ann, [AnnExpr Var ann])
-collectAnnDictArgs expr = go expr []
-  where
-    go e@(_, AnnApp f arg) dicts
-      | isPredTy . exprType . deAnnotate $ arg = go f (arg : dicts)
-      | otherwise                              = (e, dicts)
-    go e                        dicts          = (e, dicts)
-
-collectAnnTypeBinders :: AnnExpr Var ann -> ([Var], AnnExpr Var ann)
-collectAnnTypeBinders expr = go [] expr
-  where
-    go bs (_, AnnLam b e) | isTyVar b = go (b : bs) e
-    go bs e                           = (reverse bs, e)
-
--- |Collect all consecutive value binders that are not dictionaries.
---
-collectAnnValBinders :: AnnExpr Var ann -> ([Var], AnnExpr Var ann)
-collectAnnValBinders expr = go [] expr
-  where
-    go bs (_, AnnLam b e) | isId b
-                          && (not . isPredTy . idType $ b) = go (b : bs) e
-    go bs e                                                = (reverse bs, e)
-
-isAnnTypeArg :: AnnExpr b ann -> Bool
-isAnnTypeArg (_, AnnType _) = True
-isAnnTypeArg _              = False
-
-
--- PD "Parallel Data" Functions -----------------------------------------------
---
---   Given some data that has a PA dictionary, we can convert it to its
---   representation type, perform some operation on the data, then convert it back.
---
---   In the DPH backend, the types of these functions are defined
---   in dph-common/D.A.P.Lifted/PArray.hs
---
-
--- |An empty array of the given type.
---
-emptyPD :: Type -> VM CoreExpr
-emptyPD = paMethod emptyPDVar emptyPD_PrimVar
-
--- |Produce an array containing copies of a given element.
---
-replicatePD :: CoreExpr     -- ^ Number of copies in the resulting array.
-            -> CoreExpr     -- ^ Value to replicate.
-            -> VM CoreExpr
-replicatePD len x
-  = liftM (`mkApps` [len,x])
-        $ paMethod replicatePDVar replicatePD_PrimVar (exprType x)
-
--- |Select some elements from an array that correspond to a particular tag value and pack them into a new
--- array.
---
--- > packByTagPD Int# [:23, 42, 95, 50, 27, 49:]  3 [:1, 2, 1, 2, 3, 2:] 2
--- >   ==> [:42, 50, 49:]
---
-packByTagPD :: Type       -- ^ Element type.
-            -> CoreExpr   -- ^ Source array.
-            -> CoreExpr   -- ^ Length of resulting array.
-            -> CoreExpr   -- ^ Tag values of elements in source array.
-            -> CoreExpr   -- ^ The tag value for the elements to select.
-            -> VM CoreExpr
-packByTagPD ty xs len tags t
-  = liftM (`mkApps` [xs, len, tags, t])
-          (paMethod packByTagPDVar packByTagPD_PrimVar ty)
-
--- |Combine some arrays based on a selector.  The selector says which source array to choose for each
--- element of the resulting array.
---
-combinePD :: Type         -- ^ Element type
-          -> CoreExpr     -- ^ Length of resulting array
-          -> CoreExpr     -- ^ Selector.
-          -> [CoreExpr]   -- ^ Arrays to combine.
-          -> VM CoreExpr
-combinePD ty len sel xs
-  = liftM (`mkApps` (len : sel : xs))
-          (paMethod (combinePDVar n) (combinePD_PrimVar n) ty)
-  where
-    n = length xs
-
--- |Like `replicatePD` but use the lifting context in the vectoriser state.
---
-liftPD :: CoreExpr -> VM CoreExpr
-liftPD x
-  = do
-      lc <- builtin liftingContext
-      replicatePD (Var lc) x
-
-
--- Scalars --------------------------------------------------------------------
-
-isScalar :: Type -> VM Bool
-isScalar ty
-  = do
-    { scalar <- builtin scalarClass
-    ; existsInst scalar [ty]
-    }
-
-zipScalars :: [Type] -> Type -> VM CoreExpr
-zipScalars arg_tys res_ty
-  = do
-    { scalar <- builtin scalarClass
-    ; (dfuns, _) <- mapAndUnzipM (\ty -> lookupInst scalar [ty]) ty_args
-    ; zipf <- builtin (scalarZip $ length arg_tys)
-    ; return $ Var zipf `mkTyApps` ty_args `mkApps` map Var dfuns
-    }
-    where
-      ty_args = arg_tys ++ [res_ty]
-
-scalarClosure :: [Type] -> Type -> CoreExpr -> CoreExpr -> VM CoreExpr
-scalarClosure arg_tys res_ty scalar_fun array_fun
-  = do
-    { ctr <- builtin (closureCtrFun $ length arg_tys)
-    ; pas <- mapM paDictOfType (init arg_tys)
-    ; return $ Var ctr `mkTyApps` (arg_tys ++ [res_ty])
-                       `mkApps`   (pas ++ [scalar_fun, array_fun])
-    }
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
deleted file mode 100644
index 88058e22d9..0000000000
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ /dev/null
@@ -1,259 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module Vectorise.Utils.Base
-  ( voidType
-  , newLocalVVar
-
-  , mkDataConTag
-  , mkWrapType
-  , mkClosureTypes
-  , mkPReprType
-  , mkPDataType, mkPDatasType
-  , splitPrimTyCon
-  , mkBuiltinCo
-
-  , wrapNewTypeBodyOfWrap
-  , unwrapNewTypeBodyOfWrap
-  , wrapNewTypeBodyOfPDataWrap
-  , unwrapNewTypeBodyOfPDataWrap
-  , wrapNewTypeBodyOfPDatasWrap
-  , unwrapNewTypeBodyOfPDatasWrap
-
-  , pdataReprTyCon
-  , pdataReprTyConExact
-  , pdatasReprTyConExact
-  , pdataUnwrapScrut
-
-  , preprFamInst
-) where
-
-import Vectorise.Monad
-import Vectorise.Vect
-import Vectorise.Builtins
-
-import CoreSyn
-import CoreUtils
-import FamInstEnv
-import Coercion
-import Type
-import TyCon
-import DataCon
-import MkId
-import DynFlags
-import FastString
-
-#include "HsVersions.h"
-
--- Simple Types ---------------------------------------------------------------
-
-voidType :: VM Type
-voidType = mkBuiltinTyConApp voidTyCon []
-
-
--- Name Generation ------------------------------------------------------------
-
-newLocalVVar :: FastString -> Type -> VM VVar
-newLocalVVar fs vty
-  = do
-      lty <- mkPDataType vty
-      vv  <- newLocalVar fs vty
-      lv  <- newLocalVar fs lty
-      return (vv,lv)
-
-
--- Constructors ---------------------------------------------------------------
-
-mkDataConTag :: DynFlags -> DataCon -> CoreExpr
-mkDataConTag dflags = mkIntLitInt dflags . dataConTagZ
-
-
--- Type Construction ----------------------------------------------------------
-
--- |Make an application of the 'Wrap' type constructor.
---
-mkWrapType :: Type -> VM Type
-mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty]
-
--- |Make an application of the closure type constructor.
---
-mkClosureTypes :: [Type] -> Type -> VM Type
-mkClosureTypes = mkBuiltinTyConApps closureTyCon
-
--- |Make an application of the 'PRepr' type constructor.
---
-mkPReprType :: Type -> VM Type
-mkPReprType ty = mkBuiltinTyConApp preprTyCon [ty]
-
--- | Make an application of the 'PData' tycon to some argument.
---
-mkPDataType :: Type -> VM Type
-mkPDataType ty = mkBuiltinTyConApp pdataTyCon [ty]
-
--- | Make an application of the 'PDatas' tycon to some argument.
---
-mkPDatasType :: Type -> VM Type
-mkPDatasType ty = mkBuiltinTyConApp pdatasTyCon [ty]
-
--- Make an application of a builtin type constructor to some arguments.
---
-mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type
-mkBuiltinTyConApp get_tc tys
-  = do { tc <- builtin get_tc
-       ; return $ mkTyConApp tc tys
-       }
-
--- Make a cascading application of a builtin type constructor.
---
-mkBuiltinTyConApps :: (Builtins -> TyCon) -> [Type] -> Type -> VM Type
-mkBuiltinTyConApps get_tc tys ty
- = do { tc <- builtin get_tc
-      ; return $ foldr (mk tc) ty tys
-      }
-  where
-    mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
-
-
--- Type decomposition ---------------------------------------------------------
-
--- |Checks if a type constructor is defined in 'GHC.Prim' (e.g., 'Int#'); if so, returns it.
---
-splitPrimTyCon :: Type -> Maybe TyCon
-splitPrimTyCon ty
-  | Just (tycon, []) <- splitTyConApp_maybe ty
-  , isPrimTyCon tycon
-  = Just tycon
-  | otherwise = Nothing
-
-
--- Coercion Construction -----------------------------------------------------
-
--- |Make a representational coercion to some builtin type.
---
-mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion
-mkBuiltinCo get_tc
-  = do { tc <- builtin get_tc
-       ; return $ mkTyConAppCo Representational tc []
-       }
-
-
--- Wrapping and unwrapping the 'Wrap' newtype ---------------------------------
-
--- |Apply the constructor wrapper of the 'Wrap' /newtype/.
---
-wrapNewTypeBodyOfWrap :: CoreExpr -> Type -> VM CoreExpr
-wrapNewTypeBodyOfWrap e ty
-  = do { wrap_tc <- builtin wrapTyCon
-       ; return $ wrapNewTypeBody wrap_tc [ty] e
-       }
-
--- |Strip the constructor wrapper of the 'Wrap' /newtype/.
---
-unwrapNewTypeBodyOfWrap :: CoreExpr -> Type -> VM CoreExpr
-unwrapNewTypeBodyOfWrap e ty
-  = do { wrap_tc <- builtin wrapTyCon
-       ; return $ unwrapNewTypeBody wrap_tc [ty] e
-       }
-
--- |Apply the constructor wrapper of the 'PData' /newtype/ instance of 'Wrap'.
---
-wrapNewTypeBodyOfPDataWrap :: CoreExpr -> Type -> VM CoreExpr
-wrapNewTypeBodyOfPDataWrap e ty
-  = do { wrap_tc  <- builtin wrapTyCon
-       ; pwrap_tc <- pdataReprTyConExact wrap_tc
-       ; return $ wrapNewTypeBody pwrap_tc [ty] e
-       }
-
--- |Strip the constructor wrapper of the 'PData' /newtype/ instance of 'Wrap'.
---
-unwrapNewTypeBodyOfPDataWrap :: CoreExpr -> Type -> VM CoreExpr
-unwrapNewTypeBodyOfPDataWrap e ty
-  = do { wrap_tc  <- builtin wrapTyCon
-       ; pwrap_tc <- pdataReprTyConExact wrap_tc
-       ; return $ unwrapNewTypeBody pwrap_tc [ty] (unwrapFamInstScrut pwrap_tc [ty] e)
-       }
-
--- |Apply the constructor wrapper of the 'PDatas' /newtype/ instance of 'Wrap'.
---
-wrapNewTypeBodyOfPDatasWrap :: CoreExpr -> Type -> VM CoreExpr
-wrapNewTypeBodyOfPDatasWrap e ty
-  = do { wrap_tc  <- builtin wrapTyCon
-       ; pwrap_tc <- pdatasReprTyConExact wrap_tc
-       ; return $ wrapNewTypeBody pwrap_tc [ty] e
-       }
-
--- |Strip the constructor wrapper of the 'PDatas' /newtype/ instance of 'Wrap'.
---
-unwrapNewTypeBodyOfPDatasWrap :: CoreExpr -> Type -> VM CoreExpr
-unwrapNewTypeBodyOfPDatasWrap e ty
-  = do { wrap_tc  <- builtin wrapTyCon
-       ; pwrap_tc <- pdatasReprTyConExact wrap_tc
-       ; return $ unwrapNewTypeBody pwrap_tc [ty] (unwrapFamInstScrut pwrap_tc [ty] e)
-       }
-
-
--- 'PData' representation types ----------------------------------------------
-
--- |Get the representation tycon of the 'PData' data family for a given type.
---
--- This tycon does not appear explicitly in the source program — see Note [PData TyCons] in
--- 'Vectorise.Generic.Description':
---
---   @pdataReprTyCon {Sum2} = {PDataSum2}@
---
--- The type for which we look up a 'PData' instance may be more specific than the type in the
--- instance declaration.  In that case the second component of the result will be more specific than
--- a set of distinct type variables.
---
-pdataReprTyCon :: Type -> VM (TyCon, [Type])
-pdataReprTyCon ty
-  = do
-    { FamInstMatch { fim_instance = famInst
-                   , fim_tys      = tys } <- builtin pdataTyCon >>= (`lookupFamInst` [ty])
-    ; return (dataFamInstRepTyCon famInst, tys)
-    }
-
--- |Get the representation tycon of the 'PData' data family for a given type constructor.
---
--- For example, for a binary type constructor 'T', we determine the representation type constructor
--- for 'PData (T a b)'.
---
-pdataReprTyConExact :: TyCon -> VM TyCon
-pdataReprTyConExact tycon
-  = do {   -- look up the representation tycon; if there is a match at all, it will be exact
-       ;   -- (i.e.,' _tys' will be distinct type variables)
-       ; (ptycon, _tys) <- pdataReprTyCon (tycon `mkTyConApp` mkTyVarTys (tyConTyVars tycon))
-       ; return ptycon
-       }
-
--- |Get the representation tycon of the 'PDatas' data family for a given type constructor.
---
--- For example, for a binary type constructor 'T', we determine the representation type constructor
--- for 'PDatas (T a b)'.
---
-pdatasReprTyConExact :: TyCon -> VM TyCon
-pdatasReprTyConExact tycon
-  = do {   -- look up the representation tycon; if there is a match at all, it will be exact
-       ; (FamInstMatch { fim_instance = ptycon }) <- pdatasReprTyCon (tycon `mkTyConApp` mkTyVarTys (tyConTyVars tycon))
-       ; return $ dataFamInstRepTyCon ptycon
-       }
-  where
-    pdatasReprTyCon ty = builtin pdatasTyCon >>= (`lookupFamInst` [ty])
-
--- |Unwrap a 'PData' representation scrutinee.
---
-pdataUnwrapScrut :: VExpr -> VM (CoreExpr, CoreExpr, DataCon)
-pdataUnwrapScrut (ve, le)
-  = do { (tc, arg_tys) <- pdataReprTyCon ty
-       ; let [dc] = tyConDataCons tc
-       ; return (ve, unwrapFamInstScrut tc arg_tys le, dc)
-       }
-  where
-    ty = exprType ve
-
-
--- 'PRepr' representation types ----------------------------------------------
-
--- |Get the representation tycon of the 'PRepr' type family for a given type.
---
-preprFamInst :: Type -> VM FamInstMatch
-preprFamInst ty = builtin preprTyCon >>= (`lookupFamInst` [ty])
diff --git a/compiler/vectorise/Vectorise/Utils/Closure.hs b/compiler/vectorise/Vectorise/Utils/Closure.hs
deleted file mode 100644
index 118f34dfbf..0000000000
--- a/compiler/vectorise/Vectorise/Utils/Closure.hs
+++ /dev/null
@@ -1,161 +0,0 @@
--- |Utils concerning closure construction and application.
-
-module Vectorise.Utils.Closure
-  ( mkClosure
-  , mkClosureApp
-  , buildClosures
-  )
-where
-
-import Vectorise.Builtins
-import Vectorise.Vect
-import Vectorise.Monad
-import Vectorise.Utils.Base
-import Vectorise.Utils.PADict
-import Vectorise.Utils.Hoisting
-
-import CoreSyn
-import Type
-import MkCore
-import CoreUtils
-import TyCon
-import DataCon
-import MkId
-import TysWiredIn
-import BasicTypes( Boxity(..) )
-import FastString
-
-
--- |Make a closure.
---
-mkClosure :: Type       -- ^ Type of the argument.
-          -> Type       -- ^ Type of the result.
-          -> Type       -- ^ Type of the environment.
-          -> VExpr      -- ^ The function to apply.
-          -> VExpr      -- ^ The environment to use.
-          -> VM VExpr
-mkClosure arg_ty res_ty env_ty (vfn,lfn) (venv,lenv)
- = do dict <- paDictOfType env_ty
-      mkv  <- builtin closureVar
-      mkl  <- builtin liftedClosureVar
-      return (Var mkv `mkTyApps` [arg_ty, res_ty, env_ty] `mkApps` [dict, vfn, lfn, venv],
-              Var mkl `mkTyApps` [arg_ty, res_ty, env_ty] `mkApps` [dict, vfn, lfn, lenv])
-
--- |Make a closure application.
---
-mkClosureApp :: Type      -- ^ Type of the argument.
-             -> Type      -- ^ Type of the result.
-             -> VExpr     -- ^ Closure to apply.
-             -> VExpr     -- ^ Argument to use.
-             -> VM VExpr
-mkClosureApp arg_ty res_ty (vclo, lclo) (varg, larg)
- = do vapply <- builtin applyVar
-      lapply <- builtin liftedApplyVar
-      lc     <- builtin liftingContext
-      return (Var vapply `mkTyApps` [arg_ty, res_ty] `mkApps` [vclo, varg],
-              Var lapply `mkTyApps` [arg_ty, res_ty] `mkApps` [Var lc, lclo, larg])
-
--- |Build a set of 'n' closures corresponding to an 'n'-ary vectorised function.  The length of
--- the list of types of arguments determines the arity.
---
--- In addition to a set of type variables, a set of value variables is passed during closure
--- /construction/.  In contrast, the closure environment and the arguments are passed during closure
--- application.
---
-buildClosures :: [TyVar]    -- ^ Type variables passed during closure construction.
-              -> [Var]      -- ^ Variables passed during closure construction.
-              -> [VVar]     -- ^ Variables in the environment.
-              -> [Type]     -- ^ Type of the arguments.
-              -> Type       -- ^ Type of result.
-              -> VM VExpr
-              -> VM VExpr
-buildClosures _tvs _vars _env [] _res_ty mk_body
- = mk_body
-buildClosures tvs vars env [arg_ty] res_ty mk_body
- =  buildClosure tvs vars env arg_ty res_ty mk_body
-buildClosures tvs vars env (arg_ty : arg_tys) res_ty mk_body
- = do { res_ty' <- mkClosureTypes arg_tys res_ty
-      ; arg     <- newLocalVVar (fsLit "x") arg_ty
-      ; buildClosure tvs vars env arg_ty res_ty'
-          . hoistPolyVExpr tvs vars (Inline (length env + 1))
-          $ do { lc     <- builtin liftingContext
-               ; clo    <- buildClosures tvs vars (env ++ [arg]) arg_tys res_ty mk_body
-               ; return $ vLams lc (env ++ [arg]) clo
-               }
-      }
-
--- Build a closure taking one extra argument during closure application.
---
--- (clo <x1,...,xn> <f,f^>, aclo (Arr lc xs1 ... xsn) <f,f^>)
---   where
---     f  = \env v -> case env of <x1,...,xn> -> e x1 ... xn v
---     f^ = \env v -> case env of Arr l xs1 ... xsn -> e^ l x1 ... xn v
---
--- In addition to a set of type variables, a set of value variables is passed during closure
--- /construction/.  In contrast, the closure environment and the closure argument are passed during
--- closure application.
---
-buildClosure :: [TyVar]         -- ^Type variables passed during closure construction.
-             -> [Var]           -- ^Variables passed during closure construction.
-             -> [VVar]          -- ^Variables in the environment.
-             -> Type            -- ^Type of the closure argument.
-             -> Type            -- ^Type of the result.
-             -> VM VExpr
-             -> VM VExpr
-buildClosure tvs vars vvars arg_ty res_ty mk_body
-  = do { (env_ty, env, bind) <- buildEnv vvars
-       ; env_bndr <- newLocalVVar (fsLit "env") env_ty
-       ; arg_bndr <- newLocalVVar (fsLit "arg") arg_ty
-
-           -- generate the closure function as a hoisted binding
-       ; fn <- hoistPolyVExpr tvs vars (Inline 2) $
-                 do { lc     <- builtin liftingContext
-                    ; body   <- mk_body
-                    ; return . vLams lc [env_bndr, arg_bndr]
-                             $ bind (vVar env_bndr)
-                                    (vVarApps lc body (vvars ++ [arg_bndr]))
-                    }
-
-       ; mkClosure arg_ty res_ty env_ty fn env
-       }
-
--- Build the environment for a single closure.
---
-buildEnv :: [VVar] -> VM (Type, VExpr, VExpr -> VExpr -> VExpr)
-buildEnv []
- = do
-      ty    <- voidType
-      void  <- builtin voidVar
-      pvoid <- builtin pvoidVar
-      return (ty, vVar (void, pvoid), \_ body -> body)
-buildEnv [v]
- = return (vVarType v, vVar v,
-           \env body -> vLet (vNonRec v env) body)
-buildEnv vs
- = do (lenv_tc, lenv_tyargs) <- pdataReprTyCon ty
-
-      let venv_con   = tupleDataCon Boxed (length vs)
-          [lenv_con] = tyConDataCons lenv_tc
-
-          venv       = mkCoreTup (map Var vvs)
-          lenv       = Var (dataConWrapId lenv_con)
-                       `mkTyApps` lenv_tyargs
-                       `mkApps`   map Var lvs
-
-          vbind env body = mkWildCase env ty (exprType body)
-                           [(DataAlt venv_con, vvs, body)]
-
-          lbind env body =
-            let scrut = unwrapFamInstScrut lenv_tc lenv_tyargs env
-            in
-            mkWildCase scrut (exprType scrut) (exprType body)
-              [(DataAlt lenv_con, lvs, body)]
-
-          bind (venv, lenv) (vbody, lbody) = (vbind venv vbody,
-                                              lbind lenv lbody)
-
-      return (ty, (venv, lenv), bind)
-  where
-    (vvs, lvs) = unzip vs
-    tys        = map vVarType vs
-    ty         = mkBoxedTupleTy tys
diff --git a/compiler/vectorise/Vectorise/Utils/Hoisting.hs b/compiler/vectorise/Vectorise/Utils/Hoisting.hs
deleted file mode 100644
index 05883457bf..0000000000
--- a/compiler/vectorise/Vectorise/Utils/Hoisting.hs
+++ /dev/null
@@ -1,98 +0,0 @@
-module Vectorise.Utils.Hoisting
-  ( Inline(..)
-  , addInlineArity
-  , inlineMe
-
-  , hoistBinding
-  , hoistExpr
-  , hoistVExpr
-  , hoistPolyVExpr
-  , takeHoisted
-  )
-where
-
-import Vectorise.Monad
-import Vectorise.Env
-import Vectorise.Vect
-import Vectorise.Utils.Poly
-
-import CoreSyn
-import CoreUtils
-import CoreUnfold
-import Type
-import Id
-import BasicTypes  (Arity)
-import FastString
-import Control.Monad
-import Control.Applicative
-import Prelude -- avoid redundant import warning due to AMP
-
--- Inline ---------------------------------------------------------------------
-
--- |Records whether we should inline a particular binding.
---
-data Inline
-        = Inline Arity
-        | DontInline
-
--- |Add to the arity contained within an `Inline`, if any.
---
-addInlineArity :: Inline -> Int -> Inline
-addInlineArity (Inline m) n = Inline (m+n)
-addInlineArity DontInline _ = DontInline
-
--- |Says to always inline a binding.
---
-inlineMe :: Inline
-inlineMe = Inline 0
-
-
--- Hoisting --------------------------------------------------------------------
-
-hoistBinding :: Var -> CoreExpr -> VM ()
-hoistBinding v e = updGEnv $ \env ->
-  env { global_bindings = (v,e) : global_bindings env }
-
-hoistExpr :: FastString -> CoreExpr -> Inline -> VM Var
-hoistExpr fs expr inl
-  = do
-      var <- mk_inline `liftM` newLocalVar fs (exprType expr)
-      hoistBinding var expr
-      return var
-  where
-    mk_inline var = case inl of
-                      Inline arity -> var `setIdUnfolding`
-                                      mkInlineUnfoldingWithArity arity expr
-                      DontInline   -> var
-
-hoistVExpr :: VExpr -> Inline -> VM VVar
-hoistVExpr (ve, le) inl
-  = do
-      fs <- getBindName
-      vv <- hoistExpr ('v' `consFS` fs) ve inl
-      lv <- hoistExpr ('l' `consFS` fs) le (addInlineArity inl 1)
-      return (vv, lv)
-
--- |Hoist a polymorphic vectorised expression into a new top-level binding (representing a closure
--- function).
---
--- The hoisted expression is parameterised by (1) a set of type variables and (2) a set of value
--- variables that are passed as conventional type and value arguments.  The latter is implicitly
--- extended by the set of 'PA' dictionaries required for the type variables.
---
-hoistPolyVExpr :: [TyVar] -> [Var] -> Inline -> VM VExpr -> VM VExpr
-hoistPolyVExpr tvs vars inline p
-  = do { inline' <- addInlineArity inline . (+ length vars) <$> polyArity tvs
-       ; expr <- closedV . polyAbstract tvs $ \args ->
-                   mapVect (mkLams $ tvs ++ args ++ vars) <$> p
-       ; fn   <- hoistVExpr expr inline'
-       ; let varArgs = varsToCoreExprs vars
-       ; mapVect (\e -> e `mkApps` varArgs) <$> polyVApply (vVar fn) (mkTyVarTys tvs)
-       }
-
-takeHoisted :: VM [(Var, CoreExpr)]
-takeHoisted
-  = do
-      env <- readGEnv id
-      setGEnv $ env { global_bindings = [] }
-      return $ global_bindings env
diff --git a/compiler/vectorise/Vectorise/Utils/PADict.hs b/compiler/vectorise/Vectorise/Utils/PADict.hs
deleted file mode 100644
index 4d32f5df74..0000000000
--- a/compiler/vectorise/Vectorise/Utils/PADict.hs
+++ /dev/null
@@ -1,230 +0,0 @@
-module Vectorise.Utils.PADict (
-  paDictArgType,
-  paDictOfType,
-  paMethod,
-  prDictOfReprType,
-  prDictOfPReprInstTyCon
-) where
-
-import Vectorise.Monad
-import Vectorise.Builtins
-import Vectorise.Utils.Base
-
-import CoreSyn
-import CoreUtils
-import FamInstEnv
-import Coercion
-import Type
-import TyCoRep
-import TyCon
-import CoAxiom
-import Var
-import Outputable
-import DynFlags
-import FastString
-import Util
-import Control.Monad
-
-
--- |Construct the PA argument type for the tyvar. For the tyvar (v :: *) it's
--- just PA v. For (v :: (* -> *) -> *) it's
---
--- > forall (a :: * -> *). (forall (b :: *). PA b -> PA (a b)) -> PA (v a)
---
-paDictArgType :: TyVar -> VM (Maybe Type)
-paDictArgType tv = go (mkTyVarTy tv) (tyVarKind tv)
-  where
-    go ty (FunTy k1 k2)
-      = do
-          tv   <- if isCoercionType k1
-                  then newCoVar (fsLit "c") k1
-                  else newTyVar (fsLit "a") k1
-          mty1 <- go (mkTyVarTy tv) k1
-          case mty1 of
-            Just ty1 -> do
-                          mty2 <- go (mkAppTy ty (mkTyVarTy tv)) k2
-                          return $ fmap (mkInvForAllTy tv . mkFunTy ty1) mty2
-            Nothing  -> go ty k2
-
-    go ty k
-      | isLiftedTypeKind k
-      = do
-          pa_cls <- builtin paClass
-          return $ Just $ mkClassPred pa_cls [ty]
-
-    go _ _ = return Nothing
-
-
--- |Get the PA dictionary for some type
---
-paDictOfType :: Type -> VM CoreExpr
-paDictOfType ty
-  = paDictOfTyApp ty_fn ty_args
-  where
-    (ty_fn, ty_args) = splitAppTys ty
-
-    paDictOfTyApp :: Type -> [Type] -> VM CoreExpr
-    paDictOfTyApp ty_fn ty_args
-        | Just ty_fn' <- coreView ty_fn
-        = paDictOfTyApp ty_fn' ty_args
-
-    -- for type variables, look up the dfun and apply to the PA dictionaries
-    -- of the type arguments
-    paDictOfTyApp (TyVarTy tv) ty_args
-      = do
-        { dfun <- maybeCantVectoriseM "No PA dictionary for type variable"
-                                      (ppr tv <+> text "in" <+> ppr ty)
-                $ lookupTyVarPA tv
-        ; dicts <- mapM paDictOfType ty_args
-        ; return $ dfun `mkTyApps` ty_args `mkApps` dicts
-        }
-
-    -- for tycons, we also need to apply the dfun to the PR dictionary of
-    -- the representation type if the tycon is polymorphic
-    paDictOfTyApp (TyConApp tc []) ty_args
-      = do
-        { dfun <- maybeCantVectoriseM noPADictErr (ppr tc <+> text "in" <+> ppr ty)
-                $ lookupTyConPA tc
-        ; super <- super_dict tc ty_args
-        ; dicts <- mapM paDictOfType ty_args
-        ; return $ Var dfun `mkTyApps` ty_args `mkApps` super `mkApps` dicts
-        }
-      where
-        noPADictErr = "No PA dictionary for type constructor (did you import 'Data.Array.Parallel'?)"
-
-        super_dict _     []      = return []
-        super_dict tycon ty_args
-          = do
-            { pr <- prDictOfPReprInst (TyConApp tycon ty_args)
-            ; return [pr]
-            }
-
-    paDictOfTyApp _ _ = getDynFlags >>= failure
-
-    failure dflags = cantVectorise dflags "Can't construct PA dictionary for type" (ppr ty)
-
--- |Produce code that refers to a method of the 'PA' class.
---
-paMethod :: (Builtins -> Var) -> (TyCon -> Builtins -> Var) -> Type -> VM CoreExpr
-paMethod _ query ty
-  | Just tycon <- splitPrimTyCon ty             -- Is 'ty' from 'GHC.Prim' (e.g., 'Int#')?
-  = liftM Var $ builtin (query tycon)
-paMethod method _ ty
-  = do
-    { fn   <- builtin method
-    ; dict <- paDictOfType ty
-    ; return $ mkApps (Var fn) [Type ty, dict]
-    }
-
--- |Given a type @ty@, return the PR dictionary for @PRepr ty@.
---
-prDictOfPReprInst :: Type -> VM CoreExpr
-prDictOfPReprInst ty
-  = do
-    { (FamInstMatch { fim_instance = prepr_fam, fim_tys = prepr_args })
-          <- preprFamInst ty
-    ; prDictOfPReprInstTyCon ty (famInstAxiom prepr_fam) prepr_args
-    }
-
--- |Given a type @ty@, its PRepr synonym tycon and its type arguments,
--- return the PR @PRepr ty@. Suppose we have:
---
--- > type instance PRepr (T a1 ... an) = t
---
--- which is internally translated into
---
--- > type :R:PRepr a1 ... an = t
---
--- and the corresponding coercion. Then,
---
--- > prDictOfPReprInstTyCon (T a1 ... an) :R:PRepr u1 ... un = PR (T u1 ... un)
---
--- Note that @ty@ is only used for error messages
---
-prDictOfPReprInstTyCon :: Type -> CoAxiom Unbranched -> [Type] -> VM CoreExpr
-prDictOfPReprInstTyCon _ty prepr_ax prepr_args
-  = do
-      let rhs = mkUnbranchedAxInstRHS prepr_ax prepr_args []
-      dict <- prDictOfReprType' rhs
-      pr_co <- mkBuiltinCo prTyCon
-      let co = mkAppCo pr_co
-             $ mkSymCo
-             $ mkUnbranchedAxInstCo Nominal prepr_ax prepr_args []
-      return $ mkCast dict co
-
--- |Get the PR dictionary for a type. The argument must be a representation
--- type.
---
-prDictOfReprType :: Type -> VM CoreExpr
-prDictOfReprType ty
-  | Just (tycon, tyargs) <- splitTyConApp_maybe ty
-    = do
-        prepr <- builtin preprTyCon
-        if tycon == prepr
-          then do
-                 let [ty'] = tyargs
-                 pa <- paDictOfType ty'
-                 sel <- builtin paPRSel
-                 return $ Var sel `App` Type ty' `App` pa
-          else do
-                 -- a representation tycon must have a PR instance
-                 dfun <- maybeV (text "look up PR dictionary for" <+> ppr tycon) $
-                           lookupTyConPR tycon
-                 prDFunApply dfun tyargs
-
-  | otherwise
-    = do
-        -- it is a tyvar or an application of a tyvar
-        -- determine the PR dictionary from its PA dictionary
-        --
-        -- NOTE: This assumes that PRepr t ~ t is for all representation types
-        -- t
-        --
-        -- FIXME: This doesn't work for kinds other than * at the moment. We'd
-        -- have to simply abstract the term over the missing type arguments.
-        pa    <- paDictOfType ty
-        prsel <- builtin paPRSel
-        return $ Var prsel `mkApps` [Type ty, pa]
-
-prDictOfReprType' :: Type -> VM CoreExpr
-prDictOfReprType' ty = prDictOfReprType ty `orElseV`
-                       do dflags <- getDynFlags
-                          cantVectorise dflags "No PR dictionary for representation type"
-                                        (ppr ty)
-
--- | Apply a tycon's PR dfun to dictionary arguments (PR or PA) corresponding
--- to the argument types.
-prDFunApply :: Var -> [Type] -> VM CoreExpr
-prDFunApply dfun tys
-  | Just [] <- ctxs    -- PR (a :-> b) doesn't have a context
-  = return $ Var dfun `mkTyApps` tys
-
-  | Just tycons <- ctxs
-  , tycons `equalLength` tys
-  = do
-      pa <- builtin paTyCon
-      pr <- builtin prTyCon
-      dflags <- getDynFlags
-      args <- zipWithM (dictionary dflags pa pr) tys tycons
-      return $ Var dfun `mkTyApps` tys `mkApps` args
-
-  | otherwise = do dflags <- getDynFlags
-                   invalid dflags
-  where
-    -- the dfun's contexts - if its type is (PA a, PR b) => PR (C a b) then
-    -- ctxs is Just [PA, PR]
-    ctxs = fmap (map fst)
-         $ sequence
-         $ map splitTyConApp_maybe
-         $ fst
-         $ splitFunTys
-         $ snd
-         $ splitForAllTys
-         $ varType dfun
-
-    dictionary dflags pa pr ty tycon
-      | tycon == pa = paDictOfType ty
-      | tycon == pr = prDictOfReprType ty
-      | otherwise   = invalid dflags
-
-    invalid dflags = cantVectorise dflags "Invalid PR dfun type" (ppr (varType dfun) <+> ppr tys)
diff --git a/compiler/vectorise/Vectorise/Utils/Poly.hs b/compiler/vectorise/Vectorise/Utils/Poly.hs
deleted file mode 100644
index d9f657f950..0000000000
--- a/compiler/vectorise/Vectorise/Utils/Poly.hs
+++ /dev/null
@@ -1,72 +0,0 @@
--- |Auxiliary functions to vectorise type abstractions.
-
-module Vectorise.Utils.Poly
-  ( polyAbstract
-  , polyApply
-  , polyVApply
-  , polyArity
-  )
-where
-
-import Vectorise.Vect
-import Vectorise.Monad
-import Vectorise.Utils.PADict
-import CoreSyn
-import Type
-import FastString
-import Control.Monad
-
-
--- Vectorisation of type arguments -------------------------------------------------------------
-
--- |Vectorise under the 'PA' dictionary variables corresponding to a set of type arguments.
---
--- The dictionary variables are new local variables that are entered into the local vectorisation
--- map.
---
--- The purpose of this function is to introduce the additional 'PA' dictionary arguments that are
--- needed when vectorising type abstractions.
---
-polyAbstract :: [TyVar] -> ([Var] -> VM a) -> VM a
-polyAbstract tvs p
-  = localV
-  $ do { mdicts <- mapM mk_dict_var tvs
-       ; zipWithM_ (\tv -> maybe (defLocalTyVar tv)
-                                 (defLocalTyVarWithPA tv . Var)) tvs mdicts
-       ; p (mk_args mdicts)
-       }
-  where
-    mk_dict_var tv
-      = do { r <- paDictArgType tv
-           ; case r of
-               Just ty -> liftM Just (newLocalVar (fsLit "dPA") ty)
-               Nothing -> return Nothing
-           }
-
-    mk_args mdicts = [dict | Just dict <- mdicts]
-
--- |Determine the number of 'PA' dictionary arguments required for a set of type variables (depends
--- on their kinds).
---
-polyArity :: [TyVar] -> VM Int
-polyArity tvs
-  = do { tys <- mapM paDictArgType tvs
-       ; return $ length [() | Just _ <- tys]
-       }
-
--- |Apply a expression to its type arguments as well as 'PA' dictionaries for these type arguments.
---
-polyApply :: CoreExpr -> [Type] -> VM CoreExpr
-polyApply expr tys
- = do { dicts <- mapM paDictOfType tys
-      ; return $ expr `mkTyApps` tys `mkApps` dicts
-      }
-
--- |Apply a vectorised expression to a set of type arguments together with 'PA' dictionaries for
--- these type arguments.
---
-polyVApply :: VExpr -> [Type] -> VM VExpr
-polyVApply expr tys
- = do { dicts <- mapM paDictOfType tys
-      ; return $ mapVect (\e -> e `mkTyApps` tys `mkApps` dicts) expr
-      }
diff --git a/compiler/vectorise/Vectorise/Var.hs b/compiler/vectorise/Vectorise/Var.hs
deleted file mode 100644
index 5cfc8415f7..0000000000
--- a/compiler/vectorise/Vectorise/Var.hs
+++ /dev/null
@@ -1,103 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-
--- |Vectorise variables and literals.
-
-module Vectorise.Var
-  ( vectBndr
-  , vectBndrNew
-  , vectBndrIn
-  , vectBndrNewIn
-  , vectBndrsIn
-  , vectVar
-  , vectConst
-  )
-where
-
-import Vectorise.Utils
-import Vectorise.Monad
-import Vectorise.Env
-import Vectorise.Vect
-import Vectorise.Type.Type
-import CoreSyn
-import Type
-import VarEnv
-import Id
-import FastString
-import Control.Applicative
-import Prelude -- avoid redundant import warning due to AMP
-
--- Binders ----------------------------------------------------------------------------------------
-
--- |Vectorise a binder variable, along with its attached type.
---
-vectBndr :: Var -> VM VVar
-vectBndr v
- = do (vty, lty) <- vectAndLiftType (idType v)
-      let vv = v `Id.setIdType` vty
-          lv = v `Id.setIdType` lty
-
-      updLEnv (mapTo vv lv)
-
-      return  (vv, lv)
-  where
-    mapTo vv lv env = env { local_vars = extendVarEnv (local_vars env) v (vv, lv) }
-
--- |Vectorise a binder variable, along with its attached type, but give the result a new name.
---
-vectBndrNew :: Var -> FastString -> VM VVar
-vectBndrNew v fs
- = do vty <- vectType (idType v)
-      vv  <- newLocalVVar fs vty
-      updLEnv (upd vv)
-      return vv
-  where
-    upd vv env = env { local_vars = extendVarEnv (local_vars env) v vv }
-
--- |Vectorise a binder then run a computation with that binder in scope.
---
-vectBndrIn :: Var -> VM a -> VM (VVar, a)
-vectBndrIn v p
- = localV
- $ do vv <- vectBndr v
-      x <- p
-      return (vv, x)
-
--- |Vectorise a binder, give it a new name, then run a computation with that binder in scope.
---
-vectBndrNewIn :: Var -> FastString -> VM a -> VM (VVar, a)
-vectBndrNewIn v fs p
- = localV
- $ do vv <- vectBndrNew v fs
-      x  <- p
-      return (vv, x)
-
--- |Vectorise some binders, then run a computation with them in scope.
---
-vectBndrsIn :: [Var] -> VM a -> VM ([VVar], a)
-vectBndrsIn vs p
- = localV
- $ do vvs <- mapM vectBndr vs
-      x   <- p
-      return (vvs, x)
-
-
--- Variables --------------------------------------------------------------------------------------
-
--- |Vectorise a variable, producing the vectorised and lifted versions.
---
-vectVar :: Var -> VM VExpr
-vectVar var
-  = do { vVar <- lookupVar var
-       ; case vVar of
-           Local (vv, lv) -> return (Var vv, Var lv) -- local variables have a vect & lifted version
-           Global vv      -> vectConst (Var vv)      -- global variables get replicated
-       }
-
-
--- Constants --------------------------------------------------------------------------------------
-
--- |Constants are lifted by replication along the integer context in the `VM` state for the number
--- of elements in the result array.
---
-vectConst :: CoreExpr -> VM VExpr
-vectConst c = (c,) <$> liftPD c
diff --git a/compiler/vectorise/Vectorise/Vect.hs b/compiler/vectorise/Vectorise/Vect.hs
deleted file mode 100644
index 03492291d6..0000000000
--- a/compiler/vectorise/Vectorise/Vect.hs
+++ /dev/null
@@ -1,126 +0,0 @@
--- |Simple vectorised constructors and projections.
---
-module Vectorise.Vect
-  ( Vect, VVar, VExpr, VBind
-
-  , vectorised
-  , lifted
-  , mapVect
-
-  , vVarType
-  , vNonRec
-  , vRec
-  , vVar
-  , vType
-  , vTick
-  , vLet
-  , vLams
-  , vVarApps
-  , vCaseDEFAULT
-  )
-where
-
-import CoreSyn
-import Type           ( Type )
-import Var
-
--- |Contains the vectorised and lifted versions of some thing.
---
-type Vect a = (a,a)
-type VVar   = Vect Var
-type VExpr  = Vect CoreExpr
-type VBind  = Vect CoreBind
-
--- |Get the vectorised version of a thing.
---
-vectorised :: Vect a -> a
-vectorised = fst
-
--- |Get the lifted version of a thing.
---
-lifted :: Vect a -> a
-lifted = snd
-
--- |Apply some function to both the vectorised and lifted versions of a thing.
---
-mapVect :: (a -> b) -> Vect a -> Vect b
-mapVect f (x, y) = (f x, f y)
-
--- |Combine vectorised and lifted versions of two things componentwise.
---
-zipWithVect :: (a -> b -> c) -> Vect a -> Vect b -> Vect c
-zipWithVect f (x1, y1) (x2, y2) = (f x1 x2, f y1 y2)
-
--- |Get the type of a vectorised variable.
---
-vVarType :: VVar -> Type
-vVarType = varType . vectorised
-
--- |Wrap a vectorised variable as a vectorised expression.
---
-vVar :: VVar -> VExpr
-vVar = mapVect Var
-
--- |Wrap a vectorised type as a vectorised expression.
---
-vType :: Type -> VExpr
-vType ty = (Type ty, Type ty)
-
--- |Make a vectorised note.
---
-vTick :: Tickish Id -> VExpr -> VExpr
-vTick = mapVect . Tick
-
--- |Make a vectorised non-recursive binding.
---
-vNonRec :: VVar -> VExpr -> VBind
-vNonRec = zipWithVect NonRec
-
--- |Make a vectorised recursive binding.
---
-vRec :: [VVar] -> [VExpr] -> VBind
-vRec vs es = (Rec (zip vvs ves), Rec (zip lvs les))
-  where
-    (vvs, lvs) = unzip vs
-    (ves, les) = unzip es
-
--- |Make a vectorised let expression.
---
-vLet :: VBind -> VExpr -> VExpr
-vLet = zipWithVect Let
-
--- |Make a vectorised lambda abstraction.
---
--- The lifted version also binds the lifting context 'lc'.
---
-vLams :: Var      -- ^ Var bound to the lifting context.
-      -> [VVar]   -- ^ Parameter vars for the abstraction.
-      -> VExpr    -- ^ Body of the abstraction.
-      -> VExpr
-vLams lc vs (ve, le)
-  = (mkLams vvs ve, mkLams (lc:lvs) le)
-  where
-    (vvs, lvs) = unzip vs
-
--- |Apply an expression to a set of argument variables.
---
--- The lifted version is also applied to the variable of the lifting context.
---
-vVarApps :: Var -> VExpr -> [VVar] -> VExpr
-vVarApps lc (ve, le) vvs
-  = (ve `mkVarApps` vs, le `mkVarApps` (lc : ls))
-  where
-    (vs, ls) = unzip vvs
-
-
-vCaseDEFAULT :: VExpr  -- scrutinee
-             -> VVar   -- bnder
-             -> Type   -- type of vectorised version
-             -> Type   -- type of lifted version
-             -> VExpr  -- body of alternative.
-             -> VExpr
-vCaseDEFAULT (vscrut, lscrut) (vbndr, lbndr) vty lty (vbody, lbody)
-  = (Case vscrut vbndr vty (mkDEFAULT vbody),
-     Case lscrut lbndr lty (mkDEFAULT lbody))
-  where
-    mkDEFAULT e = [(DEFAULT, [], e)]