[Git][ghc/ghc][master] Refactor: remove calls to typePrimRepArgs

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Jan 4 01:09:50 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
89299a89 by Krzysztof Gogolewski at 2024-01-03T20:09:23-05:00
Refactor: remove calls to typePrimRepArgs

The function typePrimRepArgs is just a thin wrapper around
typePrimRep, adding a VoidRep if the list is empty.
However, in StgToByteCode, we were discarding that VoidRep anyway,
so there's no point in calling it.

- - - - -


1 changed file:

- compiler/GHC/StgToByteCode.hs


Changes:

=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -83,7 +83,6 @@ import Data.IntMap (IntMap)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
-import qualified Data.List.NonEmpty as NE
 import qualified GHC.Data.FiniteMap as Map
 import Data.Ord
 import GHC.Stack.CCS
@@ -297,11 +296,6 @@ argBits platform (rep : args)
   | isFollowableArg rep  = False : argBits platform args
   | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args
 
-non_void :: NonEmpty ArgRep -> [ArgRep]
-non_void = NE.filter nv
-  where nv V = False
-        nv _ = True
-
 -- -----------------------------------------------------------------------------
 -- schemeTopBind
 
@@ -495,11 +489,9 @@ returnUnliftedAtom
     -> StgArg
     -> BcM BCInstrList
 returnUnliftedAtom d s p e = do
-    let reps = case e of
-                 StgLitArg lit -> typePrimRepArgs (literalType lit)
-                 StgVarArg i   -> bcIdPrimReps i
+    let reps = stgArgRep e
     (push, szb) <- pushAtom d p e
-    ret <- returnUnliftedReps d s szb (NE.toList $! reps)
+    ret <- returnUnliftedReps d s szb reps
     return (push `appOL` ret)
 
 -- return an unlifted value from the top of the stack
@@ -512,9 +504,7 @@ returnUnliftedReps
 returnUnliftedReps d s szb reps = do
     profile <- getProfile
     let platform = profilePlatform profile
-        non_void VoidRep = False
-        non_void _ = True
-    ret <- case filter non_void reps of
+    ret <- case reps of
              -- use RETURN for nullary/unary representations
              []    -> return (unitOL $ RETURN V)
              [rep] -> return (unitOL $ RETURN (toArgRep platform rep))
@@ -549,10 +539,12 @@ returnUnboxedTuple d s p es = do
                                          massert (off == dd + szb)
                                          go (dd + szb) (push:pushes) cs
     pushes <- go d [] tuple_components
+    let non_void VoidRep = False
+        non_void _ = True
     ret <- returnUnliftedReps d
                               s
                               (wordsToBytes platform $ nativeCallSize call_info)
-                              (map atomPrimRep es)
+                              (filter non_void $ map atomPrimRep es)
     return (mconcat pushes `appOL` ret)
 
 -- Compile code to apply the given expression to the remaining args
@@ -866,7 +858,7 @@ doCase d s p scrut bndr alts
         -- have the same runtime rep. We have more efficient specialized
         -- return frames for the situations with one non-void element.
 
-        non_void_arg_reps = non_void (typeArgReps platform bndr_ty)
+        non_void_arg_reps = typeArgReps platform bndr_ty
         ubx_tuple_frame =
           (isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty) &&
           length non_void_arg_reps > 1
@@ -899,7 +891,7 @@ doCase d s p scrut bndr alts
         (bndr_size, call_info, args_offsets)
            | ubx_tuple_frame =
                let bndr_ty = primRepCmmType platform
-                   bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr)
+                   bndr_reps = typePrimRep (idType bndr)
                    (call_info, args_offsets) =
                        layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps
                in ( wordsToBytes platform (nativeCallSize call_info)
@@ -1695,19 +1687,15 @@ maybe_getCCallReturnRep :: Type -> Maybe PrimRep
 maybe_getCCallReturnRep fn_ty
    = let
        (_a_tys, r_ty) = splitFunTys (dropForAlls fn_ty)
-       r_reps = typePrimRepArgs r_ty
-
-       blargh :: a -- Used at more than one type
-       blargh = pprPanic "maybe_getCCallReturn: can't handle:"
-                         (pprType fn_ty)
      in
-       case r_reps of
-         VoidRep :| [] -> Nothing
-         rep     :| [] -> Just rep
+       case typePrimRep r_ty of
+         [] -> Nothing
+         [rep] -> Just rep
 
                  -- if it was, it would be impossible to create a
                  -- valid return value placeholder on the stack
-         _             -> blargh
+         _ -> pprPanic "maybe_getCCallReturn: can't handle:"
+                         (pprType fn_ty)
 
 maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (Id, [Name])
 -- Detect and extract relevant info for the tagToEnum kludge.
@@ -2147,7 +2135,7 @@ idSizeCon platform var
     isUnboxedSumType (idType var) =
     wordsToBytes platform .
     WordOff . sum . map (argRepSizeW platform . toArgRep platform) .
-    NE.toList . bcIdPrimReps $ var
+    typePrimRep . idType $ var
   | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var))
 
 bcIdArgRep :: Platform -> Id -> ArgRep
@@ -2160,10 +2148,6 @@ bcIdPrimRep id
   | otherwise
   = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id))
 
-
-bcIdPrimReps :: Id -> NonEmpty PrimRep
-bcIdPrimReps id = typePrimRepArgs (idType id)
-
 repSizeWords :: Platform -> PrimRep -> WordOff
 repSizeWords platform rep = WordOff $ argRepSizeW platform (toArgRep platform rep)
 
@@ -2214,8 +2198,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e)
 mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff]
 mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb)
 
-typeArgReps :: Platform -> Type -> NonEmpty ArgRep
-typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs
+typeArgReps :: Platform -> Type -> [ArgRep]
+typeArgReps platform = map (toArgRep platform) . typePrimRep
 
 -- -----------------------------------------------------------------------------
 -- The bytecode generator's monad



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89299a89c1ccb534cd4f68106ea8c606c34a4df8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89299a89c1ccb534cd4f68106ea8c606c34a4df8
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/20240103/54ffb557/attachment-0001.html>


More information about the ghc-commits mailing list