[Git][ghc/ghc][wip/zap-void-StgOpApp-args] Experiment: Try zapping StgOpApp void args in Unarise
Matthew Craven (@clyring)
gitlab at gitlab.haskell.org
Tue Apr 18 00:24:10 UTC 2023
Matthew Craven pushed to branch wip/zap-void-StgOpApp-args at Glasgow Haskell Compiler / GHC
Commits:
22048b91 by Matthew Craven at 2023-04-17T20:23:55-04:00
Experiment: Try zapping StgOpApp void args in Unarise
- - - - -
5 changed files:
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Layout.hs
- compiler/GHC/StgToCmm/Prim.hs
Changes:
=====================================
compiler/GHC/Stg/Unarise.hs
=====================================
@@ -534,7 +534,7 @@ unariseExpr rho (StgConApp dc n args ty_args)
return $ (StgConApp dc n args' (map stgArgType args'))
unariseExpr rho (StgOpApp op args ty)
- = return (StgOpApp op (unariseFunArgs rho args) ty)
+ = return (StgOpApp op (unariseConArgs rho args) ty)
unariseExpr rho (StgCase scrut bndr alt_ty alts)
-- tuple/sum binders in the scrutinee can always be eliminated
=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -642,7 +642,7 @@ isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSa
-- dataToTag# evaluates its argument, see Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold
isSimpleOp (StgPrimOp DataToTagOp) _ = return False
isSimpleOp (StgPrimOp op) stg_args = do
- arg_exprs <- getNonVoidArgAmodes stg_args
+ arg_exprs <- getArgAmodes (assertNonVoidStgArgs stg_args)
cfg <- getStgToCmmConfig
-- See Note [Inlining out-of-line primops and heap checks]
return $! shouldInlinePrimOp cfg op arg_exprs
@@ -971,7 +971,7 @@ maybeAltHeapCheck (GcInAlts regs, ReturnedTo lret off) code =
cgConApp :: DataCon -> ConstructorNumber -> [StgArg] -> FCode ReturnKind
cgConApp con mn stg_args
| isUnboxedTupleDataCon con -- Unboxed tuple: assign and return
- = do { arg_exprs <- getNonVoidArgAmodes stg_args
+ = do { arg_exprs <- getArgAmodes (assertNonVoidStgArgs stg_args)
; tickyUnboxedTupleReturn (length arg_exprs)
; emitReturn arg_exprs }
=====================================
compiler/GHC/StgToCmm/Foreign.hs
=====================================
@@ -6,6 +6,8 @@
--
-----------------------------------------------------------------------------
+{-# LANGUAGE ViewPatterns #-}
+
module GHC.StgToCmm.Foreign (
cgForeignCall,
emitPrimCall,
@@ -672,20 +674,16 @@ getFCallArgs ::
-- It's (b) that makes this differ from getNonVoidArgAmodes
-- Precondition: args and typs have the same length
-- See Note [Unlifted boxed arguments to foreign calls]
-getFCallArgs args typ
+getFCallArgs (assertNonVoidStgArgs -> args) typ
= do { mb_cmms <- mapM get (zipEqual "getFCallArgs" args (collectStgFArgTypes typ))
; return (catMaybes mb_cmms) }
where
get (arg,typ)
- | null arg_reps
- = return Nothing
- | otherwise
- = do { cmm <- getArgAmode (NonVoid arg)
+ = do { cmm <- getArgAmode arg
; profile <- getProfile
; return (Just (add_shim profile typ cmm, hint)) }
where
- arg_ty = stgArgType arg
- arg_reps = typePrimRep arg_ty
+ arg_ty = stgArgType (fromNonVoid arg)
hint = typeForeignHint arg_ty
-- The minimum amount of information needed to determine
=====================================
compiler/GHC/StgToCmm/Layout.hs
=====================================
@@ -27,7 +27,7 @@ module GHC.StgToCmm.Layout (
getHpRelOffset,
ArgRep(..), toArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep
- getArgAmode, getNonVoidArgAmodes
+ getArgAmode, getArgAmodes, getNonVoidArgAmodes
) where
@@ -601,6 +601,9 @@ getArgAmode :: NonVoid StgArg -> FCode CmmExpr
getArgAmode (NonVoid (StgVarArg var)) = idInfoToAmode <$> getCgIdInfo var
getArgAmode (NonVoid (StgLitArg lit)) = cgLit lit
+getArgAmodes :: [NonVoid StgArg] -> FCode [CmmExpr]
+getArgAmodes = mapM getArgAmode
+
getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
-- NB: Filters out void args,
-- so the result list may be shorter than the argument list
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -20,6 +20,7 @@ import GHC.Prelude hiding ((<*>))
import GHC.Platform
import GHC.Platform.Profile
+import GHC.StgToCmm.Closure
import GHC.StgToCmm.Config
import GHC.StgToCmm.Layout
import GHC.StgToCmm.Foreign
@@ -78,11 +79,11 @@ cgOpApp (StgFCallOp fcall ty) stg_args res_ty
cgOpApp (StgPrimOp primop) args res_ty = do
cfg <- getStgToCmmConfig
- cmm_args <- getNonVoidArgAmodes args
+ cmm_args <- getArgAmodes (assertNonVoidStgArgs args)
cmmPrimOpApp cfg primop cmm_args (Just res_ty)
cgOpApp (StgPrimCallOp primcall) args _res_ty
- = do { cmm_args <- getNonVoidArgAmodes args
+ = do { cmm_args <- getArgAmodes (assertNonVoidStgArgs args)
; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22048b914dd885e6798d7b64cc3e7c9eaf2ec413
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22048b914dd885e6798d7b64cc3e7c9eaf2ec413
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230417/d80feff2/attachment-0001.html>
More information about the ghc-commits
mailing list