X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcIfaceSig.lhs;h=6a8e32fb93594449ea3a2cd2e064e14dad4ea733;hb=4166dff80e8ec94022a040318ff2759913fbbe06;hp=ed543f6b67eecdf07859d16ea8e3c19e496bf24b;hpb=7c068acee32d0d6e346fb71c4efaeacbf756c496;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index ed543f6..6a8e32f 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -8,7 +8,7 @@ module TcIfaceSig ( tcInterfaceSigs, tcVar, tcCoreExpr, tcCoreLamBndrs ) where
 
 #include "HsVersions.h"
 
-import HsSyn		( HsDecl(..), TyClDecl(..), HsTupCon(..) )
+import HsSyn		( TyClDecl(..), HsTupCon(..) )
 import TcMonad
 import TcMonoType	( tcHsType )
 				-- NB: all the tyars in interface files are kinded,
@@ -17,10 +17,10 @@ import TcMonoType	( tcHsType )
 
 import TcEnv		( TcEnv, RecTcEnv, tcExtendTyVarEnv, 
 			  tcExtendGlobalValEnv, tcSetEnv,
-			  tcLookupGlobal_maybe, tcLookupRecId, tcEnvIds
+			  tcLookupGlobal_maybe, tcLookupRecId_maybe
 			)
 
-import RnHsSyn		( RenamedHsDecl )
+import RnHsSyn		( RenamedTyClDecl )
 import HsCore
 import Literal		( Literal(..) )
 import CoreSyn
@@ -33,9 +33,9 @@ import Id		( Id, mkId, mkVanillaId, isDataConWrapId_maybe )
 import MkId		( mkCCallOpId )
 import IdInfo
 import DataCon		( dataConSig, dataConArgTys )
-import Type		( mkTyVarTys, splitAlgTyConApp_maybe, unUsgTy )
+import Type		( mkTyVarTys, splitAlgTyConApp_maybe )
 import Var		( mkTyVar, tyVarKind )
-import Name		( Name, isLocallyDefined )
+import Name		( Name )
 import Demand		( wwLazy )
 import ErrUtils		( pprBagOfErrors )
 import Outputable	
@@ -52,30 +52,28 @@ signatures.
 
 \begin{code}
 tcInterfaceSigs :: RecTcEnv		-- Envt to use when checking unfoldings
-		-> [RenamedHsDecl]	-- Ignore non-sig-decls in these decls
+		-> [RenamedTyClDecl]	-- Ignore non-sig-decls in these decls
 		-> TcM [Id]
 		
 
 tcInterfaceSigs unf_env decls
   = listTc [ do_one name ty id_infos src_loc
-	   | TyClD (IfaceSig name ty id_infos src_loc) <- decls]
+	   | IfaceSig name ty id_infos src_loc <- decls]
   where
     in_scope_vars = []	-- I think this will be OK
-			-- If so, don't pass it around
-			-- Was: filter isLocallyDefined (tcEnvIds unf_env)
 
     do_one name ty id_infos src_loc
       = tcAddSrcLoc src_loc 		 		$	
 	tcAddErrCtxt (ifaceSigCtxt name)		$
 	tcHsType ty					`thenTc` \ sigma_ty ->
 	tcIdInfo unf_env in_scope_vars name 
-		 sigma_ty vanillaIdInfo id_infos	`thenTc` \ id_info ->
+		 sigma_ty id_infos			`thenTc` \ id_info ->
 	returnTc (mkId name sigma_ty id_info)
 \end{code}
 
 \begin{code}
-tcIdInfo unf_env in_scope_vars name ty info info_ins
-  = foldlTc tcPrag vanillaIdInfo info_ins
+tcIdInfo unf_env in_scope_vars name ty info_ins
+  = foldlTc tcPrag constantIdInfo info_ins
   where
     tcPrag info (HsArity arity) = returnTc (info `setArityInfo`  arity)
     tcPrag info (HsNoCafRefs)   = returnTc (info `setCafInfo`	 NoCafRefs)
@@ -110,7 +108,7 @@ tcWorkerInfo unf_env ty info worker_name
   = uniqSMToTcM (mkWrapper ty arity demands res_bot cpr_info) `thenNF_Tc` \ wrap_fn ->
     let
 	-- Watch out! We can't pull on unf_env too eagerly!
-	info' = case tcLookupRecId unf_env worker_name of
+	info' = case tcLookupRecId_maybe unf_env worker_name of
 		  Just worker_id -> info `setUnfoldingInfo`  mkTopUnfolding (wrap_fn worker_id)
                                          `setWorkerInfo`     HasWorker worker_id arity
 
@@ -212,7 +210,7 @@ tcCoreExpr (UfTuple (HsTupCon name _) args)
     mapTc tcCoreExpr args	`thenTc` \ args' ->
     let
 	-- Put the missing type arguments back in
-	con_args = map (Type . unUsgTy . exprType) args' ++ args'
+	con_args = map (Type . exprType) args' ++ args'
     in
     returnTc (mkApps (Var con_id) con_args)
 
@@ -254,8 +252,8 @@ tcCoreExpr (UfNote note expr)
   = tcCoreExpr expr		`thenTc` \ expr' ->
     case note of
 	UfCoerce to_ty -> tcHsType to_ty	`thenTc` \ to_ty' ->
-			  returnTc (Note (Coerce (unUsgTy to_ty')
-                                                 (unUsgTy (exprType expr'))) expr')
+			  returnTc (Note (Coerce to_ty'
+                                                 (exprType expr')) expr')
 	UfInlineCall   -> returnTc (Note InlineCall expr')
 	UfInlineMe     -> returnTc (Note InlineMe   expr')
 	UfSCC cc       -> returnTc (Note (SCC cc)   expr')