ATs are now implicitTyThings

Mon Sep 18 19:36:03 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * ATs are now implicitTyThings
  Tue Sep  5 21:09:54 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * ATs are now implicitTyThings

compiler/iface/LoadIface.lhs

@@ -301,7 +301,6 @@ loadDecl ignore_prags mod (_version, decl)
 	  main_name      <- mk_new_bndr mod Nothing (ifName decl)
 	; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) 
 				 (ifaceDeclSubBndrs decl)
-        ; at_names       <- mapM (mk_new_bndr mod  (Just main_name)) (atNames decl)
 
 	-- Typecheck the thing, lazily
 	-- NB. firstly, the laziness is there in case we never need the
@@ -318,7 +317,6 @@ loadDecl ignore_prags mod (_version, decl)
 						  ppr n $$ ppr (stripped_decl))
 
 	; returnM $ (main_name, thing) :  [(n, lookup n) | n <- implicit_names]
-				       ++ zip at_names (atThings thing)
 	}
 		-- 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
@@ -337,12 +335,6 @@ loadDecl ignore_prags mod (_version, decl)
 			  (importedSrcLoc (showSDoc (ppr (moduleName mod))))
 			-- ToDo: qualify with the package name if necessary
 
-    atNames (IfaceClass {ifATs = ats}) = [ifName at | at <- ats]
-    atNames _                          = []
-
-    atThings (AClass cla) = [ATyCon at | at <- classATs cla]
-    atThings _            = []
-
     doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
 
 discardDeclPrags :: IfaceDecl -> IfaceDecl
@@ -364,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

compiler/main/HscTypes.lhs

@@ -82,7 +82,7 @@ import CoreSyn		( CoreBind )
 import Id		( Id )
 import Type		( TyThing(..) )
 
-import Class		( Class, classSelIds, classTyCon )
+import Class		( Class, classSelIds, classATs, classTyCon )
 import TyCon		( TyCon, tyConSelIds, tyConDataCons, isNewTyCon,
 			  newTyConCo_maybe, tyConFamilyCoercion_maybe )
 import DataCon		( dataConImplicitIds )
@@ -634,10 +634,11 @@ implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
 					 (tyConDataCons tc)
 		     
 	-- For classes, add the class TyCon too (and its extras)
-	-- and the class selector Ids
+	-- and the class selector Ids and the associated types (they don't
+	-- have extras as these are only the family decls)
 implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
+			       map ATyCon (classATs cl) ++
 			       extras_plus (ATyCon (classTyCon cl))
-			 
 
 	-- For data cons add the worker and wrapper (if any)
 implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)

compiler/typecheck/TcTyClsDecls.lhs

@@ -213,12 +213,20 @@ tcTyAndClassDecls boot_details allDecls
 	-- Add the implicit things;
 	-- we want them in the environment because 
 	-- they may be mentioned in interface files
+	-- NB: All associated types and their implicit things will be added a
+	--     second time here.  This doesn't matter as the definitions are
+	--     the same.
 	; let {	implicit_things = concatMap implicitTyThings alg_tyclss }
 	; traceTc ((text "Adding" <+> ppr alg_tyclss) 
 		   $$ (text "and" <+> ppr implicit_things))
   	; tcExtendGlobalEnv implicit_things getGblEnv
     }}
   where
+    -- Pull associated types out of class declarations, to tie them into the
+    -- knot above.  
+    -- NB: We put them in the same place in the list as `tcTyClDecl' will
+    --	   eventually put the matching `TyThing's.  That's crucial; otherwise,
+    --	   the two argument lists of `mkGlobalThings' don't match up.
     addATs decl@(L _ (ClassDecl {tcdATs = ats})) = decl : ats
     addATs decl				         = [decl]