From: simonpj <unknown>
Date: Wed, 21 Apr 2004 12:36:51 +0000 (+0000)
Subject: [project @ 2004-04-21 12:36:51 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~1888
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=7032166d34b8769c8ae6f40d9f1e6d346c3376bd;p=ghc-hetmet.git

[project @ 2004-04-21 12:36:51 by simonpj]
Elaborate IfaceSyn.HsWorker to give the full IfaceExtName of the worker,
rather than just the internal OccName.  Very occasionally, the worker for
a function in module A turns out to be (by simplification) a function
defined in module B.  So we must remember the module. This shows up in
package ObjectIO,
	Graphics.UI.ObjectIO.OS.Window.osValidateWindowRect
which has a worker
	Graphics.UI.ObjectIO.OS.WindowCCall_12.$wwinValidateRect

*** Unfortunately this changes the binary format of hi files slightly, so
*** you'll have to recompile all your libraries from scratch.
---

diff --git a/ghc/compiler/iface/IfaceSyn.lhs b/ghc/compiler/iface/IfaceSyn.lhs
index 10889e6..5fbf8ed 100644
--- a/ghc/compiler/iface/IfaceSyn.lhs
+++ b/ghc/compiler/iface/IfaceSyn.lhs
@@ -185,8 +185,10 @@ data IfaceInfoItem
   | HsStrictness StrictSig
   | HsUnfold	 Activation IfaceExpr
   | HsNoCafRefs
-  | HsWorker	 OccName Arity	-- Worker, if any see IdInfo.WorkerInfo
-				-- for why we want arity here.
+  | HsWorker	 IfaceExtName Arity	-- Worker, if any see IdInfo.WorkerInfo
+					-- for why we want arity here.
+	-- NB: we need IfaceExtName (not just OccName) because the worker
+	--     can simplify to a function in another module.
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
@@ -566,7 +568,7 @@ toIfaceIdInfo ext id_info
     has_worker  = case work_info of { HasWorker _ _ -> True; other -> False }
     wrkr_hsinfo = case work_info of
 		    HasWorker work_id wrap_arity -> 
-			Just (HsWorker (getOccName work_id) wrap_arity)
+			Just (HsWorker (ext (idName work_id)) wrap_arity)
 		    NoWorker -> Nothing
 
     ------------  Unfolding  --------------
@@ -586,7 +588,7 @@ coreRuleToIfaceRule mod ext (id, BuiltinRule _ _)
 coreRuleToIfaceRule mod ext (id, Rule name act bndrs args rhs)
   = IfaceRule { ifRuleName = name, ifActivation = act, 
 		ifRuleBndrs = map (toIfaceBndr ext) bndrs,
-		ifRuleHead = ext (getName id), 
+		ifRuleHead = ext (idName id), 
 		ifRuleArgs = map (toIfaceExpr (mkLhsNameFn mod)) args,
 			-- Use LHS name-fn for the args
 		ifRuleRhs = toIfaceExpr ext rhs }
@@ -804,7 +806,7 @@ eq_item (HsArity a1)	   (HsArity a2)	      = bool (a1 == a2)
 eq_item (HsStrictness s1)  (HsStrictness s2)  = bool (s1 == s2)
 eq_item (HsUnfold a1 u1)   (HsUnfold a2 u2)   = bool (a1 == a2) &&& eq_ifaceExpr emptyEqEnv u1 u2
 eq_item HsNoCafRefs        HsNoCafRefs	      = Equal
-eq_item (HsWorker occ1 a1) (HsWorker occ2 a2) = bool (a1==a2 && occ1==occ2)
+eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
 eq_item _ _ = NotEqual
 
 -----------------
diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 680f11b..d09f0f5 100644
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -880,8 +880,8 @@ tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info
 \end{code}
 
 \begin{code}
-tcWorkerInfo ty info wkr_name arity
-  = do 	{ mb_wkr_id <- forkM_maybe doc (tcIfaceExtId (LocalTop wkr_name))
+tcWorkerInfo ty info wkr arity
+  = do 	{ mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 
 	-- We return without testing maybe_wkr_id, but as soon as info is
 	-- looked at we will test it.  That's ok, because its outside the
@@ -894,7 +894,7 @@ tcWorkerInfo ty info wkr_name arity
 		     Nothing     -> info
 		     Just wkr_id -> add_wkr_info us wkr_id info) }
   where
-    doc = text "Worker for" <+> ppr wkr_name
+    doc = text "Worker for" <+> ppr wkr
     add_wkr_info us wkr_id info
 	= info `setUnfoldingInfoLazily`  mk_unfolding us wkr_id
 	       `setWorkerInfo`           HasWorker wkr_id arity
@@ -905,7 +905,7 @@ tcWorkerInfo ty info wkr_name arity
 	-- before worker info,  fingers crossed ....
     strict_sig = case newStrictnessInfo info of
 		   Just sig -> sig
-		   Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr_name)
+		   Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
 \end{code}
 
 For unfoldings we try to do the job lazily, so that we never type check