X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=21332fa8b583f6ce515472cd6a08a3246c3e4563;hb=14a3631d5b7a49fef47a221f548dc7d021810de9;hp=599762e9962e8409c7a61dc618dbcf6c25a6e33a;hpb=b360db770ca5e147066b7647b225208d531a6eaf;p=ghc-hetmet.git

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 599762e..21332fa 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -35,6 +35,8 @@ import HscTypes		( ModIface(..), TyThing, IfaceExport, Usage(..),
 import BasicTypes	( Version, initialVersion,
 			  Fixity(..), FixityDirection(..), isMarkedStrict )
 import TcRnMonad
+import Type             ( TyThing(..) )
+import Class		( classATs )
 
 import PrelNames	( gHC_PRIM )
 import PrelInfo		( ghcPrimExports )
@@ -47,9 +49,9 @@ import NameEnv
 import MkId		( seqId )
 import Module
 import OccName		( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc,
-                          mkClassDataConOcc, mkSuperDictSelOcc,
-                          mkDataConWrapperOcc, mkDataConWorkerOcc,
-                          mkNewTyCoOcc )
+			  mkClassDataConOcc, mkSuperDictSelOcc,
+			  mkDataConWrapperOcc, mkDataConWorkerOcc,
+			  mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc ) 
 import SrcLoc		( importedSrcLoc )
 import Maybes		( MaybeErr(..) )
 import ErrUtils         ( Message )
@@ -62,6 +64,7 @@ import BinIface		( readBinIface, v_IgnoreHiWay )
 import Binary		( getBinFileWithDict )
 import Panic		( ghcError, tryMost, showException, GhcException(..) )
 import List		( nub )
+import Maybe            ( isJust )
 import DATA_IOREF	( writeIORef )
 \end{code}
 
@@ -269,6 +272,10 @@ badDepMsg mod
 -- each binder with the right package info in it
 -- All subsequent lookups, including crucially lookups during typechecking
 -- the declaration itself, will find the fully-glorious Name
+--
+-- We handle ATs specially.  They are not main declarations, but also not
+-- implict things (in particular, adding them to `implicitTyThings' would mess
+-- things up in the renaming/type checking of source programs).
 -----------------------------------------------------
 
 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
@@ -292,7 +299,8 @@ loadDecl ignore_prags mod (_version, decl)
   = do 	{ 	-- Populate the name cache with final versions of all 
 		-- the names associated with the decl
 	  main_name      <- mk_new_bndr mod Nothing (ifName decl)
-	; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
+	; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) 
+				 (ifaceDeclSubBndrs decl)
 
 	-- Typecheck the thing, lazily
 	-- NB. firstly, the laziness is there in case we never need the
@@ -304,9 +312,12 @@ loadDecl ignore_prags mod (_version, decl)
 	; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
 	      lookup n = case lookupOccEnv mini_env (getOccName n) of
 			   Just thing -> thing
-			   Nothing    -> pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (stripped_decl) )
+			   Nothing    -> 
+			     pprPanic "loadDecl" (ppr main_name <+> 
+						  ppr n $$ ppr (stripped_decl))
 
-	; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
+	; returnM $ (main_name, thing) :  [(n, lookup n) | n <- implicit_names]
+	}
 		-- We build a list from the *known* names, with (lookup n) thunks
 		-- as the TyThings.  That way we can extend the PTE without poking the
 		-- thunks
@@ -345,12 +356,12 @@ ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 --
 -- If you change this, make sure you change HscTypes.implicitTyThings in sync
 
-ifaceDeclSubBndrs IfaceClass { ifCtxt = sc_ctxt, 
-                               ifName = cls_occ, 
-                               ifSigs = sigs }
+ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, 
+			       ifSigs = sigs, ifATs = ats })
   = co_occs ++
     [tc_occ, dc_occ, dcww_occ] ++
-    [op | IfaceClassOp op _ _ <- sigs] ++
+    [op | IfaceClassOp op  _ _ <- sigs] ++
+    [ifName at | at <- ats ] ++
     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] 
   where
     n_ctxt = length sc_ctxt
@@ -359,7 +370,7 @@ ifaceDeclSubBndrs IfaceClass { ifCtxt = sc_ctxt,
     dc_occ  = mkClassDataConOcc cls_occ	
     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
 	    | otherwise  = []
-    dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ	-- Newtypes have wrapper but no worker
+    dcww_occ -- | is_newtype = mkDataConWrapperOcc dc_occ	-- Newtypes have wrapper but no worker
 	     | otherwise  = mkDataConWorkerOcc dc_occ	-- Otherwise worker but no wrapper
     is_newtype = n_sigs + n_ctxt == 1			-- Sigh 
 
@@ -369,13 +380,18 @@ ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 			      ifCons = IfNewTyCon (
 				         IfCon { ifConOcc = con_occ, 
-						 ifConFields = fields})})
-  = fields ++ [con_occ, mkDataConWrapperOcc con_occ, mkNewTyCoOcc tc_occ]
-	-- Wrapper, no worker; see MkId.mkDataConIds
+							   ifConFields = fields
+							 }),
+			      ifFamInst = famInst}) 
+  = fields ++ [con_occ, mkDataConWorkerOcc con_occ, mkNewTyCoOcc tc_occ]
+    ++ famInstCo famInst tc_occ
 
-ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
+ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
+			      ifCons = IfDataTyCon cons, 
+			      ifFamInst = famInst})
   = nub (concatMap ifConFields cons) 	-- Eliminate duplicate fields
     ++ concatMap dc_occs cons
+    ++ famInstCo famInst tc_occ
   where
     dc_occs con_decl
 	| has_wrapper = [con_occ, work_occ, wrap_occ]
@@ -386,9 +402,16 @@ ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
 	  wrap_occ = mkDataConWrapperOcc con_occ
 	  work_occ = mkDataConWorkerOcc con_occ
 	  has_wrapper = any isMarkedStrict strs	-- See MkId.mkDataConIds (sigh)
+			|| not (null . ifConEqSpec $ con_decl)
+			|| isJust famInst
 		-- ToDo: may miss strictness in existential dicts
 
 ifaceDeclSubBndrs _other = []
+
+-- coercion for data/newtype family instances
+famInstCo Nothing              baseOcc = []
+famInstCo (Just (_, _, index)) baseOcc = [mkInstTyTcOcc index baseOcc,
+				          mkInstTyCoOcc index baseOcc]
 \end{code}