[project @ 2001-08-20 16:50:13 by simonpj]

-------------------------------------
	Make NOINLINE zap the strictness info
	-------------------------------------

Make a NOINLINE pragma zap strictness information.
Reasons given in the WorkWrap comment:

	-- Furthermore, zap the strictess info in the Id.  Why?  Because
	-- the NOINLINE says "don't expose any of the inner workings at the call
	-- site" and the strictness is certainly an inner working.
	--
	-- More concretely, the demand analyser discovers the following strictness
	-- for unsafePerformIO:  C(U(AV))
	-- But then consider
	--	unsafePerformIO (\s -> let r = f x in
	--			       case writeIORef v r s of (# s1, _ #) ->
	--			       (# s1, r #)
	-- The strictness analyser will find that the binding for r is strict,
	-- (becuase of uPIO's strictness sig), and so it'll evaluate it before
	-- doing the writeIORef.  This actually makes tests/lib/should_run/memo002
	-- get a deadlock!
	--
	-- Solution: don't expose the strictness of unsafePerformIO.

This fixes the memo002 deadlock.

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 0586195..dd0bf19 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -44,8 +44,8 @@ module Id (
        -- IdInfo stuff
        setIdUnfolding,
        setIdArityInfo,
-       setIdDemandInfo, setIdNewDemandInfo,
-       setIdStrictness, setIdNewStrictness,
+       setIdDemandInfo, setIdNewDemandInfo, 
+       setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
         setIdTyGenInfo,
        setIdWorkerInfo,
        setIdSpecialisation,
@@ -357,6 +357,9 @@ oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_in
 setIdNewStrictness :: Id -> StrictSig -> Id
 setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
 
+zapIdNewStrictness :: Id -> Id
+zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
+
        ---------------------------------
        -- TYPE GENERALISATION
 idTyGenInfo :: Id -> TyGenInfo

diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs
index de60e75..fff7082 100644 (file)
--- a/ghc/compiler/stranal/WorkWrap.lhs
+++ b/ghc/compiler/stranal/WorkWrap.lhs
@@ -13,7 +13,7 @@ import CoreUnfold     ( certainlyWillInline )
 import CoreLint                ( showPass, endPass )
 import CoreUtils       ( exprType )
 import Id              ( Id, idType, idNewStrictness, idArity, isOneShotLambda,
-                         setIdNewStrictness, idInlinePragma, mkWorkerId,
+                         setIdNewStrictness, zapIdNewStrictness, idInlinePragma, mkWorkerId,
                          setIdWorkerInfo, idCprInfo, setInlinePragma )
 import Type            ( Type )
 import IdInfo          ( mkStrictnessInfo, noStrictnessInfo, StrictnessInfo(..),
@@ -185,10 +185,28 @@ tryWW     :: RecFlag
                                        -- if two, then a worker and a
                                        -- wrapper.
 tryWW is_rec fn_id rhs
+  | isNeverInlinePrag inline_prag
+       -- Don't split NOINLINE things, because they will never be inlined
+       -- Furthermore, zap the strictess info in the Id.  Why?  Because
+       -- the NOINLINE says "don't expose any of the inner workings at the call 
+       -- site" and the strictness is certainly an inner working.
+       --
+       -- More concretely, the demand analyser discovers the following strictness
+       -- for unsafePerformIO:  C(U(AV))
+       -- But then consider
+       --      unsafePerformIO (\s -> let r = f x in 
+       --                             case writeIORef v r s of (# s1, _ #) ->
+       --                             (# s1, r #)
+       -- The strictness analyser will find that the binding for r is strict,
+       -- (becuase of uPIO's strictness sig), and so it'll evaluate it before 
+       -- doing the writeIORef.  This actually makes tests/lib/should_run/memo002
+       -- get a deadlock!  
+       --
+       -- Solution: don't expose the strictness of unsafePerformIO.
+  = returnUs [ (zapIdNewStrictness fn_id, rhs) ]
+
   |  arity == 0
        -- Don't worker-wrapper thunks
-  || isNeverInlinePrag inline_prag
-       -- Don't split things that will never be inlined
   || isNonRec is_rec && certainlyWillInline fn_id
        -- No point in worker/wrappering a function that is going to be
        -- INLINEd wholesale anyway.  If the strictness analyser is run