summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Ericson <John.Ericson@Obsidian.Systems>2019-11-07 13:45:44 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-01-16 06:00:16 -0500
commit1ff552265bbbcc0dba272d4742e8be79baad2c51 (patch)
treece1348c66ff60a7eff6bf3242b8a457bc5fb3312
parentee5d63f40c2f507d09a16377a5b35c4c8669a028 (diff)
downloadhaskell-1ff552265bbbcc0dba272d4742e8be79baad2c51.tar.gz
Remove special case case of bool during STG -> C--
Allow removing the no longer needed cgPrimOp, getting rid of a small a small layer violation too. Change which made the special case no longer needed was #6135 / 6579a6c73082387f82b994305011f011d9d8382b, which dates back to 2013, making me feel better.
-rw-r--r--compiler/GHC/StgToCmm/Expr.hs68
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs19
2 files changed, 1 insertions, 86 deletions
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index f39d02839c..3836aa3d2a 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -301,75 +301,7 @@ data GcPlan
-------------------------------------
cgCase :: CgStgExpr -> Id -> AltType -> [CgStgAlt] -> FCode ReturnKind
-cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts
- | isEnumerationTyCon tycon -- Note [case on bool]
- = do { tag_expr <- do_enum_primop op args
-
- -- If the binder is not dead, convert the tag to a constructor
- -- and assign it. See Note [Dead-binder optimisation]
- ; unless (isDeadBinder bndr) $ do
- { dflags <- getDynFlags
- ; tmp_reg <- bindArgToReg (NonVoid bndr)
- ; emitAssign (CmmLocal tmp_reg)
- (tagToClosure dflags tycon tag_expr) }
-
- ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly)
- (NonVoid bndr) alts
- -- See Note [GC for conditionals]
- ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1)
- ; return AssignedDirectly
- }
- where
- do_enum_primop :: PrimOp -> [StgArg] -> FCode CmmExpr
- do_enum_primop TagToEnumOp [arg] -- No code!
- = getArgAmode (NonVoid arg)
- do_enum_primop primop args
- = do dflags <- getDynFlags
- tmp <- newTemp (bWord dflags)
- cgPrimOp [tmp] primop args
- return (CmmReg (CmmLocal tmp))
-
{-
-Note [case on bool]
-~~~~~~~~~~~~~~~~~~~
-This special case handles code like
-
- case a <# b of
- True ->
- False ->
-
---> case tagToEnum# (a <$# b) of
- True -> .. ; False -> ...
-
---> case (a <$# b) of r ->
- case tagToEnum# r of
- True -> .. ; False -> ...
-
-If we let the ordinary case code handle it, we'll get something like
-
- tmp1 = a < b
- tmp2 = Bool_closure_tbl[tmp1]
- if (tmp2 & 7 != 0) then ... // normal tagged case
-
-but this junk won't optimise away. What we really want is just an
-inline comparison:
-
- if (a < b) then ...
-
-So we add a special case to generate
-
- tmp1 = a < b
- if (tmp1 == 0) then ...
-
-and later optimisations will further improve this.
-
-Now that #6135 has been resolved it should be possible to remove that
-special case. The idea behind this special case and pre-6135 implementation
-of Bool-returning primops was that tagToEnum# was added implicitly in the
-codegen and then optimized away. Now the call to tagToEnum# is explicit
-in the source code, which allows to optimize it away at the earlier stages
-of compilation (i.e. at the Core level).
-
Note [Scrutinising VoidRep]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have this STG code:
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 0db42f04e0..e469e15a5d 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -17,8 +17,6 @@
module GHC.StgToCmm.Prim (
cgOpApp,
- cgPrimOp, -- internal(ish), used by cgCase to get code for a
- -- comparison without also turning it into a Bool.
shouldInlinePrimOp
) where
@@ -110,7 +108,7 @@ cgOpApp (StgPrimOp primop) args res_ty = do
f regs
emitReturn (map (CmmReg . CmmLocal) regs)
- | otherwise -> panic "cgPrimop"
+ | otherwise -> panic "cgOpApp"
where
result_info = getPrimOpResultInfo primop
@@ -134,21 +132,6 @@ cgOpApp (StgPrimCallOp primcall) args _res_ty
asUnsigned :: Width -> Integer -> Integer
asUnsigned w n = n .&. (bit (widthInBits w) - 1)
----------------------------------------------------
-cgPrimOp :: [LocalReg] -- where to put the results
- -> PrimOp -- the op
- -> [StgArg] -- arguments
- -> FCode ()
-
-cgPrimOp results op args = do
- dflags <- getDynFlags
- arg_exprs <- getNonVoidArgAmodes args
- case emitPrimOp dflags op arg_exprs of
- PrimopCmmEmit_External -> panic "External prim op"
- PrimopCmmEmit_Raw _ -> panic "caller should handle TagToEnum themselves"
- PrimopCmmEmit_IntoRegs f -> f results
-
-
------------------------------------------------------------------------
-- Emitting code for a primop
------------------------------------------------------------------------