[project @ 2000-09-08 11:09:38 by simonpj]

Fix the loop in SimplUtils.interestingArg

diff --git a/ghc/compiler/coreSyn/Subst.lhs b/ghc/compiler/coreSyn/Subst.lhs
index d9d9279..94c40da 100644 (file)
--- a/ghc/compiler/coreSyn/Subst.lhs
+++ b/ghc/compiler/coreSyn/Subst.lhs
@@ -60,7 +60,8 @@ import UniqSet                ( elemUniqSet_Directly )
 import UniqSupply      ( UniqSupply, uniqFromSupply, splitUniqSupply )
 import Var             ( Var, Id, TyVar, isTyVar )
 import Outputable
-import PprCore         ()      -- Instances
+import PprCore         ()              -- Instances
+import UniqFM          ( ufmToList )   -- Yuk (add a new op to VarEnv)
 import Util            ( mapAccumL, foldl2, seqList, ($!) )
 \end{code}
 
@@ -168,7 +169,17 @@ data Subst = Subst InScopeSet              -- In scope
        --
        -- INVARIANT 2: No variable is both in scope and in the domain of the substitution
        --              Equivalently, the substitution is idempotent
-       --
+       --      [Sep 2000: Lies, all lies.  The substitution now does contain
+       --                 mappings x77 -> DoneId x77 occ
+       --                 to record x's occurrence information.]
+       --      [Also watch out: the substitution can contain x77 -> DoneEx (Var x77)
+       --       Consider let x = case k of I# x77 -> ... in
+       --                let y = case k of I# x77 -> ... in ...
+       --       and suppose the body is strict in both x and y.  Then the simplifier
+       --       will pull the first (case k) to the top; so the second (case k) will
+       --       cancel out, mapping x77 to, well, x77!  But one is an in-Id and the 
+       --       other is an out-Id. So the substitution is idempotent in the sense
+       --       that we *must not* repeatedly apply it.]
 
 type IdSubst    = Subst
 \end{code}
@@ -180,7 +191,7 @@ The general plan about the substitution and in-scope set for Ids is as follows
   That is added back in later.  So new_id is the minimal thing it's 
   correct to substitute.
 
-* substId adds a binding (DoneVar new_id occ) to the substitution if 
+* substId adds a binding (DoneId new_id occ) to the substitution if 
        EITHER the Id's unique has changed
        OR     the Id has interesting occurrence information
   So in effect you can only get to interesting occurrence information
@@ -321,6 +332,25 @@ setSubstEnv :: Subst               -- Take in-scope part from here
 setSubstEnv (Subst in_scope1 _) env2 = Subst in_scope1 env2
 \end{code}
 
+Pretty printing, for debugging only
+
+\begin{code}
+instance Outputable SubstResult where
+  ppr (DoneEx e)   = ptext SLIT("DoneEx") <+> ppr e
+  ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v
+  ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e
+  ppr (DoneTy t)   = ptext SLIT("DoneTy") <+> ppr t
+
+instance Outputable SubstEnv where
+  ppr se = brackets (fsep (punctuate comma (map ppr_elt (ufmToList (substEnvEnv se)))))
+       where
+          ppr_elt (uniq,sr) = ppr uniq <+> ptext SLIT("->") <+> ppr sr
+
+instance Outputable Subst where
+  ppr (Subst (InScope in_scope _) se) 
+       =  ptext SLIT("<InScope =") <+> braces   (fsep (map ppr (rngVarEnv in_scope)))
+       $$ ptext SLIT(" Subst   =") <+> ppr se <> char '>'
+\end{code}
 
 %************************************************************************
 %*                                                                     *

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 235593c..85c1c4d 100644 (file)
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -24,7 +24,7 @@ import CmdLineOpts    ( switchIsOn, SimplifierSwitch(..),
 import CoreSyn
 import CoreUnfold      ( isValueUnfolding )
 import CoreUtils       ( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, exprEtaExpandArity, bindNonRec )
-import Subst           ( InScopeSet, mkSubst, substBndrs, substBndr, substIds, lookupIdSubst )
+import Subst           ( InScopeSet, mkSubst, substBndrs, substBndr, substIds, substExpr )
 import Id              ( Id, idType, isId, idName, 
                          idOccInfo, idUnfolding, idStrictness,
                          mkId, idInfo
@@ -265,27 +265,24 @@ interestingArg :: InScopeSet -> InExpr -> SubstEnv -> Bool
        -- (i.e. they are probably lambda bound): f x y z
        -- There is little point in inlining f here.
 interestingArg in_scope arg subst
-  = analyse arg
+  = analyse (substExpr (mkSubst in_scope subst) arg)
+       -- 'analyse' only looks at the top part of the result
+       -- and substExpr is lazy, so this isn't nearly as brutal
+       -- as it looks.
   where
-    analyse (Var v)
-       = case lookupIdSubst (mkSubst in_scope subst) v of
-           ContEx subst arg -> interestingArg in_scope arg subst
-           DoneEx arg       -> analyse arg
-           DoneId v' _      -> hasSomeUnfolding (idUnfolding v')
+    analyse (Var v)          = hasSomeUnfolding (idUnfolding v)
                                -- Was: isValueUnfolding (idUnfolding v')
                                -- But that seems over-pessimistic
-
-       -- NB: it's too pessimistic to return False for ContEx/DoneEx
-       -- Consider     let x = 3 in f x
-       -- The substitution will contain (x -> ContEx 3)
-       -- It's also too optimistic to return True for the ContEx/DoneEx case
-       -- Consider (\x. f x y) y
-       -- The substitution will contain (x -> ContEx y).
-
     analyse (Type _)         = False
     analyse (App fn (Type _)) = analyse fn
     analyse (Note _ a)       = analyse a
     analyse other            = True
+       -- Consider     let x = 3 in f x
+       -- The substitution will contain (x -> ContEx 3), and we want to
+       -- to say that x is an interesting argument.
+       -- But consider also (\x. f x y) y
+       -- The substitution will contain (x -> ContEx y), and we want to say
+       -- that x is not interesting (assuming y has no unfolding)
 \end{code}
 
 Comment about interestingCallContext