ifRec = is_rec,
ifGeneric = want_generic,
ifFamInst = mb_family })
- = do { tc_name <- lookupIfaceTop occ_name
- ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-
- { tycon <- fixM ( \ tycon -> do
+ = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+ { tc_name <- lookupIfaceTop occ_name
+ ; tycon <- fixM ( \ tycon -> do
{ stupid_theta <- tcIfaceCtxt ctxt
- ; famInst <-
- case mb_family of
- Nothing -> return Nothing
- Just (fam, tys) ->
- do { famTyCon <- tcIfaceTyCon fam
- ; insttys <- mapM tcIfaceType tys
- ; return $ Just (famTyCon, insttys)
- }
+ ; mb_fam_inst <- tcFamInst mb_family
; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
; buildAlgTyCon tc_name tyvars stupid_theta
- cons is_rec want_generic gadt_syn famInst
+ cons is_rec want_generic gadt_syn mb_fam_inst
})
- ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
- ; return (ATyCon tycon)
- }}
+ ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
+ ; return (ATyCon tycon) }
tcIfaceDecl _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
ifSynRhs = mb_rhs_ty,
ifSynKind = kind, ifFamInst = mb_family})
- = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
+ = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_kind <- tcIfaceType kind -- Note [Synonym kind loop]
; ~(rhs, fam) <- forkM (mk_doc tc_name) $
do { rhs <- tc_syn_rhs rhs_kind mb_rhs_ty
- ; fam <- tc_syn_fam mb_family
+ ; fam <- tcFamInst mb_family
; return (rhs, fam) }
; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind fam
; return $ ATyCon tycon
tc_syn_rhs kind Nothing = return (OpenSynTyCon kind Nothing)
tc_syn_rhs _ (Just ty) = do { rhs_ty <- tcIfaceType ty
; return (SynonymTyCon rhs_ty) }
- tc_syn_fam Nothing
- = return Nothing
- tc_syn_fam (Just (fam, tys))
- = do { famTyCon <- tcIfaceTyCon fam
- ; insttys <- mapM tcIfaceType tys
- ; return $ Just (famTyCon, insttys) }
tcIfaceDecl ignore_prags
(IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name,
; return (ATyCon (mkForeignTyCon name ext_name
liftedTypeKind 0)) }
+tcFamInst :: Maybe (IfaceTyCon, [IfaceType]) -> IfL (Maybe (TyCon, [Type]))
+tcFamInst Nothing = return Nothing
+tcFamInst (Just (fam, tys)) = do { famTyCon <- tcIfaceTyCon fam
+ ; insttys <- mapM tcIfaceType tys
+ ; return $ Just (famTyCon, insttys) }
+
tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons tycon_name tycon _ if_cons
= case if_cons of
bindIfaceBndrs bs $ \ bs' ->
thing_inside (b':bs')
+
-----------------------
tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
tcIfaceLetBndr (IfLetBndr fs ty info)
return (Var.mkCoVar name kind)
else
return (Var.mkTyVar name kind) }
-\end{code}
+
+bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
+-- Used for type variable in nested associated data/type declarations
+-- where some of the type variables are already in scope
+-- class C a where { data T a b }
+-- Here 'a' is in scope when we look at the 'data T'
+bindIfaceTyVars_AT [] thing_inside
+ = thing_inside []
+bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside
+ = bindIfaceTyVars_AT bs $ \ bs' ->
+ do { mb_tv <- lookupIfaceTyVar tv_occ
+ ; case mb_tv of
+ Just b' -> thing_inside (b':bs')
+ Nothing -> bindIfaceTyVar b $ \ b' ->
+ thing_inside (b':bs') }
+\end{code}