[project @ 2000-11-14 10:46:39 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / SimplUtils.lhs

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 29f9a6a..cf022c2 100644 (file)
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -23,29 +23,26 @@ import CmdLineOpts  ( switchIsOn, SimplifierSwitch(..),
                          opt_UF_UpdateInPlace
                        )
 import CoreSyn
-import CoreUnfold      ( isValueUnfolding )
 import CoreUtils       ( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, exprEtaExpandArity, bindNonRec )
 import Subst           ( InScopeSet, mkSubst, substBndrs, substBndr, substIds, substExpr )
-import Id              ( Id, idType, isId, idName, 
-                         idOccInfo, idUnfolding, idStrictness,
-                         mkId, idInfo
+import Id              ( idType, idName, 
+                         idUnfolding, idStrictness,
+                         mkVanillaId, idInfo
                        )
-import IdInfo          ( StrictnessInfo(..), ArityInfo, atLeastArity, setOccInfo, vanillaIdInfo )
+import IdInfo          ( StrictnessInfo(..), ArityInfo, atLeastArity, vanillaIdInfo )
 import Maybes          ( maybeToBool, catMaybes )
-import Name            ( isLocalName, setNameUnique )
-import Demand          ( Demand, isStrict, wwLazy, wwLazy )
+import Name            ( setNameUnique )
+import Demand          ( isStrict )
 import SimplMonad
-import Type            ( Type, tyVarsOfType, tyVarsOfTypes, mkForAllTys, seqType, repType,
-                         splitTyConApp_maybe, mkTyVarTys, applyTys, splitFunTys, mkFunTys,
-                         isDictTy, isDataType, applyTy, splitFunTy, isUnLiftedType,
+import Type            ( Type, mkForAllTys, seqType, repType,
+                         splitTyConApp_maybe, mkTyVarTys, splitFunTys, 
+                         isDictTy, isDataType, isUnLiftedType,
                          splitRepFunTys
                        )
 import TyCon           ( tyConDataConsIfAvailable )
 import DataCon         ( dataConRepArity )
-import VarSet
-import VarEnv          ( SubstEnv, SubstResult(..) )
+import VarEnv          ( SubstEnv )
 import Util            ( lengthExceeds )
-import BasicTypes      ( Arity )
 import Outputable
 \end{code}
 
@@ -624,7 +621,7 @@ tryRhsTyLam rhs thing_inside                -- Only does something if there's a let
        let
            poly_name = setNameUnique (idName var) uniq         -- Keep same name
            poly_ty   = mkForAllTys tyvars_here (idType var)    -- But new type of course
-           poly_id   = mkId poly_name poly_ty vanillaIdInfo
+           poly_id   = mkVanillaId poly_name poly_ty 
 
                -- In the olden days, it was crucial to copy the occInfo of the original var, 
                -- because we were looking at occurrence-analysed but as yet unsimplified code!
@@ -638,24 +635,29 @@ tryRhsTyLam rhs thing_inside              -- Only does something if there's a let
                -- where x* has an INLINE prag on it.  Now, once x* is inlined,
                -- the occurrences of x' will be just the occurrences originally
                -- pinned on x.
-               --         poly_info = vanillaIdInfo `setOccInfo` idOccInfo var
        in
        returnSmpl (poly_id, mkTyApps (Var poly_id) (mkTyVarTys tyvars_here))
 
-    mk_silly_bind var rhs = NonRec var rhs
+    mk_silly_bind var rhs = NonRec var (Note InlineMe rhs)
                -- Suppose we start with:
                --
-               --      x = let g = /\a -> \x -> f x x
-               --          in 
-               --          /\ b -> let g* = g b in E
+               --      x = /\ a -> let g = G in E
                --
-               -- Then:        * the binding for g gets floated out
-               --              * but then it MIGHT get inlined into the rhs of g*
-               --              * then the binding for g* is floated out of the /\b
-               --              * so we're back to square one
-               -- We rely on the simplifier not to inline g into the RHS of g*,
-               -- because it's a "lone" occurrence, and there is no benefit in
-               -- inlining.  But it's a slightly delicate property; hence this comment
+               -- Then we'll float to get
+               --
+               --      x = let poly_g = /\ a -> G
+               --          in /\ a -> let g = poly_g a in E
+               --
+               -- But now the occurrence analyser will see just one occurrence
+               -- of poly_g, not inside a lambda, so the simplifier will
+               -- PreInlineUnconditionally poly_g back into g!  Badk to square 1!
+               -- (I used to think that the "don't inline lone occurrences" stuff
+               --  would stop this happening, but since it's the *only* occurrence,
+               --  PreInlineUnconditionally kicks in first!)
+               --
+               -- Solution: put an INLINE note on g's RHS, so that poly_g seems
+               --           to appear many times.  (NB: mkInlineMe eliminates
+               --           such notes on trivial RHSs, so do it manually.)
 \end{code}