From c173e8d155ca61ec53224c39d8cb936ddcc5dbda Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 15 Oct 2009 12:01:59 +0000
Subject: [PATCH] Fix several missing dependencies in ifFreeNames

These missing dependencies led to:
  ghc-stage1: panic! (the 'impossible' happened)
  (GHC version 6.13 for x86_64-unknown-linux):
	urk! lookup local fingerprint ghc-6.13:CgBindery.CgBindings{tc r4Z}

Simon and I don't quite understand why I've encountered these while
no one else has, but they are certainly bugs, and this patch certainly
fixes them.

Merge to 6.12 branch
---
 compiler/iface/IfaceSyn.lhs |   64 ++++++++++++++++++++++++++++++++++++-------
 1 file changed, 54 insertions(+), 10 deletions(-)

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 470a5ea..129ebd0 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -675,9 +675,10 @@ instance Outputable IfaceInfoItem where
 -- fingerprinting the instance, so DFuns are not dependencies.
 
 freeNamesIfDecl :: IfaceDecl -> NameSet
-freeNamesIfDecl (IfaceId _s t _d i) = 
+freeNamesIfDecl (IfaceId _s t d i) = 
   freeNamesIfType t &&&
-  freeNamesIfIdInfo i
+  freeNamesIfIdInfo i &&&
+  freeNamesIfIdDetails d
 freeNamesIfDecl IfaceForeign{} = 
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
@@ -695,6 +696,10 @@ freeNamesIfDecl d@IfaceClass{} =
   freeNamesIfDecls   (ifATs d) &&&
   fnList freeNamesIfClsSig (ifSigs d)
 
+freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
+freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
+freeNamesIfIdDetails _                 = emptyNameSet
+
 -- All other changes are handled via the version info on the tycon
 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
@@ -753,6 +758,11 @@ freeNamesIfBndr :: IfaceBndr -> NameSet
 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 
+freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
+-- Remember IfaceLetBndr is used only for *nested* bindings
+-- The cut-down IdInfo never contains any Names, but the type may!
+freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
+
 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
     -- kinds can have Names inside, when the Kind is an equality predicate
@@ -774,23 +784,32 @@ freeNamesIfExpr (IfaceExt v)	  = unitNameSet v
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
-freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
+freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
 freeNamesIfExpr (IfaceNote _n r)   = freeNamesIfExpr r
 
 freeNamesIfExpr (IfaceCase s _ ty alts)
-  = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
+  = freeNamesIfExpr s 
+    &&& fnList fn_alt alts &&& fn_cons alts
+    &&& freeNamesIfType ty
   where
-    -- no need to look at the constructor, because we'll already have its
-    -- parent recorded by the type on the case expression.
-    freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
+    fn_alt (_con,_bs,r) = freeNamesIfExpr r
+
+    -- Depend on the data constructors.  Just one will do!
+    -- Note [Tracking data constructors]
+    fn_cons []                              = emptyNameSet
+    fn_cons ((IfaceDefault    ,_,_) : alts) = fn_cons alts
+    fn_cons ((IfaceDataAlt con,_,_) : _   ) = unitNameSet con    
+    fn_cons (_                      : _   ) = emptyNameSet
 
-freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
-  = freeNamesIfExpr r &&& freeNamesIfExpr x
+freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
+  = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
 
 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
-  = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
+  = fnList fn_pair as &&& freeNamesIfExpr x
+  where
+    fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
 
 freeNamesIfExpr _ = emptyNameSet
 
@@ -814,3 +833,28 @@ freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
 fnList :: (a -> NameSet) -> [a] -> NameSet
 fnList f = foldr (&&&) emptyNameSet . map f
 \end{code}
+
+Note [Tracking data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In a case expression 
+   case e of { C a -> ...; ... }
+You might think that we don't need to include the datacon C
+in the free names, because its type will probably show up in 
+the free names of 'e'.  But in rare circumstances this may
+not happen.   Here's the one that bit me:
+
+   module DynFlags where 
+     import {-# SOURCE #-} Packages( PackageState )
+     data DynFlags = DF ... PackageState ...
+
+   module Packages where 
+     import DynFlags
+     data PackageState = PS ...
+     lookupModule (df :: DynFlags)
+        = case df of
+              DF ...p... -> case p of
+                               PS ... -> ...
+
+Now, lookupModule depends on DynFlags, but the transitive dependency
+on the *locally-defined* type PackageState is not visible. We need
+to take account of the use of the data constructor PS in the pattern match.
-- 
1.7.10.4