+mkTopSigTy :: CoreExpr -> DmdType -> StrictSig
+ -- Take a DmdType and turn it into a StrictSig
+ -- NB: not used for never-inline things; hence False
+mkTopSigTy rhs dmd_ty = snd (mk_sig_ty False False rhs dmd_ty)
+
+mkSigTy :: Id -> CoreExpr -> DmdType -> (DmdEnv, StrictSig)
+mkSigTy id rhs dmd_ty = mk_sig_ty (isNeverActive (idInlinePragma id))
+ (isStrictDmd (idNewDemandInfo id))
+ rhs dmd_ty
+
+mk_sig_ty never_inline strictly_demanded rhs (DmdType fv dmds res)
+ | never_inline && not (isBotRes res)
+ -- HACK ALERT
+ -- Don't strictness-analyse NOINLINE things. Why not? 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.
+ --
+ -- But we do want to expose the strictness of error functions,
+ -- which are also often marked NOINLINE
+ -- {-# NOINLINE foo #-}
+ -- foo x = error ("wubble buggle" ++ x)
+ -- So (hack, hack) we only drop the strictness for non-bottom things
+ -- This is all very unsatisfactory.
+ = (deferEnv fv, topSig)
+
+ | otherwise