Commit 14a3631d authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

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
parent d76c18e0
......@@ -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
......
......@@ -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)
......
......@@ -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]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment