vectorise: Put it out of its misery
authorBen Gamari <bgamari.foss@gmail.com>
Sat, 2 Jun 2018 15:56:58 +0000 (11:56 -0400)
committerBen Gamari <ben@smart-cactus.org>
Sat, 2 Jun 2018 20:21:12 +0000 (16:21 -0400)
Poor DPH and its vectoriser have long been languishing; sadly it seems there is
little chance that the effort will be rekindled. Every few years we discuss
what to do with this mass of code and at least once we have agreed that it
should be archived on a branch and removed from `master`. Here we do just that,
eliminating heaps of dead code in the process.

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

Test Plan: Validate

Reviewers: simonpj, simonmar, hvr, goldfire, alanz

Reviewed By: simonmar

Subscribers: goldfire, rwbarton, thomie, mpickering, carter

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

208 files changed:
compiler/backpack/RnModIface.hs
compiler/basicTypes/MkId.hs
compiler/basicTypes/Module.hs
compiler/basicTypes/Name.hs
compiler/basicTypes/OccName.hs
compiler/basicTypes/Unique.hs
compiler/coreSyn/CoreFVs.hs
compiler/coreSyn/CoreLint.hs
compiler/coreSyn/CoreOpt.hs
compiler/coreSyn/CoreSyn.hs
compiler/coreSyn/PprCore.hs
compiler/deSugar/Check.hs
compiler/deSugar/Coverage.hs
compiler/deSugar/Desugar.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsListComp.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/DsMonad.hs
compiler/deSugar/DsUtils.hs
compiler/deSugar/Match.hs
compiler/deSugar/MatchCon.hs
compiler/deSugar/PmExpr.hs
compiler/ghc.cabal.in
compiler/hsSyn/HsDecls.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsExtension.hs
compiler/hsSyn/HsInstances.hs
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsTypes.hs
compiler/hsSyn/HsUtils.hs
compiler/iface/IfaceType.hs
compiler/iface/LoadIface.hs
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/iface/TcIface.hs-boot
compiler/main/DynFlags.hs
compiler/main/HscTypes.hs
compiler/main/Packages.hs
compiler/main/TidyPgm.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/prelude/PrelNames.hs
compiler/prelude/TysWiredIn.hs
compiler/rename/RnExpr.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnTypes.hs
compiler/rename/RnUtils.hs
compiler/simplCore/CoreMonad.hs
compiler/simplCore/OccurAnal.hs
compiler/simplCore/SimplCore.hs
compiler/specialise/SpecConstr.hs
compiler/typecheck/FamInst.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcUnify.hs
compiler/utils/Outputable.hs
compiler/vectorise/Vectorise.hs [deleted file]
compiler/vectorise/Vectorise/Builtins.hs [deleted file]
compiler/vectorise/Vectorise/Builtins/Base.hs [deleted file]
compiler/vectorise/Vectorise/Builtins/Initialise.hs [deleted file]
compiler/vectorise/Vectorise/Convert.hs [deleted file]
compiler/vectorise/Vectorise/Env.hs [deleted file]
compiler/vectorise/Vectorise/Exp.hs [deleted file]
compiler/vectorise/Vectorise/Generic/Description.hs [deleted file]
compiler/vectorise/Vectorise/Generic/PADict.hs [deleted file]
compiler/vectorise/Vectorise/Generic/PAMethods.hs [deleted file]
compiler/vectorise/Vectorise/Generic/PData.hs [deleted file]
compiler/vectorise/Vectorise/Monad.hs [deleted file]
compiler/vectorise/Vectorise/Monad/Base.hs [deleted file]
compiler/vectorise/Vectorise/Monad/Global.hs [deleted file]
compiler/vectorise/Vectorise/Monad/InstEnv.hs [deleted file]
compiler/vectorise/Vectorise/Monad/Local.hs [deleted file]
compiler/vectorise/Vectorise/Monad/Naming.hs [deleted file]
compiler/vectorise/Vectorise/Type/Classify.hs [deleted file]
compiler/vectorise/Vectorise/Type/Env.hs [deleted file]
compiler/vectorise/Vectorise/Type/TyConDecl.hs [deleted file]
compiler/vectorise/Vectorise/Type/Type.hs [deleted file]
compiler/vectorise/Vectorise/Utils.hs [deleted file]
compiler/vectorise/Vectorise/Utils/Base.hs [deleted file]
compiler/vectorise/Vectorise/Utils/Closure.hs [deleted file]
compiler/vectorise/Vectorise/Utils/Hoisting.hs [deleted file]
compiler/vectorise/Vectorise/Utils/PADict.hs [deleted file]
compiler/vectorise/Vectorise/Utils/Poly.hs [deleted file]
compiler/vectorise/Vectorise/Var.hs [deleted file]
compiler/vectorise/Vectorise/Vect.hs [deleted file]
docs/ndp/haskell.sty [deleted file]
docs/ndp/vect.tex [deleted file]
docs/users_guide/debugging.rst
docs/users_guide/extending_ghc.rst
docs/users_guide/glasgow_exts.rst
docs/users_guide/parallel.rst
docs/users_guide/using-optimisation.rst
ghc.mk
libraries/base/GHC/PArr.hs [deleted file]
libraries/base/base.cabal
libraries/dph [deleted submodule]
libraries/primitive [deleted submodule]
libraries/vector [deleted submodule]
packages
testsuite/tests/dph/Makefile [deleted file]
testsuite/tests/dph/classes/DefsVect.hs [deleted file]
testsuite/tests/dph/classes/Main.hs [deleted file]
testsuite/tests/dph/classes/Makefile [deleted file]
testsuite/tests/dph/classes/dph-classes-copy-fast.stdout [deleted file]
testsuite/tests/dph/classes/dph-classes-vseg-fast.stdout [deleted file]
testsuite/tests/dph/classes/dph-classes.T [deleted file]
testsuite/tests/dph/diophantine/DiophantineVect.hs [deleted file]
testsuite/tests/dph/diophantine/Main.hs [deleted file]
testsuite/tests/dph/diophantine/Makefile [deleted file]
testsuite/tests/dph/diophantine/dph-diophantine-copy-fast.stdout [deleted file]
testsuite/tests/dph/diophantine/dph-diophantine-copy-opt.stdout [deleted file]
testsuite/tests/dph/diophantine/dph-diophantine.T [deleted file]
testsuite/tests/dph/dotp/DotPVect.hs [deleted file]
testsuite/tests/dph/dotp/Main.hs [deleted file]
testsuite/tests/dph/dotp/Makefile [deleted file]
testsuite/tests/dph/dotp/dph-dotp-copy-fast.stdout [deleted file]
testsuite/tests/dph/dotp/dph-dotp-copy-opt.stdout [deleted file]
testsuite/tests/dph/dotp/dph-dotp-vseg-fast.stdout [deleted file]
testsuite/tests/dph/dotp/dph-dotp-vseg-opt.stdout [deleted file]
testsuite/tests/dph/dotp/dph-dotp.T [deleted file]
testsuite/tests/dph/enumfromto/EnumFromToP.hs [deleted file]
testsuite/tests/dph/enumfromto/Makefile [deleted file]
testsuite/tests/dph/enumfromto/dph-enumfromto.T [deleted file]
testsuite/tests/dph/modules/ExportList.hs [deleted file]
testsuite/tests/dph/modules/Makefile [deleted file]
testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr [deleted file]
testsuite/tests/dph/modules/dph-modules.T [deleted file]
testsuite/tests/dph/nbody/Body.hs [deleted file]
testsuite/tests/dph/nbody/Config.hs [deleted file]
testsuite/tests/dph/nbody/Dump.hs [deleted file]
testsuite/tests/dph/nbody/Generate.hs [deleted file]
testsuite/tests/dph/nbody/Main.hs [deleted file]
testsuite/tests/dph/nbody/Makefile [deleted file]
testsuite/tests/dph/nbody/Randomish.hs [deleted file]
testsuite/tests/dph/nbody/Solver.hs [deleted file]
testsuite/tests/dph/nbody/Types.hs [deleted file]
testsuite/tests/dph/nbody/Util.hs [deleted file]
testsuite/tests/dph/nbody/World.hs [deleted file]
testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout [deleted file]
testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout [deleted file]
testsuite/tests/dph/nbody/dph-nbody-vseg-fast.stdout [deleted file]
testsuite/tests/dph/nbody/dph-nbody-vseg-opt.stdout [deleted file]
testsuite/tests/dph/nbody/dph-nbody.T [deleted file]
testsuite/tests/dph/primespj/Main.hs [deleted file]
testsuite/tests/dph/primespj/Makefile [deleted file]
testsuite/tests/dph/primespj/PrimesVect.hs [deleted file]
testsuite/tests/dph/primespj/dph-primespj-copy-fast.stdout [deleted file]
testsuite/tests/dph/primespj/dph-primespj-copy-opt.stdout [deleted file]
testsuite/tests/dph/primespj/dph-primespj-vseg-fast.stdout [deleted file]
testsuite/tests/dph/primespj/dph-primespj-vseg-opt.stdout [deleted file]
testsuite/tests/dph/primespj/dph-primespj.T [deleted file]
testsuite/tests/dph/quickhull/Main.hs [deleted file]
testsuite/tests/dph/quickhull/Makefile [deleted file]
testsuite/tests/dph/quickhull/QuickHullVect.hs [deleted file]
testsuite/tests/dph/quickhull/SVG.hs [deleted file]
testsuite/tests/dph/quickhull/TestData.hs [deleted file]
testsuite/tests/dph/quickhull/Types.hs [deleted file]
testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout [deleted file]
testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout [deleted file]
testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout [deleted file]
testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout [deleted file]
testsuite/tests/dph/quickhull/dph-quickhull.T [deleted file]
testsuite/tests/dph/smvm/Main.hs [deleted file]
testsuite/tests/dph/smvm/Makefile [deleted file]
testsuite/tests/dph/smvm/SMVMVect.hs [deleted file]
testsuite/tests/dph/smvm/dph-smvm-copy.stdout [deleted file]
testsuite/tests/dph/smvm/dph-smvm-vseg.stdout [deleted file]
testsuite/tests/dph/smvm/dph-smvm.T [deleted file]
testsuite/tests/dph/smvm/result-i386.txt [deleted file]
testsuite/tests/dph/smvm/result-sparc.txt [deleted file]
testsuite/tests/dph/smvm/result-x86_64.txt [deleted file]
testsuite/tests/dph/smvm/test-i386.dat [deleted file]
testsuite/tests/dph/smvm/test-sparc.dat [deleted file]
testsuite/tests/dph/smvm/test-x86_64.dat [deleted file]
testsuite/tests/dph/sumnats/Main.hs [deleted file]
testsuite/tests/dph/sumnats/Makefile [deleted file]
testsuite/tests/dph/sumnats/SumNatsVect.hs [deleted file]
testsuite/tests/dph/sumnats/dph-sumnats-copy.stdout [deleted file]
testsuite/tests/dph/sumnats/dph-sumnats-vseg.stdout [deleted file]
testsuite/tests/dph/sumnats/dph-sumnats.T [deleted file]
testsuite/tests/dph/words/Main.hs [deleted file]
testsuite/tests/dph/words/Makefile [deleted file]
testsuite/tests/dph/words/WordsVect.hs [deleted file]
testsuite/tests/dph/words/dph-words-copy-fast.stdout [deleted file]
testsuite/tests/dph/words/dph-words-copy-opt.stdout [deleted file]
testsuite/tests/dph/words/dph-words-vseg-fast.stdout [deleted file]
testsuite/tests/dph/words/dph-words-vseg-opt.stdout [deleted file]
testsuite/tests/dph/words/dph-words.T [deleted file]
testsuite/tests/ghc-api/T9015.hs
testsuite/tests/ghc-api/T9015.stdout
testsuite/tests/ghci/should_run/T7253.script
testsuite/tests/ghci/should_run/T7253.stderr
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
testsuite/tests/parser/should_compile/T14189.stderr
utils/ghctags/Main.hs
utils/haddock
validate

index afdd89e..f807b39 100644 (file)
@@ -108,7 +108,6 @@ rnModIface hsc_env insts nsubst iface = do
         deps <- rnDependencies (mi_deps iface)
         -- TODO:
         -- mi_rules
