X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FClosureInfo.lhs;h=2801d453eebb3e30a8f2cf7f23bd813682fa2a43;hb=0a277a7671265265e819136280a8aec58727b364;hp=6ccd79e184f38468a6314357c887ee14bfcbcdcb;hpb=8d873902b0ba7e267089f9e1faf690368670fe62;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 6ccd79e..2801d45 100644
--- 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}