diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-01-12 19:30:55 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-01-22 15:02:45 -0500 |
| commit | 957b53760e50d072accc17c77948f18a10a4bb53 (patch) | |
| tree | 5099bcc355fc9a5047e5dac697511259f688e155 /compiler/GHC/CoreToStg/Prep.hs | |
| parent | 887eb6ec23eed243604f71c025d280c0b854f4c4 (diff) | |
| download | haskell-957b53760e50d072accc17c77948f18a10a4bb53.tar.gz | |
Core: introduce Alt/AnnAlt/IfaceAlt datatypes
Alt, AnnAlt and IfaceAlt were using triples. This patch makes them use
dedicated types so that we can try to make some fields strict (for
example) in the future.
Diffstat (limited to 'compiler/GHC/CoreToStg/Prep.hs')
| -rw-r--r-- | compiler/GHC/CoreToStg/Prep.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index f8955ae977..d0515b4d86 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -622,7 +622,7 @@ cpeRhsE env expr@(Lam {}) cpeRhsE env (Case scrut bndr ty alts) | isUnsafeEqualityProof scrut - , [(con, bs, rhs)] <- alts + , [Alt con bs rhs] <- alts = do { (floats1, scrut') <- cpeBody env scrut ; (env1, bndr') <- cpCloneBndr env bndr ; (env2, bs') <- cpCloneBndrs env1 bs @@ -652,10 +652,10 @@ cpeRhsE env (Case scrut bndr ty alts) ; return (floats, Case scrut' bndr2 ty alts'') } where - sat_alt env (con, bs, rhs) + sat_alt env (Alt con bs rhs) = do { (env2, bs') <- cpCloneBndrs env bs ; rhs' <- cpeBodyNF env2 rhs - ; return (con, bs', rhs') } + ; return (Alt con bs' rhs') } -- --------------------------------------------------------------------------- -- CpeBody: produces a result satisfying CpeBody @@ -1120,7 +1120,7 @@ cpExprIsTrivial e = cpExprIsTrivial e | Case scrut _ _ alts <- e , isUnsafeEqualityProof scrut - , [(_,_,rhs)] <- alts + , [Alt _ _ rhs] <- alts = cpExprIsTrivial rhs | otherwise = exprIsTrivial e @@ -1374,7 +1374,7 @@ wrapBinds :: Floats -> CpeBody -> CpeBody wrapBinds (Floats _ binds) body = foldrOL mk_bind body binds where - mk_bind (FloatCase rhs bndr con bs _) body = Case rhs bndr (exprType body) [(con,bs,body)] + mk_bind (FloatCase rhs bndr con bs _) body = Case rhs bndr (exprType body) [Alt con bs body] mk_bind (FloatLet bind) body = Let bind body mk_bind (FloatTick tickish) body = mkTick tickish body @@ -1828,7 +1828,7 @@ collectCostCentres mod_name Type{} -> cs Coercion{} -> cs - go_alts = foldl' (\cs (_con, _bndrs, e) -> go cs e) + go_alts = foldl' (\cs (Alt _con _bndrs e) -> go cs e) go_bind :: S.Set CostCentre -> CoreBind -> S.Set CostCentre go_bind cs (NonRec b e) = |