-        -- mi_vect_info (LOW PRIORITY)
         return iface { mi_module = mod
                      , mi_sig_of = sig_of
                      , mi_insts = insts
index 7e55520..f68a28d 100644 (file)
@@ -20,9 +20,7 @@ module MkId (
         mkPrimOpId, mkFCallId,
 
         wrapNewTypeBody, unwrapNewTypeBody,
-        wrapFamInstBody, unwrapFamInstScrut,
-        wrapTypeUnbranchedFamInstBody, unwrapTypeUnbranchedFamInstScrut,
-
+        wrapFamInstBody,
         DataConBoxer(..), mkDataConRep, mkDataConWorkId,
 
         -- And some particular Ids; see below for why they are wired in
@@ -54,7 +52,6 @@ import CoreUtils        ( exprType, mkCast )
 import CoreUnfold
 import Literal
 import TyCon
-import CoAxiom
 import Class
 import NameSet
 import Name
@@ -1047,35 +1044,6 @@ wrapFamInstBody tycon args body
   | otherwise
   = body
 
--- Same as `wrapFamInstBody`, but for type family instances, which are
--- represented by a `CoAxiom`, and not a `TyCon`
-wrapTypeFamInstBody :: CoAxiom br -> Int -> [Type] -> [Coercion]
-                    -> CoreExpr -> CoreExpr
-wrapTypeFamInstBody axiom ind args cos body
-  = mkCast body (mkSymCo (mkAxInstCo Representational axiom ind args cos))
-
-wrapTypeUnbranchedFamInstBody :: CoAxiom Unbranched -> [Type] -> [Coercion]
-                              -> CoreExpr -> CoreExpr
-wrapTypeUnbranchedFamInstBody axiom
-  = wrapTypeFamInstBody axiom 0
-
-unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
-unwrapFamInstScrut tycon args scrut
-  | Just co_con <- tyConFamilyCoercion_maybe tycon
-  = mkCast scrut (mkUnbranchedAxInstCo Representational co_con args []) -- data instances only
-  | otherwise
-  = scrut
-
-unwrapTypeFamInstScrut :: CoAxiom br -> Int -> [Type] -> [Coercion]
-                       -> CoreExpr -> CoreExpr
-unwrapTypeFamInstScrut axiom ind args cos scrut
-  = mkCast scrut (mkAxInstCo Representational axiom ind args cos)
-
-unwrapTypeUnbranchedFamInstScrut :: CoAxiom Unbranched -> [Type] -> [Coercion]
-                                 -> CoreExpr -> CoreExpr
-unwrapTypeUnbranchedFamInstScrut axiom
-  = unwrapTypeFamInstScrut axiom 0
-
 {-
 ************************************************************************
 *                                                                      *
index e4dc1a8..1851496 100644 (file)
@@ -78,8 +78,6 @@ module Module
         baseUnitId,
         rtsUnitId,
         thUnitId,
-        dphSeqUnitId,
-        dphParUnitId,
         mainUnitId,
         thisGhcUnitId,
         isHoleModule,
@@ -1067,8 +1065,7 @@ parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')
 
 integerUnitId, primUnitId,
   baseUnitId, rtsUnitId,
-  thUnitId, dphSeqUnitId, dphParUnitId,
-  mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId
+  thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId
 primUnitId        = fsToUnitId (fsLit "ghc-prim")
 integerUnitId     = fsToUnitId (fsLit n)
   where
@@ -1078,8 +1075,6 @@ integerUnitId     = fsToUnitId (fsLit n)
 baseUnitId        = fsToUnitId (fsLit "base")
 rtsUnitId         = fsToUnitId (fsLit "rts")
 thUnitId          = fsToUnitId (fsLit "template-haskell")
-dphSeqUnitId      = fsToUnitId (fsLit "dph-seq")
-dphParUnitId      = fsToUnitId (fsLit "dph-par")
 thisGhcUnitId     = fsToUnitId (fsLit "ghc")
 interactiveUnitId = fsToUnitId (fsLit "interactive")
 
@@ -1127,9 +1122,7 @@ wiredInUnitIds = [ primUnitId,
                        baseUnitId,
                        rtsUnitId,
                        thUnitId,
-                       thisGhcUnitId,
-                       dphSeqUnitId,
-                       dphParUnitId ]
+                       thisGhcUnitId ]
 
 {-
 ************************************************************************
index c005c03..4e11276 100644 (file)
@@ -51,7 +51,6 @@ module Name (
         setNameLoc,
         tidyNameOcc,
         localiseName,
-        mkLocalisedOccName,
 
         nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
 
@@ -414,18 +413,6 @@ tidyNameOcc name                            occ = name { n_occ = occ }
 localiseName :: Name -> Name
 localiseName n = n { n_sort = Internal }
 
--- |Create a localised variant of a name.
---
--- If the name is external, encode the original's module name to disambiguate.
--- SPJ says: this looks like a rather odd-looking function; but it seems to
---           be used only during vectorisation, so I'm not going to worry
-mkLocalisedOccName :: Module -> (Maybe String -> OccName -> OccName) -> Name -> OccName
-mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
-  where
-    origin
-      | nameIsLocalOrFrom this_mod name = Nothing
-      | otherwise                       = Just (moduleNameColons . moduleName . nameModule $ name)
-
 {-
 ************************************************************************
 *                                                                      *
index f6a66fd..1af53fb 100644 (file)
@@ -67,11 +67,6 @@ module OccName (
         mkSuperDictSelOcc, mkSuperDictAuxOcc,
         mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
         mkInstTyCoOcc, mkEqPredCoOcc,
-        mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-        mkPDataTyConOcc,  mkPDataDataConOcc,
-        mkPDatasTyConOcc, mkPDatasDataConOcc,
-        mkPReprTyConOcc,
-        mkPADFunOcc,
         mkRecFldSelOcc,
         mkTyConRepOcc,
 
@@ -655,23 +650,6 @@ mkTyConRepOcc occ = mk_simple_deriv varName prefix occ
 mkGenR   = mk_simple_deriv tcName "Rep_"
 mkGen1R  = mk_simple_deriv tcName "Rep1_"
 
--- Vectorisation
-mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
- mkPADFunOcc,      mkPReprTyConOcc,
- mkPDataTyConOcc,  mkPDataDataConOcc,
- mkPDatasTyConOcc, mkPDatasDataConOcc
-  :: Maybe String -> OccName -> OccName
-mkVectOcc          = mk_simple_deriv_with varName  "$v"
-mkVectTyConOcc     = mk_simple_deriv_with tcName   "V:"
-mkVectDataConOcc   = mk_simple_deriv_with dataName "VD:"
-mkVectIsoOcc       = mk_simple_deriv_with varName  "$vi"
-mkPADFunOcc        = mk_simple_deriv_with varName  "$pa"
-mkPReprTyConOcc    = mk_simple_deriv_with tcName   "VR:"
-mkPDataTyConOcc    = mk_simple_deriv_with tcName   "VP:"
-mkPDatasTyConOcc   = mk_simple_deriv_with tcName   "VPs:"
-mkPDataDataConOcc  = mk_simple_deriv_with dataName "VPD:"
-mkPDatasDataConOcc = mk_simple_deriv_with dataName "VPDs:"
-
 -- Overloaded record field selectors
 mkRecFldSelOcc :: String -> OccName
 mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s]
@@ -679,15 +657,6 @@ mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s]
 mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
 mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ]
 
-mk_simple_deriv_with :: NameSpace     -- ^ the namespace
-                     -> FastString    -- ^ an identifying prefix
-                     -> Maybe String  -- ^ another optional prefix
-                     -> OccName       -- ^ the 'OccName' to derive from
-                     -> OccName
-mk_simple_deriv_with sp px Nothing     occ = mk_deriv sp px [occNameFS occ]
-mk_simple_deriv_with sp px (Just with) occ =
-    mk_deriv sp px [fsLit with, fsLit "_", occNameFS occ]
-
 -- Data constructor workers are made by setting the name space
 -- of the data constructor OccName (which should be a DataName)
 -- to VarName
index bd7ed3e..f0c9814 100644 (file)
@@ -49,7 +49,7 @@ module Unique (
         mkPrimOpIdUnique,
         mkPreludeMiscIdUnique, mkPreludeDataConUnique,
         mkPreludeTyConUnique, mkPreludeClassUnique,
-        mkPArrDataConUnique, mkCoVarUnique,
+        mkCoVarUnique,
 
         mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
         mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
@@ -369,7 +369,6 @@ mkPreludeTyConUnique   :: Int -> Unique
 mkPreludeDataConUnique :: Arity -> Unique
 mkPrimOpIdUnique       :: Int -> Unique
 mkPreludeMiscIdUnique  :: Int -> Unique
-mkPArrDataConUnique    :: Int -> Unique
 mkCoVarUnique          :: Int -> Unique
 
 mkAlphaTyVarUnique   i = mkUnique '1' i
@@ -409,9 +408,6 @@ dataConRepNameUnique u = stepUnique u 2
 mkPrimOpIdUnique op         = mkUnique '9' op
 mkPreludeMiscIdUnique  i    = mkUnique '0' i
 
--- No numbers left anymore, so I pick something different for the character tag
-mkPArrDataConUnique a           = mkUnique ':' (2*a)
-
 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
 -- See pprUnique for details
 
index 4a72516..a7a96e2 100644 (file)
@@ -37,7 +37,6 @@ module CoreFVs (
         ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,
         rulesFreeVarsDSet,
         ruleLhsFreeIds, ruleLhsFreeIdsList,
-        vectsFreeVars,
 
         expr_fvs,
 
@@ -515,17 +514,6 @@ put this 'f' in a Rec block, but will mark the binding as a non-rule loop
 breaker, which is perfectly inlinable.
 -}
 
--- |Free variables of a vectorisation declaration
-vectsFreeVars :: [CoreVect] -> VarSet
-vectsFreeVars = mapUnionVarSet vectFreeVars
-  where
-    vectFreeVars (Vect   _ rhs)   = fvVarSet $ filterFV isLocalId $ expr_fvs rhs
-    vectFreeVars (NoVect _)       = noFVs
-    vectFreeVars (VectType _ _ _) = noFVs
-    vectFreeVars (VectClass _)    = noFVs
-    vectFreeVars (VectInst _)     = noFVs
-      -- this function is only concerned with values, not types
-
 {-
 ************************************************************************
 *                                                                      *
index e5db499..d92082c 100644 (file)
@@ -274,7 +274,6 @@ coreDumpFlag CoreDoWorkerWrapper      = Just Opt_D_dump_worker_wrapper
 coreDumpFlag CoreDoSpecialising       = Just Opt_D_dump_spec
 coreDumpFlag CoreDoSpecConstr         = Just Opt_D_dump_spec
 coreDumpFlag CoreCSE                  = Just Opt_D_dump_cse
-coreDumpFlag CoreDoVectorisation      = Just Opt_D_dump_vect
 coreDumpFlag CoreDesugar              = Just Opt_D_dump_ds_preopt
 coreDumpFlag CoreDesugarOpt           = Just Opt_D_dump_ds
 coreDumpFlag CoreTidy                 = Just Opt_D_dump_simpl
index 73bb427..de0dd04 100644 (file)
@@ -127,25 +127,24 @@ simpleOptExprWith subst expr
 
 ----------------------
 simpleOptPgm :: DynFlags -> Module
-             -> CoreProgram -> [CoreRule] -> [CoreVect]
-             -> IO (CoreProgram, [CoreRule], [CoreVect])
+             -> CoreProgram -> [CoreRule]
+             -> IO (CoreProgram, [CoreRule])
 -- See Note [The simple optimiser]
-simpleOptPgm dflags this_mod binds rules vects
+simpleOptPgm dflags this_mod binds rules
   = do { dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
                        (pprCoreBindings occ_anald_binds $$ pprRules rules );
 
-       ; return (reverse binds', rules', vects') }
+       ; return (reverse binds', rules') }
   where
     occ_anald_binds  = occurAnalysePgm this_mod
                           (\_ -> True)  {- All unfoldings active -}
                           (\_ -> False) {- No rules active -}
-                          rules vects emptyVarSet binds
+                          rules binds
 
     (final_env, binds') = foldl do_one (emptyEnv, []) occ_anald_binds
     final_subst = soe_subst final_env
 
     rules' = substRulesForImportedIds final_subst rules
-    vects' = substVects final_subst vects
              -- We never unconditionally inline into rules,
              -- hence paying just a substitution
 
@@ -536,18 +535,6 @@ wrapLet :: Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr
 wrapLet Nothing      body = body
 wrapLet (Just (b,r)) body = Let (NonRec b r) body
 
-------------------
-substVects :: Subst -> [CoreVect] -> [CoreVect]
-substVects subst = map (substVect subst)
-
-------------------
-substVect :: Subst -> CoreVect -> CoreVect
-substVect subst  (Vect v rhs)        = Vect v (simpleOptExprWith subst rhs)
-substVect _subst vd@(NoVect _)       = vd
-substVect _subst vd@(VectType _ _ _) = vd
-substVect _subst vd@(VectClass _)    = vd
-substVect _subst vd@(VectInst _)     = vd
-
 {-
 Note [Inline prag in simplOpt]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 729825f..c2aeabe 100644 (file)
@@ -92,9 +92,6 @@ module CoreSyn (
         ruleArity, ruleName, ruleIdName, ruleActivation,
         setRuleIdName, ruleModule,
         isBuiltinRule, isLocalRule, isAutoRule,
-
-        -- * Core vectorisation declarations data type
-        CoreVect(..)
     ) where
 
 #include "HsVersions.h"
@@ -112,7 +109,6 @@ import NameEnv( NameEnv, emptyNameEnv )
 import Literal
 import DataCon
 import Module
-import TyCon
 import BasicTypes
 import DynFlags
 import Outputable
@@ -1305,23 +1301,6 @@ setRuleIdName nm ru = ru { ru_fn = nm }
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Vectorisation declarations}
-*                                                                      *
-************************************************************************
-
-Representation of desugared vectorisation declarations that are fed to the vectoriser (via
-'ModGuts').
--}
-
-data CoreVect = Vect      Id   CoreExpr
-              | NoVect    Id
-              | VectType  Bool TyCon (Maybe TyCon)
-              | VectClass TyCon                     -- class tycon
-              | VectInst  Id                        -- instance dfun (always SCALAR)  !!!FIXME: should be superfluous now
-
-{-
-************************************************************************
-*                                                                      *
                 Unfoldings
 *                                                                      *
 ************************************************************************
index ca2b8af..f22d803 100644 (file)
@@ -612,21 +612,3 @@ instance Outputable id => Outputable (Tickish id) where
   ppr (SourceNote span _) =
       hcat [ text "src<", pprUserRealSpan True span, char '>']
 
-{-
------------------------------------------------------
---      Vectorisation declarations
------------------------------------------------------
--}
-
-instance Outputable CoreVect where
-  ppr (Vect     var e)               = hang (text "VECTORISE" <+> ppr var <+> char '=')
-                                         4 (pprCoreExpr e)
-  ppr (NoVect   var)                 = text "NOVECTORISE" <+> ppr var
-  ppr (VectType False var Nothing)   = text "VECTORISE type" <+> ppr var
-  ppr (VectType True  var Nothing)   = text "VECTORISE SCALAR type" <+> ppr var
-  ppr (VectType False var (Just tc)) = text "VECTORISE type" <+> ppr var <+> char '=' <+>
-                                       ppr tc
-  ppr (VectType True var (Just tc))  = text "VECTORISE SCALAR type" <+> ppr var <+>
-                                       char '=' <+> ppr tc
-  ppr (VectClass tc)                 = text "VECTORISE class" <+> ppr tc
-  ppr (VectInst var)                 = text "VECTORISE SCALAR instance" <+> ppr var
index 39f5853..d5449f3 100644 (file)
@@ -841,11 +841,6 @@ translatePat fam_insts pat = case pat of
                             (map (LitPat noExt  . HsChar src) (unpackFS s))
     | otherwise -> return [mkLitPattern lit]
 
-  PArrPat ty ps -> do
-    tidy_ps <- translatePatVec fam_insts (map unLoc ps)
-    let fake_con = RealDataCon (parrFakeCon (length ps))
-    return [vanillaConPattern fake_con [ty] (concat tidy_ps)]
-
   TuplePat tys ps boxity -> do
     tidy_ps <- translatePatVec fam_insts (map unLoc ps)
     let tuple_con = RealDataCon (tupleDataCon boxity (length ps))
index 25b77f2..ac02989 100644 (file)
@@ -562,10 +562,6 @@ addTickHsExpr (ExplicitList ty wit es) =
                    addTickWit (Just fln)
                      = do fln' <- addTickSyntaxExpr hpcSrcSpan fln
                           return (Just fln')
-addTickHsExpr (ExplicitPArr ty es) =
-        liftM2 ExplicitPArr
-                (return ty)
-                (mapM (addTickLHsExpr) es)
 
 addTickHsExpr (HsStatic fvs e) = HsStatic fvs <$> addTickLHsExpr e
 
@@ -602,10 +598,6 @@ addTickHsExpr (HsTickPragma _ _ _ _ (L pos e0)) = do
     e2 <- allocTickBox (ExpBox False) False False pos $
                 addTickHsExpr e0
     return $ unLoc e2
-addTickHsExpr (PArrSeq ty arith_seq) =
-        liftM2 PArrSeq
-                (return ty)
-                (addTickArithSeqInfo arith_seq)
 addTickHsExpr (HsSCC x src nm e) =
         liftM3 (HsSCC x)
                 (return src)
index ce12a56..2f3fead 100644 (file)
@@ -28,8 +28,6 @@ import TcRnDriver ( runTcInteractive )
 import Id
 import Name
 import Type
-import InstEnv
-import Class
 import Avail
 import CoreSyn
 import CoreFVs     ( exprsSomeFreeVarsList )
@@ -104,7 +102,6 @@ deSugar hsc_env
                             tcg_th_foreign_files = th_foreign_files_var,
                             tcg_fords        = fords,
                             tcg_rules        = rules,
-                            tcg_vects        = vects,
                             tcg_patsyns      = patsyns,
                             tcg_tcs          = tcs,
                             tcg_insts        = insts,
@@ -134,18 +131,17 @@ deSugar hsc_env
                           ; (spec_prs, spec_rules) <- dsImpSpecs imp_specs
                           ; (ds_fords, foreign_prs) <- dsForeigns fords
                           ; ds_rules <- mapMaybeM dsRule rules
-                          ; ds_vects <- mapM dsVect vects
                           ; let hpc_init
                                   | gopt Opt_Hpc dflags = hpcInitCode mod ds_hpc_info
                                   | otherwise = empty
                           ; return ( ds_ev_binds
                                    , foreign_prs `appOL` core_prs `appOL` spec_prs
-                                   , spec_rules ++ ds_rules, ds_vects
+                                   , spec_rules ++ ds_rules
                                    , ds_fords `appendStubC` hpc_init) }
 
         ; case mb_res of {
            Nothing -> return (msgs, Nothing) ;
-           Just (ds_ev_binds, all_prs, all_rules, vects0, ds_fords) ->
+           Just (ds_ev_binds, all_prs, all_rules, ds_fords) ->
 
      do {       -- Add export flags to bindings
           keep_alive <- readIORef keep_var
@@ -162,8 +158,8 @@ deSugar hsc_env
         -- things into the in-scope set before simplifying; so we get no unfolding for F#!
 
         ; endPassIO hsc_env print_unqual CoreDesugar final_pgm rules_for_imps
-        ; (ds_binds, ds_rules_for_imps, ds_vects)
-            <- simpleOptPgm dflags mod final_pgm rules_for_imps vects0
+        ; (ds_binds, ds_rules_for_imps)
+            <- simpleOptPgm dflags mod final_pgm rules_for_imps
                          -- The simpleOptPgm gets rid of type
                          -- bindings plus any stupid dead code
 
@@ -211,8 +207,6 @@ deSugar hsc_env
                 mg_foreign_files = foreign_files,
                 mg_hpc_info     = ds_hpc_info,
                 mg_modBreaks    = modBreaks,
-                mg_vect_decls   = ds_vects,
-                mg_vect_info    = noVectInfo,
                 mg_safe_haskell = safe_mode,
                 mg_trust_pkg    = imp_trust_own_pkg imports,
                 mg_complete_sigs = complete_matches
@@ -548,32 +542,4 @@ and similar, which will elicit exactly these warnings, and risk never
 firing.  But it's not clear what to do instead.  We could make the
 class method rules inactive in phase 2, but that would delay when
 subsequent transformations could fire.
-
-
-************************************************************************
-*                                                                      *
-*              Desugaring vectorisation declarations
-*                                                                      *
-************************************************************************
 -}
-
-dsVect :: LVectDecl GhcTc -> DsM CoreVect
-dsVect (L loc (HsVect _ _ (L _ v) rhs))
-  = putSrcSpanDs loc $
-    do { rhs' <- dsLExpr rhs
-       ; return $ Vect v rhs'
-       }
-dsVect (L _loc (HsNoVect _ _ (L _ v)))
-  = return $ NoVect v
-dsVect (L _loc (HsVectType (VectTypeTc tycon rhs_tycon) isScalar))
-  = return $ VectType isScalar tycon' rhs_tycon
-  where
-    tycon' | Just ty <- coreView $ mkTyConTy tycon
-           , (tycon', []) <- splitTyConApp ty      = tycon'
-           | otherwise                             = tycon
-dsVect (L _loc (HsVectClass cls))
-  = return $ VectClass (classTyCon cls)
-dsVect (L _loc (HsVectInst inst))
-  = return $ VectInst (instanceDFunId inst)
-dsVect vd@(L _ (XVectDecl {}))
-  = pprPanic "Desugar.dsVect: unexpected 'XVectDecl'" (ppr vd)
index 5e355f0..c69d749 100644 (file)
@@ -1213,7 +1213,6 @@ collectl (L _ pat) bndrs
     go (ParPat _ pat)             = collectl pat bndrs
 
     go (ListPat _ pats)           = foldr collectl bndrs pats
-    go (PArrPat _ pats)           = foldr collectl bndrs pats
     go (TuplePat _ pats _)        = foldr collectl bndrs pats
     go (SumPat _ pat _ _)         = collectl pat bndrs
 
index 7ee1857..b6337e4 100644 (file)
@@ -423,7 +423,6 @@ ds_expr _ (HsLet _ binds body) = do
 -- because the interpretation of `stmts' depends on what sort of thing it is.
 --
 ds_expr _ (HsDo res_ty ListComp (L _ stmts)) = dsListComp stmts res_ty
-ds_expr _ (HsDo _ PArrComp      (L _ stmts)) = dsPArrComp (map unLoc stmts)
 ds_expr _ (HsDo _ DoExpr        (L _ stmts)) = dsDo stmts
 ds_expr _ (HsDo _ GhciStmtCtxt  (L _ stmts)) = dsDo stmts
 ds_expr _ (HsDo _ MDoExpr       (L _ stmts)) = dsDo stmts
@@ -460,38 +459,12 @@ ds_expr _ (HsMultiIf res_ty alts)
 ds_expr _ (ExplicitList elt_ty wit xs)
   = dsExplicitList elt_ty wit xs
 
--- We desugar [:x1, ..., xn:] as
---   singletonP x1 +:+ ... +:+ singletonP xn
---
-ds_expr _ (ExplicitPArr  ty []) = do
-    emptyP <- dsDPHBuiltin emptyPVar
-    return (Var emptyP `App` Type ty)
-ds_expr _ (ExplicitPArr ty xs) = do
-    singletonP <- dsDPHBuiltin singletonPVar
-    appP       <- dsDPHBuiltin appPVar
-    xs'        <- mapM dsLExprNoLP xs
-    let unary  fn x   = mkApps (Var fn) [Type ty, x]
-        binary fn x y = mkApps (Var fn) [Type ty, x, y]
-
-    return . foldr1 (binary appP) $ map (unary singletonP) xs'
-
 ds_expr _ (ArithSeq expr witness seq)
   = case witness of
      Nothing -> dsArithSeq expr seq
      Just fl -> do { newArithSeq <- dsArithSeq expr seq
                    ; dsSyntaxExpr fl [newArithSeq] }
 
-ds_expr _ (PArrSeq expr (FromTo from to))
-  = mkApps <$> dsExpr expr <*> mapM dsLExprNoLP [from, to]
-
-ds_expr _ (PArrSeq expr (FromThenTo from thn to))
-  = mkApps <$> dsExpr expr <*> mapM dsLExprNoLP [from, thn, to]
-
-ds_expr _ (PArrSeq _ _)
-  = panic "DsExpr.dsExpr: Infinite parallel array!"
-    -- the parser shouldn't have generated it and the renamer and typechecker
-    -- shouldn't have let it through
-
 {-
 Static Pointers
 ~~~~~~~~~~~~~~~
index 8c9fa72..29b3cf4 100644 (file)
@@ -9,7 +9,7 @@ Desugaring list comprehensions, monad comprehensions and array comprehensions
 {-# LANGUAGE CPP, NamedFieldPuns #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module DsListComp ( dsListComp, dsPArrComp, dsMonadComp ) where
+module DsListComp ( dsListComp, dsMonadComp ) where
 
 #include "HsVersions.h"
 
@@ -476,214 +476,6 @@ mkUnzipBind _ elt_tys
 
     mkConcatExpression (list_element_ty, head, tail) = mkConsExpr list_element_ty head tail
 
-{-
-************************************************************************
-*                                                                      *
-\subsection[DsPArrComp]{Desugaring of array comprehensions}
-*                                                                      *
-************************************************************************
--}
-
--- entry point for desugaring a parallel array comprehension
---
---   [:e | qss:] = <<[:e | qss:]>> () [:():]
---
-dsPArrComp :: [ExprStmt GhcTc]
-            -> DsM CoreExpr
-
--- Special case for parallel comprehension
-dsPArrComp (ParStmt _ qss _ _ : quals) = dePArrParComp qss quals
-
--- Special case for simple generators:
---
---  <<[:e' | p <- e, qs:]>> = <<[: e' | qs :]>> p e
---
--- if matching again p cannot fail, or else
---
---  <<[:e' | p <- e, qs:]>> =
---    <<[:e' | qs:]>> p (filterP (\x -> case x of {p -> True; _ -> False}) e)
---
-dsPArrComp (BindStmt _ p e _ _ : qs) = do
-    filterP <- dsDPHBuiltin filterPVar
-    ce <- dsLExprNoLP e
-    let ety'ce  = parrElemType ce
-        false   = Var falseDataConId
-        true    = Var trueDataConId
-    v <- newSysLocalDs ety'ce
-    pred <- matchSimply (Var v) (StmtCtxt PArrComp) p true false
-    let gen | isIrrefutableHsPat p = ce
-            | otherwise            = mkApps (Var filterP) [Type ety'ce, mkLams [v] pred, ce]
-    dePArrComp qs p gen
-
-dsPArrComp qs = do -- no ParStmt in `qs'
-    sglP <- dsDPHBuiltin singletonPVar
-    let unitArray = mkApps (Var sglP) [Type unitTy, mkCoreTup []]
-    dePArrComp qs (noLoc $ WildPat unitTy) unitArray
-
-
-
--- the work horse
---
-dePArrComp :: [ExprStmt GhcTc]
-           -> LPat GhcTc        -- the current generator pattern
-           -> CoreExpr          -- the current generator expression
-           -> DsM CoreExpr
-
-dePArrComp [] _ _ = panic "dePArrComp"
-
---
---  <<[:e' | :]>> pa ea = mapP (\pa -> e') ea
---
-dePArrComp (LastStmt _ e' _ _ : quals) pa cea
-  = ASSERT( null quals )
-    do { mapP <- dsDPHBuiltin mapPVar
-       ; let ty = parrElemType cea
-       ; (clam, ty'e') <- deLambda ty pa e'
-       ; return $ mkApps (Var mapP) [Type ty, Type ty'e', clam, cea] }
---
---  <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
---
-dePArrComp (BodyStmt _ b _ _ : qs) pa cea = do
-    filterP <- dsDPHBuiltin filterPVar
-    let ty = parrElemType cea
-    (clam,_) <- deLambda ty pa b
-    dePArrComp qs pa (mkApps (Var filterP) [Type ty, clam, cea])
-
---
---  <<[:e' | p <- e, qs:]>> pa ea =
---    let ef = \pa -> e
---    in
---    <<[:e' | qs:]>> (pa, p) (crossMap ea ef)
---
--- if matching again p cannot fail, or else
---
---  <<[:e' | p <- e, qs:]>> pa ea =
---    let ef = \pa -> filterP (\x -> case x of {p -> True; _ -> False}) e
---    in
---    <<[:e' | qs:]>> (pa, p) (crossMapP ea ef)
---
-dePArrComp (BindStmt _ p e _ _ : qs) pa cea = do
-    filterP <- dsDPHBuiltin filterPVar
-    crossMapP <- dsDPHBuiltin crossMapPVar
-    ce <- dsLExpr e
-    let ety'cea = parrElemType cea
-        ety'ce  = parrElemType ce
-        false   = Var falseDataConId
-        true    = Var trueDataConId
-    v <- newSysLocalDs ety'ce
-    pred <- matchSimply (Var v) (StmtCtxt PArrComp) p true false
-    let cef | isIrrefutableHsPat p = ce
-            | otherwise            = mkApps (Var filterP) [Type ety'ce, mkLams [v] pred, ce]
-    (clam, _) <- mkLambda ety'cea pa cef
-    let ety'cef = ety'ce                    -- filter doesn't change the element type
-        pa'     = mkLHsPatTup [pa, p]
-
-    dePArrComp qs pa' (mkApps (Var crossMapP)
-                                 [Type ety'cea, Type ety'cef, cea, clam])
---
---  <<[:e' | let ds, qs:]>> pa ea =
---    <<[:e' | qs:]>> (pa, (x_1, ..., x_n))
---                    (mapP (\v@pa -> let ds in (v, (x_1, ..., x_n))) ea)
---  where
---    {x_1, ..., x_n} = DV (ds)         -- Defined Variables
---
-dePArrComp (LetStmt _ lds@(L _ ds) : qs) pa cea = do
-    mapP <- dsDPHBuiltin mapPVar
-    let xs = collectLocalBinders ds
-        ty'cea = parrElemType cea
-    v <- newSysLocalDs ty'cea
-    clet <- dsLocalBinds lds (mkCoreTup (map Var xs))
-    let'v <- newSysLocalDs (exprType clet)
-    let projBody = mkCoreLet (NonRec let'v clet) $
-                   mkCoreTup [Var v, Var let'v]
-        errTy    = exprType projBody
-        errMsg   = text "DsListComp.dePArrComp: internal error!"
-    cerr <- mkErrorAppDs pAT_ERROR_ID errTy errMsg
-    ccase <- matchSimply (Var v) (StmtCtxt PArrComp) pa projBody cerr
-    let pa'    = mkLHsPatTup [pa, mkLHsPatTup (map nlVarPat xs)]
-        proj   = mkLams [v] ccase
-    dePArrComp qs pa' (mkApps (Var mapP)
-                                   [Type ty'cea, Type errTy, proj, cea])
---
--- The parser guarantees that parallel comprehensions can only appear as
--- singleton qualifier lists, which we already special case in the caller.
--- So, encountering one here is a bug.
---
-dePArrComp (ParStmt {} : _) _ _ =
-  panic "DsListComp.dePArrComp: malformed comprehension AST: ParStmt"
-dePArrComp (TransStmt {} : _) _ _ = panic "DsListComp.dePArrComp: TransStmt"
-dePArrComp (RecStmt   {} : _) _ _ = panic "DsListComp.dePArrComp: RecStmt"
-dePArrComp (ApplicativeStmt   {} : _) _ _ =
-  panic "DsListComp.dePArrComp: ApplicativeStmt"
-dePArrComp (XStmtLR   {} : _) _ _ =
-  panic "DsListComp.dePArrComp: XStmtLR"
-
---  <<[:e' | qs | qss:]>> pa ea =
---    <<[:e' | qss:]>> (pa, (x_1, ..., x_n))
---                     (zipP ea <<[:(x_1, ..., x_n) | qs:]>>)
---    where
---      {x_1, ..., x_n} = DV (qs)
---
-dePArrParComp :: [ParStmtBlock GhcTc GhcTc] -> [ExprStmt GhcTc] -> DsM CoreExpr
-dePArrParComp qss quals = do
-    (pQss, ceQss) <- deParStmt qss
-    dePArrComp quals pQss ceQss
-  where
-    deParStmt []             =
-      -- empty parallel statement lists have no source representation
-      panic "DsListComp.dePArrComp: Empty parallel list comprehension"
-    deParStmt (ParStmtBlock _ qs xs _:qss) = do        -- first statement
-      let res_expr = mkLHsVarTuple xs
-      cqs <- dsPArrComp (map unLoc qs ++ [mkLastStmt res_expr])
-      parStmts qss (mkLHsVarPatTup xs) cqs
-    deParStmt (XParStmtBlock{}:_) = panic "dePArrParComp"
-    ---
-    parStmts []             pa cea = return (pa, cea)
-    parStmts (ParStmtBlock _ qs xs _:qss) pa cea = do
-                                              -- subsequent statements (zip'ed)
-      zipP <- dsDPHBuiltin zipPVar
-      let pa'      = mkLHsPatTup [pa, mkLHsVarPatTup xs]
-          ty'cea   = parrElemType cea
-          res_expr = mkLHsVarTuple xs
-      cqs <- dsPArrComp (map unLoc qs ++ [mkLastStmt res_expr])
-      let ty'cqs = parrElemType cqs
-          cea'   = mkApps (Var zipP) [Type ty'cea, Type ty'cqs, cea, cqs]
-      parStmts qss pa' cea'
-    parStmts (XParStmtBlock{}:_) _ _ = panic "dePArrParComp"
-
--- generate Core corresponding to `\p -> e'
---
-deLambda :: Type                       -- type of the argument (not levity-polymorphic)
-         -> LPat GhcTc                 -- argument pattern
-         -> LHsExpr GhcTc              -- body
-         -> DsM (CoreExpr, Type)
-deLambda ty p e =
-    mkLambda ty p =<< dsLExpr e
-
--- generate Core for a lambda pattern match, where the body is already in Core
---
-mkLambda :: Type                        -- type of the argument (not levity-polymorphic)
-         -> LPat GhcTc                  -- argument pattern
-         -> CoreExpr                    -- desugared body
-         -> DsM (CoreExpr, Type)
-mkLambda ty p ce = do
-    v <- newSysLocalDs ty
-    let errMsg = text "DsListComp.deLambda: internal error!"
-        ce'ty  = exprType ce
-    cerr <- mkErrorAppDs pAT_ERROR_ID ce'ty errMsg
-    res <- matchSimply (Var v) (StmtCtxt PArrComp) p ce cerr
-    return (mkLams [v] res, ce'ty)
-
--- obtain the element type of the parallel array produced by the given Core
--- expression
---
-parrElemType   :: CoreExpr -> Type
-parrElemType e  =
-  case splitTyConApp_maybe (exprType e) of
-    Just (tycon, [ty]) | tycon == parrTyCon -> ty
-    _                                                     -> panic
-      "DsListComp.parrElemType: not a parallel array type"
-
 -- Translation for monad comprehensions
 
 -- Entry point for monad comprehension desugaring
index 6bff897..cc1bd3d 100644 (file)
@@ -121,7 +121,6 @@ repTopDs group@(HsGroup { hs_valds   = valds
                         , hs_warnds  = warnds
                         , hs_annds   = annds
                         , hs_ruleds  = ruleds
-                        , hs_vects   = vects
                         , hs_docs    = docs })
  = do { let { bndrs  = hsSigTvBinders valds
                        ++ hsGroupBinders group
@@ -151,7 +150,6 @@ repTopDs group@(HsGroup { hs_valds   = valds
                      ; ann_ds   <- mapM repAnnD annds
                      ; rule_ds  <- mapM repRuleD (concatMap (rds_rules . unLoc)
                                                             ruleds)
-                     ; _        <- mapM no_vect vects
                      ; _        <- mapM no_doc docs
 
                         -- more needed
@@ -178,8 +176,6 @@ repTopDs group@(HsGroup { hs_valds   = valds
       = notHandledL loc "WARNING and DEPRECATION pragmas" $
                     text "Pragma for declaration of" <+> ppr thing
     no_warn (L _ (XWarnDecl _)) = panic "repTopDs"
-    no_vect (L loc decl)
-      = notHandledL loc "Vectorisation pragmas" (ppr decl)
     no_doc (L loc _)
       = notHandledL loc "Haddock documentation" empty
 repTopDs (XHsGroup _) = panic "repTopDs"
@@ -1114,11 +1110,6 @@ repTy (HsListTy _ t)        = do
                                 t1   <- repLTy t
                                 tcon <- repListTyCon
                                 repTapp tcon t1
-repTy (HsPArrTy _ t)   = do
-                           t1   <- repLTy t
-                           tcon <- repTy (HsTyVar noExt NotPromoted
-                                                  (noLoc (tyConName parrTyCon)))
-                           repTapp tcon t1
 repTy (HsTupleTy _ HsUnboxedTuple tys) = do
                                 tys1 <- repLTys tys
                                 tcon <- repUnboxedTupleTyCon (length tys)
@@ -1291,7 +1282,6 @@ repE e@(HsDo _ ctxt (L _ sts))
   = notHandled "mdo, monad comprehension and [: :]" (ppr e)
 
 repE (ExplicitList _ _ es) = do { xs <- repLEs es; repListExp xs }
-repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
 repE e@(ExplicitTuple _ es boxed)
   | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
   | isBoxed boxed = do { xs <- repLEs [e | L _ (Present _ e) <- es]; repTup xs }
@@ -1340,7 +1330,6 @@ repE (HsUnboundVar _ uv)   = do
                                sname <- repNameS occ
                                repUnboundVar sname
 
-repE e@(PArrSeq {})        = notHandled "Parallel arrays" (ppr e)
 repE e@(HsCoreAnn {})      = notHandled "Core annotations" (ppr e)
 repE e@(HsSCC {})          = notHandled "Cost centres" (ppr e)
 repE e@(HsTickPragma {})   = notHandled "Tick Pragma" (ppr e)
index d075d0a..c26854f 100644 (file)
@@ -23,13 +23,9 @@ module DsMonad (
         newUnique,
         UniqSupply, newUniqueSupply,
         getGhcModeDs, dsGetFamInstEnvs,
-        dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon,
+        dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,
         dsLookupDataCon, dsLookupConLike,
 
-        PArrBuiltin(..),
-        dsLookupDPHRdrEnv, dsLookupDPHRdrEnv_maybe,
-        dsInitPArrBuiltin,
-
         DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv,
 
         -- Getting and setting EvVars and term constraints in local environment
@@ -65,8 +61,6 @@ import CoreUtils ( exprType, isExprLevPoly )
 import HsSyn
 import TcIface
 import TcMType ( checkForLevPolyX, formatLevPolyErr )
-import LoadIface
-import Finder
 import PrelNames
 import RdrName
 import HscTypes
@@ -86,15 +80,12 @@ import NameEnv
 import DynFlags
 import ErrUtils
 import FastString
-import Maybes
 import Var (EvVar)
-import qualified GHC.LanguageExtensions as LangExt
 import UniqFM ( lookupWithDefaultUFM )
 import Literal ( mkMachString )
 import CostCentreState
 
 import Data.IORef
-import Control.Monad
 
 {-
 ************************************************************************
@@ -166,7 +157,7 @@ initDsTc thing_inside
        ; msg_var  <- getErrsVar
        ; hsc_env  <- getTopEnv
        ; envs     <- mkDsEnvsFromTcGbl hsc_env msg_var tcg_env
-       ; setEnvs envs $ initDPH thing_inside
+       ; setEnvs envs thing_inside
        }
 
 -- | Run a 'DsM' action inside the 'IO' monad.
@@ -198,7 +189,7 @@ mkDsEnvsFromTcGbl hsc_env msg_var tcg_env
 runDs :: HscEnv -> (DsGblEnv, DsLclEnv) -> DsM a -> IO (Messages, Maybe a)
 runDs hsc_env (ds_gbl, ds_lcl) thing_inside
   = do { res    <- initTcRnIf 'd' hsc_env ds_gbl ds_lcl
-                              (initDPH $ tryM thing_inside)
+                              (tryM thing_inside)
        ; msgs   <- readIORef (ds_msgs ds_gbl)
        ; let final_res
                | errorsFound dflags msgs = Nothing
@@ -271,8 +262,6 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var pmvar cc_st_var
                            , ds_if_env  = (if_genv, if_lenv)
                            , ds_unqual  = mkPrintUnqualified dflags rdr_env
                            , ds_msgs    = msg_var
-                           , ds_dph_env = emptyGlobalRdrEnv
-                           , ds_parr_bi = panic "DsMonad: uninitialised ds_parr_bi"
                            , ds_complete_matches = completeMatchMap
                            , ds_cc_st   = cc_st_var
                            }
@@ -500,23 +489,6 @@ mkPrintUnqualifiedDs = ds_unqual <$> getGblEnv
 instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
     lookupThing = dsLookupGlobal
 
--- | Attempt to load the given module and return its exported entities if
--- successful.
-dsLoadModule :: SDoc -> Module -> DsM GlobalRdrEnv
-dsLoadModule doc mod
-  = do { env    <- getGblEnv
-       ; setEnvs (ds_if_env env) $ do
-       { iface <- loadInterface doc mod ImportBySystem
-       ; case iface of
-           Failed err      -> pprPanic "DsMonad.dsLoadModule: failed to load" (err $$ doc)
-           Succeeded iface -> return $ mkGlobalRdrEnv . gresFromAvails prov . mi_exports $ iface
-       } }
-  where
-    prov     = Just (ImpSpec { is_decl = imp_spec, is_item = ImpAll })
-    imp_spec = ImpDeclSpec { is_mod = name, is_qual = True,
-                             is_dloc = wiredInSrcSpan, is_as = name }
-    name = moduleName mod
-
 dsLookupGlobal :: Name -> DsM TyThing
 -- Very like TcEnv.tcLookupGlobal
 dsLookupGlobal name
@@ -609,138 +581,6 @@ dsWhenNoErrs thing_inside mk_expr
                   then mk_expr result
                   else unitExpr }
 
---------------------------------------------------------------------------
---                  Data Parallel Haskell
---------------------------------------------------------------------------
-
--- | Run a 'DsM' with DPH things in scope if necessary.
-initDPH :: DsM a -> DsM a
-initDPH = loadDAP . initDPHBuiltins
-
--- | Extend the global environment with a 'GlobalRdrEnv' containing the exported
--- entities of,
---
---   * 'Data.Array.Parallel'      iff '-XParallelArrays' specified (see also 'checkLoadDAP').
---   * 'Data.Array.Parallel.Prim' iff '-fvectorise' specified.
-loadDAP :: DsM a -> DsM a
-loadDAP thing_inside
-  = do { dapEnv  <- loadOneModule dATA_ARRAY_PARALLEL_NAME      checkLoadDAP          paErr
-       ; dappEnv <- loadOneModule dATA_ARRAY_PARALLEL_PRIM_NAME (goptM Opt_Vectorise) veErr
-       ; updGblEnv (\env -> env {ds_dph_env = dapEnv `plusOccEnv` dappEnv }) thing_inside
-       }
-  where
-    loadOneModule :: ModuleName           -- the module to load
-                  -> DsM Bool             -- under which condition
-                  -> MsgDoc               -- error message if module not found
-                  -> DsM GlobalRdrEnv     -- empty if condition 'False'
-    loadOneModule modname check err
-      = do { doLoad <- check
-           ; if not doLoad
-             then return emptyGlobalRdrEnv
-             else do {
-           ; hsc_env <- getTopEnv
-           ; result <- liftIO $ findImportedModule hsc_env modname Nothing
-           ; case result of
-               Found _ mod -> dsLoadModule err mod
-               _           -> pprPgmError "Unable to use Data Parallel Haskell (DPH):" err
-           } }
-
-    paErr       = text "To use ParallelArrays," <+> specBackend $$ hint1 $$ hint2
-    veErr       = text "To use -fvectorise," <+> specBackend $$ hint1 $$ hint2
-    specBackend = text "you must specify a DPH backend package"
-    hint1       = text "Look for packages named 'dph-lifted-*' with 'ghc-pkg'"
-    hint2       = text "You may need to install them with 'cabal install dph-examples'"
-
--- | If '-XParallelArrays' given, we populate the builtin table for desugaring
--- those.
-initDPHBuiltins :: DsM a -> DsM a
-initDPHBuiltins thing_inside
-  = do { doInitBuiltins <- checkLoadDAP
-       ; if doInitBuiltins
-         then dsInitPArrBuiltin thing_inside
-         else thing_inside
-       }
-
-checkLoadDAP :: DsM Bool
-checkLoadDAP
-  = do { paEnabled <- xoptM LangExt.ParallelArrays
-       ; mod <- getModule
-         -- do not load 'Data.Array.Parallel' iff compiling 'base:GHC.PArr' or a
-         -- module called 'dATA_ARRAY_PARALLEL_NAME'; see also the comments at the top
-         -- of 'base:GHC.PArr' and 'Data.Array.Parallel' in the DPH libraries
-       ; return $ paEnabled &&
-                  mod /= gHC_PARR' &&
-                  moduleName mod /= dATA_ARRAY_PARALLEL_NAME
-       }
-
--- | Populate 'ds_parr_bi' from 'ds_dph_env'.
---
-dsInitPArrBuiltin :: DsM a -> DsM a
-dsInitPArrBuiltin thing_inside
-  = do { lengthPVar         <- externalVar (fsLit "lengthP")
-       ; replicatePVar      <- externalVar (fsLit "replicateP")
-       ; singletonPVar      <- externalVar (fsLit "singletonP")
-       ; mapPVar            <- externalVar (fsLit "mapP")
-       ; filterPVar         <- externalVar (fsLit "filterP")
-       ; zipPVar            <- externalVar (fsLit "zipP")
-       ; crossMapPVar       <- externalVar (fsLit "crossMapP")
-       ; indexPVar          <- externalVar (fsLit "!:")
-       ; emptyPVar          <- externalVar (fsLit "emptyP")
-       ; appPVar            <- externalVar (fsLit "+:+")
-       -- ; enumFromToPVar     <- externalVar (fsLit "enumFromToP")
-       -- ; enumFromThenToPVar <- externalVar (fsLit "enumFromThenToP")
-       ; enumFromToPVar     <- return arithErr
-       ; enumFromThenToPVar <- return arithErr
-
-       ; updGblEnv (\env -> env {ds_parr_bi = PArrBuiltin
-                                              { lengthPVar         = lengthPVar
-                                              , replicatePVar      = replicatePVar
-                                              , singletonPVar      = singletonPVar
-                                              , mapPVar            = mapPVar
-                                              , filterPVar         = filterPVar
-                                              , zipPVar            = zipPVar
-                                              , crossMapPVar       = crossMapPVar
-                                              , indexPVar          = indexPVar
-                                              , emptyPVar          = emptyPVar
-                                              , appPVar            = appPVar
-                                              , enumFromToPVar     = enumFromToPVar
-                                              , enumFromThenToPVar = enumFromThenToPVar
-                                              } })
-                   thing_inside
-       }
-  where
-    externalVar :: FastString -> DsM Var
-    externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
-
-    arithErr = panic "Arithmetic sequences have to wait until we support type classes"
-
--- |Get a name from "Data.Array.Parallel" for the desugarer, from the
--- 'ds_parr_bi' component of the global desugerar environment.
---
-dsDPHBuiltin :: (PArrBuiltin -> a) -> DsM a
-dsDPHBuiltin sel = (sel . ds_parr_bi) <$> getGblEnv
-
--- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
---  Panic if there isn't one, or if it is defined multiple times.
-dsLookupDPHRdrEnv :: OccName -> DsM Name
-dsLookupDPHRdrEnv occ
-  = liftM (fromMaybe (pprPanic nameNotFound (ppr occ)))
-  $ dsLookupDPHRdrEnv_maybe occ
-  where nameNotFound  = "Name not found in 'Data.Array.Parallel' or 'Data.Array.Parallel.Prim':"
-
--- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim',
---  returning `Nothing` if it's not defined. Panic if it's defined multiple times.
-dsLookupDPHRdrEnv_maybe :: OccName -> DsM (Maybe Name)
-dsLookupDPHRdrEnv_maybe occ
-  = do { env <- ds_dph_env <$> getGblEnv
-       ; let gres = lookupGlobalRdrEnv env occ
-       ; case gres of
-           []    -> return $ Nothing
-           [gre] -> return $ Just $ gre_name gre
-           _     -> pprPanic multipleNames (ppr occ)
-       }
-  where multipleNames = "Multiple definitions in 'Data.Array.Parallel' and 'Data.Array.Parallel.Prim':"
-
 -- | Inject a trace message into the compiled program. Whereas
 -- pprTrace prints out information *while compiling*, pprRuntimeTrace
 -- captures that information and causes it to be printed *at runtime*
index 7bec30a..4c30889 100644 (file)
@@ -282,18 +282,15 @@ data CaseAlt a = MkCaseAlt{ alt_pat :: a,
                             alt_result :: MatchResult }
 
 mkCoAlgCaseMatchResult
-  :: DynFlags
-  -> Id                 -- Scrutinee
+  :: Id                 -- Scrutinee
   -> Type               -- Type of exp
   -> [CaseAlt DataCon]  -- Alternatives (bndrs *include* tyvars, dicts)
   -> MatchResult
-mkCoAlgCaseMatchResult dflags var ty match_alts
+mkCoAlgCaseMatchResult var ty match_alts
   | isNewtype  -- Newtype case; use a let
   = ASSERT( null (tail match_alts) && null (tail arg_ids1) )
     mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1
 
-  | isPArrFakeAlts match_alts
-  = MatchResult CanFail $ mkPArrCase dflags var ty (sort_alts match_alts)
   | otherwise
   = mkDataConCase var ty match_alts
   where
@@ -311,34 +308,6 @@ mkCoAlgCaseMatchResult dflags var ty match_alts
                                                 -- (not that splitTyConApp does, these days)
     newtype_rhs = unwrapNewTypeBody tc ty_args (Var var)
 
-        --- Stuff for parallel arrays
-        --
-        -- Concerning `isPArrFakeAlts':
-        --
-        --  * it is *not* sufficient to just check the type of the type
-        --   constructor, as we have to be careful not to confuse the real
-        --   representation of parallel arrays with the fake constructors;
-        --   moreover, a list of alternatives must not mix fake and real
-        --   constructors (this is checked earlier on)
-        --
-        -- FIXME: We actually go through the whole list and make sure that
-        --        either all or none of the constructors are fake parallel
-        --        array constructors.  This is to spot equations that mix fake
-        --        constructors with the real representation defined in
-        --        `PrelPArr'.  It would be nicer to spot this situation
-        --        earlier and raise a proper error message, but it can really
-        --        only happen in `PrelPArr' anyway.
-        --
-
-    isPArrFakeAlts :: [CaseAlt DataCon] -> Bool
-    isPArrFakeAlts [alt] = isPArrFakeCon (alt_pat alt)
-    isPArrFakeAlts (alt:alts) =
-      case (isPArrFakeCon (alt_pat alt), isPArrFakeAlts alts) of
-        (True , True ) -> True
-        (False, False) -> False
-        _              -> panic "DsUtils: you may not mix `[:...:]' with `PArr' patterns"
-    isPArrFakeAlts [] = panic "DsUtils: unexpectedly found an empty list of PArr fake alternatives"
-
 mkCoSynCaseMatchResult :: Id -> Type -> CaseAlt PatSyn -> MatchResult
 mkCoSynCaseMatchResult var ty alt = MatchResult CanFail $ mkPatSynCase var ty alt
 
@@ -412,49 +381,6 @@ mkDataConCase var ty alts@(alt1:_) = MatchResult fail_flag mk_case
         = mkUniqSet data_cons `minusUniqSet` mentioned_constructors
     exhaustive_case = isEmptyUniqSet un_mentioned_constructors
 
---- Stuff for parallel arrays
---
---  * the following is to desugar cases over fake constructors for
---   parallel arrays, which are introduced by `tidy1' in the `PArrPat'
---   case
---
-mkPArrCase :: DynFlags -> Id -> Type -> [CaseAlt DataCon] -> CoreExpr
-           -> DsM CoreExpr
-mkPArrCase dflags var ty sorted_alts fail = do
-    lengthP <- dsDPHBuiltin lengthPVar
-    alt <- unboxAlt
-    return (mkWildCase (len lengthP) intTy ty [alt])
-  where
-    elemTy      = case splitTyConApp (idType var) of
-        (_, [elemTy]) -> elemTy
-        _             -> panic panicMsg
-    panicMsg    = "DsUtils.mkCoAlgCaseMatchResult: not a parallel array?"
-    len lengthP = mkApps (Var lengthP) [Type elemTy, Var var]
-    --
-    unboxAlt = do
-        l      <- newSysLocalDs intPrimTy
-        indexP <- dsDPHBuiltin indexPVar
-        alts   <- mapM (mkAlt indexP) sorted_alts
-        return (DataAlt intDataCon, [l], mkWildCase (Var l) intPrimTy ty (dft : alts))
-      where
-        dft  = (DEFAULT, [], fail)
-
-    --
-    -- each alternative matches one array length (corresponding to one
-    -- fake array constructor), so the match is on a literal; each
-    -- alternative's body is extended by a local binding for each
-    -- constructor argument, which are bound to array elements starting
-    -- with the first
-    --
-    mkAlt indexP alt@MkCaseAlt{alt_result = MatchResult _ bodyFun} = do
-        body <- bodyFun fail
-        return (LitAlt lit, [], mkCoreLets binds body)
-      where
-        lit   = MachInt $ toInteger (dataConSourceArity (alt_pat alt))
-        binds = [NonRec arg (indexExpr i) | (i, arg) <- zip [1..] (alt_bndrs alt)]
-        --
-        indexExpr i = mkApps (Var indexP) [Type elemTy, Var var, mkIntExpr dflags i]
-
 {-
 ************************************************************************
 *                                                                      *
index 6b548a4..fabbe2b 100644 (file)
@@ -448,14 +448,6 @@ tidy1 _ (ListPat (ListPatTc ty Nothing) pats )
                         (mkNilPat ty)
                         pats
 
--- Introduce fake parallel array constructors to be able to handle parallel
--- arrays with the existing machinery for constructor pattern
-tidy1 _ (PArrPat ty pats)
-  = return (idDsWrapper, unLoc parrConPat)
-  where
-    arity      = length pats
-    parrConPat = mkPrefixConPat (parrFakeCon arity) pats [ty]
-
 tidy1 _ (TuplePat tys pats boxity)
   = return (idDsWrapper, unLoc tuple_ConPat)
   where
@@ -498,7 +490,6 @@ tidy_bang_pat v _ p@(LitPat {})    = tidy1 v p
 tidy_bang_pat v _ p@(ListPat {})   = tidy1 v p
 tidy_bang_pat v _ p@(TuplePat {})  = tidy1 v p
 tidy_bang_pat v _ p@(SumPat {})    = tidy1 v p
-tidy_bang_pat v _ p@(PArrPat {})   = tidy1 v p
 
 -- Data/newtype constructors
 tidy_bang_pat v l p@(ConPatOut { pat_con = L _ (RealDataCon dc)
index 5bf8c06..49586bc 100644 (file)
@@ -29,7 +29,6 @@ import Id
 import NameEnv
 import FieldLabel ( flSelector )
 import SrcLoc
-import DynFlags
 import Outputable
 import Control.Monad(liftM)
 import Data.List (groupBy)
@@ -93,9 +92,8 @@ matchConFamily :: [Id]
                -> DsM MatchResult
 -- Each group of eqns is for a single constructor
 matchConFamily (var:vars) ty groups
-  = do dflags <- getDynFlags
-       alts <- mapM (fmap toRealAlt . matchOneConLike vars ty) groups
-       return (mkCoAlgCaseMatchResult dflags var ty alts)
+  = do alts <- mapM (fmap toRealAlt . matchOneConLike vars ty) groups
+       return (mkCoAlgCaseMatchResult var ty alts)
   where
     toRealAlt alt = case alt_pat alt of
         RealDataCon dcon -> alt{ alt_pat = dcon }
index f008a31..56d310f 100644 (file)
@@ -261,10 +261,6 @@ hsExprToPmExpr e@(ExplicitList _  mb_ol elems)
     cons x xs = mkPmExprData consDataCon [x,xs]
     nil       = mkPmExprData nilDataCon  []
 
-hsExprToPmExpr (ExplicitPArr _ elems)
-  = mkPmExprData (parrFakeCon (length elems)) (map lhsExprToPmExpr elems)
-
-
 -- we want this but we would have to make everything monadic :/
 -- ./compiler/deSugar/DsMonad.hs:397:dsLookupDataCon :: Name -> DsM DataCon
 --
@@ -395,7 +391,7 @@ needsParens (PmExprLit    l) = isNegatedPmLit l
 needsParens (PmExprEq    {}) = False -- will become a wildcard
 needsParens (PmExprOther {}) = False -- will become a wildcard
 needsParens (PmExprCon (RealDataCon c) es)
-  | isTupleDataCon c || isPArrFakeCon c
+  | isTupleDataCon c
   || isConsDataCon c || null es = False
   | otherwise                   = True
 needsParens (PmExprCon (PatSynCon _) es) = not (null es)
@@ -408,12 +404,10 @@ pprPmExprWithParens expr
 pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc
 pprPmExprCon (RealDataCon con) args
   | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args
-  |  isPArrFakeCon con = mkPArr  <$> mapM pprPmExpr args
-  |  isConsDataCon con = pretty_list
+  | isConsDataCon con  = pretty_list
   where
-    mkTuple, mkPArr :: [SDoc] -> SDoc
+    mkTuple :: [SDoc] -> SDoc
     mkTuple = parens     . fsep . punctuate comma
-    mkPArr  = paBrackets . fsep . punctuate comma
 
     -- lazily, to be used in the list case only
     pretty_list :: PmPprM SDoc
index 267e03b..a6e6149 100644 (file)
@@ -160,7 +160,6 @@ Library
         typecheck
         types
         utils
-        vectorise
 
     -- we use an explicit Prelude
     Default-Extensions:
@@ -534,35 +533,6 @@ Library
         UniqMap
         UniqSet
         Util
-        Vectorise.Builtins.Base
-        Vectorise.Builtins.Initialise
-        Vectorise.Builtins
-        Vectorise.Monad.Base
-        Vectorise.Monad.Naming
-        Vectorise.Monad.Local
-        Vectorise.Monad.Global
-        Vectorise.Monad.InstEnv
-        Vectorise.Monad
-        Vectorise.Utils.Base
-        Vectorise.Utils.Closure
-        Vectorise.Utils.Hoisting
-        Vectorise.Utils.PADict
-        Vectorise.Utils.Poly
-        Vectorise.Utils
-        Vectorise.Generic.Description
-        Vectorise.Generic.PAMethods
-        Vectorise.Generic.PADict
-        Vectorise.Generic.PData
-        Vectorise.Type.Env
-        Vectorise.Type.Type
-        Vectorise.Type.TyConDecl
-        Vectorise.Type.Classify
-        Vectorise.Convert
-        Vectorise.Vect
-        Vectorise.Var
-        Vectorise.Env
-        Vectorise.Exp
-        Vectorise
         Hoopl.Block
         Hoopl.Collections
         Hoopl.Dataflow
index 10f09da..d389f61 100644 (file)
@@ -50,9 +50,6 @@ module HsDecls (
   RuleBndr(..),LRuleBndr,
   collectRuleBndrSigTys,
   flattenRuleDecls, pprFullRuleName,
-  -- ** @VECTORISE@ declarations
-  VectDecl(..), LVectDecl,VectTypePR(..),VectTypeTc(..),VectClassPR(..),
-  lvectDeclName, lvectInstDecl,
   -- ** @default@ declarations
   DefaultDecl(..), LDefaultDecl,
   -- ** Template haskell declaration splice
@@ -87,7 +84,7 @@ module HsDecls (
 -- friends:
 import GhcPrelude
 
-import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr,
+import {-# SOURCE #-}   HsExpr( HsExpr, HsSplice, pprExpr,
                                 pprSpliceDecl )
         -- Because Expr imports Decls via HsBracket
 
@@ -95,7 +92,6 @@ import HsBinds
 import HsTypes
 import HsDoc
 import TyCon
-import Name
 import BasicTypes
 import Coercion
 import ForeignCall
@@ -103,7 +99,6 @@ import HsExtension
 import NameSet
 
 -- others:
-import InstEnv
 import Class
 import Outputable
 import Util
@@ -141,7 +136,6 @@ data HsDecl p
   | WarningD   (XWarningD p)   (WarnDecls p)     -- ^ Warning declaration
   | AnnD       (XAnnD p)       (AnnDecl p)       -- ^ Annotation declaration
   | RuleD      (XRuleD p)      (RuleDecls p)     -- ^ Rule declaration
-  | VectD      (XVectD p)      (VectDecl p)      -- ^ Vectorise declaration
   | SpliceD    (XSpliceD p)    (SpliceDecl p)    -- ^ Splice declaration
                                                  -- (Includes quasi-quotes)
   | DocD       (XDocD p)       (DocDecl)  -- ^ Documentation comment declaration
@@ -158,7 +152,6 @@ type instance XForD       (GhcPass _) = NoExt
 type instance XWarningD   (GhcPass _) = NoExt
 type instance XAnnD       (GhcPass _) = NoExt
 type instance XRuleD      (GhcPass _) = NoExt
-type instance XVectD      (GhcPass _) = NoExt
 type instance XSpliceD    (GhcPass _) = NoExt
 type instance XDocD       (GhcPass _) = NoExt
 type instance XRoleAnnotD (GhcPass _) = NoExt
@@ -204,7 +197,6 @@ data HsGroup p
         hs_warnds :: [LWarnDecls p],
         hs_annds  :: [LAnnDecl p],
         hs_ruleds :: [LRuleDecls p],
-        hs_vects  :: [LVectDecl p],
 
         hs_docs   :: [LDocDecl]
     }
@@ -225,7 +217,7 @@ emptyGroup = HsGroup { hs_ext = noExt,
                        hs_tyclds = [],
                        hs_derivds = [],
                        hs_fixds = [], hs_defds = [], hs_annds = [],
-                       hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
+                       hs_fords = [], hs_warnds = [], hs_ruleds = [],
                        hs_valds = error "emptyGroup hs_valds: Can't happen",
                        hs_splcds = [],
                        hs_docs = [] }
@@ -244,8 +236,7 @@ appendGroups
         hs_fords  = fords1,
         hs_warnds = warnds1,
         hs_ruleds = rulds1,
-        hs_vects = vects1,
-  hs_docs   = docs1 }
+        hs_docs   = docs1 }
     HsGroup {
         hs_valds  = val_groups2,
         hs_splcds = spliceds2,
@@ -257,7 +248,6 @@ appendGroups
         hs_fords  = fords2,
         hs_warnds = warnds2,
         hs_ruleds = rulds2,
-        hs_vects  = vects2,
         hs_docs   = docs2 }
   =
     HsGroup {
@@ -272,7 +262,6 @@ appendGroups
         hs_fords  = fords1 ++ fords2,
         hs_warnds = warnds1 ++ warnds2,
         hs_ruleds = rulds1 ++ rulds2,
-        hs_vects  = vects1 ++ vects2,
         hs_docs   = docs1  ++ docs2 }
 appendGroups _ _ = panic "appendGroups"
 
@@ -285,7 +274,6 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
     ppr (ForD _ fd)               = ppr fd
     ppr (SigD _ sd)               = ppr sd
     ppr (RuleD _ rd)              = ppr rd
-    ppr (VectD _ vect)            = ppr vect
     ppr (WarningD _ wd)           = ppr wd
     ppr (AnnD _ ad)               = ppr ad
     ppr (SpliceD _ dd)            = ppr dd
@@ -302,13 +290,11 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
                    hs_annds  = ann_decls,
                    hs_fords  = foreign_decls,
                    hs_defds  = default_decls,
-                   hs_ruleds = rule_decls,
-                   hs_vects  = vect_decls })
+                   hs_ruleds = rule_decls })
         = vcat_mb empty
             [ppr_ds fix_decls, ppr_ds default_decls,
              ppr_ds deprec_decls, ppr_ds ann_decls,
              ppr_ds rule_decls,
-             ppr_ds vect_decls,
              if isEmptyValBinds val_decls
                 then Nothing
                 else Just (ppr val_decls),
@@ -2106,137 +2092,6 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Vectorisation declarations}
-*                                                                      *
-************************************************************************
-
-A vectorisation pragma, one of
-
-  {-# VECTORISE f = closure1 g (scalar_map g) #-}
-  {-# VECTORISE SCALAR f #-}
-  {-# NOVECTORISE f #-}
-
-  {-# VECTORISE type T = ty #-}
-  {-# VECTORISE SCALAR type T #-}
--}
-
--- | Located Vectorise Declaration
-type LVectDecl pass = Located (VectDecl pass)
-
--- | Vectorise Declaration
-data VectDecl pass
-  = HsVect
-      (XHsVect pass)
-      SourceText   -- Note [Pragma source text] in BasicTypes
-      (Located (IdP pass))
-      (LHsExpr pass)
-        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
-        --           'ApiAnnotation.AnnEqual','ApiAnnotation.AnnClose'
-
-        -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsNoVect
-      (XHsNoVect pass)
-      SourceText   -- Note [Pragma source text] in BasicTypes
-      (Located (IdP pass))
-        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
-        --                                    'ApiAnnotation.AnnClose'
-
-        -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsVectType
-      (XHsVectType pass)
-      Bool                      -- 'TRUE' => SCALAR declaration
-  | HsVectClass               -- pre type-checking
-      (XHsVectClass pass)
-  | HsVectInst                -- pre type-checking (always SCALAR)
-                              -- !!!FIXME: should be superfluous now
-      (XHsVectInst pass)
-  | XVectDecl (XXVectDecl pass)
-
--- Used for XHsVectType for parser and renamer phases
-data VectTypePR pass
-  = VectTypePR
-      SourceText                   -- Note [Pragma source text] in BasicTypes
-      (Located (IdP pass))
-      (Maybe (Located (IdP pass))) -- 'Nothing' => no right-hand side
-
--- Used for XHsVectType
-data VectTypeTc
-  = VectTypeTc
-      TyCon
-      (Maybe TyCon)                -- 'Nothing' => no right-hand side
-  deriving Data
-
--- Used for XHsVectClass for parser and renamer phases
-data VectClassPR pass
-  = VectClassPR
-      SourceText                   -- Note [Pragma source text] in BasicTypes
-      (Located (IdP pass))
-
-type instance XHsVect        (GhcPass _) = NoExt
-type instance XHsNoVect      (GhcPass _) = NoExt
-
-type instance XHsVectType  GhcPs = VectTypePR GhcPs
-type instance XHsVectType  GhcRn = VectTypePR GhcRn
-type instance XHsVectType  GhcTc = VectTypeTc
-
-type instance XHsVectClass GhcPs = VectClassPR GhcPs
-type instance XHsVectClass GhcRn = VectClassPR GhcRn
-type instance XHsVectClass GhcTc = Class
-
-type instance XHsVectInst  GhcPs = (LHsSigType GhcPs)
-type instance XHsVectInst  GhcRn = (LHsSigType GhcRn)
-type instance XHsVectInst  GhcTc = ClsInst
-
-type instance XXVectDecl     (GhcPass _) = NoExt
-
-
-lvectDeclName :: LVectDecl GhcTc -> Name
-lvectDeclName (L _ (HsVect _ _       (L _ name) _))     = getName name
-lvectDeclName (L _ (HsNoVect _ _     (L _ name)))       = getName name
-lvectDeclName (L _ (HsVectType (VectTypeTc tycon _) _)) = getName tycon
-lvectDeclName (L _ (HsVectClass cls))                   = getName cls
-lvectDeclName (L _ (HsVectInst {}))
-  = panic "HsDecls.lvectDeclName: HsVectInst"
-lvectDeclName (L _ (XVectDecl {}))
-  = panic "HsDecls.lvectDeclName: XVectDecl"
-
-lvectInstDecl :: LVectDecl pass -> Bool
-lvectInstDecl (L _ (HsVectInst {}))  = True
-lvectInstDecl _                      = False
-
-instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (VectDecl p) where
-  ppr (HsVect _ _ v rhs)
-    = sep [text "{-# VECTORISE" <+> ppr v,
-           nest 4 $
-             pprExpr (unLoc rhs) <+> text "#-}" ]
-  ppr (HsNoVect _ _ v)
-    = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
-  ppr (HsVectType x False)
-    = sep [text "{-# VECTORISE type" <+> ppr x <+> text "#-}" ]
-  ppr (HsVectType x True)
-    = sep [text "{-# VECTORISE SCALAR type" <+> ppr x <+> text "#-}" ]
-  ppr (HsVectClass c)
-    = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
-  ppr (HsVectInst i)
-    = sep [text "{-# VECTORISE SCALAR instance" <+> ppr i <+> text "#-}" ]
-  ppr (XVectDecl x) = ppr x
-
-instance (p ~ GhcPass pass, OutputableBndrId p)
-        => Outputable (VectTypePR p) where
-  ppr (VectTypePR _ n Nothing) = ppr n
-  ppr (VectTypePR _ n (Just t)) = sep [ppr n, text "=", ppr t]
-
-instance Outputable VectTypeTc where
-  ppr (VectTypeTc n Nothing) = ppr n
-  ppr (VectTypeTc n (Just t)) = sep [ppr n, text "=", ppr t]
-
-instance (p ~ GhcPass pass, OutputableBndrId p)
-        => Outputable (VectClassPR p) where
-  ppr (VectClassPR _ n ) = ppr n
-
-{-
-************************************************************************
-*                                                                      *
 \subsection[DocDecl]{Document comments}
 *                                                                      *
 ************************************************************************
index 19cb70d..96d86c8 100644 (file)
@@ -460,18 +460,6 @@ data HsExpr p
                                    -- For OverloadedLists, the fromListN witness
                 [LHsExpr p]
 
-  -- | Syntactic parallel array: [:e1, ..., en:]
-  --
-  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
-  --              'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnComma',
-  --              'ApiAnnotation.AnnVbar'
-  --              'ApiAnnotation.AnnClose' @':]'@
-
-  -- For details on above see note [Api annotations] in ApiAnnotation
-  | ExplicitPArr
-                (XExplicitPArr p) -- type of elements of the parallel array
-                [LHsExpr p]
-
   -- | Record construction
   --
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
@@ -522,24 +510,6 @@ data HsExpr p
                                   -- For OverloadedLists, the fromList witness
                 (ArithSeqInfo p)
 
-  -- | Arithmetic sequence for parallel array
-  --
-  -- > [:e1..e2:] or [:e1, e2..e3:]
-  --
-  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
-  --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
-  --              'ApiAnnotation.AnnVbar',
-  --              'ApiAnnotation.AnnClose' @':]'@
-
-  -- For details on above see note [Api annotations] in ApiAnnotation
-  | PArrSeq
-                (XPArrSeq p)
-                (ArithSeqInfo p)
-
-  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# SCC'@,
-  --             'ApiAnnotation.AnnVal' or 'ApiAnnotation.AnnValStr',
-  --              'ApiAnnotation.AnnClose' @'\#-}'@
-
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsSCC       (XSCC p)
                 SourceText            -- Note [Pragma source text] in BasicTypes
@@ -781,10 +751,6 @@ type instance XExplicitList  GhcPs = NoExt
 type instance XExplicitList  GhcRn = NoExt
 type instance XExplicitList  GhcTc = Type
 
-type instance XExplicitPArr  GhcPs = NoExt
-type instance XExplicitPArr  GhcRn = NoExt
-type instance XExplicitPArr  GhcTc = Type
-
 type instance XRecordCon     GhcPs = NoExt
 type instance XRecordCon     GhcRn = NoExt
 type instance XRecordCon     GhcTc = RecordConTc
@@ -801,10 +767,6 @@ type instance XArithSeq      GhcPs = NoExt
 type instance XArithSeq      GhcRn = NoExt
 type instance XArithSeq      GhcTc = PostTcExpr
 
-type instance XPArrSeq       GhcPs = NoExt
-type instance XPArrSeq       GhcRn = NoExt
-type instance XPArrSeq       GhcTc = PostTcExpr
-
 type instance XSCC           (GhcPass _) = NoExt
 type instance XCoreAnn       (GhcPass _) = NoExt
 type instance XBracket       (GhcPass _) = NoExt
@@ -1111,9 +1073,6 @@ ppr_expr (HsDo _ do_or_list_comp (L _ stmts)) = pprDo do_or_list_comp stmts
 ppr_expr (ExplicitList _ _ exprs)
   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
 
-ppr_expr (ExplicitPArr _ exprs)
-  = paBrackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
-
 ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })
   = hang (ppr con_id) 2 (ppr rbinds)
 
@@ -1125,7 +1084,6 @@ ppr_expr (ExprWithTySig sig expr)
          4 (ppr sig)
 
 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
-ppr_expr (PArrSeq  _ info)   = paBrackets (ppr info)
 
 ppr_expr (EWildPat _)     = char '_'
 ppr_expr (ELazyPat _ e)   = char '~' <> ppr e
@@ -1279,11 +1237,9 @@ hsExprNeedsParens p = go
       | isListCompExpr sc             = False
       | otherwise                     = p > topPrec
     go (ExplicitList{})               = False
-    go (ExplicitPArr{})               = False
     go (RecordUpd{})                  = False
     go (ExprWithTySig{})              = p > topPrec
     go (ArithSeq{})                   = False
-    go (PArrSeq{})                    = False
     go (EWildPat{})                   = False
     go (ELazyPat{})                   = False
     go (EAsPat{})                     = False
@@ -1891,14 +1847,14 @@ type GhciStmt   id = Stmt  id (LHsExpr id)
 
 -- For details on above see note [Api annotations] in ApiAnnotation
 data StmtLR idL idR body -- body should always be (LHs**** idR)
-  = LastStmt  -- Always the last Stmt in ListComp, MonadComp, PArrComp,
+  = LastStmt  -- Always the last Stmt in ListComp, MonadComp,
               -- and (after the renamer) DoExpr, MDoExpr
               -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff
           (XLastStmt idL idR body)
           body
           Bool               -- True <=> return was stripped by ApplicativeDo
           (SyntaxExpr idR)   -- The return operator, used only for
-                             -- MonadComp For ListComp, PArrComp, we
+                             -- MonadComp For ListComp we
                              -- use the baked-in 'return' For DoExpr,
                              -- MDoExpr, we don't apply a 'return' at
                              -- all See Note [Monad Comprehensions] |
@@ -2374,7 +2330,6 @@ pprDo GhciStmtCtxt  stmts = text "do"  <+> ppr_do_stmts stmts
 pprDo ArrowExpr     stmts = text "do"  <+> ppr_do_stmts stmts
 pprDo MDoExpr       stmts = text "mdo" <+> ppr_do_stmts stmts
 pprDo ListComp      stmts = brackets    $ pprComp stmts
-pprDo PArrComp      stmts = paBrackets  $ pprComp stmts
 pprDo MonadComp     stmts = brackets    $ pprComp stmts
 pprDo _             _     = panic "pprDo" -- PatGuard, ParStmtCxt
 
@@ -2778,7 +2733,6 @@ isPatSynCtxt ctxt =
 data HsStmtContext id
   = ListComp
   | MonadComp
-  | PArrComp                         -- ^Parallel array comprehension
 
   | DoExpr                           -- ^do { ... }
   | MDoExpr                          -- ^mdo { ... }  ie recursive do-expression
@@ -2794,7 +2748,6 @@ deriving instance (Data id) => Data (HsStmtContext id)
 isListCompExpr :: HsStmtContext id -> Bool
 -- Uses syntax [ e | quals ]
 isListCompExpr ListComp          = True
-isListCompExpr PArrComp          = True
 isListCompExpr MonadComp         = True
 isListCompExpr (ParStmtCtxt c)   = isListCompExpr c
 isListCompExpr (TransStmtCtxt c) = isListCompExpr c
@@ -2809,7 +2762,7 @@ isMonadFailStmtContext MDoExpr              = True
 isMonadFailStmtContext GhciStmtCtxt         = True
 isMonadFailStmtContext (ParStmtCtxt ctxt)   = isMonadFailStmtContext ctxt
 isMonadFailStmtContext (TransStmtCtxt ctxt) = isMonadFailStmtContext ctxt
-isMonadFailStmtContext _ = False -- ListComp, PArrComp, PatGuard, ArrowExpr
+isMonadFailStmtContext _ = False -- ListComp, PatGuard, ArrowExpr
 
 matchSeparator :: HsMatchContext id -> SDoc
 matchSeparator (FunRhs {})   = text "="
@@ -2864,7 +2817,6 @@ pprAStmtContext ctxt = article <+> pprStmtContext ctxt
     pp_a  = text "a"
     article = case ctxt of
                   MDoExpr       -> pp_an
-                  PArrComp      -> pp_an
                   GhciStmtCtxt  -> pp_an
                   _             -> pp_a
 
@@ -2876,7 +2828,6 @@ pprStmtContext MDoExpr         = text "'mdo' block"
 pprStmtContext ArrowExpr       = text "'do' block in an arrow command"
 pprStmtContext ListComp        = text "list comprehension"
 pprStmtContext MonadComp       = text "monad comprehension"
-pprStmtContext PArrComp        = text "array comprehension"
 pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt
 
 -- Drop the inner contexts when reporting errors, else we get
@@ -2918,7 +2869,6 @@ matchContextErrString (StmtCtxt ArrowExpr)         = text "'do' block"
 matchContextErrString (StmtCtxt MDoExpr)           = text "'mdo' block"
 matchContextErrString (StmtCtxt ListComp)          = text "list comprehension"
 matchContextErrString (StmtCtxt MonadComp)         = text "monad comprehension"
-matchContextErrString (StmtCtxt PArrComp)          = text "array comprehension"
 
 pprMatchInCtxt :: (OutputableBndrId (GhcPass idR),
                    -- TODO:AZ these constraints do not make sense
index 4545b2b..4898e36 100644 (file)
@@ -216,7 +216,6 @@ type family XForD        x
 type family XWarningD    x
 type family XAnnD        x
 type family XRuleD       x
-type family XVectD       x
 type family XSpliceD     x
 type family XDocD        x
 type family XRoleAnnotD  x
@@ -233,7 +232,6 @@ type ForallXHsDecl (c :: * -> Constraint) (x :: *) =
        , c (XWarningD    x)
        , c (XAnnD        x)
        , c (XRuleD       x)
-       , c (XVectD       x)
        , c (XSpliceD     x)
        , c (XDocD        x)
        , c (XRoleAnnotD  x)
@@ -442,25 +440,6 @@ type ForallXRuleBndr (c :: * -> Constraint) (x :: *) =
        )
 
 -- -------------------------------------
--- RuleBndr type families
-type family XHsVect          x
-type family XHsNoVect        x
-type family XHsVectType      x
-type family XHsVectClass     x
-type family XHsVectInst      x
-type family XXVectDecl       x
-
-type ForallXVectDecl (c :: * -> Constraint) (x :: *) =
-       ( c (XHsVect          x)
-       , c (XHsNoVect        x)
-       , c (XHsVectType      x)
-       , c (XHsVectClass     x)
-       , c (XHsVectInst      x)
-       , c (XXVectDecl       x)
-       , c (XXVectDecl       x)
-       )
-
--- -------------------------------------
 -- WarnDecls type families
 type family XWarnings        x
 type family XXWarnDecls      x
@@ -528,12 +507,10 @@ type family XMultiIf        x
 type family XLet            x
 type family XDo             x
 type family XExplicitList   x
-type family XExplicitPArr   x
 type family XRecordCon      x
 type family XRecordUpd      x
 type family XExprWithTySig  x
 type family XArithSeq       x
-type family XPArrSeq        x
 type family XSCC            x
 type family XCoreAnn        x
 type family XBracket        x
@@ -580,12 +557,10 @@ type ForallXExpr (c :: * -> Constraint) (x :: *) =
        , c (XLet            x)
        , c (XDo             x)
        , c (XExplicitList   x)
-       , c (XExplicitPArr   x)
        , c (XRecordCon      x)
        , c (XRecordUpd      x)
        , c (XExprWithTySig  x)
        , c (XArithSeq       x)
-       , c (XPArrSeq        x)
        , c (XSCC            x)
        , c (XCoreAnn        x)
        , c (XBracket        x)
@@ -856,7 +831,6 @@ type family XBangPat   x
 type family XListPat   x
 type family XTuplePat  x
 type family XSumPat    x
-type family XPArrPat   x
 type family XConPat    x
 type family XViewPat   x
 type family XSplicePat x
@@ -878,7 +852,6 @@ type ForallXPat (c :: * -> Constraint) (x :: *) =
        , c (XListPat   x)
        , c (XTuplePat  x)
        , c (XSumPat    x)
-       , c (XPArrPat   x)
        , c (XViewPat   x)
        , c (XSplicePat x)
        , c (XLitPat    x)
@@ -929,7 +902,6 @@ type family XAppsTy          x
 type family XAppTy           x
 type family XFunTy           x
 type family XListTy          x
-type family XPArrTy          x
 type family XTupleTy         x
 type family XSumTy           x
 type family XOpTy            x
@@ -957,7 +929,6 @@ type ForallXType (c :: * -> Constraint) (x :: *) =
        , c (XAppTy           x)
        , c (XFunTy           x)
        , c (XListTy          x)
-       , c (XPArrTy          x)
        , c (XTupleTy         x)
        , c (XSumTy           x)
        , c (XOpTy            x)
@@ -1129,16 +1100,6 @@ type OutputableX p = -- See Note [OutputableX]
 
   , Outputable (XAppTypeE p)
   , Outputable (XAppTypeE GhcRn)
-
-  , Outputable (XHsVectType p)
-  , Outputable (XHsVectType GhcRn)
-
-  , Outputable (XHsVectClass p)
-  , Outputable (XHsVectClass GhcRn)
-
-  , Outputable (XHsVectInst p)
-  , Outputable (XHsVectInst GhcRn)
-
   )
 -- TODO: Should OutputableX be included in OutputableBndrId?
 
index 5833e17..be72ec7 100644 (file)
@@ -209,16 +209,6 @@ deriving instance Data (RuleBndr GhcPs)
 deriving instance Data (RuleBndr GhcRn)
 deriving instance Data (RuleBndr GhcTc)
 
--- deriving instance (DataIdLR p p) => Data (VectDecl p)
-deriving instance Data (VectDecl GhcPs)
-deriving instance Data (VectDecl GhcRn)
-deriving instance Data (VectDecl GhcTc)
-
-deriving instance Data (VectTypePR GhcPs)
-deriving instance Data (VectTypePR GhcRn)
-deriving instance Data (VectClassPR GhcPs)
-deriving instance Data (VectClassPR GhcRn)
-
 -- deriving instance (DataId p)     => Data (WarnDecls p)
 deriving instance Data (WarnDecls GhcPs)
 deriving instance Data (WarnDecls GhcRn)
index 6c092d3..866b0e2 100644 (file)
@@ -166,12 +166,7 @@ data Pat p
     --            'ApiAnnotation.AnnClose' @'#)'@
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-  | PArrPat     (XPArrPat p)   -- After typechecking,  the type of the elements
-                [LPat p]       -- Syntactic parallel array
-    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
-    --                                    'ApiAnnotation.AnnClose' @':]'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
         ------------ Constructor patterns ---------------
   | ConPatIn    (Located (IdP p))
                 (HsConPatDetails p)
@@ -309,10 +304,6 @@ type instance XSumPat GhcPs = NoExt
 type instance XSumPat GhcRn = NoExt
 type instance XSumPat GhcTc = [Type]
 
-type instance XPArrPat GhcPs = NoExt
-type instance XPArrPat GhcRn = NoExt
-type instance XPArrPat GhcTc = Type
-
 type instance XViewPat GhcPs = NoExt
 type instance XViewPat GhcRn = NoExt
 type instance XViewPat GhcTc = Type
@@ -535,7 +526,6 @@ pprPat (CoPat _ co pat _)       = pprHsWrapper co $ \parens
                                                  else pprPat pat
 pprPat (SigPat ty pat)          = ppr pat <+> dcolon <+> ppr ty
 pprPat (ListPat _ pats)         = brackets (interpp'SP pats)
-pprPat (PArrPat _ pats)         = paBrackets (interpp'SP pats)
 pprPat (TuplePat _ pats bx)     = tupleParens (boxityTupleSort bx)
                                               (pprWithCommas ppr pats)
 pprPat (SumPat _ pat alt arity) = sumParens (pprAlternative ppr pat alt arity)
@@ -694,7 +684,6 @@ isIrrefutableHsPat pat
     go1 (SumPat {})         = False
                     -- See Note [Unboxed sum patterns aren't irrefutable]
     go1 (ListPat {})        = False
-    go1 (PArrPat {})        = False     -- ?
 
     go1 (ConPatIn {})       = False     -- Conservative
     go1 (ConPatOut{ pat_con = L _ (RealDataCon con), pat_args = details })
@@ -758,7 +747,6 @@ patNeedsParens p = go
     go (TuplePat {})          = False
     go (SumPat {})            = False
     go (ListPat {})           = False
-    go (PArrPat {})           = False
     go (LitPat _ l)           = hsLitNeedsParens p l
     go (NPat _ (L _ ol) _ _)  = hsOverLitNeedsParens p ol
     go (XPat {})              = True -- conservative default
@@ -800,7 +788,6 @@ collectEvVarsPat pat =
     ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
     TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps
     SumPat _ p _ _   -> collectEvVarsLPat p
-    PArrPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
     ConPatOut {pat_dicts = dicts, pat_args  = args}
                      -> unionBags (listToBag dicts)
                                    $ unionManyBags
index af64c2c..11d301d 100644 (file)
@@ -513,13 +513,6 @@ data HsType pass
 
       -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsPArrTy            (XPArrTy pass)
-                        (LHsType pass)  -- Elem. type of parallel array: [:t:]
-      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
-      --         'ApiAnnotation.AnnClose' @':]'@
-
-      -- For details on above see note [Api annotations] in ApiAnnotation
-
   | HsTupleTy           (XTupleTy pass)
                         HsTupleSort
                         [LHsType pass]  -- Element types (length gives arity)
@@ -669,7 +662,6 @@ type instance XAppsTy          (GhcPass _) = NoExt
 type instance XAppTy           (GhcPass _) = NoExt
 type instance XFunTy           (GhcPass _) = NoExt
 type instance XListTy          (GhcPass _) = NoExt
-type instance XPArrTy          (GhcPass _) = NoExt
 type instance XTupleTy         (GhcPass _) = NoExt
 type instance XSumTy           (GhcPass _) = NoExt
 type instance XOpTy            (GhcPass _) = NoExt
@@ -1454,7 +1446,6 @@ ppr_mono_ty (HsSumTy _ tys)
 ppr_mono_ty (HsKindSig _ ty kind)
   = parens (ppr_mono_lty ty <+> dcolon <+> ppr kind)
 ppr_mono_ty (HsListTy _ ty)       = brackets (ppr_mono_lty ty)
-ppr_mono_ty (HsPArrTy _ ty)       = paBrackets (ppr_mono_lty ty)
 ppr_mono_ty (HsIParamTy _ n ty)   = (ppr n <+> dcolon <+> ppr_mono_lty ty)
 ppr_mono_ty (HsSpliceTy _ s)      = pprSplice s
 ppr_mono_ty (HsExplicitListTy _ Promoted tys)
@@ -1535,7 +1526,6 @@ hsTypeNeedsParens p = go
     go (HsSumTy{})           = False
     go (HsKindSig{})         = False
     go (HsListTy{})          = False
-    go (HsPArrTy{})          = False
     go (HsIParamTy{})        = p > topPrec
     go (HsSpliceTy{})        = False
     go (HsExplicitListTy{})  = False
index fe22fb3..39149d0 100644 (file)
@@ -1054,7 +1054,6 @@ collect_lpat (L _ pat) bndrs
     go (ParPat _ pat)             = collect_lpat pat bndrs
 
     go (ListPat _ pats)           = foldr collect_lpat bndrs pats
-    go (PArrPat _ pats)           = foldr collect_lpat bndrs pats
     go (TuplePat _ pats _)        = foldr collect_lpat bndrs pats
     go (SumPat _ pat _ _)         = collect_lpat pat bndrs
 
@@ -1345,7 +1344,6 @@ lPatImplicits = hs_lpat
     hs_pat (ViewPat _ _ pat)    = hs_lpat pat
     hs_pat (ParPat _ pat)       = hs_lpat pat
     hs_pat (ListPat _ pats)     = hs_lpats pats
-    hs_pat (PArrPat _ pats)     = hs_lpats pats
     hs_pat (TuplePat _ pats _)  = hs_lpats pats
 
     hs_pat (SigPat _ pat)       = hs_lpat pat
index 6f548f5..2524593 100644 (file)
@@ -1100,7 +1100,6 @@ pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys
 ppr_iface_tc_app :: (PprPrec -> a -> SDoc) -> PprPrec -> IfaceTyCon -> [a] -> SDoc
 ppr_iface_tc_app pp _ tc [ty]
   | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)
-  | tc `ifaceTyConHasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp topPrec ty)
 
 ppr_iface_tc_app pp ctxt_prec tc tys
   |  tc `ifaceTyConHasKey` starKindTyConKey
index 0845208..02e7d50 100644 (file)
@@ -36,7 +36,7 @@ module LoadIface (
 import GhcPrelude
 
 import {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
-                                 tcIfaceFamInst, tcIfaceVectInfo,
+                                 tcIfaceFamInst,
                                  tcIfaceAnnotations, tcIfaceCompleteSigs )
 
 import DynFlags
@@ -453,7 +453,7 @@ loadInterface doc_str mod from
         --
         -- The main thing is to add the ModIface to the PIT, but
         -- we also take the
-        --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules, IfaceVectInfo
+        --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules,
         -- out of the ModIface and put them into the big EPS pools
 
         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
@@ -467,7 +467,6 @@ loadInterface doc_str mod from
         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
         ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)
-        ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) (mi_vect_info iface)
         ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
 
         ; let { final_iface = iface {
@@ -495,8 +494,6 @@ loadInterface doc_str mod from
                                                        new_eps_insts,
                   eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
                                                           new_eps_fam_insts,
-                  eps_vect_info    = plusVectInfo (eps_vect_info eps)
-                                                  new_eps_vect_info,
                   eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
                                                       new_eps_anns,
                   eps_mod_fam_inst_env
@@ -979,7 +976,6 @@ initExternalPackageState
         -- Initialise the EPS rule pool with the built-in rules
       eps_mod_fam_inst_env
                            = emptyModuleEnv,
-      eps_vect_info        = noVectInfo,
       eps_complete_matches = emptyUFM,
       eps_ann_env          = emptyAnnEnv,
       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
@@ -1087,7 +1083,6 @@ pprModIface iface
         , vcat (map ppr (mi_insts iface))
         , vcat (map ppr (mi_fam_insts iface))
         , vcat (map ppr (mi_rules iface))
-        , pprVectInfo (mi_vect_info iface)
         , ppr (mi_warns iface)
         , pprTrustInfo (mi_trust iface)
         , pprTrustPkg (mi_trust_pkg iface)
@@ -1161,21 +1156,6 @@ pprFixities fixes = text "fixities" <+> pprWithCommas pprFix fixes
                   where
                     pprFix (occ,fix) = ppr fix <+> ppr occ
 
-pprVectInfo :: IfaceVectInfo -> SDoc
-pprVectInfo (IfaceVectInfo { ifaceVectInfoVar            = vars
-                           , ifaceVectInfoTyCon          = tycons
-                           , ifaceVectInfoTyConReuse     = tyconsReuse
-                           , ifaceVectInfoParallelVars   = parallelVars
-                           , ifaceVectInfoParallelTyCons = parallelTyCons
-                           }) =
-  vcat
-  [ text "vectorised variables:" <+> hsep (map ppr vars)
-  , text "vectorised tycons:" <+> hsep (map ppr tycons)
-  , text "vectorised reused tycons:" <+> hsep (map ppr tyconsReuse)
-  , text "parallel variables:" <+> hsep (map ppr parallelVars)
-  , text "parallel tycons:" <+> hsep (map ppr parallelTyCons)
-  ]
-
 pprTrustInfo :: IfaceTrustInfo -> SDoc
 pprTrustInfo trust = text "trusted:" <+> ppr trust
 
index 3375abd..5c6912d 100644 (file)
@@ -86,7 +86,6 @@ import HscTypes
 import Finder
 import DynFlags
 import VarEnv
-import VarSet
 import Var
 import Name
 import Avail
@@ -222,7 +221,6 @@ mkIface_ hsc_env maybe_old_fingerprint
                       md_fam_insts = fam_insts,
                       md_rules     = rules,
                       md_anns      = anns,
-                      md_vect_info = vect_info,
                       md_types     = type_env,
                       md_exports   = exports,
                       md_complete_sigs = complete_sigs }
@@ -257,7 +255,6 @@ mkIface_ hsc_env maybe_old_fingerprint
         iface_rules = map coreRuleToIfaceRule rules
         iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
         iface_fam_insts = map famInstToIfaceFamInst fam_insts
-        iface_vect_info = flattenVectInfo vect_info
         trust_info  = setSafeMode safe_mode
         annotations = map mkIfaceAnnotation anns
         icomplete_sigs = map mkIfaceCompleteSig complete_sigs
@@ -280,8 +277,6 @@ mkIface_ hsc_env maybe_old_fingerprint
               mi_fam_insts   = sortBy cmp_fam_inst iface_fam_insts,
               mi_rules       = sortBy cmp_rule     iface_rules,
 
-              mi_vect_info   = iface_vect_info,
-
               mi_fixities    = fixities,
               mi_warns       = warns,
               mi_anns        = annotations,
@@ -352,19 +347,6 @@ mkIface_ hsc_env maybe_old_fingerprint
 
      ifFamInstTcName = ifFamInstFam
 
-     flattenVectInfo (VectInfo { vectInfoVar            = vVar
-                               , vectInfoTyCon          = vTyCon
-                               , vectInfoParallelVars     = vParallelVars
-                               , vectInfoParallelTyCons = vParallelTyCons
-                               }) =
-       IfaceVectInfo
-       { ifaceVectInfoVar            = [Var.varName v | (v, _  ) <- dVarEnvElts vVar]
-       , ifaceVectInfoTyCon          = [tyConName t   | (t, t_v) <- nameEnvElts vTyCon, t /= t_v]
-       , ifaceVectInfoTyConReuse     = [tyConName t   | (t, t_v) <- nameEnvElts vTyCon, t == t_v]
-       , ifaceVectInfoParallelVars   = [Var.varName v | v <- dVarSetElems vParallelVars]
-       , ifaceVectInfoParallelTyCons = nameSetElemsStable vParallelTyCons
-       }
-
 -----------------------------
 writeIfaceFile :: DynFlags -> FilePath -> ModIface -> IO ()
 writeIfaceFile dflags hi_file_path new_iface
@@ -686,13 +668,11 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    --   - export list
    --   - orphans
    --   - deprecations
-   --   - vect info
    --   - flag abi hash
    mod_hash <- computeFingerprint putNameLiterally
                       (map fst sorted_decls,
                        export_hash,  -- includes orphan_hash
-                       mi_warns iface0,
-                       mi_vect_info iface0)
+                       mi_warns iface0)
 
    -- The interface hash depends on:
    --   - the ABI hash, plus
@@ -722,8 +702,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                 mi_orphan      = not (   all ifRuleAuto orph_rules
                                            -- See Note [Orphans and auto-generated rules]
                                       && null orph_insts
-                                      && null orph_fis
-                                      && isNoIfaceVectInfo (mi_vect_info iface0)),
+                                      && null orph_fis),
                 mi_finsts      = not . null $ mi_fam_insts iface0,
                 mi_decls       = sorted_decls,
                 mi_hash_fn     = lookupOccEnv local_env }
index 1d18c12..9d04bf2 100644 (file)
@@ -15,7 +15,7 @@ module TcIface (
         typecheckIfacesForMerging,
         typecheckIfaceForInstantiate,
         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
-        tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceCompleteSigs,
+        tcIfaceAnnotations, tcIfaceCompleteSigs,
         tcIfaceExpr,    -- Desired by HERMIT (Trac #7683)
         tcIfaceGlobal
  ) where
@@ -55,7 +55,6 @@ import PrelNames
 import TysWiredIn
 import Literal
 import Var
-import VarEnv
 import VarSet
 import Name
 import NameEnv
@@ -173,9 +172,6 @@ typecheckIface iface
         ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)
         ; anns      <- tcIfaceAnnotations (mi_anns iface)
 
-                -- Vectorisation information
-        ; vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface)
-
                 -- Exports
         ; exports <- ifaceExportNames (mi_exports iface)
 
@@ -193,7 +189,6 @@ typecheckIface iface
                               , md_fam_insts = fam_insts
                               , md_rules     = rules
                               , md_anns      = anns
-                              , md_vect_info = vect_info
                               , md_exports   = exports
                               , md_complete_sigs = complete_sigs
                               }
@@ -393,7 +388,6 @@ typecheckIfacesForMerging mod ifaces tc_env_var =
         fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
         rules     <- tcIfaceRules ignore_prags (mi_rules iface)
         anns      <- tcIfaceAnnotations (mi_anns iface)
-        vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface)
         exports   <- ifaceExportNames (mi_exports iface)
         complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
         return $ ModDetails { md_types     = type_env
@@ -401,7 +395,6 @@ typecheckIfacesForMerging mod ifaces tc_env_var =
                             , md_fam_insts = fam_insts
                             , md_rules     = rules
                             , md_anns      = anns
-                            , md_vect_info = vect_info
                             , md_exports   = exports
                             , md_complete_sigs = complete_sigs
                             }
@@ -434,7 +427,6 @@ typecheckIfaceForInstantiate nsubst iface =
     fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
     rules     <- tcIfaceRules ignore_prags (mi_rules iface)
     anns      <- tcIfaceAnnotations (mi_anns iface)
-    vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface)
     exports   <- ifaceExportNames (mi_exports iface)
     complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
     return $ ModDetails { md_types     = type_env
@@ -442,7 +434,6 @@ typecheckIfaceForInstantiate nsubst iface =
                         , md_fam_insts = fam_insts
                         , md_rules     = rules
                         , md_anns      = anns
-                        , md_vect_info = vect_info
                         , md_exports   = exports
                         , md_complete_sigs = complete_sigs
                         }
@@ -1131,134 +1122,6 @@ tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t)
 {-
 ************************************************************************
 *                                                                      *
-                Vectorisation information
-*                                                                      *
-************************************************************************
--}
-
--- We need access to the type environment as we need to look up information about type constructors
--- (i.e., their data constructors and whether they are class type constructors).  If a vectorised
--- type constructor or class is defined in the same module as where it is vectorised, we cannot
--- look that information up from the type constructor that we obtained via a 'forkM'ed
--- 'tcIfaceTyCon' without recursively loading the interface that we are already type checking again
--- and again and again...
---
-tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
-tcIfaceVectInfo mod typeEnv (IfaceVectInfo
-                             { ifaceVectInfoVar            = vars
-                             , ifaceVectInfoTyCon          = tycons
-                             , ifaceVectInfoTyConReuse     = tyconsReuse
-                             , ifaceVectInfoParallelVars   = parallelVars
-                             , ifaceVectInfoParallelTyCons = parallelTyCons
-                             })
-  = do { let parallelTyConsSet = mkNameSet parallelTyCons
-       ; vVars         <- mapM vectVarMapping                  vars
-       ; let varsSet = mkVarSet (map fst vVars)
-       ; tyConRes1     <- mapM (vectTyConVectMapping varsSet)  tycons
-       ; tyConRes2     <- mapM (vectTyConReuseMapping varsSet) tyconsReuse
-       ; vParallelVars <- mapM vectVar                         parallelVars
-       ; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2)
-       ; return $ VectInfo
-                  { vectInfoVar            = mkDVarEnv vVars `extendDVarEnvList` concat vScSels
-                  , vectInfoTyCon          = mkNameEnv vTyCons
-                  , vectInfoDataCon        = mkNameEnv (concat vDataCons)
-                  , vectInfoParallelVars   = mkDVarSet vParallelVars
-                  , vectInfoParallelTyCons = parallelTyConsSet
-                  }
-       }
-  where
-    vectVarMapping name
-      = do { vName <- lookupIfaceTop (mkLocalisedOccName mod mkVectOcc name)
-           ; var   <- forkM (text "vect var"  <+> ppr name)  $
-                        tcIfaceExtId name
-           ; vVar  <- forkM (text "vect vVar [mod =" <+>
-                             ppr mod <> text "; nameModule =" <+>
-                             ppr (nameModule name) <> text "]" <+> ppr vName) $
-                       tcIfaceExtId vName
-           ; return (var, (var, vVar))
-           }
-      -- where
-      --   lookupLocalOrExternalId name
-      --     = do { let mb_id = lookupTypeEnv typeEnv name
-      --          ; case mb_id of
-      --                -- id is local
-      --              Just (AnId id) -> return id
-      --                -- name is not an Id => internal inconsistency
-      --              Just _         -> notAnIdErr
-      --                -- Id is external
-      --              Nothing        -> tcIfaceExtId name
-      --          }
-      --
-      --   notAnIdErr = pprPanic "TcIface.tcIfaceVectInfo: not an id" (ppr name)
-
-    vectVar name
-      = forkM (text "vect scalar var"  <+> ppr name)  $
-          tcIfaceExtId name
-
-    vectTyConVectMapping vars name
-      = do { vName  <- lookupIfaceTop (mkLocalisedOccName mod mkVectTyConOcc name)
-           ; vectTyConMapping vars name vName
-           }
-
-    vectTyConReuseMapping vars name
-      = vectTyConMapping vars name name
-
-    vectTyConMapping vars name vName
-      = do { tycon  <- lookupLocalOrExternalTyCon name
-           ; vTycon <- forkM (text "vTycon of" <+> ppr vName) $
-                         lookupLocalOrExternalTyCon vName
-
-               -- Map the data constructors of the original type constructor to those of the
-               -- vectorised type constructor /unless/ the type constructor was vectorised
-               -- abstractly; if it was vectorised abstractly, the workers of its data constructors
-               -- do not appear in the set of vectorised variables.
-               --
-               -- NB: This is lazy!  We don't pull at the type constructors before we actually use
-               --     the data constructor mapping.
-           ; let isAbstract | isClassTyCon tycon = False
-                            | datacon:_ <- tyConDataCons tycon
-                                                 = not $ dataConWrapId datacon `elemVarSet` vars
-                            | otherwise          = True
-                 vDataCons  | isAbstract = []
-                            | otherwise  = [ (dataConName datacon, (datacon, vDatacon))
-                                           | (datacon, vDatacon) <- zip (tyConDataCons tycon)
-                                                                        (tyConDataCons vTycon)
-                                           ]
-
-                   -- Map the (implicit) superclass and methods selectors as they don't occur in
-                   -- the var map.
-                 vScSels    | Just cls  <- tyConClass_maybe tycon
-                            , Just vCls <- tyConClass_maybe vTycon
-                            = [ (sel, (sel, vSel))
-                              | (sel, vSel) <- zip (classAllSelIds cls) (classAllSelIds vCls)
-                              ]
-                            | otherwise
-                            = []
-
-           ; return ( (name, (tycon, vTycon))          -- (T, T_v)
-                    , vDataCons                        -- list of (Ci, Ci_v)
-                    , vScSels                          -- list of (seli, seli_v)
-                    )
-           }
-      where
-          -- we need a fully defined version of the type constructor to be able to extract
-          -- its data constructors etc.
-        lookupLocalOrExternalTyCon name
-          = do { let mb_tycon = lookupTypeEnv typeEnv name
-               ; case mb_tycon of
-                     -- tycon is local
-                   Just (ATyCon tycon) -> return tycon
-                     -- name is not a tycon => internal inconsistency
-                   Just _              -> notATyConErr
-                     -- tycon is external
-                   Nothing             -> tcIfaceTyConByName name
-               }
-
-        notATyConErr = pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name)
-
-{-
-************************************************************************
-*                                                                      *
                         Types
 *                                                                      *
 ************************************************************************
index dbc5ff1..f137f13 100644 (file)
@@ -8,13 +8,11 @@ import TcRnTypes   ( IfL )
 import InstEnv     ( ClsInst )
 import FamInstEnv  ( FamInst )
 import CoreSyn     ( CoreRule )
-import HscTypes    ( TypeEnv, VectInfo, IfaceVectInfo, CompleteMatch )
-import Module      ( Module )
+import HscTypes    ( CompleteMatch )
 import Annotations ( Annotation )
 
 tcIfaceDecl         :: Bool -> IfaceDecl -> IfL TyThing
 tcIfaceRules        :: Bool -> [IfaceRule] -> IfL [CoreRule]
-tcIfaceVectInfo     :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
 tcIfaceInst         :: IfaceClsInst -> IfL ClsInst
 tcIfaceFamInst      :: IfaceFamInst -> IfL FamInst
 tcIfaceAnnotations  :: [IfaceAnnotation] -> IfL [Annotation]
index 2a96fd0..558fa99 100644 (file)
@@ -394,7 +394,6 @@ data DumpFlag
    | Opt_D_dump_splices
    | Opt_D_th_dec_file
    | Opt_D_dump_BCOs
-   | Opt_D_dump_vect
    | Opt_D_dump_ticked
    | Opt_D_dump_rtti
    | Opt_D_source_stats
@@ -470,8 +469,6 @@ data GeneralFlag
    | Opt_UnboxSmallStrictFields
    | Opt_DictsCheap
    | Opt_EnableRewriteRules             -- Apply rewrite rules during simplification
-   | Opt_Vectorise
-   | Opt_VectorisationAvoidance
    | Opt_RegsGraph                      -- do graph coloring register allocation
    | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation
    | Opt_PedanticBottoms                -- Be picky about how we treat bottom
@@ -667,8 +664,6 @@ optimisationFlags = EnumSet.fromList
    , Opt_UnboxSmallStrictFields
    , Opt_DictsCheap
    , Opt_EnableRewriteRules
-   , Opt_Vectorise
-   , Opt_VectorisationAvoidance
    , Opt_RegsGraph
    , Opt_RegsIterative
    , Opt_PedanticBottoms
@@ -3207,8 +3202,6 @@ dynamic_flags_deps = [
         (setDumpFlag Opt_D_dump_hi)
   , make_ord_flag defGhcFlag "ddump-minimal-imports"
         (NoArg (setGeneralFlag Opt_D_dump_minimal_imports))
-  , make_ord_flag defGhcFlag "ddump-vect"
-        (setDumpFlag Opt_D_dump_vect)
   , make_ord_flag defGhcFlag "ddump-hpc"
         (setDumpFlag Opt_D_dump_ticked) -- back compat
   , make_ord_flag defGhcFlag "ddump-ticked"
@@ -3334,7 +3327,6 @@ dynamic_flags_deps = [
         ------ Optimisation flags ------------------------------------------
   , make_dep_flag defGhcFlag "Onot"   (noArgM $ setOptLevel 0 )
                                                             "Use -O0 instead"
-  , make_ord_flag defGhcFlag "Odph"   (noArgM setDPHOpt)
   , make_ord_flag defGhcFlag "O"      (optIntSuffixM (\mb_n ->
                                                 setOptLevel (mb_n `orElse` 1)))
                 -- If the number is missing, use 1
@@ -3968,8 +3960,6 @@ fFlagsDeps = [
   flagSpec "write-interface"                  Opt_WriteInterface,
   flagSpec "unbox-small-strict-fields"        Opt_UnboxSmallStrictFields,
   flagSpec "unbox-strict-fields"              Opt_UnboxStrictFields,
-  flagSpec "vectorisation-avoidance"          Opt_VectorisationAvoidance,
-  flagSpec "vectorise"                        Opt_Vectorise,
   flagSpec "version-macros"                   Opt_VersionMacros,
   flagSpec "worker-wrapper"                   Opt_WorkerWrapper,
   flagSpec "solve-constant-dicts"             Opt_SolveConstantDicts,
@@ -4037,10 +4027,6 @@ fLangFlagsDeps = [
     (deprecatedForExtension "ImplicitParams"),
   depFlagSpec' "scoped-type-variables"          LangExt.ScopedTypeVariables
     (deprecatedForExtension "ScopedTypeVariables"),
-  depFlagSpec' "parr"                           LangExt.ParallelArrays
-    (deprecatedForExtension "ParallelArrays"),
-  depFlagSpec' "PArr"                           LangExt.ParallelArrays
-    (deprecatedForExtension "ParallelArrays"),
   depFlagSpec' "allow-overlapping-instances"    LangExt.OverlappingInstances
     (deprecatedForExtension "OverlappingInstances"),
   depFlagSpec' "allow-undecidable-instances"    LangExt.UndecidableInstances
@@ -4380,11 +4366,6 @@ optLevelFlags -- see Note [Documenting optimisation flags]
     , ([0,1,2], Opt_DoEtaReduction)       -- See Note [Eta-reduction in -O0]
     , ([0,1,2], Opt_DmdTxDictSel)
     , ([0,1,2], Opt_LlvmTBAA)
-    , ([0,1,2], Opt_VectorisationAvoidance)
-                -- This one is important for a tiresome reason:
-                -- we want to make sure that the bindings for data
-                -- constructors are eta-expanded.  This is probably
-                -- a good thing anyway, but it seems fragile.
 
     , ([0],     Opt_IgnoreInterfacePragmas)
     , ([0],     Opt_OmitInterfacePragmas)
@@ -5129,17 +5110,6 @@ checkOptLevel n dflags
    | otherwise
      = Right dflags
 
--- -Odph is equivalent to
---
---    -O2                               optimise as much as possible
---    -fmax-simplifier-iterations20     this is necessary sometimes
---    -fsimplifier-phases=3             we use an additional simplifier phase for fusion
---
-setDPHOpt :: DynFlags -> DynP DynFlags
-setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
-                                         , simplPhases         = 3
-                                         })
-
 setMainIs :: String -> DynP ()
 setMainIs arg
   | not (null main_fn) && isLower (head main_fn)
index e17e279..7cb25df 100644 (file)
@@ -44,7 +44,7 @@ module HscTypes (
         lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,
         addToHpt, addListToHpt, lookupHptDirectly, listToHpt,
         hptCompleteSigs,
-        hptInstances, hptRules, hptVectInfo, pprHPT,
+        hptInstances, hptRules, pprHPT,
 
         -- * State relating to known packages
         ExternalPackageState(..), EpsStats(..), addEpsInStats,
@@ -123,10 +123,6 @@ module HscTypes (
         -- * Breakpoints
         ModBreaks (..), emptyModBreaks,
 
-        -- * Vectorisation information
-        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
-        noIfaceVectInfo, isNoIfaceVectInfo,
-
         -- * Safe Haskell information
         IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
         trustInfoToNum, numToTrustInfo, IsSafeImport,
@@ -161,11 +157,9 @@ import Avail
 import Module
 import InstEnv          ( InstEnv, ClsInst, identicalClsInstHead )
 import FamInstEnv
-import CoreSyn          ( CoreProgram, RuleBase, CoreRule, CoreVect )
+import CoreSyn          ( CoreProgram, RuleBase, CoreRule )
 import Name
 import NameEnv
-import NameSet
-import VarEnv
 import VarSet
 import Var
 import Id
@@ -665,13 +659,6 @@ hptInstances hsc_env want_this_module
                 return (md_insts details, md_fam_insts details)
     in (concat insts, concat famInsts)
 
--- | Get the combined VectInfo of all modules in the home package table. In
--- contrast to instances and rules, we don't care whether the modules are
--- "below" us in the dependency sense. The VectInfo of those modules not "below"
--- us does not affect the compilation of the current module.
-hptVectInfo :: HscEnv -> VectInfo
-hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
-
 -- | Get rules from modules "below" this one (in the dependency sense)
 hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
 hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
@@ -934,9 +921,7 @@ data ModIface
         mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances
         mi_rules       :: [IfaceRule],     -- ^ Sorted rules
         mi_orphan_hash :: !Fingerprint,    -- ^ Hash for orphan rules, class and family
-                                           -- instances, and vectorise pragmas combined
-
-        mi_vect_info :: !IfaceVectInfo,    -- ^ Vectorisation information
+                                           -- instances combined
 
                 -- Cached environments for easy lookup
                 -- These are computed (lazily) from other fields
@@ -1040,7 +1025,6 @@ instance Binary ModIface where
                  mi_fam_insts = fam_insts,
                  mi_rules     = rules,
                  mi_orphan_hash = orphan_hash,
-                 mi_vect_info = vect_info,
                  mi_hpc       = hpc_info,
                  mi_trust     = trust,
                  mi_trust_pkg = trust_pkg,
@@ -1069,7 +1053,6 @@ instance Binary ModIface where
         put_ bh fam_insts
         lazyPut bh rules
         put_ bh orphan_hash
-        put_ bh vect_info
         put_ bh hpc_info
         put_ bh trust
         put_ bh trust_pkg
@@ -1100,7 +1083,6 @@ instance Binary ModIface where
         fam_insts   <- {-# SCC "bin_fam_insts" #-} get bh
         rules       <- {-# SCC "bin_rules" #-} lazyGet bh
         orphan_hash <- get bh
-        vect_info   <- get bh
         hpc_info    <- get bh
         trust       <- get bh
         trust_pkg   <- get bh
@@ -1131,7 +1113,6 @@ instance Binary ModIface where
                  mi_fam_insts   = fam_insts,
                  mi_rules       = rules,
                  mi_orphan_hash = orphan_hash,
-                 mi_vect_info   = vect_info,
                  mi_hpc         = hpc_info,
                  mi_trust       = trust,
                  mi_trust_pkg   = trust_pkg,
@@ -1172,7 +1153,6 @@ emptyModIface mod
                mi_decls       = [],
                mi_globals     = Nothing,
                mi_orphan_hash = fingerprint0,
-               mi_vect_info   = noIfaceVectInfo,
                mi_warn_fn     = emptyIfaceWarnCache,
                mi_fix_fn      = emptyIfaceFixCache,
                mi_hash_fn     = emptyIfaceHashCache,
@@ -1211,7 +1191,6 @@ data ModDetails
         md_rules     :: ![CoreRule],    -- ^ Domain may include 'Id's from other modules
         md_anns      :: ![Annotation],  -- ^ Annotations present in this module: currently
                                         -- they only annotate things also declared in this module
-        md_vect_info :: !VectInfo,       -- ^ Module vectorisation information
         md_complete_sigs :: [CompleteMatch]
           -- ^ Complete match pragmas for this module
      }
@@ -1225,7 +1204,6 @@ emptyModDetails
                  md_rules     = [],
                  md_fam_insts = [],
                  md_anns      = [],
-                 md_vect_info = noVectInfo,
                  md_complete_sigs = [] }
 
 -- | Records the modules directly imported by a module for extracting e.g.
@@ -1292,9 +1270,6 @@ data ModGuts
         mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches
         mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module
         mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module
-        mg_vect_decls:: ![CoreVect],     -- ^ Vectorisation declarations in this module
-                                         --   (produced by desugarer & consumed by vectoriser)
-        mg_vect_info :: !VectInfo,       -- ^ Pool of vectorised declarations in the module
 
                         -- The next two fields are unusual, because they give instance
                         -- environments for *all* modules in the home package, including
@@ -2323,7 +2298,6 @@ lookupFixity env n = case lookupNameEnv env n of
 -- * A transformation rule in a module other than the one defining
 --   the function in the head of the rule
 --
--- * A vectorisation pragma
 type WhetherHasOrphans   = Bool
 
 -- | Does this module define family instances?
@@ -2517,7 +2491,6 @@ type PackageTypeEnv          = TypeEnv
 type PackageRuleBase         = RuleBase
 type PackageInstEnv          = InstEnv
 type PackageFamInstEnv       = FamInstEnv
-type PackageVectInfo         = VectInfo
 type PackageAnnEnv           = AnnEnv
 type PackageCompleteMatchMap = CompleteMatchMap
 
@@ -2579,8 +2552,6 @@ data ExternalPackageState
                                                -- from all the external-package modules
         eps_rule_base    :: !PackageRuleBase,  -- ^ The total 'RuleEnv' accumulated
                                                -- from all the external-package modules
-        eps_vect_info    :: !PackageVectInfo,  -- ^ The total 'VectInfo' accumulated
-                                               -- from all the external-package modules
         eps_ann_env      :: !PackageAnnEnv,    -- ^ The total 'AnnEnv' accumulated
                                                -- from all the external-package modules
         eps_complete_matches :: !PackageCompleteMatchMap,
@@ -2883,119 +2854,6 @@ isHpcUsed (NoHpcInfo { hpcUsed = used }) = used
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Vectorisation Support}
-*                                                                      *
-************************************************************************
-
-The following information is generated and consumed by the vectorisation
-subsystem.  It communicates the vectorisation status of declarations from one
-module to another.
-
-Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo
-below?  We need to know `f' when converting to IfaceVectInfo.  However, during
-vectorisation, we need to know `f_v', whose `Var' we cannot lookup based
-on just the OccName easily in a Core pass.
--}
-
--- |Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'; see also
--- documentation at 'Vectorise.Env.GlobalEnv'.
---
--- NB: The following tables may also include 'Var's, 'TyCon's and 'DataCon's from imported modules,
---     which have been subsequently vectorised in the current module.
---
-data VectInfo
-  = VectInfo
-    { vectInfoVar            :: DVarEnv (Var    , Var  )    -- ^ @(f, f_v)@ keyed on @f@
-    , vectInfoTyCon          :: NameEnv (TyCon  , TyCon)    -- ^ @(T, T_v)@ keyed on @T@
-    , vectInfoDataCon        :: NameEnv (DataCon, DataCon)  -- ^ @(C, C_v)@ keyed on @C@
-    , vectInfoParallelVars   :: DVarSet                     -- ^ set of parallel variables
-    , vectInfoParallelTyCons :: NameSet                     -- ^ set of parallel type constructors
-    }
-
--- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated
--- across module boundaries.
---
--- NB: The field 'ifaceVectInfoVar' explicitly contains the workers of data constructors as well as
---     class selectors — i.e., their mappings are /not/ implicitly generated from the data types.
---     Moreover, whether the worker of a data constructor is in 'ifaceVectInfoVar' determines
---     whether that data constructor was vectorised (or is part of an abstractly vectorised type
---     constructor).
---
-data IfaceVectInfo
-  = IfaceVectInfo
-    { ifaceVectInfoVar            :: [Name]  -- ^ All variables in here have a vectorised variant
-    , ifaceVectInfoTyCon          :: [Name]  -- ^ All 'TyCon's in here have a vectorised variant;
-                                             -- the name of the vectorised variant and those of its
-                                             -- data constructors are determined by
-                                             -- 'OccName.mkVectTyConOcc' and
-                                             -- 'OccName.mkVectDataConOcc'; the names of the
-                                             -- isomorphisms are determined by 'OccName.mkVectIsoOcc'
-    , ifaceVectInfoTyConReuse     :: [Name]  -- ^ The vectorised form of all the 'TyCon's in here
-                                             -- coincides with the unconverted form; the name of the
-                                             -- isomorphisms is determined by 'OccName.mkVectIsoOcc'
-    , ifaceVectInfoParallelVars   :: [Name]  -- iface version of 'vectInfoParallelVar'
-    , ifaceVectInfoParallelTyCons :: [Name]  -- iface version of 'vectInfoParallelTyCon'
-    }
-
-noVectInfo :: VectInfo
-noVectInfo
-  = VectInfo emptyDVarEnv emptyNameEnv emptyNameEnv emptyDVarSet emptyNameSet
-
-plusVectInfo :: VectInfo -> VectInfo -> VectInfo
-plusVectInfo vi1 vi2 =
-  VectInfo (vectInfoVar            vi1 `plusDVarEnv`   vectInfoVar            vi2)
-           (vectInfoTyCon          vi1 `plusNameEnv`   vectInfoTyCon          vi2)
-           (vectInfoDataCon        vi1 `plusNameEnv`   vectInfoDataCon        vi2)
-           (vectInfoParallelVars   vi1 `unionDVarSet`  vectInfoParallelVars   vi2)
-           (vectInfoParallelTyCons vi1 `unionNameSet` vectInfoParallelTyCons vi2)
-
-concatVectInfo :: [VectInfo] -> VectInfo
-concatVectInfo = foldr plusVectInfo noVectInfo
-
-noIfaceVectInfo :: IfaceVectInfo
-noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
-
-isNoIfaceVectInfo :: IfaceVectInfo -> Bool
-isNoIfaceVectInfo (IfaceVectInfo l1 l2 l3 l4 l5)
-  = null l1 && null l2 && null l3 && null l4 && null l5
-
-instance Outputable VectInfo where
-  ppr info = vcat
-             [ text "variables       :" <+> ppr (vectInfoVar            info)
-             , text "tycons          :" <+> ppr (vectInfoTyCon          info)
-             , text "datacons        :" <+> ppr (vectInfoDataCon        info)
-             , text "parallel vars   :" <+> ppr (vectInfoParallelVars   info)
-             , text "parallel tycons :" <+> ppr (vectInfoParallelTyCons info)
-             ]
-
-instance Outputable IfaceVectInfo where
-  ppr info = vcat
-             [ text "variables       :" <+> ppr (ifaceVectInfoVar            info)
-             , text "tycons          :" <+> ppr (ifaceVectInfoTyCon          info)
-             , text "tycons reuse    :" <+> ppr (ifaceVectInfoTyConReuse     info)
-             , text "parallel vars   :" <+> ppr (ifaceVectInfoParallelVars   info)
-             , text "parallel tycons :" <+> ppr (ifaceVectInfoParallelTyCons info)
-             ]
-
-
-instance Binary IfaceVectInfo where
-    put_ bh (IfaceVectInfo a1 a2 a3 a4 a5) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        return (IfaceVectInfo a1 a2 a3 a4 a5)
-
-{-
-************************************************************************
-*                                                                      *
 \subsection{Safe Haskell Support}
 *                                                                      *
 ************************************************************************
index f27e597..008e9b5 100644 (file)
@@ -911,15 +911,6 @@ packageFlagErr :: DynFlags
                -> PackageFlag
                -> [(PackageConfig, UnusablePackageReason)]
                -> IO a
-
--- for missing DPH package we emit a more helpful error message, because
--- this may be the result of using -fdph-par or -fdph-seq.
-packageFlagErr dflags (ExposePackage _ (PackageArg pkg) _) []
-  | is_dph_package pkg
-  = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ dph_err))
-  where dph_err = text "the " <> text pkg <> text " package is not installed."
-                  $$ text "To install it: \"cabal install dph\"."
-        is_dph_package pkg = "dph" `isPrefixOf` pkg
 packageFlagErr dflags flag reasons
   = packageFlagErr' dflags (pprFlag flag) reasons
 
index ce8ac53..1728bc0 100644 (file)
@@ -61,7 +61,6 @@ import Maybes
 import UniqSupply
 import ErrUtils (Severity(..))
 import Outputable
-import UniqDFM
 import SrcLoc
 import qualified ErrUtils as Err
 
@@ -71,7 +70,7 @@ import Data.List        ( sortBy )
 import Data.IORef       ( atomicModifyIORef' )
 
 {-
-Constructing the TypeEnv, Instances, Rules, VectInfo from which the
+Constructing the TypeEnv, Instances, Rules from which the
 ModIface is constructed, and which goes on to subsequent modules in
 --make mode.
 
@@ -165,7 +164,6 @@ mkBootModDetailsTc hsc_env
                              , md_rules     = []
                              , md_anns      = []
                              , md_exports   = exports
-                             , md_vect_info = noVectInfo
                              , md_complete_sigs = []
                              })
         }
@@ -246,9 +244,8 @@ First we figure out which Ids are "external" Ids.  An
 unit.  These are
   a) the user exported ones
   b) the ones bound to static forms
-  c) ones mentioned in the unfoldings, workers,
-     rules of externally-visible ones ,
-     or vectorised versions of externally-visible ones
+  c) ones mentioned in the unfoldings, workers, or
+     rules of externally-visible ones
 
 While figuring out which Ids are external, we pick a "tidy" OccName
 for each one.  That is, we make its OccName distinct from the other
@@ -324,7 +321,6 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                               , mg_binds     = binds
                               , mg_patsyns   = patsyns
                               , mg_rules     = imp_rules
-                              , mg_vect_info = vect_info
                               , mg_anns      = anns
                               , mg_complete_sigs = complete_sigs
                               , mg_deps      = deps
@@ -351,7 +347,7 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
 
         ; (unfold_env, tidy_occ_env)
               <- chooseExternalIds hsc_env mod omit_prags expose_all
-                                   binds implicit_binds imp_rules (vectInfoVar vect_info)
+                                   binds implicit_binds imp_rules
         ; let { (trimmed_binds, trimmed_rules)
                     = findExternalRules omit_prags binds imp_rules unfold_env }
 
@@ -373,8 +369,6 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                 -- and indeed it does, but if omit_prags is on, ext_rules is
                 -- empty
 
-              ; tidy_vect_info = tidyVectInfo tidy_env vect_info
-
                 -- Tidy the Ids inside each PatSyn, very similarly to DFunIds
                 -- and then override the PatSyns in the type_env with the new tidy ones
                 -- This is really the only reason we keep mg_patsyns at all; otherwise
@@ -444,7 +438,6 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                    ModDetails { md_types     = tidy_type_env,
                                 md_rules     = tidy_rules,
                                 md_insts     = tidy_cls_insts,
-                                md_vect_info = tidy_vect_info,
                                 md_fam_insts = fam_insts,
                                 md_exports   = exports,
                                 md_anns      = anns,      -- are already tidy
@@ -493,38 +486,6 @@ extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv
 extendTypeEnvWithPatSyns tidy_patsyns type_env
   = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
 
-tidyVectInfo :: TidyEnv -> VectInfo -> VectInfo
-tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar          = vars
-                                         , vectInfoParallelVars = parallelVars
-                                         })
-  = info { vectInfoVar          = tidy_vars
-         , vectInfoParallelVars = tidy_parallelVars
-         }
-  where
-      -- we only export mappings whose domain and co-domain is exported (otherwise, the iface is
-      -- inconsistent)
-    tidy_vars = mkDVarEnv [ (tidy_var, (tidy_var, tidy_var_v))
-                          | (var, var_v) <- eltsUDFM vars
-                          , let tidy_var   = lookup_var var
-                                tidy_var_v = lookup_var var_v
-                          , isExternalId tidy_var   && isExportedId tidy_var
-                          , isExternalId tidy_var_v && isExportedId tidy_var_v
-                          , isDataConWorkId var || not (isImplicitId var)
-                          ]
-
-    tidy_parallelVars = mkDVarSet
-                          [ tidy_var
-                          | var <- dVarSetElems parallelVars
-                          , let tidy_var = lookup_var var
-                          , isExternalId tidy_var && isExportedId tidy_var
-                          ]
-
-    lookup_var var = lookupWithDefaultVarEnv var_env var var
-
-    -- We need to make sure that all names getting into the iface version of 'VectInfo' are
-    -- external; otherwise, 'MkIface' will bomb out.
-    isExternalId = isExternalName . idName
-
 {-
 Note [Don't attempt to trim data types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -641,11 +602,10 @@ chooseExternalIds :: HscEnv
                   -> [CoreBind]
                   -> [CoreBind]
                   -> [CoreRule]
-                  -> DVarEnv (Var, Var)
                   -> IO (UnfoldEnv, TidyOccEnv)
                   -- Step 1 from the notes above
 
-chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules vect_vars
+chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules
   = do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env
        ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders
        ; tidy_internal internal_ids unfold_env1 occ_env1 }
@@ -665,13 +625,10 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
 
   -- An Id should be external if either (a) it is exported,
   -- (b) it appears in the RHS of a local rule for an imported Id, or
-  -- (c) it is the vectorised version of an imported Id.
   -- See Note [Which rules to expose]
   is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars
-                 || id `elemVarSet` vect_var_vs
 
   rule_rhs_vars  = mapUnionVarSet ruleRhsFreeVars imp_id_rules
-  vect_var_vs    = mkVarSet [var_v | (var, var_v) <- eltsUDFM vect_vars, isGlobalId var]
 
   binders          = map fst $ flattenBinds binds
   implicit_binders = bindersOfBinds implicit_binds
@@ -721,9 +678,6 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
                 | omit_prags = ([], False)
                 | otherwise  = addExternal expose_all refined_id
 
-                -- add vectorised version if any exists
-          new_ids' = new_ids ++ maybeToList (fmap snd $ lookupDVarEnv vect_vars idocc)
-
                 -- 'idocc' is an *occurrence*, but we need to see the
                 -- unfolding in the *definition*; so look up in binder_set
           refined_id = case lookupVarSet binder_set idocc of
@@ -734,7 +688,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
           referrer' | isExportedId refined_id = refined_id
                     | otherwise               = referrer
       --
-      search (zip new_ids' (repeat referrer') ++ rest) unfold_env' occ_env'
+      search (zip new_ids (repeat referrer') ++ rest) unfold_env' occ_env'
 
   tidy_internal :: [Id] -> UnfoldEnv -> TidyOccEnv
                 -> IO (UnfoldEnv, TidyOccEnv)
index 83beef2..fc8b988 100644 (file)
@@ -371,11 +371,6 @@ $tab          { warnTab }
 -- "special" symbols
 
 <0> {
-  "[:" / { ifExtension parrEnabled }    { token ITopabrack }
-  ":]" / { ifExtension parrEnabled }    { token ITcpabrack }
-}
-
-<0> {
   "[|"        / { ifExtension thQuotesEnabled } { token (ITopenExpQuote NoE
                                                                 NormalSyntax) }
   "[||"       / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote NoE) }
@@ -665,9 +660,6 @@ data Token
   | IToptions_prag String
   | ITinclude_prag String
   | ITlanguage_prag
-  | ITvect_prag         SourceText
-  | ITvect_scalar_prag  SourceText
-  | ITnovect_prag       SourceText
   | ITminimal_prag      SourceText
   | IToverlappable_prag SourceText  -- instance overlap mode
   | IToverlapping_prag  SourceText  -- instance overlap mode
@@ -2230,7 +2222,6 @@ data ExtBits
   = FfiBit
   | InterruptibleFfiBit
   | CApiFfiBit
-  | ParrBit
   | ArrowsBit
   | ThBit
   | ThQuotesBit
@@ -2271,8 +2262,6 @@ data ExtBits
 
 always :: ExtsBitmap -> Bool
 always           _     = True
-parrEnabled :: ExtsBitmap -> Bool
-parrEnabled = xtest ParrBit
 arrowsEnabled :: ExtsBitmap -> Bool
 arrowsEnabled = xtest ArrowsBit
 thEnabled :: ExtsBitmap -> Bool
@@ -2357,7 +2346,6 @@ mkParserFlags flags =
       bitmap =     FfiBit                      `setBitIf` xopt LangExt.ForeignFunctionInterface flags
                .|. InterruptibleFfiBit         `setBitIf` xopt LangExt.InterruptibleFFI         flags
                .|. CApiFfiBit                  `setBitIf` xopt LangExt.CApiFFI                  flags
-               .|. ParrBit                     `setBitIf` xopt LangExt.ParallelArrays           flags
                .|. ArrowsBit                   `setBitIf` xopt LangExt.Arrows                   flags
                .|. ThBit                       `setBitIf` xopt LangExt.TemplateHaskell          flags
                .|. ThQuotesBit                 `setBitIf` xopt LangExt.TemplateHaskellQuotes    flags
@@ -2878,8 +2866,6 @@ oneWordPrags = Map.fromList [
      ("unpack", strtoken (\s -> ITunpack_prag (SourceText s))),
      ("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))),
      ("ann", strtoken (\s -> ITann_prag (SourceText s))),
-     ("vectorize", strtoken (\s -> ITvect_prag (SourceText s))),
-     ("novectorize", strtoken (\s -> ITnovect_prag (SourceText s))),
      ("minimal", strtoken (\s -> ITminimal_prag (SourceText s))),
      ("overlaps", strtoken (\s -> IToverlaps_prag (SourceText s))),
      ("overlappable", strtoken (\s -> IToverlappable_prag (SourceText s))),
@@ -2890,7 +2876,7 @@ oneWordPrags = Map.fromList [
      ("column", columnPrag)
      ]
 
-twoWordPrags = Map.fromList([
+twoWordPrags = Map.fromList [
      ("inline conlike",
          strtoken (\s -> (ITinline_prag (SourceText s) Inline ConLike))),
      ("notinline conlike",
@@ -2898,9 +2884,8 @@ twoWordPrags = Map.fromList([
      ("specialize inline",
          strtoken (\s -> (ITspec_inline_prag (SourceText s) True))),
      ("specialize notinline",
-         strtoken (\s -> (ITspec_inline_prag (SourceText s) False))),
-     ("vectorize scalar",
-         strtoken (\s -> ITvect_scalar_prag (SourceText s)))])
+         strtoken (\s -> (ITspec_inline_prag (SourceText s) False)))
+     ]
 
 dispatch_pragmas :: Map String Action -> Action
 dispatch_pragmas prags span buf len = case Map.lookup (clean_pragma (lexemeToString buf len)) prags of
@@ -2922,8 +2907,6 @@ clean_pragma prag = canon_ws (map toLower (unprefix prag))
                           canonical prag' = case prag' of
                                               "noinline" -> "notinline"
                                               "specialise" -> "specialize"
-                                              "vectorise" -> "vectorize"
-                                              "novectorise" -> "novectorize"
                                               "constructorlike" -> "conlike"
                                               _ -> prag'
                           canon_ws s = unwords (map canonical (words s))
index c6face8..533e21d 100644 (file)
@@ -79,7 +79,7 @@ import TysPrim          ( eqPrimTyCon )
 import PrelNames        ( eqTyCon_RDR )
 import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
                           unboxedUnitTyCon, unboxedUnitDataCon,
-                          listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
+                          listTyCon_RDR, consDataCon_RDR )
 
 -- compiler/utils
 import Util             ( looksLikePackageName )
@@ -88,7 +88,7 @@ import GhcPrelude
 import qualified GHC.LanguageExtensions as LangExt
 }
 
-%expect 233 -- shift/reduce conflicts
+%expect 229 -- shift/reduce conflicts
 
 {- Last updated: 14 Apr 2018
 
@@ -502,9 +502,6 @@ are the most common patterns, rewritten as regular expressions for clarity:
  '{-# UNPACK'             { L _ (ITunpack_prag _) }
  '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }
  '{-# ANN'                { L _ (ITann_prag _) }
- '{-# VECTORISE'          { L _ (ITvect_prag _) }
- '{-# VECTORISE_SCALAR'   { L _ (ITvect_scalar_prag _) }
- '{-# NOVECTORISE'        { L _ (ITnovect_prag _) }
  '{-# MINIMAL'            { L _ (ITminimal_prag _) }
  '{-# CTYPE'              { L _ (ITctype _) }
  '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }
@@ -1040,33 +1037,6 @@ topdecl :: { LHsDecl GhcPs }
                                                        [mo $1,mc $3] }
         | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD noExt (HsRules noExt (getRULES_PRAGs $1) (fromOL $2)))
                                                        [mo $1,mc $3] }
-        | '{-# VECTORISE' qvar '=' exp '#-}' {% ams (sLL $1 $> $ VectD noExt (HsVect noExt (getVECT_PRAGs $1) $2 $4))
-                                                    [mo $1,mj AnnEqual $3
-                                                    ,mc $5] }
-        | '{-# NOVECTORISE' qvar '#-}'       {% ams (sLL $1 $> $ VectD noExt (HsNoVect noExt (getNOVECT_PRAGs $1) $2))
-                                                     [mo $1,mc $3] }
-        | '{-# VECTORISE' 'type' gtycon '#-}'
-                                {% ams (sLL $1 $> $
-                                    VectD noExt (HsVectType (VectTypePR (getVECT_PRAGs $1) $3 Nothing) False))
-                                    [mo $1,mj AnnType $2,mc $4] }
-
-        | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
-                                {% ams (sLL $1 $> $
-                                    VectD noExt (HsVectType (VectTypePR (getVECT_SCALAR_PRAGs $1) $3 Nothing) True))
-                                    [mo $1,mj AnnType $2,mc $4] }
-
-        | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
-                                {% ams (sLL $1 $> $
-                                    VectD noExt (HsVectType (VectTypePR (getVECT_PRAGs $1) $3 (Just $5)) False))
-                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
-        | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
-                                {% ams (sLL $1 $> $
-                                    VectD noExt (HsVectType (VectTypePR (getVECT_SCALAR_PRAGs $1) $3 (Just $5)) True))
-                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
-
-        | '{-# VECTORISE' 'class' gtycon '#-}'
-                                         {% ams (sLL $1 $>  $ VectD noExt (HsVectClass (VectClassPR (getVECT_PRAGs $1) $3)))
-                                                 [mo $1,mj AnnClass $2,mc $4] }
         | annotation { $1 }
         | decl_no_th                            { $1 }
 
@@ -1968,9 +1938,8 @@ atype :: { LHsType GhcPs }
                                              [mo $1,mc $3] }
         | '(#' bar_types2 '#)'        {% ams (sLL $1 $> $ HsSumTy noExt $2)
                                              [mo $1,mc $3] }
-        | '[' ctype ']'               {% ams (sLL $1 $> $ HsListTy noExt $2) [mos $1,mcs $3] }
-        | '[:' ctype ':]'             {% ams (sLL $1 $> $ HsPArrTy noExt $2) [mo $1,mc $3] }
-        | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy  noExt $2) [mop $1,mcp $3] }
+        | '[' ctype ']'               {% ams (sLL $1 $> $ HsListTy  noExt $2) [mos $1,mcs $3] }
+        | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy   noExt $2) [mop $1,mcp $3] }
         | '(' ctype '::' kind ')'     {% ams (sLL $1 $> $ HsKindSig noExt $2 $4)
                                              [mop $1,mu AnnDcolon $3,mcp $5] }
         | quasiquote                  { sL1 $1 (HsSpliceTy noExt (unLoc $1) ) }
@@ -2628,7 +2597,6 @@ aexp2   :: { LHsExpr GhcPs }
                                               ; ams (sLL $1 $> e) ((mo $1:fst $2) ++ [mc $3]) } }
 
         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
-        | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
         | '_'               { sL1 $1 $ EWildPat noExt }
 
         -- Template Haskell Extension
@@ -2834,28 +2802,6 @@ transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs
 -- in by choosing the "group by" variant, which is what we want.
 
 -----------------------------------------------------------------------------
--- Parallel array expressions
-
--- The rules below are little bit contorted; see the list case for details.
--- Note that, in contrast to lists, we only have finite arithmetic sequences.
--- Moreover, we allow explicit arrays with no element (represented by the nil
--- constructor in the list case).
-
-parr :: { ([AddAnn],HsExpr GhcPs) }
-        :                      { ([],ExplicitPArr noExt []) }
-        | texp                 { ([],ExplicitPArr noExt [$1]) }
-        | lexps                { ([],ExplicitPArr noExt (reverse (unLoc $1))) }
-        | texp '..' exp        { ([mj AnnDotdot $2]
-                                 ,PArrSeq noExt (FromTo $1 $3)) }
-        | texp ',' exp '..' exp
-                        { ([mj AnnComma $2,mj AnnDotdot $4]
-                          ,PArrSeq noExt (FromThenTo $1 $3 $5)) }
-        | texp '|' flattenedpquals
-                        { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
-
--- We are reusing `lexps' and `flattenedpquals' from the list case.
-
------------------------------------------------------------------------------
 -- Guards
 
 guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
@@ -3114,8 +3060,6 @@ gen_qcon :: { Located RdrName }
   | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
                                    [mop $1,mj AnnVal $2,mcp $3] }
 
--- The case of '[:' ':]' is part of the production `parr'
-
 con     :: { Located RdrName }
         : conid                 { $1 }
         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
@@ -3175,7 +3119,6 @@ ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit
         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
                                        [mop $1,mu AnnRarrow $2,mcp $3] }
         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
-        | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
                                         [mop $1,mj AnnTildehsh $2,mcp $3] }
 
@@ -3555,9 +3498,6 @@ getCORE_PRAGs         (L _ (ITcore_prag         src)) = src
 getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src
 getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src
 getANN_PRAGs          (L _ (ITann_prag          src)) = src
-getVECT_PRAGs         (L _ (ITvect_prag         src)) = src
-getVECT_SCALAR_PRAGs  (L _ (ITvect_scalar_prag  src)) = src
-getNOVECT_PRAGs       (L _ (ITnovect_prag       src)) = src
 getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src
 getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src
 getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src
index b887440..dfcccd3 100644 (file)
@@ -1012,11 +1012,10 @@ checkAPat msg loc e0 = do
 
    OpApp {}           -> patFail msg loc e0
 
-   HsPar _ e          -> checkLPat msg e >>= (return . (ParPat noExt))
    ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es
                              return (ListPat noExt ps)
-   ExplicitPArr _ es  -> do ps <- mapM (checkLPat msg) es
-                            return (PArrPat noExt ps)
+
+   HsPar _ e          -> checkLPat msg e >>= (return . (ParPat noExt))
 
    ExplicitTuple _ es b
      | all tupArgPresent es  -> do ps <- mapM (checkLPat msg)
index fd324cb..8854112 100644 (file)
@@ -543,9 +543,6 @@ dATA_TYPE_EQUALITY = mkBaseModule (fsLit "Data.Type.Equality")
 dATA_COERCE     = mkBaseModule (fsLit "Data.Coerce")
 dEBUG_TRACE     = mkBaseModule (fsLit "Debug.Trace")
 
-gHC_PARR' :: Module
-gHC_PARR' = mkBaseModule (fsLit "GHC.PArr")
-
 gHC_SRCLOC :: Module
 gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc")
 
@@ -1744,10 +1741,6 @@ funPtrTyConKey                          = mkPreludeTyConUnique 76
 tVarPrimTyConKey                        = mkPreludeTyConUnique 77
 compactPrimTyConKey                     = mkPreludeTyConUnique 78
 
--- Parallel array type constructor
-parrTyConKey :: Unique
-parrTyConKey                            = mkPreludeTyConUnique 82
-
 -- dotnet interop
 objectTyConKey :: Unique
 objectTyConKey                          = mkPreludeTyConUnique 83
@@ -1938,10 +1931,6 @@ inlDataConKey                           = mkPreludeDataConUnique 21
 inrDataConKey                           = mkPreludeDataConUnique 22
 genUnitDataConKey                       = mkPreludeDataConUnique 23
 
--- Data constructor for parallel arrays
-parrDataConKey :: Unique
-parrDataConKey                          = mkPreludeDataConUnique 24
-
 leftDataConKey, rightDataConKey :: Unique
 leftDataConKey                          = mkPreludeDataConUnique 25
 rightDataConKey                         = mkPreludeDataConUnique 26
index 72c24ed..0817a75 100644 (file)
@@ -95,11 +95,6 @@ module TysWiredIn (
         unicodeStarKindTyCon, unicodeStarKindTyConName,
         liftedTypeKindTyCon, constraintKindTyCon,
 
-        -- * Parallel arrays
-        mkPArrTy,
-        parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
-        parrTyCon_RDR, parrTyConName,
-
         -- * Equality predicates
         heqTyCon, heqClass, heqDataCon,
         coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
@@ -220,7 +215,6 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because then
                 , word8TyCon
                 , listTyCon
                 , maybeTyCon
-                , parrTyCon
                 , heqTyCon
                 , coercibleTyCon
                 , typeNatKindCon
@@ -445,14 +439,8 @@ vecElemDataConNames = zipWith3Lazy mk_special_dc_name
 mk_special_dc_name :: FastString -> Unique -> DataCon -> Name
 mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc
 
-parrTyConName, parrDataConName :: Name
-parrTyConName   = mkWiredInTyConName   BuiltInSyntax
-                    gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon
-parrDataConName = mkWiredInDataConName UserSyntax
-                    gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon
-
 boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
-    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR :: RdrName
+    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName
 boolTyCon_RDR   = nameRdrName boolTyConName
 false_RDR       = nameRdrName falseDataConName
 true_RDR        = nameRdrName trueDataConName
@@ -461,7 +449,6 @@ charTyCon_RDR   = nameRdrName charTyConName
 intDataCon_RDR  = nameRdrName intDataConName
 listTyCon_RDR   = nameRdrName listTyConName
 consDataCon_RDR = nameRdrName consDataConName
-parrTyCon_RDR   = nameRdrName parrTyConName
 
 {-
 ************************************************************************
@@ -692,8 +679,6 @@ isBuiltInOcc_maybe occ =
       "[]" -> Just $ choose_ns listTyConName nilDataConName
       ":"    -> Just consDataConName
 
-      "[::]" -> Just parrTyConName
-
       -- boxed tuple data/tycon
       "()"    -> Just $ tup_name Boxed 0
       _ | Just rest <- "(" `BS.stripPrefix` name
@@ -1518,78 +1503,6 @@ mkSumTy :: [Type] -> Type
 mkSumTy tys = mkTyConApp (sumTyCon (length tys))
                          (map getRuntimeRep tys ++ tys)
 
-{- *********************************************************************
-*                                                                      *
-        The parallel-array type,  [::]
-*                                                                      *
-************************************************************************
-
-Special syntax for parallel arrays needs some wired in definitions.
--}
-
--- | Construct a type representing the application of the parallel array constructor
-mkPArrTy    :: Type -> Type
-mkPArrTy ty  = mkTyConApp parrTyCon [ty]
-
--- | Represents the type constructor of parallel arrays
---
---  * This must match the definition in @PrelPArr@
---
--- NB: Although the constructor is given here, it will not be accessible in
---     user code as it is not in the environment of any compiled module except
---     @PrelPArr@.
---
-parrTyCon :: TyCon
-parrTyCon  = pcTyCon parrTyConName Nothing alpha_tyvar [parrDataCon]
-
-parrDataCon :: DataCon
-parrDataCon  = pcDataCon
-                 parrDataConName
-                 alpha_tyvar            -- forall'ed type variables
-                 [intTy,                -- 1st argument: Int
-                  mkTyConApp            -- 2nd argument: Array# a
-                    arrayPrimTyCon
-                    alpha_ty]
-                 parrTyCon
-
--- | Check whether a type constructor is the constructor for parallel arrays
-isPArrTyCon    :: TyCon -> Bool
-isPArrTyCon tc  = tyConName tc == parrTyConName
-
--- | Fake array constructors
---
--- * These constructors are never really used to represent array values;
---   however, they are very convenient during desugaring (and, in particular,
---   in the pattern matching compiler) to treat array pattern just like
---   yet another constructor pattern
---
-parrFakeCon                        :: Arity -> DataCon
-parrFakeCon i | i > mAX_TUPLE_SIZE  = mkPArrFakeCon  i  -- build one specially
-parrFakeCon i                       = parrFakeConArr!i
-
--- pre-defined set of constructors
---
-parrFakeConArr :: Array Int DataCon
-parrFakeConArr  = array (0, mAX_TUPLE_SIZE) [(i, mkPArrFakeCon i)
-                                            | i <- [0..mAX_TUPLE_SIZE]]
-
--- build a fake parallel array constructor for the given arity
---
-mkPArrFakeCon       :: Int -> DataCon
-mkPArrFakeCon arity  = data_con
-  where
-        data_con  = pcDataCon name [tyvar] tyvarTys parrTyCon
-        tyvar     = head alphaTyVars
-        tyvarTys  = replicate arity $ mkTyVarTy tyvar
-        nameStr   = mkFastString ("MkPArr" ++ show arity)
-        name      = mkWiredInName gHC_PARR' (mkDataOccFS nameStr) unique
-                                  (AConLike (RealDataCon data_con)) UserSyntax
-        unique      = mkPArrDataConUnique arity
-
--- | Checks whether a data constructor is a fake constructor for parallel arrays
-isPArrFakeCon      :: DataCon -> Bool
-isPArrFakeCon dcon  = dcon == parrFakeCon (dataConSourceArity dcon)
-
 -- Promoted Booleans
 
 promotedFalseDataCon, promotedTrueDataCon :: TyCon
index 8478ab0..937ffaf 100644 (file)
@@ -272,10 +272,6 @@ rnExpr (ExplicitList x _  exps)
            else
             return  (ExplicitList x Nothing exps', fvs) }
 
-rnExpr (ExplicitPArr x exps)
-  = do { (exps', fvs) <- rnExprs exps
-       ; return  (ExplicitPArr x exps', fvs) }
-
 rnExpr (ExplicitTuple x tup_args boxity)
   = do { checkTupleSection tup_args
        ; checkTupSize (length tup_args)
@@ -342,10 +338,6 @@ rnExpr (ArithSeq x _ seq)
            else
             return (ArithSeq x Nothing new_seq, fvs) }
 
-rnExpr (PArrSeq x seq)
-  = do { (new_seq, fvs) <- rnArithSeq seq
-       ; return (PArrSeq x new_seq, fvs) }
-
 {-
 These three are pattern syntax appearing in expressions.
 Since all the symbols are reservedops we can simply reject them.
@@ -841,7 +833,7 @@ rnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside
         ; (guard_op, fvs2) <- if isListCompExpr ctxt
                               then lookupStmtName ctxt guardMName
                               else return (noSyntaxExpr, emptyFVs)
-                              -- Only list/parr/monad comprehensions use 'guard'
+                              -- Only list/monad comprehensions use 'guard'
                               -- Also for sub-stmts of same eg [ e | x<-xs, gd | blah ]
                               -- Here "gd" is a guard
         ; (thing, fvs3)    <- thing_inside []
@@ -1020,12 +1012,11 @@ lookupStmtNamePoly ctxt name
     not_rebindable = return (HsVar noExt (noLoc name), emptyFVs)
 
 -- | Is this a context where we respect RebindableSyntax?
--- but ListComp/PArrComp are never rebindable
+-- but ListComp are never rebindable
 -- Neither is ArrowExpr, which has its own desugarer in DsArrows
 rebindableContext :: HsStmtContext Name -> Bool
 rebindableContext ctxt = case ctxt of
   ListComp        -> False
-  PArrComp        -> False
   ArrowExpr       -> False
   PatGuard {}     -> False
 
@@ -1818,7 +1809,6 @@ isStrictPattern (L _ pat) =
     ListPat{}       -> True
     TuplePat{}      -> True
     SumPat{}        -> True
-    PArrPat{}       -> True
     ConPatIn{}      -> True
     ConPatOut{}     -> True
     LitPat{}        -> True
@@ -1977,7 +1967,6 @@ checkLastStmt ctxt lstmt@(L loc stmt)
   = case ctxt of
       ListComp  -> check_comp
       MonadComp -> check_comp
-      PArrComp  -> check_comp
       ArrowExpr -> check_do
       DoExpr    -> check_do
       MDoExpr   -> check_do
@@ -2028,7 +2017,7 @@ pprStmtCat (XStmtLR {})         = panic "pprStmtCat: XStmtLR"
 emptyInvalid :: Validity  -- Payload is the empty document
 emptyInvalid = NotValid Outputable.empty
 
-okStmt, okDoStmt, okCompStmt, okParStmt, okPArrStmt
+okStmt, okDoStmt, okCompStmt, okParStmt
    :: DynFlags -> HsStmtContext Name
    -> Stmt GhcPs (Located (body GhcPs)) -> Validity
 -- Return Nothing if OK, (Just extra) if not ok
@@ -2044,7 +2033,6 @@ okStmt dflags ctxt stmt
       GhciStmtCtxt       -> okDoStmt   dflags ctxt stmt
       ListComp           -> okCompStmt dflags ctxt stmt
       MonadComp          -> okCompStmt dflags ctxt stmt
-      PArrComp           -> okPArrStmt dflags ctxt stmt
       TransStmtCtxt ctxt -> okStmt dflags ctxt stmt
 
 -------------
@@ -2091,21 +2079,6 @@ okCompStmt dflags _ stmt
        ApplicativeStmt {} -> emptyInvalid
        XStmtLR{} -> panic "okCompStmt"
 
-----------------
-okPArrStmt dflags _ stmt
-  = case stmt of
-       BindStmt {} -> IsValid
-       LetStmt {}  -> IsValid
-       BodyStmt {} -> IsValid
-       ParStmt {}
-         | LangExt.ParallelListComp `xopt` dflags -> IsValid
-         | otherwise -> NotValid (text "Use ParallelListComp")
-       TransStmt {} -> emptyInvalid
-       RecStmt {}   -> emptyInvalid
-       LastStmt {}  -> emptyInvalid  -- Should not happen (dealt with by checkLastStmt)
-       ApplicativeStmt {} -> emptyInvalid
-       XStmtLR{} -> panic "okPArrStmt"
-
 ---------
 checkTupleSection :: [LHsTupArg GhcPs] -> RnM ()
 checkTupleSection args
index 8f7c2e2..4601b94 100644 (file)
@@ -483,10 +483,6 @@ rnPatAndThen mk (ListPat _ pats)
                      ; return (ListPat (Just to_list_name) pats')}
           False -> return (ListPat Nothing pats') }
 
-rnPatAndThen mk (PArrPat x pats)
-  = do { pats' <- rnLPatsAndThen mk pats
-       ; return (PArrPat x pats') }
-
 rnPatAndThen mk (TuplePat x pats boxed)
   = do { liftCps $ checkTupSize (length pats)
        ; pats' <- rnLPatsAndThen mk pats
index 502be23..5e01f28 100644 (file)
@@ -99,7 +99,6 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
                             hs_fords   = foreign_decls,
                             hs_defds   = default_decls,
                             hs_ruleds  = rule_decls,
-                            hs_vects   = vect_decls,
                             hs_docs    = docs })
  = do {
    -- (A) Process the fixity declarations, creating a mapping from
@@ -187,12 +186,11 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    (rn_rule_decls,    src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $
                                    rnList rnHsRuleDecls rule_decls ;
                            -- Inside RULES, scoped type variables are on
-   (rn_vect_decls,    src_fvs3) <- rnList rnHsVectDecl    vect_decls ;
-   (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
-   (rn_ann_decls,     src_fvs5) <- rnList rnAnnDecl       ann_decls ;
-   (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl   default_decls ;
-   (rn_deriv_decls,   src_fvs7) <- rnList rnSrcDerivDecl  deriv_decls ;
-   (rn_splice_decls,  src_fvs8) <- rnList rnSpliceDecl    splice_decls ;
+   (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ;
+   (rn_ann_decls,     src_fvs4) <- rnList rnAnnDecl       ann_decls ;
+   (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl   default_decls ;
+   (rn_deriv_decls,   src_fvs6) <- rnList rnSrcDerivDecl  deriv_decls ;
+   (rn_splice_decls,  src_fvs7) <- rnList rnSpliceDecl    splice_decls ;
       -- Haddock docs; no free vars
    rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
 
@@ -210,13 +208,12 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
                              hs_annds  = rn_ann_decls,
                              hs_defds  = rn_default_decls,
                              hs_ruleds = rn_rule_decls,
-                             hs_vects  = rn_vect_decls,
                              hs_docs   = rn_docs } ;
 
         tcf_bndrs = hsTyClForeignBinders rn_tycl_decls rn_foreign_decls ;
         other_def  = (Just (mkNameSet tcf_bndrs), emptyNameSet) ;
-        other_fvs  = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4, src_fvs5,
-                              src_fvs6, src_fvs7, src_fvs8] ;
+        other_fvs  = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
+                              src_fvs5, src_fvs6, src_fvs7] ;
                 -- It is tiresome to gather the binders from type and class decls
 
         src_dus = [other_def] `plusDU` bind_dus `plusDU` usesOnly other_fvs ;
@@ -1106,53 +1103,6 @@ badRuleLhsErr name lhs bad_e
             HsUnboundVar _ uv -> text "Not in scope:" <+> ppr uv
             _ -> text "Illegal expression:" <+> ppr bad_e
 
-{-
-*********************************************************
-*                                                      *
-\subsection{Vectorisation declarations}
-*                                                      *
-*********************************************************
--}
-
-rnHsVectDecl :: VectDecl GhcPs -> RnM (VectDecl GhcRn, FreeVars)
--- FIXME: For the moment, the right-hand side is restricted to be a variable as we cannot properly
---        typecheck a complex right-hand side without invoking 'vectType' from the vectoriser.
-rnHsVectDecl (HsVect _ s var rhs@(L _ (HsVar _ _)))
-  = do { var' <- lookupLocatedOccRn var
-       ; (rhs', fv_rhs) <- rnLExpr rhs
-       ; return (HsVect noExt s var' rhs', fv_rhs `addOneFV` unLoc var')
-       }
-rnHsVectDecl (HsVect _ _ _var _rhs)
-  = failWith $ vcat
-               [ text "IMPLEMENTATION RESTRICTION: right-hand side of a VECTORISE pragma"
-               , text "must be an identifier"
-               ]
-rnHsVectDecl (HsNoVect _ s var)
-  = do { var' <- lookupLocatedTopBndrRn var           -- only applies to local (not imported) names
-       ; return (HsNoVect noExt s var', unitFV (unLoc var'))
-       }
-rnHsVectDecl (HsVectType (VectTypePR s tycon Nothing) isScalar)
-  = do { tycon' <- lookupLocatedOccRn tycon
-       ; return ( HsVectType (VectTypePR s tycon' Nothing) isScalar
-                , unitFV (unLoc tycon'))
-       }
-rnHsVectDecl (HsVectType (VectTypePR s tycon (Just rhs_tycon)) isScalar)
-  = do { tycon'     <- lookupLocatedOccRn tycon
-       ; rhs_tycon' <- lookupLocatedOccRn rhs_tycon
-       ; return ( HsVectType (VectTypePR s tycon' (Just rhs_tycon')) isScalar
-                , mkFVs [unLoc tycon', unLoc rhs_tycon'])
-       }
-rnHsVectDecl (HsVectClass (VectClassPR s cls))
-  = do { cls' <- lookupLocatedOccRn cls
-       ; return (HsVectClass (VectClassPR s cls'), unitFV (unLoc cls'))
-       }
-rnHsVectDecl (HsVectInst instTy)
-  = do { (instTy', fvs) <- rnLHsInstType (text "a VECTORISE pragma") instTy
-       ; return (HsVectInst instTy', fvs)
-       }
-rnHsVectDecl (XVectDecl {})
-  = panic "RnSource.rnHsVectDecl: Unexpected 'XVectDecl'"
-
 {- **************************************************************
          *                                                      *
       Renaming type, class, instance and role declarations
@@ -2187,8 +2137,6 @@ add gp@(HsGroup {hs_annds  = ts}) l (AnnD _ d) ds
   = addl (gp { hs_annds = L l d : ts }) ds
 add gp@(HsGroup {hs_ruleds  = ts}) l (RuleD _ d) ds
   = addl (gp { hs_ruleds = L l d : ts }) ds
-add gp@(HsGroup {hs_vects  = ts}) l (VectD _ d) ds
-  = addl (gp { hs_vects = L l d : ts }) ds
 add gp l (DocD _ d) ds
   = addl (gp { hs_docs = (L l d) : (hs_docs gp) })  ds
 add (HsGroup {}) _ (SpliceD _ (XSpliceDecl _)) _ = panic "RnSource.add"
index b51a178..1f08856 100644 (file)
@@ -350,7 +350,7 @@ rnImplicitBndrs bind_free_tvs
 
 rnLHsInstType :: SDoc -> LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars)
 -- Rename the type in an instance.
--- The 'doc_str' is "an instance declaration" or "a VECTORISE pragma"
+-- The 'doc_str' is "an instance declaration".
 -- Do not try to decompose the inst_ty in case it is malformed
 rnLHsInstType doc inst_ty = rnHsSigType (GenericCtx doc) inst_ty
 
@@ -608,11 +608,6 @@ rnHsTyKi env t@(HsKindSig _ ty k)
        ; (k', fvs2)  <- rnLHsTyKi (env { rtke_level = KindLevel }) k
        ; return (HsKindSig noExt ty' k', fvs1 `plusFV` fvs2) }
 
-rnHsTyKi env t@(HsPArrTy _ ty)
-  = do { notInKinds env t
-       ; (ty', fvs) <- rnLHsTyKi env ty
-       ; return (HsPArrTy noExt ty', fvs) }
-
 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 rnHsTyKi env tupleTy@(HsTupleTy _ tup_con tys)
@@ -1149,7 +1144,6 @@ collectAnonWildCards lty = go lty
       HsAppTy _ ty1 ty2              -> go ty1 `mappend` go ty2
       HsFunTy _ ty1 ty2              -> go ty1 `mappend` go ty2
       HsListTy _ ty                  -> go ty
-      HsPArrTy _ ty                  -> go ty
       HsTupleTy _ _ tys              -> gos tys
       HsSumTy _ tys                  -> gos tys
       HsOpTy _ ty1 _ ty2             -> go ty1 `mappend` go ty2
@@ -1839,7 +1833,6 @@ extract_lty t_or_k (L _ ty) acc
       HsAppTy _ ty1 ty2           -> extract_lty t_or_k ty1 =<<
                                      extract_lty t_or_k ty2 acc
       HsListTy _ ty               -> extract_lty t_or_k ty acc
-      HsPArrTy _ ty               -> extract_lty t_or_k ty acc
       HsTupleTy _ _ tys           -> extract_ltys t_or_k tys acc
       HsSumTy _ tys               -> extract_ltys t_or_k tys acc
       HsFunTy _ ty1 ty2           -> extract_lty t_or_k ty1 =<<
index bbac43d..99272c2 100644 (file)
@@ -374,7 +374,6 @@ data HsDocContext
   | GHCiCtx
   | SpliceTypeCtx (LHsType GhcPs)
   | ClassInstanceCtx
-  | VectDeclCtx (Located RdrName)
   | GenericCtx SDoc   -- Maybe we want to use this more!
 
 withHsDocContext :: HsDocContext -> SDoc -> SDoc
@@ -409,5 +408,3 @@ pprHsDocContext (ConDeclCtx [name])
    = text "the definition of data constructor" <+> quotes (ppr name)
 pprHsDocContext (ConDeclCtx names)
    = text "the definition of data constructors" <+> interpp'SP names
-pprHsDocContext (VectDeclCtx tycon)
-   = text "the VECTORISE pragma for type constructor" <+> quotes (ppr tycon)
index e5b449b..912ff99 100644 (file)
@@ -123,7 +123,6 @@ data CoreToDo           -- These are diff core-to-core passes,
   | CoreCSE
   | CoreDoRuleCheck CompilerPhase String   -- Check for non-application of rules
                                            -- matching this string
-  | CoreDoVectorisation
   | CoreDoNothing                -- Useful when building up
   | CoreDoPasses [CoreToDo]      -- lists of these things
 
@@ -149,7 +148,6 @@ instance Outputable CoreToDo where
   ppr CoreDoSpecialising       = text "Specialise"
   ppr CoreDoSpecConstr         = text "SpecConstr"
   ppr CoreCSE                  = text "Common sub-expression"
-  ppr CoreDoVectorisation      = text "Vectorisation"
   ppr CoreDesugar              = text "Desugar (before optimization)"
   ppr CoreDesugarOpt           = text "Desugar (after optimization)"
   ppr CoreTidy                 = text "Tidy Core"
index 016574e..8ffb6be 100644 (file)
@@ -62,9 +62,9 @@ Here's the externally-callable interface:
 occurAnalysePgm :: Module         -- Used only in debug output
                 -> (Id -> Bool)         -- Active unfoldings
                 -> (Activation -> Bool) -- Active rules
-                -> [CoreRule] -> [CoreVect] -> VarSet
+                -> [CoreRule]
                 -> CoreProgram -> CoreProgram
-occurAnalysePgm this_mod active_unf active_rule imp_rules vects vectVars binds
+occurAnalysePgm this_mod active_unf active_rule imp_rules binds
   | isEmptyDetails final_usage
   = occ_anald_binds
 
@@ -86,12 +86,8 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules vects vectVars binds
           -- we can easily create an infinite loop (Trac #9583 is an example)
 
     initial_uds = addManyOccsSet emptyDetails
-                            (rulesFreeVars imp_rules `unionVarSet`
-                             vectsFreeVars vects `unionVarSet`
-                             vectVars)
-    -- The RULES and VECTORISE declarations keep things alive! (For VECTORISE declarations,
-    -- we only get them *until* the vectoriser runs. Afterwards, these dependencies are
-    -- reflected in 'vectors' — see Note [Vectorisation declarations and occurrences].)
+                            (rulesFreeVars imp_rules)
+    -- The RULES declarations keep things alive!
 
     -- Note [Preventing loops due to imported functions rules]
     imp_rule_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv
index 70a13cc..8884636 100644 (file)
@@ -48,14 +48,12 @@ import DmdAnal          ( dmdAnalProgram )
 import CallArity        ( callArityAnalProgram )
 import Exitify          ( exitifyProgram )
 import WorkWrap         ( wwTopBinds )
-import Vectorise        ( vectorise )
 import SrcLoc
 import Util
 import Module
 import Plugins          ( withPlugins, installCoreToDos )
 import DynamicLoading  -- ( initializePlugins )
 
-import Maybes
 import UniqSupply       ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
 import UniqFM
 import Outputable
@@ -137,7 +135,6 @@ getCoreToDo dflags
     rules_on      = gopt Opt_EnableRewriteRules           dflags
     eta_expand_on = gopt Opt_DoLambdaEtaExpansion         dflags
     ww_on         = gopt Opt_WorkerWrapper                dflags
-    vectorise_on  = gopt Opt_Vectorise                    dflags
     static_ptrs   = xopt LangExt.StaticPointers           dflags
 
     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
@@ -162,30 +159,6 @@ getCoreToDo dflags
 
           , maybe_rule_check (Phase phase) ]
 
-          -- Vectorisation can introduce a fair few common sub expressions involving
-          --  DPH primitives. For example, see the Reverse test from dph-examples.
-          --  We need to eliminate these common sub expressions before their definitions
-          --  are inlined in phase 2. The CSE introduces lots of  v1 = v2 bindings,
-          --  so we also run simpl_gently to inline them.
-      ++  (if vectorise_on && phase == 3
-            then [CoreCSE, simpl_gently]
-            else [])
-
-    vectorisation
-      = runWhen vectorise_on $
-          CoreDoPasses [ simpl_gently, CoreDoVectorisation ]
-
-                -- By default, we have 2 phases before phase 0.
-
-                -- Want to run with inline phase 2 after the specialiser to give
-                -- maximum chance for fusion to work before we inline build/augment
-                -- in phase 1.  This made a difference in 'ansi' where an
-                -- overloaded function wasn't inlined till too late.
-
-                -- Need phase 1 so that build/augment get
-                -- inlined.  I found that spectral/hartel/genfft lost some useful
-                -- strictness in the function sumcode' if augment is not inlined
-                -- before strictness analysis runs
     simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
                                 | phase <- [phases, phases-1 .. 1] ]
 
@@ -195,7 +168,7 @@ getCoreToDo dflags
                        (base_mode { sm_phase = InitialPhase
                                   , sm_names = ["Gentle"]
                                   , sm_rules = rules_on   -- Note [RULEs enabled in SimplGently]
-                                  , sm_inline = not vectorise_on
+                                  , sm_inline = True
                                               -- See Note [Inline in InitialPhase]
                                   , sm_case_case = False })
                           -- Don't do case-of-case transformations.
@@ -228,8 +201,7 @@ getCoreToDo dflags
 
     core_todo =
      if opt_level == 0 then
-       [ vectorisation,
-         static_ptrs_float_outwards,
+       [ static_ptrs_float_outwards,
          CoreDoSimplify max_iter
              (base_mode { sm_phase = Phase 0
                         , sm_names = ["Non-opt simplification"] })
@@ -243,10 +215,6 @@ getCoreToDo dflags
     -- after this before anything else
         runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
 
-        -- We run vectorisation here for now, but we might also try to run
-        -- it later
-        vectorisation,
-
         -- initial simplify: mk specialiser happy: minimum effort please
         simpl_gently,
 
@@ -483,9 +451,6 @@ doCorePass CoreDoSpecialising        = {-# SCC "Specialise" #-}
 doCorePass CoreDoSpecConstr          = {-# SCC "SpecConstr" #-}
                                        specConstrProgram
 
-doCorePass CoreDoVectorisation       = {-# SCC "Vectorise" #-}
-                                       vectorise
-
 doCorePass CoreDoPrintCore              = observe   printCore
 doCorePass (CoreDoRuleCheck phase pat)  = ruleCheckPass phase pat
 doCorePass CoreDoNothing                = return
@@ -718,30 +683,9 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
       , () <- sz `seq` ()     -- Force it
       = do {
                 -- Occurrence analysis
-           let {   -- Note [Vectorisation declarations and occurrences]
-                   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-                   -- During the 'InitialPhase' (i.e., before vectorisation), we need to make sure
-                   -- that the right-hand sides of vectorisation declarations are taken into
-                   -- account during occurrence analysis. After the 'InitialPhase', we need to ensure
-                   -- that the binders representing variable vectorisation declarations are kept alive.
-                   -- (In contrast to automatically vectorised variables, their unvectorised versions
-                   -- don't depend on them.)
-                 vectVars = mkVarSet $
-                              catMaybes [ fmap snd $ lookupDVarEnv (vectInfoVar (mg_vect_info guts)) bndr
-                                        | Vect bndr _ <- mg_vect_decls guts]
-                              ++
-                              catMaybes [ fmap snd $ lookupDVarEnv (vectInfoVar (mg_vect_info guts)) bndr
-                                        | bndr <- bindersOfBinds binds]
-                                        -- FIXME: This second comprehensions is only needed as long as we
-                                        --        have vectorised bindings where we get "Could NOT call
-                                        --        vectorised from original version".
-              ;  (maybeVects, maybeVectVars)
-                   = case sm_phase mode of
-                       InitialPhase -> (mg_vect_decls guts, vectVars)
-                       _            -> ([], vectVars)
-               ; tagged_binds = {-# SCC "OccAnal" #-}
+           let { tagged_binds = {-# SCC "OccAnal" #-}
                      occurAnalysePgm this_mod active_unf active_rule rules
-                                     maybeVects maybeVectVars binds
+                                     binds
                } ;
            Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
                      (pprCoreBindings tagged_binds);
index f32e0e3..2f6821c 100644 (file)
@@ -611,7 +611,7 @@ to mean "don't specialise on arguments of this type".  It was added
 before we had ForceSpecConstr.  Lacking ForceSpecConstr we specialised
 regardless of size; and then we needed a way to turn that *off*.  Now
 that we have ForceSpecConstr, this NoSpecConstr is probably redundant.
-(Used only for PArray.)
+(Used only for PArray, TODO: remove?)
 
 -----------------------------------------------------
                 Stuff not yet handled
index 5fceeff..b409c07 100644 (file)
@@ -152,7 +152,6 @@ See #9562.
 
 newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcRnIf gbl lcl FamInst
 -- Freshen the type variables of the FamInst branches
--- Called from the vectoriser monad too, hence the rather general type
 newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc })
   = ASSERT2( tyCoVarsOfTypes lhs `subVarSet` tcv_set, text "lhs" <+> pp_ax )
     ASSERT2( tyCoVarsOfType  rhs `subVarSet` tcv_set, text "rhs" <+> pp_ax )
index 980185c..4b2cc08 100644 (file)
@@ -11,7 +11,7 @@
 
 module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds,
                  tcHsBootSigs, tcPolyCheck,
-                 tcVectDecls, addTypecheckedBinds,
+                 addTypecheckedBinds,
                  chooseInferredQuantifiers,
                  badBootDeclErr ) where
 
@@ -53,7 +53,6 @@ import NameSet
 import NameEnv
 import SrcLoc
 import Bag
-import ListSetOps
 import ErrUtils
 import Digraph
 import Maybes
@@ -68,7 +67,6 @@ import qualified GHC.LanguageExtensions as LangExt
 import ConLike
 
 import Control.Monad
-import Data.List.NonEmpty ( NonEmpty(..) )
 
 #include "HsVersions.h"
 
@@ -1215,78 +1213,6 @@ It also cleverly does an ambiguity check; for example, rejecting
 where F is a non-injective type function.
 -}
 
-{- *********************************************************************
-*                                                                      *
-                         Vectorisation
-*                                                                      *
-********************************************************************* -}
-
-tcVectDecls :: [LVectDecl GhcRn] -> TcM ([LVectDecl GhcTcId])
-tcVectDecls decls
-  = do { decls' <- mapM (wrapLocM tcVect) decls
-       ; let ids  = [lvectDeclName decl | decl <- decls', not $ lvectInstDecl decl]
-             dups = findDupsEq (==) ids
-       ; mapM_ reportVectDups dups
-       ; traceTcConstraints "End of tcVectDecls"
-       ; return decls'
-       }
-  where
-    reportVectDups (first :| (_second:_more))
-      = addErrAt (getSrcSpan first) $
-          text "Duplicate vectorisation declarations for" <+> ppr first
-    reportVectDups _ = return ()
-
---------------
-tcVect :: VectDecl GhcRn -> TcM (VectDecl GhcTcId)
--- FIXME: We can't typecheck the expression of a vectorisation declaration against the vectorised
---   type of the original definition as this requires internals of the vectoriser not available
---   during type checking.  Instead, constrain the rhs of a vectorisation declaration to be a single
---   identifier (this is checked in 'rnHsVectDecl').  Fix this by enabling the use of 'vectType'
---   from the vectoriser here.
-tcVect (HsVect _ s name rhs)
-  = addErrCtxt (vectCtxt name) $
-    do { var <- wrapLocM tcLookupId name
-       ; let L rhs_loc (HsVar noExt (L lv rhs_var_name)) = rhs
-       ; rhs_id <- tcLookupId rhs_var_name
-       ; return $ HsVect noExt s var (L rhs_loc (HsVar noExt (L lv rhs_id)))
-       }
-
-tcVect (HsNoVect _ s name)
-  = addErrCtxt (vectCtxt name) $
-    do { var <- wrapLocM tcLookupId name
-       ; return $ HsNoVect noExt s var
-       }
-tcVect (HsVectType (VectTypePR _ lname rhs_name) isScalar)
-  = addErrCtxt (vectCtxt lname) $
-    do { tycon <- tcLookupLocatedTyCon lname
-       ; checkTc (   not isScalar             -- either    we have a non-SCALAR declaration
-                 || isJust rhs_name           -- or        we explicitly provide a vectorised type
-                 || tyConArity tycon == 0     -- otherwise the type constructor must be nullary
-                 )
-                 scalarTyConMustBeNullary
-
-       ; rhs_tycon <- fmapMaybeM (tcLookupTyCon . unLoc) rhs_name
-       ; return $ HsVectType (VectTypeTc tycon rhs_tycon) isScalar
-       }
-tcVect (HsVectClass (VectClassPR _ lname))
-  = addErrCtxt (vectCtxt lname) $
-    do { cls <- tcLookupLocatedClass lname
-       ; return $ HsVectClass cls
-       }
-tcVect (HsVectInst linstTy)
-  = addErrCtxt (vectCtxt linstTy) $
-    do { (cls, tys) <- tcHsVectInst linstTy
-       ; inst       <- tcLookupInstance cls tys
-       ; return $ HsVectInst inst
-       }
-tcVect (XVectDecl {})
-  = panic "TcBinds.tcVect: Unexpected 'XVectDecl'"
-
-vectCtxt :: Outputable thing => thing -> SDoc
-vectCtxt thing = text "When checking the vectorisation declaration for" <+> ppr thing
-
-scalarTyConMustBeNullary :: MsgDoc
-scalarTyConMustBeNullary = text "VECTORISE SCALAR type constructor must be nullary"
 
 {-
 Note [SPECIALISE pragmas]
index aac880f..dd70aa2 100644 (file)
@@ -45,7 +45,6 @@ import TcPatSyn( tcPatSynBuilderOcc, nonBidirectionalErr )
 import TcPat
 import TcMType
 import TcType
-import DsMonad
 import Id
 import IdInfo
 import ConLike
@@ -533,15 +532,6 @@ tcExpr (ExplicitList _ witness exprs) res_ty
                      ; return $ ExplicitList elt_ty (Just fln') exprs' }
      where tc_elt elt_ty expr = tcPolyExpr expr elt_ty
 
-tcExpr (ExplicitPArr _ exprs) res_ty    -- maybe empty
-  = do  { res_ty <- expTypeToType res_ty
-        ; (coi, elt_ty) <- matchExpectedPArrTy res_ty
-        ; exprs' <- mapM (tc_elt elt_ty) exprs
-        ; return $
-          mkHsWrapCo coi $ ExplicitPArr elt_ty exprs' }
-  where
-    tc_elt elt_ty expr = tcPolyExpr expr elt_ty
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1001,34 +991,6 @@ tcExpr e@(HsRecFld _ f) res_ty
 tcExpr (ArithSeq _ witness seq) res_ty
   = tcArithSeq witness seq res_ty
 
-tcExpr (PArrSeq _ seq@(FromTo expr1 expr2)) res_ty
-  = do  { res_ty <- expTypeToType res_ty
-        ; (coi, elt_ty) <- matchExpectedPArrTy res_ty
-        ; expr1' <- tcPolyExpr expr1 elt_ty
-        ; expr2' <- tcPolyExpr expr2 elt_ty
-        ; enumFromToP <- initDsTc $ dsDPHBuiltin enumFromToPVar
-        ; enum_from_to <- newMethodFromName (PArrSeqOrigin seq)
-                                 (idName enumFromToP) elt_ty
-        ; return $
-          mkHsWrapCo coi $ PArrSeq enum_from_to (FromTo expr1' expr2') }
-
-tcExpr (PArrSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
-  = do  { res_ty <- expTypeToType res_ty
-        ; (coi, elt_ty) <- matchExpectedPArrTy res_ty
-        ; expr1' <- tcPolyExpr expr1 elt_ty
-        ; expr2' <- tcPolyExpr expr2 elt_ty
-        ; expr3' <- tcPolyExpr expr3 elt_ty
-        ; enumFromThenToP <- initDsTc $ dsDPHBuiltin enumFromThenToPVar
-        ; eft <- newMethodFromName (PArrSeqOrigin seq)
-                      (idName enumFromThenToP) elt_ty        -- !!!FIXME: chak
-        ; return $
-          mkHsWrapCo coi $ PArrSeq eft (FromThenTo expr1' expr2' expr3') }
-
-tcExpr (PArrSeq {}) _
-  = panic "TcExpr.tcExpr: Infinite parallel array!"
-    -- the parser shouldn't have generated it and the renamer shouldn't have
-    -- let it through
-
 {-
 ************************************************************************
 *                                                                      *
index b7b06dd..0bc5c9c 100644 (file)
@@ -101,7 +101,6 @@ hsPatType (AsPat _ var _)               = idType (unLoc var)
 hsPatType (ViewPat ty _ _)              = ty
 hsPatType (ListPat (ListPatTc ty Nothing) _)      = mkListTy ty
 hsPatType (ListPat (ListPatTc _ (Just (ty,_))) _) = ty
-hsPatType (PArrPat ty _)                = mkPArrTy ty
 hsPatType (TuplePat tys _ bx)           = mkTupleTy bx tys
 hsPatType (SumPat tys _ _ _ )           = mkSumTy tys
 hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys })
@@ -379,24 +378,22 @@ zonkTopLExpr e = zonkLExpr emptyZonkEnv e
 
 zonkTopDecls :: Bag EvBind
              -> LHsBinds GhcTcId
-             -> [LRuleDecl GhcTcId] -> [LVectDecl GhcTcId] -> [LTcSpecPrag]
+             -> [LRuleDecl GhcTcId] -> [LTcSpecPrag]
              -> [LForeignDecl GhcTcId]
              -> TcM (TypeEnv,
                      Bag EvBind,
                      LHsBinds GhcTc,
                      [LForeignDecl GhcTc],
                      [LTcSpecPrag],
-                     [LRuleDecl    GhcTc],
-                     [LVectDecl    GhcTc])
-zonkTopDecls ev_binds binds rules vects imp_specs fords
+                     [LRuleDecl    GhcTc])
+zonkTopDecls ev_binds binds rules imp_specs fords
   = do  { (env1, ev_binds') <- zonkEvBinds emptyZonkEnv ev_binds
         ; (env2, binds') <- zonkRecMonoBinds env1 binds
                         -- Top level is implicitly recursive
         ; rules' <- zonkRules env2 rules
-        ; vects' <- zonkVects env2 vects
         ; specs' <- zonkLTcSpecPrags env2 imp_specs
         ; fords' <- zonkForeignExports env2 fords
-        ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules', vects') }
+        ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules') }
 
 ---------------------------------------------
 zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId
@@ -784,11 +781,6 @@ zonkExpr env (ExplicitList ty wit exprs)
    where zonkWit env Nothing    = return (env, Nothing)
          zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
 
-zonkExpr env (ExplicitPArr ty exprs)
-  = do new_ty <- zonkTcTypeToType env ty
-       new_exprs <- zonkLExprs env exprs
-       return (ExplicitPArr new_ty new_exprs)
-
 zonkExpr env expr@(RecordCon { rcon_ext = ext, rcon_flds = rbinds })
   = do  { new_con_expr <- zonkExpr env (rcon_con_expr ext)
         ; new_rbinds   <- zonkRecFields env rbinds
@@ -823,11 +815,6 @@ zonkExpr env (ArithSeq expr wit info)
    where zonkWit env Nothing    = return (env, Nothing)
          zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
 
-zonkExpr env (PArrSeq expr info)
-  = do new_expr <- zonkExpr env expr
-       new_info <- zonkArithSeq env info
-       return (PArrSeq new_expr new_info)
-
 zonkExpr env (HsSCC x src lbl expr)
   = do new_expr <- zonkLExpr env expr
        return (HsSCC x src lbl new_expr)
@@ -1284,11 +1271,6 @@ zonk_pat env (ListPat (ListPatTc ty (Just (ty2,wit))) pats)
         ; (env'', pats') <- zonkPats env' pats
         ; return (env'', ListPat (ListPatTc ty' (Just (ty2',wit'))) pats') }
 
-zonk_pat env (PArrPat ty pats)
-  = do  { ty' <- zonkTcTypeToType env ty
-        ; (env', pats') <- zonkPats env pats
-        ; return (env', PArrPat ty' pats') }
-
 zonk_pat env (TuplePat tys pats boxed)
   = do  { tys' <- mapM (zonkTcTypeToType env) tys
         ; (env', pats') <- zonkPats env pats
@@ -1446,27 +1428,6 @@ zonkRule env (HsRule fvs name act (vars{-::[RuleBndr TcId]-}) lhs rhs)
                     -- of v and zonk there!
 zonkRule _ (XRuleDecl _) = panic "zonkRule"
 
-zonkVects :: ZonkEnv -> [LVectDecl GhcTcId] -> TcM [LVectDecl GhcTc]
-zonkVects env = mapM (wrapLocM (zonkVect env))
-
-zonkVect :: ZonkEnv -> VectDecl GhcTcId -> TcM (VectDecl GhcTc)
-zonkVect env (HsVect x s v e)
-  = do { v' <- wrapLocM (zonkIdBndr env) v
-       ; e' <- zonkLExpr env e
-       ; return $ HsVect x s v' e'
-       }
-zonkVect env (HsNoVect x s v)
-  = do { v' <- wrapLocM (zonkIdBndr env) v
-       ; return $ HsNoVect x s v'
-       }
-zonkVect _env (HsVectType (VectTypeTc t rt) s)
-  = return $ HsVectType (VectTypeTc t rt) s
-zonkVect _env (HsVectClass c)
-  = return $ HsVectClass c
-zonkVect _env (HsVectInst i)
-  = return $ HsVectInst i
-zonkVect _ (XVectDecl _) = panic "TcHsSyn.zonkVect: XVectDecl"
-
 {-
 ************************************************************************
 *                                                                      *
index ba1fc3f..d23ae23 100644 (file)
@@ -15,7 +15,7 @@ module TcHsType (
         funsSigCtxt, addSigCtxt, pprSigCtxt,
 
         tcHsClsInstType,
-        tcHsDeriv, tcHsVectInst,
+        tcHsDeriv,
         tcHsTypeApp,
         UserTypeCtxt(..),
         tcImplicitTKBndrs, tcImplicitTKBndrsX,
@@ -303,22 +303,6 @@ tcHsClsInstType user_ctxt hs_inst_ty
     do { inst_ty <- tc_hs_sig_type_and_gen (SigTypeSkol user_ctxt) hs_inst_ty constraintKind
        ; checkValidInstance user_ctxt hs_inst_ty inst_ty }
 
--- Used for 'VECTORISE [SCALAR] instance' declarations
-tcHsVectInst :: LHsSigType GhcRn -> TcM (Class, [Type])
-tcHsVectInst ty
-  | let hs_cls_ty = hsSigType ty
-  , Just (L _ cls_name, tys) <- hsTyGetAppHead_maybe hs_cls_ty
-    -- Ignoring the binders looks pretty dodgy to me
-  = do { (cls, cls_kind) <- tcClass cls_name
-       ; (applied_class, _res_kind)
-           <- tcTyApps typeLevelMode hs_cls_ty (mkClassPred cls []) cls_kind tys
-       ; case tcSplitTyConApp_maybe applied_class of
-           Just (_tc, args) -> ASSERT( _tc == classTyCon cls )
-                               return (cls, args)
-           _ -> failWithTc (text "Too many arguments passed to" <+> ppr cls_name) }
-  | otherwise
-  = failWithTc $ text "Malformed instance type"
-
 ----------------------------------------------
 -- | Type-check a visible type application
 tcHsTypeApp :: LHsWcType GhcRn -> Kind -> TcM Type
@@ -679,12 +663,6 @@ tc_hs_type mode rn_ty@(HsListTy _ elt_ty) exp_kind
        ; checkWiredInTyCon listTyCon
        ; checkExpectedKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind }
 
-tc_hs_type mode rn_ty@(HsPArrTy _ elt_ty) exp_kind
-  = do { MASSERT( isTypeLevel (mode_level mode) )
-       ; tau_ty <- tc_lhs_type mode elt_ty liftedTypeKind
-       ; checkWiredInTyCon parrTyCon
-       ; checkExpectedKind rn_ty (mkPArrTy tau_ty) liftedTypeKind exp_kind }
-
 -- See Note [Distinguishing tuple kinds] in HsTypes
 -- See Note [Inferring tuple kinds]
 tc_hs_type mode rn_ty@(HsTupleTy _ HsBoxedOrConstraintTuple hs_tys) exp_kind
@@ -1187,23 +1165,6 @@ tcTyVar mode name         -- Could be a tyvar, a tycon, or a datacon
                 _                -> do { traceTc "lk1 (loopy)" (ppr name)
                                        ; return tc_tc } }
 
-tcClass :: Name -> TcM (Class, TcKind)
-tcClass cls     -- Must be a class
-  = do { thing <- tcLookup cls
-       ; case thing of
-           ATcTyCon tc -> return (aThingErr "tcClass" cls, tyConKind tc)
-           AGlobal (ATyCon tc)
-             | Just cls <- tyConClass_maybe tc
-             -> return (cls, tyConKind tc)
-           _ -> wrongThingErr "class" thing cls }
-
-
-aThingErr :: String -> Name -> b
--- The type checker for types is sometimes called simply to
--- do *kind* checking; and in that case it ignores the type
--- returned. Which is a good thing since it may not be available yet!
-aThingErr str x = pprPanic "AThing evaluated unexpectedly" (text str <+> ppr x)
-
 {-
 Note [Type-checking inside the knot]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 1ab91bd..e2c29ca 100644 (file)
@@ -302,14 +302,6 @@ tcDoStmts ListComp (L l stmts) res_ty
                             (mkCheckExpType elt_ty)
         ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) }
 
-tcDoStmts PArrComp (L l stmts) res_ty
-  = do  { res_ty <- expTypeToType res_ty
-        ; (co, elt_ty) <- matchExpectedPArrTy res_ty
-        ; let parr_ty = mkPArrTy elt_ty
-        ; stmts' <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts
-                            (mkCheckExpType elt_ty)
-        ; return $ mkHsWrapCo co (HsDo parr_ty PArrComp (L l stmts')) }
-
 tcDoStmts DoExpr (L l stmts) res_ty
   = do  { stmts' <- tcStmts DoExpr tcDoStmt stmts res_ty
         ; res_ty <- readExpType res_ty
@@ -427,20 +419,19 @@ tcGuardStmt _ stmt _ _
 
 
 ---------------------------------------------------
---           List comprehensions and PArrays
+--           List comprehensions
 --               (no rebindable syntax)
 ---------------------------------------------------
 
 -- Dealt with separately, rather than by tcMcStmt, because
---   a) PArr isn't (yet) an instance of Monad, so the generality seems overkill
---   b) We have special desugaring rules for list comprehensions,
+--   a) We have special desugaring rules for list comprehensions,
 --      which avoid creating intermediate lists.  They in turn
 --      assume that the bind/return operations are the regular
 --      polymorphic ones, and in particular don't have any
 --      coercion matching stuff in them.  It's hard to avoid the
 --      potential for non-trivial coercions in tcMcStmt
 
-tcLcStmt :: TyCon       -- The list/Parray type constructor ([] or PArray)
+tcLcStmt :: TyCon       -- The list type constructor ([])
          -> TcExprStmtChecker
 
 tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside
index 249b01f..e59d15f 100644 (file)
@@ -442,14 +442,6 @@ tc_pat penv (ListPat (Just e) pats) pat_ty thing_inside
         ; return (ListPat (ListPatTc elt_ty (Just (tau_pat_ty,e'))) pats', res)
 }
 
-tc_pat penv (PArrPat _ pats ) pat_ty thing_inside
-  = do  { (coi, elt_ty) <- matchExpectedPatTy matchExpectedPArrTy penv pat_ty
-        ; (pats', res) <- tcMultiple (\p -> tc_lpat p (mkCheckExpType elt_ty))
-                                     pats penv thing_inside
-        ; pat_ty <- readExpType pat_ty
-        ; return (mkHsWrapPat coi (PArrPat elt_ty pats') pat_ty, res)
-        }
-
 tc_pat penv (TuplePat _ pats boxity) pat_ty thing_inside
   = do  { let arity = length pats
               tc = tupleTyCon boxity arity
index f39ce52..fcea649 100644 (file)
@@ -893,8 +893,6 @@ tcPatToExpr name args pat = go pat
         | otherwise
         = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym")
     go1 (ParPat _ pat)          = fmap (HsPar noExt) $ go pat
-    go1 (PArrPat _ pats)        = do { exprs <- mapM go pats
-                                     ; return $ ExplicitPArr noExt exprs }
     go1 p@(ListPat reb pats)
       | Nothing <- reb = do { exprs <- mapM go pats
                             ; return $ ExplicitList noExt Nothing exprs }
@@ -1064,7 +1062,6 @@ tcCollectEx pat = go pat
     go1 (ListPat _ ps)     = mergeMany . map go $ ps
     go1 (TuplePat _ ps _)  = mergeMany . map go $ ps
     go1 (SumPat _ p _ _)   = go p
-    go1 (PArrPat _ ps)     = mergeMany . map go $ ps
     go1 (ViewPat _ _ p)    = go p
     go1 con@ConPatOut{}    = merge (pat_tvs con, pat_dicts con) $
                               goConDetails $ pat_args con
index d20d43a..7730f7e 100644 (file)
@@ -2,7 +2,7 @@
 (c) The University of Glasgow 2006
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 
-\section[TcMovectle]{Typechecking a whole module}
+\section[TcRnDriver]{Typechecking a whole module}
 
 https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeChecker
 -}
@@ -435,13 +435,12 @@ tcRnSrcDecls explicit_mod_hdr decls
                          tcg_ev_binds  = cur_ev_binds,
                          tcg_imp_specs = imp_specs,
                          tcg_rules     = rules,
-                         tcg_vects     = vects,
                          tcg_fords     = fords } = tcg_env
             ; all_ev_binds = cur_ev_binds `unionBags` new_ev_binds } ;
 
-      ; (bind_env, ev_binds', binds', fords', imp_specs', rules', vects')
+      ; (bind_env, ev_binds', binds', fords', imp_specs', rules')
             <- {-# SCC "zonkTopDecls" #-}
-               zonkTopDecls all_ev_binds binds rules vects
+               zonkTopDecls all_ev_binds binds rules
                             imp_specs fords ;
       ; traceTc "Tc11" empty
 
@@ -450,7 +449,6 @@ tcRnSrcDecls explicit_mod_hdr decls
                                    tcg_ev_binds = ev_binds',
                                    tcg_imp_specs = imp_specs',
                                    tcg_rules    = rules',
-                                   tcg_vects    = vects',
                                    tcg_fords    = fords' } } ;
 
       ; setGlobalTypeEnv tcg_env' final_type_env
@@ -575,7 +573,6 @@ tcRnHsBootDecls hsc_src decls
                             , hs_fords  = for_decls
                             , hs_defds  = def_decls
                             , hs_ruleds = rule_decls
-                            , hs_vects  = vect_decls
                             , hs_annds  = _
                             , hs_valds
                                  = XValBindsLR (NValBinds val_binds val_sigs) })
@@ -593,7 +590,6 @@ tcRnHsBootDecls hsc_src decls
         ; mapM_ (badBootDecl hsc_src "foreign") for_decls
         ; mapM_ (badBootDecl hsc_src "default") def_decls
         ; mapM_ (badBootDecl hsc_src "rule")    rule_decls
-        ; mapM_ (badBootDecl hsc_src "vect")    vect_decls
 
                 -- Typecheck type/class/instance decls
         ; traceTc "Tc2 (boot)" empty
@@ -1324,7 +1320,6 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
                          hs_defds  = default_decls,
                          hs_annds  = annotation_decls,
                          hs_ruleds = rule_decls,
-                         hs_vects  = vect_decls,
                          hs_valds  = hs_val_binds@(XValBindsLR
                                               (NValBinds val_binds val_sigs)) })
  = do {         -- Type-check the type and class decls, and all imported decls
@@ -1387,9 +1382,6 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
                 -- Rules
         rules <- tcRules rule_decls ;
 
-                -- Vectorisation declarations
-        vects <- tcVectDecls vect_decls ;
-
                 -- Wrap up
         traceTc "Tc7a" empty ;
         let { all_binds = inst_binds     `unionBags`
@@ -1408,7 +1400,6 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
                                  , tcg_sigs    = tcg_sigs tcg_env `unionNameSet` sig_names
                                  , tcg_rules   = tcg_rules tcg_env
                                                       ++ flattenRuleDecls rules
-                                 , tcg_vects   = tcg_vects tcg_env ++ vects
                                  , tcg_anns    = tcg_anns tcg_env ++ annotations
                                  , tcg_ann_env = extendAnnEnvList (tcg_ann_env tcg_env) annotations
                                  , tcg_fords   = tcg_fords tcg_env ++ foe_decls ++ fi_decls
@@ -2608,14 +2599,12 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                         tcg_insts     = insts,
                         tcg_fam_insts = fam_insts,
                         tcg_rules     = rules,
-                        tcg_vects     = vects,
                         tcg_imports   = imports })
   = vcat [ ppr_types type_env
          , ppr_tycons fam_insts type_env
          , ppr_insts insts
          , ppr_fam_insts fam_insts
          , vcat (map ppr rules)
-         , vcat (map ppr vects)
          , text "Dependent modules:" <+>
                 pprUFM (imp_dep_mods imports) (ppr . sort)
          , text "Dependent packages:" <+>
index 8f4812e..a68d0f5 100644 (file)
@@ -290,7 +290,6 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
                 tcg_fam_insts      = [],
                 tcg_rules          = [],
                 tcg_fords          = [],
-                tcg_vects          = [],
                 tcg_patsyns        = [],
                 tcg_merged         = [],
                 tcg_dfun_n         = dfun_n_var,
index 4be3e5e..fb09fdd 100644 (file)
@@ -46,7 +46,7 @@ module TcRnTypes(
         pprTcTyThingCategory, pprPECategory, CompleteMatch(..),
 
         -- Desugaring types
-        DsM, DsLclEnv(..), DsGblEnv(..), PArrBuiltin(..),
+        DsM, DsLclEnv(..), DsGblEnv(..),
         DsMetaEnv, DsMetaVal(..), CompleteMatchMap,
         mkCompleteMatchMap, extendCompleteMatchMap,
 
@@ -362,25 +362,6 @@ a @UniqueSupply@ and some annotations, which
 presumably include source-file location information:
 -}
 
--- If '-XParallelArrays' is given, the desugarer populates this table with the corresponding
--- variables found in 'Data.Array.Parallel'.
---
-data PArrBuiltin
-        = PArrBuiltin
-        { lengthPVar         :: Var     -- ^ lengthP
-        , replicatePVar      :: Var     -- ^ replicateP
-        , singletonPVar      :: Var     -- ^ singletonP
-        , mapPVar            :: Var     -- ^ mapP
-        , filterPVar         :: Var     -- ^ filterP
-        , zipPVar            :: Var     -- ^ zipP
-        , crossMapPVar       :: Var     -- ^ crossMapP
-        , indexPVar          :: Var     -- ^ (!:)
-        , emptyPVar          :: Var     -- ^ emptyP
-        , appPVar            :: Var     -- ^ (+:+)
-        , enumFromToPVar     :: Var     -- ^ enumFromToP
-        , enumFromThenToPVar :: Var     -- ^ enumFromThenToP
-        }
-
 data DsGblEnv
         = DsGblEnv
         { ds_mod          :: Module             -- For SCC profiling
@@ -389,11 +370,6 @@ data DsGblEnv
         , ds_msgs    :: IORef Messages          -- Warning messages
         , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global,
                                                 -- possibly-imported things
-        , ds_dph_env :: GlobalRdrEnv            -- exported entities of 'Data.Array.Parallel.Prim'
-                                                -- iff '-fvectorise' flag was given as well as
-                                                -- exported entities of 'Data.Array.Parallel' iff
-                                                -- '-XParallelArrays' was given; otherwise, empty
-        , ds_parr_bi :: PArrBuiltin             -- desugarer names for '-XParallelArrays'
         , ds_complete_matches :: CompleteMatchMap
            -- Additional complete pattern matches
         , ds_cc_st   :: IORef CostCentreState
@@ -678,7 +654,6 @@ data TcGblEnv
         tcg_fam_insts :: [FamInst],          -- ...Family instances
         tcg_rules     :: [LRuleDecl GhcTc],  -- ...Rules
         tcg_fords     :: [LForeignDecl GhcTc], -- ...Foreign import & exports
-        tcg_vects     :: [LVectDecl GhcTc],   -- ...Vectorisation declarations
         tcg_patsyns   :: [PatSyn],            -- ...Pattern synonyms
 
         tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
@@ -3383,7 +3358,6 @@ data CtOrigin
   | NegateOrigin                        -- Occurrence of syntactic negation
 
   | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc
-  | PArrSeqOrigin  (ArithSeqInfo GhcRn) -- [:x..y:] and [:x,y..z:]
   | SectionOrigin
   | TupleOrigin                        -- (..,..)
   | ExprSigOrigin       -- e :: ty
@@ -3523,12 +3497,10 @@ exprCtOrigin (HsMultiIf _ rhs)   = lGRHSCtOrigin rhs
 exprCtOrigin (HsLet _ _ e)       = lexprCtOrigin e
 exprCtOrigin (HsDo {})           = DoOrigin
 exprCtOrigin (ExplicitList {})   = Shouldn'tHappenOrigin "list"
-exprCtOrigin (ExplicitPArr {})   = Shouldn'tHappenOrigin "parallel array"
 exprCtOrigin (RecordCon {})      = Shouldn'tHappenOrigin "record construction"
 exprCtOrigin (RecordUpd {})      = Shouldn'tHappenOrigin "record update"
 exprCtOrigin (ExprWithTySig {})  = ExprSigOrigin
 exprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin "arithmetic sequence"
-exprCtOrigin (PArrSeq {})      = Shouldn'tHappenOrigin "parallel array sequence"
 exprCtOrigin (HsSCC _ _ _ e)     = lexprCtOrigin e
 exprCtOrigin (HsCoreAnn _ _ _ e) = lexprCtOrigin e
 exprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin "TH bracket"
@@ -3675,7 +3647,6 @@ pprCtO ViewPatOrigin         = text "a view pattern"
 pprCtO IfOrigin              = text "an if expression"
 pprCtO (LiteralOrigin lit)   = hsep [text "the literal", quotes (ppr lit)]
 pprCtO (ArithSeqOrigin seq)  = hsep [text "the arithmetic sequence", quotes (ppr seq)]
-pprCtO (PArrSeqOrigin seq)   = hsep [text "the parallel array sequence", quotes (ppr seq)]
 pprCtO SectionOrigin         = text "an operator section"
 pprCtO TupleOrigin           = text "a tuple"
 pprCtO NegateOrigin          = text "a use of syntactic negation"
index 4343c32..be0586e 100644 (file)
@@ -25,7 +25,6 @@ module TcUnify (
   -- Holes
   tcInferInst, tcInferNoInst,
   matchExpectedListTy,
-  matchExpectedPArrTy,
   matchExpectedTyConApp,
   matchExpectedAppTy,
   matchExpectedFunTys,
@@ -362,13 +361,6 @@ matchExpectedListTy exp_ty
  = do { (co, [elt_ty]) <- matchExpectedTyConApp listTyCon exp_ty
       ; return (co, elt_ty) }
 
-----------------------
-matchExpectedPArrTy :: TcRhoType -> TcM (TcCoercionN, TcRhoType)
--- Special case for parrs
-matchExpectedPArrTy exp_ty
-  = do { (co, [elt_ty]) <- matchExpectedTyConApp parrTyCon exp_ty
-       ; return (co, elt_ty) }
-
 ---------------------
 matchExpectedTyConApp :: TyCon                -- T :: forall kv1 ... kvm. k1 -> ... -> kn -> *
                       -> TcRhoType            -- orig_ty
index 2b89162..2c96dda 100644 (file)
@@ -24,7 +24,7 @@ module Outputable (
         text, ftext, ptext, ztext,
         int, intWithCommas, integer, word, float, double, rational, doublePrec,
         parens, cparen, brackets, braces, quotes, quote,
-        doubleQuotes, angleBrackets, paBrackets,
+        doubleQuotes, angleBrackets,
         semi, comma, colon, dcolon, space, equals, dot, vbar,
         arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,
         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
@@ -592,7 +592,7 @@ doublePrec :: Int -> Double -> SDoc
 doublePrec p n = text (showFFloat (Just p) n "")
 
 parens, braces, brackets, quotes, quote,
-        paBrackets, doubleQuotes, angleBrackets :: SDoc -> SDoc
+        doubleQuotes, angleBrackets :: SDoc -> SDoc
 
 parens d        = SDoc $ Pretty.parens . runSDoc d
 braces d        = SDoc $ Pretty.braces . runSDoc d
@@ -600,7 +600,6 @@ brackets d      = SDoc $ Pretty.brackets . runSDoc d
 quote d         = SDoc $ Pretty.quote . runSDoc d
 doubleQuotes d  = SDoc $ Pretty.doubleQuotes . runSDoc d
 angleBrackets d = char '<' <> d <> char '>'
-paBrackets d    = text "[:" <> d <> text ":]"
 
 cparen :: Bool -> SDoc -> SDoc
 cparen b d = SDoc $ Pretty.maybeParens b . runSDoc d
diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
deleted file mode 100644 (file)
index 0181c6c..0000000
+++ /dev/null
@@ -1,358 +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 GhcPrelude
-
-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 (file)
index 7fe5b2c..0000000
+++ /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 (file)
index ba61a8b..0000000
+++ /dev/null
@@ -1,219 +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 GhcPrelude
-
-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 (file)
index 0772e5b..0000000
+++ /dev/null
@@ -1,234 +0,0 @@
--- Set up the data structures provided by 'Vectorise.Builtins'.
-
-module Vectorise.Builtins.Initialise (
-  -- * Initialisation
-  initBuiltins, initBuiltinVars
-) where
-
-import GhcPrelude
-
-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 (file)
index dda724f..0000000
+++ /dev/null
@@ -1,104 +0,0 @@
-module Vectorise.Convert
-  ( fromVect
-  )
-where
-
-import GhcPrelude
-
-import Vectorise.Monad
-import Vectorise.Builtins
-import Vectorise.Type.Type
-
-import CoreSyn
-import TyCon
-import Type
-import TyCoRep
-import NameSet
-import FastString
-import Outputable
-
--- |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
-