[project @ 1998-08-14 11:29:07 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 e3648e7..a3b148e 100644 (file)
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -41,8 +41,10 @@ import IdInfo                ( IdInfo, StrictnessInfo, ArityInfo, InlinePragInfo(..), inlinePr
                          bottomIsGuaranteed, workerExists, 
                        )
 import CoreSyn         ( CoreExpr, CoreBinding, GenCoreExpr, GenCoreBinding(..) )
-import CoreUnfold      ( calcUnfoldingGuidance, UnfoldingGuidance(..), Unfolding )
-import FreeVars                ( addExprFVs )
+import CoreUnfold      ( calcUnfoldingGuidance, UnfoldingGuidance(..), Unfolding,
+                         okToUnfoldInHiFile
+                       )
+import FreeVars                ( exprFreeVars )
 import Name            ( isLocallyDefined, isWiredInName, modAndOcc, nameModule, pprOccName,
                          OccName, occNameString, nameOccName, nameString, isExported,
                          Name {-instance NamedThing-}, Provenance, NamedThing(..)
@@ -102,7 +104,7 @@ startIface mod
       Nothing -> return Nothing -- not producing any .hi file
       Just fn -> do
        if_hdl <- openFile fn WriteMode
-       hPutStrLn if_hdl ("_interface_ "++ _UNPK_ mod ++ ' ':show (PROJECTVERSION :: Int))
+       hPutStrLn if_hdl ("_interface_ "++ _UNPK_ mod ++ ' ':show (opt_HiVersion :: Int))
        return (Just if_hdl)
 
 endIface Nothing       = return ()
@@ -180,6 +182,7 @@ ifaceExports if_hdl avails
                       mod = nameModule (availName avail)
 
        -- Print one module's worth of stuff
+    do_one_module :: (Module, [AvailInfo]) -> SDoc
     do_one_module (mod_name, avails@(avail1:_))
        = hsep [pp_hif (ifaceFlavour (availName avail1)), 
                pprModule mod_name,
@@ -304,13 +307,15 @@ ifaceId get_idinfo needed_ids is_rec id rhs
 
     unfolding_is_ok
        = case inline_pragma of
-           IMustBeINLINEd    -> True
-           IWantToBeINLINEd  -> True
-           IMustNotBeINLINEd -> False
-           NoPragmaInfo      -> case guidance of
+           IMustBeINLINEd       -> definitely_ok_to_unfold
+           IWantToBeINLINEd     -> definitely_ok_to_unfold
+           IDontWantToBeINLINEd -> False
+           IMustNotBeINLINEd    -> False
+           NoPragmaInfo         -> case guidance of
                                        UnfoldNever -> False    -- Too big
-                                       other       -> True
+                                       other       -> definitely_ok_to_unfold
 
+    definitely_ok_to_unfold =  okToUnfoldInHiFile rhs
     guidance = calcUnfoldingGuidance opt_InterfaceUnfoldThreshold rhs
 
     ------------  Specialisations --------------
@@ -346,10 +351,9 @@ ifaceId get_idinfo needed_ids is_rec id rhs
 
     find_fvs expr = free_vars
                  where
-                   (_,free_vars) = addExprFVs interesting emptyIdSet expr
-                   interesting bound id = isLocallyDefined id &&
-                                          not (id `elementOfIdSet` bound) &&
-                                          not (omitIfaceSigForId id)
+                   free_vars = exprFreeVars interesting expr
+                   interesting id = isLocallyDefined id &&
+                                    not (omitIfaceSigForId id)
 \end{code}
 
 \begin{code}