[Git][ghc/ghc][wip/keepAlive-optionB] 2 commits: base: Use keepAlive# in withForeignPtr

Ben Gamari gitlab at gitlab.haskell.org
Wed Sep 9 21:29:04 UTC 2020



Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC


Commits:
98a7b602 by Ben Gamari at 2020-09-09T21:09:09+00:00
base: Use keepAlive# in withForeignPtr

- - - - -
e09f8c4d by GHC GitLab CI at 2020-09-09T21:28:41+00:00
Simplify

- - - - -


4 changed files:

- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/CoreToStg/Prep.hs
- libraries/base/Foreign/ForeignPtr/Imp.hs
- libraries/base/GHC/ForeignPtr.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -2011,16 +2011,20 @@ rebuildCall env fun_info
 rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont
   = rebuild env (argInfoExpr fun rev_args) cont
 
+-- | Simplifications of runRW# and keepAlive#
 rebuildContOpCall :: SimplEnv -> ArgInfo -> SimplCont -> Maybe (SimplM (SimplFloats, OutExpr))
----------- The runRW# rule. Do this after absorbing all arguments ------
--- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep.
---
--- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o
--- K[ runRW# rr ty body ]   -->   runRW rr' ty' (\s. K[ body s ])
 rebuildContOpCall _env _arg_info cont
   | not (contIsStop cont)  -- Don't fiddle around if the continuation is boring
   = Nothing
 
+-- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep.
+--
+-- N.B. runRW# :: forall (r :: RuntimeRep) (o :: TYPE r).
+--                (State# RealWorld -> o) -> o
+--
+--   K[ runRW# rr ty body ]
+--       ~>
+--   runRW rr' ty' (\s. K[ body s ])
 rebuildContOpCall
     env
     (ArgInfo { ai_fun = fun_id, ai_args = rev_args })
@@ -2033,9 +2037,10 @@ rebuildContOpCall
        ; let (m,_,_) = splitFunTy fun_ty
              env'  = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s]
              ty'   = contResultType cont
+             k'_ty = mkVisFunTy m realWorldStatePrimTy ty'
              cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s
                                 , sc_env = env', sc_cont = cont
-                                , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty' }
+                                , sc_hole_ty = k'_ty }
                      -- cont' applies to s, then K
        ; body' <- simplExprC env' arg cont'
        ; let arg'  = Lam s body'
@@ -2043,6 +2048,11 @@ rebuildContOpCall
              call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg']
        ; return (emptyFloats env, call') }
 
+-- See Note [Simplification of keepAlive#] in GHC.CoreToStg.Prep.
+--
+--   K[keepAlive# @a_rep @a @r_rep @r x s k]
+--       ~>
+--   keepAlive# @a_rep @a @r_rep @r x s K[k]
 rebuildContOpCall
     env
     (ArgInfo { ai_fun = fun_id, ai_args = rev_args })
@@ -2058,17 +2068,20 @@ rebuildContOpCall
     ] <- rev_args
   = Just $
     do { s <- newId (fsLit "s") One realWorldStatePrimTy
-       ; let k_env = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s]
-             k_cont = ApplyToVal { sc_dup = Simplified, sc_arg = Var s
-                                 , sc_env = k_env, sc_cont = cont, sc_hole_ty = undefined }
+       ; let (m,_,_) = splitFunTy fun_ty
+             k_env   = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s]
+             ty'     = contResultType cont
+             k'_ty   = mkVisFunTy m realWorldStatePrimTy ty'
+             k_cont  = ApplyToVal { sc_dup = Simplified, sc_arg = Var s
+                                  , sc_env = k_env, sc_cont = cont
+                                  , sc_hole_ty = k'_ty }
        ; k' <- simplExprC k_env k k_cont
        ; let env' = zapSubstEnv env
        ; s0' <- simplExpr env' s0
        ; x' <- simplExpr env' x
        ; arg_rep' <- simplType env' arg_rep
        ; arg_ty' <- simplType env' arg_ty
-       ; let ty' = contResultType cont
-             call' = mkApps (Var fun_id)
+       ; let call' = mkApps (Var fun_id)
                [ mkTyArg arg_rep', mkTyArg arg_ty'
                , mkTyArg (getRuntimeRep ty'), mkTyArg ty'
                , x'


=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -1096,10 +1096,26 @@ Breaking our desired invariant. Ultimately we decided to simply accept that
 the continuation may not be a manifest lambda.
 
 
+Note [Simplification of keepAlive#]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The keepAlive# primop benefits from a similar optimisation to that described in
+Note [Simplification of runRW#] above. Specifically, we transform:
+
+    K[keepAlive# @a_rep @a @r_rep @r x s k]
+            ~>
+    keepAlive# @a_rep @a @r_rep @r x s K[k]
+
+The reasons are similar to those described in Note [Simplification of runRW#].
+
+-}
+
+
 -- ---------------------------------------------------------------------------
 --      CpeArg: produces a result satisfying CpeArg
 -- ---------------------------------------------------------------------------
 
+{-
 Note [ANF-ising literal string arguments]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 


=====================================
libraries/base/Foreign/ForeignPtr/Imp.hs
=====================================
@@ -66,31 +66,6 @@ newForeignPtr finalizer p
        addForeignPtrFinalizer finalizer fObj
        return fObj
 
-withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
--- ^This is a way to look at the pointer living inside a
--- foreign object.  This function takes a function which is
--- applied to that pointer. The resulting 'IO' action is then
--- executed. The foreign object is kept alive at least during
--- the whole action, even if it is not used directly
--- inside. Note that it is not safe to return the pointer from
--- the action and use it after the action completes. All uses
--- of the pointer should be inside the
--- 'withForeignPtr' bracket.  The reason for
--- this unsafeness is the same as for
--- 'unsafeForeignPtrToPtr' below: the finalizer
--- may run earlier than expected, because the compiler can only
--- track usage of the 'ForeignPtr' object, not
--- a 'Ptr' object made from it.
---
--- This function is normally used for marshalling data to
--- or from the object pointed to by the
--- 'ForeignPtr', using the operations from the
--- 'Storable' class.
-withForeignPtr fo io
-  = do r <- io (unsafeForeignPtrToPtr fo)
-       touchForeignPtr fo
-       return r
-
 -- | This variant of 'newForeignPtr' adds a finalizer that expects an
 -- environment in addition to the finalized pointer.  The environment
 -- that will be passed to the finalizer is fixed by the second argument to


=====================================
libraries/base/GHC/ForeignPtr.hs
=====================================
@@ -46,6 +46,7 @@ module GHC.ForeignPtr
         castForeignPtr,
         plusForeignPtr,
         -- * Finalization
+        withForeignPtr,
         touchForeignPtr,
         finalizeForeignPtr
         -- * Commentary
@@ -60,6 +61,7 @@ import GHC.Base
 import GHC.IORef
 import GHC.STRef        ( STRef(..) )
 import GHC.Ptr          ( Ptr(..), FunPtr(..) )
+import GHC.Prim         ( keepAlive# )
 
 import Unsafe.Coerce    ( unsafeCoerce, unsafeCoerceUnlifted )
 
@@ -503,6 +505,31 @@ newForeignPtr_ (Ptr obj) =  do
   r <- newIORef NoFinalizers
   return (ForeignPtr obj (PlainForeignPtr r))
 
+withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+-- ^This is a way to look at the pointer living inside a
+-- foreign object.  This function takes a function which is
+-- applied to that pointer. The resulting 'IO' action is then
+-- executed. The foreign object is kept alive at least during
+-- the whole action, even if it is not used directly
+-- inside. Note that it is not safe to return the pointer from
+-- the action and use it after the action completes. All uses
+-- of the pointer should be inside the
+-- 'withForeignPtr' bracket.  The reason for
+-- this unsafeness is the same as for
+-- 'unsafeForeignPtrToPtr' below: the finalizer
+-- may run earlier than expected, because the compiler can only
+-- track usage of the 'ForeignPtr' object, not
+-- a 'Ptr' object made from it.
+--
+-- This function is normally used for marshalling data to
+-- or from the object pointed to by the
+-- 'ForeignPtr', using the operations from the
+-- 'Storable' class.
+withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s ->
+  case f (unsafeForeignPtrToPtr fo) of
+    IO action# -> keepAlive# r s action#
+
+
 touchForeignPtr :: ForeignPtr a -> IO ()
 -- ^This function ensures that the foreign object in
 -- question is alive at the given place in the sequence of IO



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84923598ec40dffaa9d2ab5712c63795d63f854c...e09f8c4d7f87c703a5428723354f8527a3420e1e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84923598ec40dffaa9d2ab5712c63795d63f854c...e09f8c4d7f87c703a5428723354f8527a3420e1e
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/20200909/3c8d5744/attachment-0001.html>


More information about the ghc-commits mailing list