X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FTcIface.lhs;h=7416a5f0d886c236937512ae11659a892aab4ec1;hb=b0c46848af7e431a2898af1a8aa1fbb0d2499137;hp=6f76ae116ea23197e32ec271857abf6e635f9fc8;hpb=098f818b622e5095fbd3f6318a463fcb2ce14fc6;p=ghc-hetmet.git diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 6f76ae1..7416a5f 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 + { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse + }) + = do { vVars <- mapM vectVarMapping vars + ; tyConRes1 <- mapM vectTyConMapping tycons + ; tyConRes2 <- mapM vectTyConReuseMapping tycons + ; let (vTyCons, vDataCons, vIsos) = unzip3 (tyConRes1 ++ tyConRes2) + ; return $ VectInfo + { vectInfoVar = mkVarEnv vVars + , vectInfoTyCon = mkNameEnv vTyCons + , vectInfoDataCon = mkNameEnv (concat vDataCons) + , vectInfoIso = mkNameEnv vIsos + } } where - ccMapping name - = do { ccName <- lookupOrig mod (mkCloOcc (nameOccName name)) - ; let { var = lookup name - ; ccVar = lookup ccName + vectVarMapping name + = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name)) + ; let { var = lookupVar name + ; vVar = lookupVar vName + } + ; return (var, (var, vVar)) + } + vectTyConMapping name + = do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name)) + ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name)) + ; let { tycon = lookupTyCon name + ; vTycon = lookupTyCon vName + ; isoTycon = lookupVar isoName + } + ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon) + ; return ((name, (tycon, vTycon)), -- (T, T_v) + vDataCons, -- list of (Ci, Ci_v) + (name, (tycon, isoTycon))) -- (T, isoT) + } + vectTyConReuseMapping name + = do { isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name)) + ; let { tycon = lookupTyCon name + ; isoTycon = lookupVar isoName + ; vDataCons = [ (dataConName dc, (dc, dc)) + | dc <- tyConDataCons tycon] } - ; return (var, (var, ccVar)) + ; return ((name, (tycon, tycon)), -- (T, T) + vDataCons, -- list of (Ci, Ci) + (name, (tycon, isoTycon))) -- (T, isoT) + } + vectDataConMapping datacon + = do { let name = dataConName datacon + ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name)) + ; let vDataCon = lookupDataCon vName + ; return (name, (datacon, vDataCon)) } - lookup name = case lookupTypeEnv typeEnv name of - Just (AnId var) -> var - Just _ -> - panic "TcIface.tcIfaceVectInfo: wrong TyThing" - Nothing -> - panic "TcIface.tcIfaceVectInfo: unknown name" + -- + 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} %************************************************************************ @@ -649,6 +711,10 @@ tcIfaceExpr (IfaceLcl name) = tcIfaceLclId name `thenM` \ id -> returnM (Var id) +tcIfaceExpr (IfaceTick modName tickNo) + = tcIfaceTick modName tickNo `thenM` \ id -> + returnM (Var id) + tcIfaceExpr (IfaceExt gbl) = tcIfaceExtId gbl `thenM` \ id -> returnM (Var id) @@ -931,6 +997,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 +1099,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') }