X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcIfaceSig.lhs;fp=ghc%2Fcompiler%2Ftypecheck%2FTcIfaceSig.lhs;h=4b3499075b17753ebf87baeb3d32eb6821d01a7e;hb=19108ede05d6528d0b66edb2bcf031e8da9522e2;hp=4956bdbf99368e40c5d000ef08c5f954d2ebeb21;hpb=1b2e253b3463f6d57d0741b46f7d20ef7ba8f361;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index 4956bdb..4b34990 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -28,7 +28,7 @@ import CoreUnfold
 import CoreLint		( lintUnfolding )
 import WorkWrap		( mkWrapper )
 
-import Id		( Id, mkVanillaGlobal, mkLocalId )
+import Id		( Id, mkVanillaGlobal, mkLocalId, idInfo )
 import MkId		( mkFCallId )
 import IdInfo
 import TyCon		( tyConDataCons, tyConTyVars )
@@ -55,7 +55,10 @@ signatures.
 tcInterfaceSigs :: [RenamedTyClDecl]	-- Ignore non-sig-decls in these decls
 		-> TcM TcGblEnv
 		
-tcInterfaceSigs decls = fixM (tc_interface_sigs decls)
+tcInterfaceSigs decls = 
+  zapEnv (fixM (tc_interface_sigs decls)) `thenM` \ (_,sig_ids) ->
+  tcExtendGlobalValEnv sig_ids getGblEnv  `thenM` \ gbl_env ->
+  returnM gbl_env
 	-- We tie a knot so that the Ids read out of interfaces are in scope
 	--   when we read their pragmas.
 	-- What we rely on is that pragmas are typechecked lazily; if
@@ -86,10 +89,10 @@ tcInterfaceSigs decls = fixM (tc_interface_sigs decls)
 	-- bound in this module (and hence not yet processed).
 	-- The discarding happens when forkM finds a type error.
 
-tc_interface_sigs decls unf_env 
+tc_interface_sigs decls ~(unf_env, _)
   = sequenceM [do_one d | d@(IfaceSig {}) <- decls]	`thenM` \ sig_ids ->
-    tcExtendGlobalValEnv sig_ids getGblEnv
-	-- Return the extended environment
+    tcExtendGlobalValEnv sig_ids getGblEnv		`thenM` \ gbl_env ->
+    returnM (gbl_env, sig_ids)
   where
     in_scope_vars = typeEnvIds (tcg_type_env unf_env)
 	-- When we have hi-boot files, an unfolding might refer to
@@ -116,7 +119,7 @@ tcIdInfo unf_env in_scope_vars name ty info_ins
   where
     -- Set the CgInfo to something sensible but uninformative before
     -- we start; default assumption is that it has CAFs
-    init_info = hasCafIdInfo
+    init_info = vanillaIdInfo
 
     tcPrag info HsNoCafRefs         = returnM (info `setCafInfo`   NoCafRefs)
     tcPrag info (HsArity arity)     = returnM (info `setArityInfo` arity)