X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FTcIface.lhs;h=7416a5f0d886c236937512ae11659a892aab4ec1;hb=84ca819a2640cfb688acbf53a9e71e5329b4b8ee;hp=bae0405988cfaa12cd4ea36fc50735f8107e71d6;hpb=686d87447e2186e2aa55e1a925f0a3a8e94872f5;p=ghc-hetmet.git diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index bae0405..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) @@ -591,57 +593,57 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd \begin{code} tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo tcIfaceVectInfo mod typeEnv (IfaceVectInfo - { ifaceVectInfoCCVar = vars - , ifaceVectInfoCCTyCon = tycons - , ifaceVectInfoCCTyConReuse = tyconsReuse + { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse }) - = do { ccVars <- mapM ccVarMapping vars - ; tyConRes1 <- mapM ccTyConMapping tycons - ; tyConRes2 <- mapM ccTyConReuseMapping tycons - ; let (ccTyCons, ccDataCons, ccIsos) = unzip3 (tyConRes1 ++ tyConRes2) + = do { vVars <- mapM vectVarMapping vars + ; tyConRes1 <- mapM vectTyConMapping tycons + ; tyConRes2 <- mapM vectTyConReuseMapping tycons + ; let (vTyCons, vDataCons, vIsos) = unzip3 (tyConRes1 ++ tyConRes2) ; return $ VectInfo - { vectInfoCCVar = mkVarEnv ccVars - , vectInfoCCTyCon = mkNameEnv ccTyCons - , vectInfoCCDataCon = mkNameEnv (concat ccDataCons) - , vectInfoCCIso = mkNameEnv ccIsos + { vectInfoVar = mkVarEnv vVars + , vectInfoTyCon = mkNameEnv vTyCons + , vectInfoDataCon = mkNameEnv (concat vDataCons) + , vectInfoIso = mkNameEnv vIsos } } where - ccVarMapping name - = do { ccName <- lookupOrig mod (mkCloOcc (nameOccName name)) - ; let { var = lookupVar name - ; ccVar = lookupVar ccName + vectVarMapping name + = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name)) + ; let { var = lookupVar name + ; vVar = lookupVar vName } - ; return (var, (var, ccVar)) + ; return (var, (var, vVar)) } - ccTyConMapping name - = do { ccName <- lookupOrig mod (mkCloTyConOcc (nameOccName name)) - ; isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name)) + vectTyConMapping name + = do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name)) + ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name)) ; let { tycon = lookupTyCon name - ; ccTycon = lookupTyCon ccName + ; vTycon = lookupTyCon vName ; isoTycon = lookupVar isoName } - ; ccDataCons <- mapM ccDataConMapping (tyConDataCons tycon) - ; return ((name, (tycon, ccTycon)), -- (T, T_CC) - ccDataCons, -- list of (Ci, Ci_CC) + ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon) + ; return ((name, (tycon, vTycon)), -- (T, T_v) + vDataCons, -- list of (Ci, Ci_v) (name, (tycon, isoTycon))) -- (T, isoT) } - ccTyConReuseMapping name - = do { isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name)) + vectTyConReuseMapping name + = do { isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name)) ; let { tycon = lookupTyCon name ; isoTycon = lookupVar isoName - ; ccDataCons = [ (dataConName dc, (dc, dc)) + ; vDataCons = [ (dataConName dc, (dc, dc)) | dc <- tyConDataCons tycon] } ; return ((name, (tycon, tycon)), -- (T, T) - ccDataCons, -- list of (Ci, Ci) + vDataCons, -- list of (Ci, Ci) (name, (tycon, isoTycon))) -- (T, isoT) } - ccDataConMapping datacon + vectDataConMapping datacon = do { let name = dataConName datacon - ; ccName <- lookupOrig mod (mkCloDataConOcc (nameOccName name)) - ; let ccDataCon = lookupDataCon ccName - ; return (name, (datacon, ccDataCon)) + ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name)) + ; let vDataCon = lookupDataCon vName + ; return (name, (datacon, vDataCon)) } -- lookupVar name = case lookupTypeEnv typeEnv name of @@ -709,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) @@ -991,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