[project @ 1999-07-31 18:40:27 by sof]

[ghc-hetmet.git] / ghc / compiler / main / MkIface.lhs

diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 0766eea..e823e47 100644 (file)
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -19,7 +19,6 @@ import RnMonad
 import RnEnv           ( availName )
 
 import TcInstUtil      ( InstInfo(..) )
-import WorkWrap                ( getWorkerId )
 
 import CmdLineOpts
 import Id              ( Id, idType, idInfo, omitIfaceSigForId, isUserExportedId,
@@ -30,10 +29,10 @@ import VarSet
 import DataCon         ( StrictnessMark(..), dataConSig, dataConFieldLabels, dataConStrictMarks )
 import IdInfo          ( IdInfo, StrictnessInfo, ArityInfo, InlinePragInfo(..), inlinePragInfo,
                          arityInfo, ppArityInfo, 
-                         strictnessInfo, ppStrictnessInfo, 
+                         strictnessInfo, ppStrictnessInfo, isBottomingStrictness,
                          cafInfo, ppCafInfo, specInfo,
                          cprInfo, ppCprInfo,
-                         workerExists, workerInfo, isBottomingStrictness
+                         workerExists, workerInfo, ppWorkerInfo
                        )
 import CoreSyn         ( CoreExpr, CoreBind, Bind(..), rulesRules, rulesRhsFreeVars )
 import CoreFVs         ( exprSomeFreeVars, ruleSomeLhsFreeVars, ruleSomeFreeVars )
@@ -293,7 +292,8 @@ ifaceId get_idinfo needed_ids is_rec id rhs
 ifaceId get_idinfo needed_ids is_rec id rhs
   = Just (hsep [sig_pretty, prag_pretty, char ';'], new_needed_ids)
   where
-    idinfo         = get_idinfo id
+    core_idinfo = idInfo id
+    stg_idinfo  = get_idinfo id
 
     ty_pretty  = pprType (idType id)
     sig_pretty = hsep [ppr (getOccName id), dcolon, ty_pretty]
@@ -304,43 +304,40 @@ ifaceId get_idinfo needed_ids is_rec id rhs
                                        arity_pretty, 
                                        caf_pretty,
                                        cpr_pretty,
-                                       strict_pretty, 
+                                       strict_pretty,
+                                       wrkr_pretty,
                                        unfold_pretty, 
                                        ptext SLIT("##-}")]
 
     ------------  Arity  --------------
-    arity_pretty  = ppArityInfo (arityInfo idinfo)
+    arity_pretty  = ppArityInfo (arityInfo stg_idinfo)
 
     ------------ Caf Info --------------
-    caf_pretty = ppCafInfo (cafInfo idinfo)
+    caf_pretty = ppCafInfo (cafInfo stg_idinfo)
 
     ------------ CPR Info --------------
-    cpr_pretty = ppCprInfo (cprInfo idinfo)
+    cpr_pretty = ppCprInfo (cprInfo core_idinfo)
 
-    ------------  Strictness and Worker  --------------
-    strict_info   = strictnessInfo idinfo
-    work_info     = workerInfo idinfo
-    has_worker    = workerExists work_info
+    ------------  Strictness  --------------
+    strict_info   = strictnessInfo core_idinfo
     bottoming_fn  = isBottomingStrictness strict_info
-    strict_pretty = ppStrictnessInfo strict_info <+> wrkr_pretty
+    strict_pretty = ppStrictnessInfo strict_info
 
-    wrkr_pretty | not has_worker = empty
-               | otherwise      = ppr work_id
+    ------------  Worker  --------------
+    work_info     = workerInfo core_idinfo
+    has_worker    = workerExists work_info
+    wrkr_pretty   = ppWorkerInfo work_info
+    Just work_id  = work_info
 
---    (Just work_id) = work_info
--- Temporary fix.  We can't use the worker id saved by the w/w
--- pass because later optimisations may have changed it.  So try
--- to snaffle from the wrapper code again ...
-    work_id    = getWorkerId id rhs
 
     ------------  Unfolding  --------------
-    inline_pragma  = inlinePragInfo idinfo
+    inline_pragma  = inlinePragInfo core_idinfo
     dont_inline           = case inline_pragma of
                        IMustNotBeINLINEd -> True
                        IAmALoopBreaker   -> True
                        other             -> False
 
-    unfold_pretty | show_unfold = ptext SLIT("__u") <+> pprIfaceUnfolding rhs
+    unfold_pretty | show_unfold = ptext SLIT("__U") <+> pprIfaceUnfolding rhs
                  | otherwise   = empty
 
     show_unfold = not has_worker        &&     -- Not unnecessary
@@ -352,7 +349,7 @@ ifaceId get_idinfo needed_ids is_rec id rhs
     rhs_is_small = couldBeSmallEnoughToInline (calcUnfoldingGuidance opt_UF_HiFileThreshold rhs)
 
     ------------  Specialisations --------------
-    spec_info   = specInfo idinfo
+    spec_info   = specInfo core_idinfo
     
     ------------  Extra free Ids  --------------
     new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet