summaryrefslogtreecommitdiff
path: root/compiler/codeGen/StgCmm.hs
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2016-09-20 00:19:15 -0400
committerÖmer Sinan Ağacan <omeragacan@gmail.com>2016-09-20 00:19:27 -0400
commit14c2e8e0c11bb2b95f81303284d1460bb80a9a98 (patch)
treeb9c67117f0e2f7f79037e9a07c20a0256800f5cc /compiler/codeGen/StgCmm.hs
parentea310f9956179f91ca973bc747b0bc7b061bc174 (diff)
downloadhaskell-14c2e8e0c11bb2b95f81303284d1460bb80a9a98.tar.gz
Codegen for case: Remove redundant void id checks
New unarise (714bebf) eliminates void binders in patterns already, so no need to eliminate them here. I leave assertions to make sure this is the case. Assertion failure -> bug in unarise Reviewers: bgamari, simonpj, austin, simonmar, hvr Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2416
Diffstat (limited to 'compiler/codeGen/StgCmm.hs')
-rw-r--r--compiler/codeGen/StgCmm.hs19
1 files changed, 12 insertions, 7 deletions
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 85f8845c8a..28ca97d9a2 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -138,7 +138,9 @@ cgTopRhs :: DynFlags -> RecFlag -> Id -> StgRhs -> (CgIdInfo, FCode ())
-- It's already been externalised if necessary
cgTopRhs dflags _rec bndr (StgRhsCon _cc con args)
- = cgTopRhsCon dflags bndr con args
+ = cgTopRhsCon dflags bndr con (assertNonVoidStgArgs args)
+ -- con args are always non-void,
+ -- see Note [Post-unarisation invariants] in UnariseStg
cgTopRhs dflags rec bndr (StgRhsClosure cc bi fvs upd_flag args body)
= ASSERT(null fvs) -- There should be no free variables
@@ -219,8 +221,8 @@ cgDataCon data_con
= do { dflags <- getDynFlags
; let
(tot_wds, -- #ptr_wds + #nonptr_wds
- ptr_wds, -- #ptr_wds
- arg_things) = mkVirtConstrOffsets dflags arg_reps
+ ptr_wds) -- #ptr_wds
+ = mkVirtConstrSizes dflags arg_reps
nonptr_wds = tot_wds - ptr_wds
@@ -240,14 +242,17 @@ cgDataCon data_con
-- NB 2: We don't set CC when entering data (WDP 94/06)
do { _ <- ticky_code
; ldvEnter (CmmReg nodeReg)
- ; tickyReturnOldCon (length arg_things)
+ ; tickyReturnOldCon (length arg_reps)
; void $ emitReturn [cmmOffsetB dflags (CmmReg nodeReg) (tagForCon dflags data_con)]
}
-- The case continuation code expects a tagged pointer
- arg_reps :: [(PrimRep, UnaryType)]
- arg_reps = [(typePrimRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con
- , rep_ty <- repTypeArgs ty]
+ -- We're generating info tables, so we don't know and care about
+ -- what the actual arguments are. Using () here as the place holder.
+ arg_reps :: [NonVoid PrimRep]
+ arg_reps = [NonVoid (typePrimRep rep_ty) | ty <- dataConRepArgTys data_con
+ , rep_ty <- repTypeArgs ty
+ , not (isVoidTy rep_ty)]
-- Dynamic closure code for non-nullary constructors only
; when (not (isNullaryRepDataCon data_con))