[Git][ghc/ghc][wip/T16846] Don't eta-expand unsaturated primops

Ben Gamari gitlab at gitlab.haskell.org
Fri Jun 21 20:41:08 UTC 2019



Ben Gamari pushed to branch wip/T16846 at Glasgow Haskell Compiler / GHC


Commits:
aa6955c0 by Ben Gamari at 2019-06-21T20:36:36Z
Don't eta-expand unsaturated primops

Previously, as described in Note [Primop wrappers], `hasNoBinding` would
return False in the case of `PrimOpId`s. This would result in eta
expansion of unsaturated primop applications during CorePrep. Not only
did this expansion result in unnecessary allocations, but it also meant
lead to rather nasty inconsistencies between the CAFfy-ness
determinations made by TidyPgm and CorePrep.

This fixes #16846.

- - - - -


6 changed files:

- compiler/basicTypes/Id.hs
- compiler/basicTypes/Unique.hs
- compiler/prelude/PrelInfo.hs
- compiler/prelude/PrelNames.hs
- compiler/prelude/PrimOp.hs
- compiler/stgSyn/CoreToStg.hs


Changes:

=====================================
compiler/basicTypes/Id.hs
=====================================
@@ -524,9 +524,13 @@ hasNoBinding :: Id -> Bool
 -- Data constructor workers used to be things of this kind, but
 -- they aren't any more.  Instead, we inject a binding for
 -- them at the CorePrep stage.
+--
+-- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers]
+-- for the history of this.
+--
 -- EXCEPT: unboxed tuples, which definitely have no binding
 hasNoBinding id = case Var.idDetails id of
-                        PrimOpId _       -> True        -- See Note [Primop wrappers]
+                        PrimOpId _       -> False       -- See Note [Primop wrappers]
                         FCallId _        -> True
                         DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
                         _                -> isCompulsoryUnfolding (idUnfolding id)
@@ -573,13 +577,21 @@ simple way to fix #14561.
 
 Note [Primop wrappers]
 ~~~~~~~~~~~~~~~~~~~~~~
