diff options
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 |
commit | 14c2e8e0c11bb2b95f81303284d1460bb80a9a98 (patch) | |
tree | b9c67117f0e2f7f79037e9a07c20a0256800f5cc /compiler/codeGen/StgCmm.hs | |
parent | ea310f9956179f91ca973bc747b0bc7b061bc174 (diff) | |
download | haskell-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.hs | 19 |
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)) |