[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