-Currently hasNoBinding claims that PrimOpIds don't have a curried
-function definition.  But actually they do, in GHC.PrimopWrappers,
-which is auto-generated from prelude/primops.txt.pp.  So actually, hasNoBinding
-could return 'False' for PrimOpIds.
-
-But we'd need to add something in CoreToStg to swizzle any unsaturated
-applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
+Previously hasNoBinding would claim that PrimOpIds didn't have a curried
+function definition. This caused quite some trouble as we would be forced to
+eta expand unsaturated primop applications very late in the Core pipeline. Not
+only would this produce unnecessary thunks, but it would also result in nasty
+inconsistencies in CAFfy-ness determinations (see #16846).
+
+However, it was quite unnecessary for hasNoBinding to claim this; primops in
+fact *do* have curried definitions which are found in GHC.PrimopWrappers, which
+is auto-generated from prelude/primops.txt.pp.
+
+We now take advantage of these curried definitions by letting hasNoBinding
+claim that PrimOpIds have a curried definition and then rewrite any unsaturated
+PrimOpId applications that we find during CoreToStg as applications of the
+associated wrapper (e.g. `GHC.Prim.plusInt# 3#` will get rewritten to
+`GHC.PrimopWrappers.plusInt# 3#`).`
 
 Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
 used by GHCi, which does not implement primops direct at all.


=====================================
compiler/basicTypes/Unique.hs
=====================================
@@ -46,7 +46,7 @@ module Unique (
         -- now all the built-in Uniques (and functions to make them)
         -- [the Oh-So-Wonderful Haskell module system wins again...]
         mkAlphaTyVarUnique,
-        mkPrimOpIdUnique,
+        mkPrimOpIdUnique, mkPrimOpWrapperUnique,
         mkPreludeMiscIdUnique, mkPreludeDataConUnique,
         mkPreludeTyConUnique, mkPreludeClassUnique,
         mkCoVarUnique,
@@ -368,6 +368,8 @@ mkPreludeClassUnique   :: Int -> Unique
 mkPreludeTyConUnique   :: Int -> Unique
 mkPreludeDataConUnique :: Arity -> Unique
 mkPrimOpIdUnique       :: Int -> Unique
+-- See Note [Primop wrappers].
+mkPrimOpWrapperUnique  :: Int -> Unique
 mkPreludeMiscIdUnique  :: Int -> Unique
 mkCoVarUnique          :: Int -> Unique
 
@@ -405,7 +407,8 @@ dataConWorkerUnique  u = incrUnique u
 dataConTyRepNameUnique u = stepUnique u 2
 
 --------------------------------------------------
-mkPrimOpIdUnique op         = mkUnique '9' op
+mkPrimOpIdUnique op         = mkUnique '9' (2*op)
+mkPrimOpWrapperUnique op    = mkUnique '9' (2*op+1)
 mkPreludeMiscIdUnique  i    = mkUnique '0' i
 
 -- The "tyvar uniques" print specially nicely: a, b, c, etc.


=====================================
compiler/prelude/PrelInfo.hs
=====================================
@@ -131,6 +131,7 @@ knownKeyNames
 
              , map idName wiredInIds
              , map (idName . primOpId) allThePrimOps
+             , map (idName . primOpWrapperId) allThePrimOps
              , basicKnownKeyNames
              , templateHaskellNames
              ]


=====================================
compiler/prelude/PrelNames.hs
=====================================
@@ -498,7 +498,8 @@ pRELUDE :: Module
 pRELUDE         = mkBaseModule_ pRELUDE_NAME
 
 gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
-    gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,
+    gHC_CLASSES, gHC_PRIMOPWRAPPERS,
+    gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,
     gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,
     gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING,
     dATA_FOLDABLE, dATA_TRAVERSABLE,
@@ -516,6 +517,7 @@ gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
 gHC_MAGIC       = mkPrimModule (fsLit "GHC.Magic")
 gHC_CSTRING     = mkPrimModule (fsLit "GHC.CString")
 gHC_CLASSES     = mkPrimModule (fsLit "GHC.Classes")
+gHC_PRIMOPWRAPPERS = mkPrimModule (fsLit "GHC.PrimopWrappers")
 
 gHC_BASE        = mkBaseModule (fsLit "GHC.Base")
 gHC_ENUM        = mkBaseModule (fsLit "GHC.Enum")


=====================================
compiler/prelude/PrimOp.hs
=====================================
@@ -13,6 +13,7 @@ module PrimOp (
         PrimOp(..), PrimOpVecCat(..), allThePrimOps,
         primOpType, primOpSig,
         primOpTag, maxPrimOpTag, primOpOcc,
+        primOpWrapperId,
 
         tagToEnumKey,
 
@@ -34,14 +35,18 @@ import TysWiredIn
 
 import CmmType
 import Demand
-import OccName          ( OccName, pprOccName, mkVarOccFS )
+import Id               ( Id, mkVanillaGlobalWithInfo )
+import IdInfo           ( vanillaIdInfo, setCafInfo, CafInfo(NoCafRefs) )
+import Name
+import PrelNames        ( gHC_PRIMOPWRAPPERS )
 import TyCon            ( TyCon, isPrimTyCon, PrimRep(..) )
 import Type
 import RepType          ( typePrimRep1, tyConPrimRep1 )
 import BasicTypes       ( Arity, Fixity(..), FixityDirection(..), Boxity(..),
                           SourceText(..) )
+import SrcLoc           ( wiredInSrcSpan )
 import ForeignCall      ( CLabelString )
-import Unique           ( Unique, mkPrimOpIdUnique )
+import Unique           ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique )
 import Outputable
 import FastString
 import Module           ( UnitId )
@@ -572,6 +577,15 @@ primOpOcc op = case primOpInfo op of
                Compare   occ _     -> occ
                GenPrimOp occ _ _ _ -> occ
 
+-- | Returns the 'Id' of the wrapper associated with the given 'PrimOp'.
+primOpWrapperId :: PrimOp -> Id
+primOpWrapperId op = mkVanillaGlobalWithInfo name ty info
+  where
+    info = setCafInfo vanillaIdInfo NoCafRefs
+    name = mkExternalName uniq gHC_PRIMOPWRAPPERS (primOpOcc op) wiredInSrcSpan
+    uniq = mkPrimOpWrapperUnique (primOpTag op)
+    ty   = primOpType op
+
 isComparisonPrimOp :: PrimOp -> Bool
 isComparisonPrimOp op = case primOpInfo op of
                           Compare {} -> True


=====================================
compiler/stgSyn/CoreToStg.hs
=====================================
@@ -45,7 +45,7 @@ import Util
 import DynFlags
 import ForeignCall
 import Demand           ( isUsedOnce )
-import PrimOp           ( PrimCall(..) )
+import PrimOp           ( PrimCall(..), primOpWrapperId )
 import SrcLoc           ( mkGeneralSrcSpan )
 
 import Data.List.NonEmpty (nonEmpty, toList)
@@ -533,8 +533,12 @@ coreToStgApp _ f args ticks = do
                                       (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty)))
 
                 -- Some primitive operator that might be implemented as a library call.
-                PrimOpId op      -> ASSERT( saturated )
-                                    StgOpApp (StgPrimOp op) args' res_ty
+                -- As described in Note [Primop wrappers] we turn unsaturated
+                -- primop applications into applications of the primop's
+                -- wrapper here.
+                PrimOpId op
+                  | saturated    -> StgOpApp (StgPrimOp op) args' res_ty
+                  | otherwise    -> StgApp (primOpWrapperId op) args'
 
                 -- A call to some primitive Cmm function.
                 FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aa6955c03496216d7b94d06f77bdfcb8f4f278bc

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aa6955c03496216d7b94d06f77bdfcb8f4f278bc
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/20190621/71db8153/attachment-0001.html>


More information about the ghc-commits mailing list