From 36a3f8f330caa40380a78ff4a218199130c81ec3 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 17 Mar 2005 10:15:37 +0000
Subject: [PATCH] [project @ 2005-03-17 10:15:32 by simonpj] Buglet in
 compiling hs-boot files 	We should make GlobalIds not
 LocalIds

	Merge to STABLE
---
 ghc/compiler/typecheck/TcBinds.lhs    |   17 ++++++++---------
 ghc/compiler/typecheck/TcRnDriver.lhs |    6 ++----
 2 files changed, 10 insertions(+), 13 deletions(-)

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index b1bfc65..21ba248 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -40,11 +40,12 @@ import TcType		( TcTyVar, SkolemInfo(SigSkol),
 			  TcTauType, TcSigmaType, 
 			  mkTyVarTy, mkForAllTys, mkFunTys, tyVarsOfType, 
 			  mkForAllTy, isUnLiftedType, tcGetTyVar, 
-			  mkTyVarTys, tidyOpenTyVar, tidyOpenType )
+			  mkTyVarTys, tidyOpenTyVar )
 import Kind		( argTypeKind )
 import VarEnv		( TyVarEnv, emptyVarEnv, lookupVarEnv, extendVarEnv, emptyTidyEnv ) 
 import TysPrim		( alphaTyVar )
-import Id		( mkLocalId, mkSpecPragmaId, setInlinePragma )
+import Id		( Id, mkLocalId, mkVanillaGlobal, mkSpecPragmaId, setInlinePragma )
+import IdInfo		( vanillaIdInfo )
 import Var		( idType, idName )
 import Name		( Name )
 import NameSet
@@ -106,18 +107,16 @@ tcTopBinds binds
     glue (HsIPBinds _) 		  _		= panic "Top-level HsIpBinds"
 	-- Can't have a HsIPBinds at top level
 
-tcHsBootSigs :: [HsBindGroup Name] -> TcM (LHsBinds TcId, TcLclEnv)
+tcHsBootSigs :: [HsBindGroup Name] -> TcM [Id]
 -- A hs-boot file has only one BindGroup, and it only has type
 -- signatures in it.  The renamer checked all this
 tcHsBootSigs [HsBindGroup _ sigs _]
-  = do	{ ids <- mapM (addLocM tc_sig) (filter isVanillaLSig sigs)
-	; tcExtendIdEnv ids $ do 
-	{ env <- getLclEnv
-	; return (emptyLHsBinds, env) }}
+  = mapM (addLocM tc_boot_sig) (filter isVanillaLSig sigs)
   where
-    tc_sig (Sig (L _ name) ty)
+    tc_boot_sig (Sig (L _ name) ty)
       = do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
-	   ; return (mkLocalId name sigma_ty) }
+	   ; return (mkVanillaGlobal name sigma_ty vanillaIdInfo) }
+	-- Notice that we make GlobalIds, not LocalIds
 
 tcBindsAndThen
 	:: (HsBindGroup TcId -> thing -> thing)		-- Combinator
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index fd8cdae..84c8ec4 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -478,16 +478,14 @@ tcRnHsBootDecls decls
 
 		-- Typecheck value declarations
 	; traceTc (text "Tc5") 
-	; (tc_val_binds, lcl_env) <- tcHsBootSigs (hs_valds rn_group)
+	; new_ids <- tcHsBootSigs (hs_valds rn_group)
 
 		-- Wrap up
 		-- No simplification or zonking to do
 	; traceTc (text "Tc7a")
 	; gbl_env <- getGblEnv 
 	
-	; let { new_ids = [ id | ATcId id _ _ <- varEnvElts (tcl_env lcl_env) ]
-	      ; final_type_env = extendTypeEnvWithIds (tcg_type_env gbl_env) new_ids }
-
+	; let { final_type_env = extendTypeEnvWithIds (tcg_type_env gbl_env) new_ids }
 	; return (gbl_env { tcg_type_env = final_type_env }) 
    }}}}
 
-- 
1.7.10.4