[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 (file)
--- 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 (file)
--- 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