X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FTcIface.lhs;h=7e6406fe710c176aacedea08bea843ea0caf4a6f;hb=fe3321f99f4d9c9ff40429a7ac290f8ef7ca3297;hp=6f76ae116ea23197e32ec271857abf6e635f9fc8;hpb=098f818b622e5095fbd3f6318a463fcb2ce14fc6;p=ghc-hetmet.git diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 6f76ae1..7e6406f 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -105,6 +105,7 @@ tcImportDecl :: Name -> TcM TyThing tcImportDecl name | Just thing <- wiredInNameTyThing_maybe name = do { initIfaceTcRn (loadWiredInHomeIface name) + -- See Note [Loading instances] in LoadIface ; return thing } | otherwise = do { traceIf (text "tcImportDecl" <+> ppr name) @@ -115,7 +116,8 @@ tcImportDecl name checkWiredInTyCon :: TyCon -> TcM () -- Ensure that the home module of the TyCon (and hence its instances) --- are loaded. It might not be a wired-in tycon (see the calls in TcUnify), +-- are loaded. See See Note [Loading instances] in LoadIface +-- It might not be a wired-in tycon (see the calls in TcUnify), -- in which case this is a no-op. checkWiredInTyCon tc | not (isWiredInName tc_name) @@ -383,14 +385,21 @@ tcIfaceDecl ignore_prags tcIfaceDecl ignore_prags (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, - ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty}) + ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty, + ifFamInst = mb_family}) = bindIfaceTyVars tv_bndrs $ \ tyvars -> do { tc_name <- lookupIfaceTop occ_name ; rhs_tyki <- tcIfaceType rdr_rhs_ty ; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing else SynonymTyCon rhs_tyki - -- !!!TODO: read mb_family info from iface and pass as last argument - ; tycon <- buildSynTyCon tc_name tyvars rhs Nothing + ; famInst <- case mb_family of + Nothing -> return Nothing + Just (fam, tys) -> + do { famTyCon <- tcIfaceTyCon fam + ; insttys <- mapM tcIfaceType tys + ; return $ Just (famTyCon, insttys) + } + ; tycon <- buildSynTyCon tc_name tyvars rhs famInst ; return $ ATyCon tycon } @@ -447,7 +456,6 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons = case if_cons of IfAbstractTyCon -> return mkAbstractTyConRhs IfOpenDataTyCon -> return mkOpenDataTyConRhs - IfOpenNewTyCon -> return mkOpenNewTyConRhs IfDataTyCon cons -> do { data_cons <- mappM tc_con_decl cons ; return (mkDataTyConRhs data_cons) } IfNewTyCon con -> do { data_con <- tc_con_decl con @@ -491,7 +499,7 @@ tcIfaceEqSpec spec do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ) ; ty <- tcIfaceType if_ty ; return (tv,ty) } -\end{code} +\end{code} %************************************************************************ @@ -584,24 +592,78 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd \begin{code} tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo -tcIfaceVectInfo mod typeEnv (IfaceVectInfo names) - = do { ccVars <- mapM ccMapping names - ; return $ VectInfo (mkVarEnv ccVars) +tcIfaceVectInfo mod typeEnv (IfaceVectInfo + { ifaceVectInfoCCVar = vars + , ifaceVectInfoCCTyCon = tycons + , ifaceVectInfoCCTyConReuse = tyconsReuse + }) + = do { ccVars <- mapM ccVarMapping vars + ; tyConRes1 <- mapM ccTyConMapping tycons + ; tyConRes2 <- mapM ccTyConReuseMapping tycons + ; let (ccTyCons, ccDataCons, ccIsos) = unzip3 (tyConRes1 ++ tyConRes2) + ; return $ VectInfo + { vectInfoCCVar = mkVarEnv ccVars + , vectInfoCCTyCon = mkNameEnv ccTyCons + , vectInfoCCDataCon = mkNameEnv (concat ccDataCons) + , vectInfoCCIso = mkNameEnv ccIsos + } } where - ccMapping name + ccVarMapping name = do { ccName <- lookupOrig mod (mkCloOcc (nameOccName name)) - ; let { var = lookup name - ; ccVar = lookup ccName + ; let { var = lookupVar name + ; ccVar = lookupVar ccName } ; return (var, (var, ccVar)) } - lookup name = case lookupTypeEnv typeEnv name of - Just (AnId var) -> var - Just _ -> - panic "TcIface.tcIfaceVectInfo: wrong TyThing" - Nothing -> - panic "TcIface.tcIfaceVectInfo: unknown name" + ccTyConMapping name + = do { ccName <- lookupOrig mod (mkCloTyConOcc (nameOccName name)) + ; isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name)) + ; let { tycon = lookupTyCon name + ; ccTycon = lookupTyCon ccName + ; isoTycon = lookupVar isoName + } + ; ccDataCons <- mapM ccDataConMapping (tyConDataCons tycon) + ; return ((name, (tycon, ccTycon)), -- (T, T_CC) + ccDataCons, -- list of (Ci, Ci_CC) + (name, (tycon, isoTycon))) -- (T, isoT) + } + ccTyConReuseMapping name + = do { isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name)) + ; let { tycon = lookupTyCon name + ; isoTycon = lookupVar isoName + ; ccDataCons = [ (dataConName dc, (dc, dc)) + | dc <- tyConDataCons tycon] + } + ; return ((name, (tycon, tycon)), -- (T, T) + ccDataCons, -- list of (Ci, Ci) + (name, (tycon, isoTycon))) -- (T, isoT) + } + ccDataConMapping datacon + = do { let name = dataConName datacon + ; ccName <- lookupOrig mod (mkCloDataConOcc (nameOccName name)) + ; let ccDataCon = lookupDataCon ccName + ; return (name, (datacon, ccDataCon)) + } + -- + lookupVar name = case lookupTypeEnv typeEnv name of + Just (AnId var) -> var + Just _ -> + panic "TcIface.tcIfaceVectInfo: not an id" + Nothing -> + panic "TcIface.tcIfaceVectInfo: unknown name" + lookupTyCon name = case lookupTypeEnv typeEnv name of + Just (ATyCon tc) -> tc + Just _ -> + panic "TcIface.tcIfaceVectInfo: not a tycon" + Nothing -> + panic "TcIface.tcIfaceVectInfo: unknown name" + lookupDataCon name = case lookupTypeEnv typeEnv name of + Just (ADataCon dc) -> dc + Just _ -> + panic "TcIface.tcIfaceVectInfo: not a datacon" + Nothing -> + panic "TcIface.tcIfaceVectInfo: unknown name" \end{code} %************************************************************************ @@ -931,6 +993,7 @@ ifCheckWiredInThing :: Name -> IfL () -- Even though we are in an interface file, we want to make -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double) -- Ditto want to ensure that RULES are loaded too +-- See Note [Loading instances] in LoadIface ifCheckWiredInThing name = do { mod <- getIfModule -- Check whether we are typechecking the interface for this @@ -1032,7 +1095,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info) newExtCoreBndr :: IfaceLetBndr -> IfL Id newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now = do { mod <- getIfModule - ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcLoc + ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan ; ty' <- tcIfaceType ty ; return (mkLocalId name ty') }