From 5e65c9fef4d73b3109ea9b1063f0e14850ae9af1 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 15 Oct 2001 16:03:04 +0000
Subject: [PATCH] [project @ 2001-10-15 16:03:04 by simonpj]
 -------------------------- 	Tidy up arity propagation
 (the saga continues) 	--------------------------

Turns out that it's not as easy as I thought.

The code generator was assuming that (not . isLocalName) was enough to
identify an imported thing (whose CgInfo should be right), but that's
not true.  Needs more thought.

Meanwhile, I've made the code generator a bit more sensible about how
it looks things up.  But there's still a problem for GHCi: the
unfoldings in the TypeEnv won't have CgIdInfo stuff.  Sigh.  Thinks.
---
 ghc/compiler/codeGen/CgBindery.lhs |   51 ++++++++++++++++++++----------------
 ghc/compiler/codeGen/CgMonad.lhs   |    4 +--
 2 files changed, 30 insertions(+), 25 deletions(-)

diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index 3ecb56f..bf11d6a 100644
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -43,7 +43,7 @@ import Type		( typePrimRep )
 import VarEnv
 import VarSet		( varSetElems )
 import Literal		( Literal )
-import Maybes		( catMaybes, maybeToBool )
+import Maybes		( catMaybes, maybeToBool, seqMaybe )
 import Name		( isLocalName, NamedThing(..) )
 #ifdef DEBUG
 import PprAbsC		( pprAmode )
@@ -194,22 +194,26 @@ modifyBindC name mangle_fn = do
 	setBinds $ modifyVarEnv mangle_fn binds name
 
 lookupBindC :: Id -> FCode CgIdInfo
-lookupBindC name = do
-	static_binds <- getStaticBinds
-	local_binds <- getBinds
-	case (lookupVarEnv local_binds name) of
-		Nothing -> case (lookupVarEnv static_binds name) of
-			Nothing -> cgPanic (text "lookupBindC: no info for" <+> ppr name)
-			Just this -> return this
-		Just this -> return this
+lookupBindC id = do maybe_info <- lookupBindC_maybe id
+		    case maybe_info of
+		      Just info -> return info
+		      Nothing   -> cgLookupPanic id
+
+lookupBindC_maybe :: Id -> FCode (Maybe CgIdInfo)
+lookupBindC_maybe id
+  = do	static_binds <- getStaticBinds
+	local_binds  <- getBinds
+	return (lookupVarEnv local_binds id
+			`seqMaybe`
+		lookupVarEnv static_binds id)
 			
-cgPanic :: SDoc -> FCode a
-cgPanic doc = do
-	static_binds <- getStaticBinds
+cgLookupPanic :: Id -> FCode a
+cgLookupPanic id
+  = do	static_binds <- getStaticBinds
 	local_binds <- getBinds
 	srt <- getSRTLabel
 	pprPanic "cgPanic"
-		(vcat [doc,
+		(vcat [ppr id,
 		ptext SLIT("static binds for:"),
 		vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ],
 		ptext SLIT("local binds for:"),
@@ -250,16 +254,17 @@ I {\em think} all looking-up is done through @getCAddrMode(s)@.
 getCAddrModeAndInfo :: Id -> FCode (Id, CAddrMode, LambdaFormInfo)
 
 getCAddrModeAndInfo id
-  | not (isLocalName name)
-  = returnFC (id, global_amode, mkLFImported id)
-	-- deals with imported or locally defined but externally visible ids
-	-- (CoreTidy makes all these into global names).
-
-  | otherwise = do -- *might* be a nested defn: in any case, it's something whose
-		-- definition we will know about...
-	(MkCgIdInfo id' volatile_loc stable_loc lf_info) <- lookupBindC id
-	amode <- idInfoPiecesToAmode kind volatile_loc stable_loc
-	return (id', amode, lf_info)
+  = do
+	maybe_cg_id_info <- lookupBindC_maybe id
+	case maybe_cg_id_info of
+
+		-- Nothing => not in the environment, so should be imported
+	  Nothing | isLocalName name -> cgLookupPanic id
+		  | otherwise	     -> returnFC (id, global_amode, mkLFImported id)
+
+	  Just (MkCgIdInfo id' volatile_loc stable_loc lf_info)
+		  -> do amode <- idInfoPiecesToAmode kind volatile_loc stable_loc
+			return (id', amode, lf_info)
   where
     name = getName id
     global_amode = CLbl (mkClosureLabel name) kind
diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index 780db64..3b918f6 100644
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgMonad.lhs,v 1.30 2001/09/26 15:11:50 simonpj Exp $
+% $Id: CgMonad.lhs,v 1.31 2001/10/15 16:03:04 simonpj Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -280,7 +280,7 @@ initC :: CompilationInfo -> Code -> AbstractC
 initC cg_info (FCode code)
   = case (code (MkCgInfoDown 
 			cg_info 
-			(error "initC: statics")
+			emptyVarEnv -- (error "initC: statics")
 			(error "initC: srt")
 			(mkTopTickyCtrLabel)
 			initEobInfo)
-- 
1.7.10.4