update to current master againwip/T13904

5 files changed, 0 insertions, 820 deletions

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
-      }