[project @ 2001-09-12 11:05:34 by qrczak]

[ghc-hetmet.git] / ghc / compiler / codeGen / ClosureInfo.lhs

diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 6ccd79e..2801d45 100644 (file)
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: ClosureInfo.lhs,v 1.43 2000/07/14 08:14:53 simonpj Exp $
+% $Id: ClosureInfo.lhs,v 1.47 2001/05/22 13:43:15 simonpj Exp $
 %
 \section[ClosureInfo]{Data structures which describe closures}
 
@@ -79,14 +79,12 @@ import CLabel               ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
 import CmdLineOpts     ( opt_SccProfilingOn, opt_OmitBlackHoling,
                          opt_Parallel, opt_DoTickyProfiling,
                          opt_SMP )
-import Id              ( Id, idType, idArityInfo )
+import Id              ( Id, idType, idCgArity )
 import DataCon         ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
                          isNullaryDataCon, dataConName
                        )
 import TyCon           ( isBoxedTupleTyCon )
-import IdInfo          ( ArityInfo(..) )
-import Name            ( Name, isExternallyVisibleName, nameUnique, 
-                         getOccName )
+import Name            ( Name, nameUnique, getOccName )
 import OccName         ( occNameUserString )
 import PprType         ( getTyDescription )
 import PrimRep         ( getPrimRepSize, separateByPtrFollowness, PrimRep )
@@ -262,16 +260,11 @@ mkLFLetNoEscape = LFLetNoEscape
 
 mkLFImported :: Id -> LambdaFormInfo
 mkLFImported id
-  = case idArityInfo id of
-      ArityExactly 0   -> LFThunk (idType id)
-                               TopLevel True{-no fvs-}
-                               True{-updatable-} NonStandardThunk
-                               (error "mkLFImported: no srt label") 
-                               (error "mkLFImported: no srt")
-      ArityExactly n   -> LFReEntrant (idType id) TopLevel n True  -- n > 0
-                               (error "mkLFImported: no srt label") 
-                               (error "mkLFImported: no srt")
-      other            -> LFImported   -- Not sure of exact arity
+  = case idCgArity id of
+      n | n > 0 -> LFReEntrant (idType id) TopLevel n True  -- n > 0
+                      (error "mkLFImported: no srt label") 
+                      (error "mkLFImported: no srt")
+      other -> LFImported      -- Not sure of exact arity
 \end{code}
 
 %************************************************************************
@@ -686,7 +679,7 @@ getEntryConvention name lf_info arg_kinds
          -> StdEntry (mkReturnPtLabel (nameUnique name))
 
        LFLetNoEscape arity
-         -> ASSERT(arity == length arg_kinds)
+         -> if (arity /= length arg_kinds) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
             DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
         where
            (arg_regs, _) = assignRegs [] arg_kinds
@@ -830,13 +823,11 @@ staticClosureRequired
        -> StgBinderInfo
        -> LambdaFormInfo
        -> Bool
-staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
+staticClosureRequired binder bndr_info
                      (LFReEntrant _ top_level _ _ _ _) -- It's a function
   = ASSERT( isTopLevel top_level )
        -- Assumption: it's a top-level, no-free-var binding
-    arg_occ            -- There's an argument occurrence
-    || unsat_occ       -- There's an unsaturated call
-    || isExternallyVisibleName binder
+       not (satCallsOnly bndr_info)
 
 staticClosureRequired binder other_binder_info other_lf_info = True
 
@@ -845,27 +836,20 @@ slowFunEntryCodeRequired  -- Assumption: it's a function, not a thunk.
        -> StgBinderInfo
        -> EntryConvention
        -> Bool
-slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
-  = arg_occ            -- There's an argument occurrence
-    || unsat_occ       -- There's an unsaturated call
-    || isExternallyVisibleName binder
+slowFunEntryCodeRequired binder bndr_info entry_conv
+  =    not (satCallsOnly bndr_info)
     || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
            {- The last case deals with the parallel world; a function usually
               as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
 
-slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
-
 funInfoTableRequired
        :: Name
        -> StgBinderInfo
        -> LambdaFormInfo
        -> Bool
-funInfoTableRequired  binder (StgBinderInfo arg_occ unsat_occ _ _ _)
-                    (LFReEntrant _ top_level _ _ _ _)
+funInfoTableRequired binder bndr_info (LFReEntrant _ top_level _ _ _ _)
   =    isNotTopLevel top_level
-    || arg_occ                 -- There's an argument occurrence
-    || unsat_occ       -- There's an unsaturated call
-    || isExternallyVisibleName binder
+    || not (satCallsOnly bndr_info)
 
 funInfoTableRequired other_binder_info binder other_lf_info = True
 \end{code}
@@ -925,13 +909,6 @@ isToplevClosure (MkClosureInfo _ lf_info _)
       other -> False
 \end{code}
 
-\begin{code}
-isLetNoEscape :: ClosureInfo -> Bool
-
-isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
-isLetNoEscape _ = False
-\end{code}
-
 Label generation.
 
 \begin{code}