summaryrefslogtreecommitdiff
path: root/compiler/deSugar/DsUtils.hs
diff options
context:
space:
mode:
authorBen Gamari <bgamari.foss@gmail.com>2018-06-02 11:56:58 -0400
committerBen Gamari <ben@smart-cactus.org>2018-06-02 16:21:12 -0400
commitfaee23bb69ca813296da484bc177f4480bcaee9f (patch)
tree28e1c99f0de9d505c1df81ae7459839f5db4121c /compiler/deSugar/DsUtils.hs
parent13a86606e51400bc2a81a0e04cfbb94ada5d2620 (diff)
downloadhaskell-faee23bb69ca813296da484bc177f4480bcaee9f.tar.gz
vectorise: Put it out of its misery
Poor DPH and its vectoriser have long been languishing; sadly it seems there is little chance that the effort will be rekindled. Every few years we discuss what to do with this mass of code and at least once we have agreed that it should be archived on a branch and removed from `master`. Here we do just that, eliminating heaps of dead code in the process. Here we drop the ParallelArrays extension, the vectoriser, and the `vector` and `primitive` submodules. Test Plan: Validate Reviewers: simonpj, simonmar, hvr, goldfire, alanz Reviewed By: simonmar Subscribers: goldfire, rwbarton, thomie, mpickering, carter Differential Revision: https://phabricator.haskell.org/D4761
Diffstat (limited to 'compiler/deSugar/DsUtils.hs')
-rw-r--r--compiler/deSugar/DsUtils.hs78
1 files changed, 2 insertions, 76 deletions
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index 7bec30acdc..4c30889858 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -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]
-
{-
************************************************************************
* *