X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=0bce56bd1435ed3d09d6da19978d68902d0a7a18;hp=847e7c7b7a5e21541f786eed5e3b42c997101e7f;hb=e2e0785eb7f4efd9f7791d913cdfdfd03148cd86;hpb=924142621ebc30a3c16368e0df3466ee14185ddd diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 847e7c7..0bce56b 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -7,23 +7,23 @@ module MkIface ( mkUsedNames, mkDependencies, - mkIface, -- Build a ModIface from a ModGuts, - -- including computing version information + mkIface, -- Build a ModIface from a ModGuts, + -- including computing version information mkIfaceTc, - writeIfaceFile, -- Write the interface file + writeIfaceFile, -- Write the interface file - checkOldIface, -- See if recompilation is required, by - -- comparing version information + checkOldIface, -- See if recompilation is required, by + -- comparing version information tyThingToIfaceDecl -- Converting things to their Iface equivalents ) where \end{code} - ----------------------------------------------- - Recompilation checking - ----------------------------------------------- + ----------------------------------------------- + Recompilation checking + ----------------------------------------------- A complete description of how recompilation checking works can be found in the wiki commentary: @@ -59,10 +59,10 @@ import Annotations import CoreSyn import CoreFVs import Class +import Kind import TyCon import DataCon import Type -import Coercion import TcType import InstEnv import FamInstEnv @@ -72,6 +72,7 @@ import HscTypes import Finder import DynFlags import VarEnv +import VarSet import Var import Name import RdrName @@ -325,18 +326,17 @@ mkIface_ hsc_env maybe_old_fingerprint ifFamInstTcName = ifaceTyConName . ifFamInstTyCon - flattenVectInfo (VectInfo { vectInfoVar = vVar - , vectInfoTyCon = vTyCon + flattenVectInfo (VectInfo { vectInfoVar = vVar + , vectInfoTyCon = vTyCon + , vectInfoScalarVars = vScalarVars + , vectInfoScalarTyCons = vScalarTyCons }) = - IfaceVectInfo { - ifaceVectInfoVar = [ Var.varName v - | (v, _) <- varEnvElts vVar], - ifaceVectInfoTyCon = [ tyConName t - | (t, t_v) <- nameEnvElts vTyCon - , t /= t_v], - ifaceVectInfoTyConReuse = [ tyConName t - | (t, t_v) <- nameEnvElts vTyCon - , t == t_v] + IfaceVectInfo + { ifaceVectInfoVar = [Var.varName v | (v, _ ) <- varEnvElts vVar] + , ifaceVectInfoTyCon = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t /= t_v] + , ifaceVectInfoTyConReuse = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t == t_v] + , ifaceVectInfoScalarVars = [Var.varName v | v <- varSetElems vScalarVars] + , ifaceVectInfoScalarTyCons = nameSetToList vScalarTyCons } ----------------------------- @@ -1386,14 +1386,16 @@ tyThingToIfaceDecl (ATyCon tycon) = IfCon { ifConOcc = getOccName (dataConName data_con), ifConInfix = dataConIsInfix data_con, ifConWrapper = isJust (dataConWrapId_maybe data_con), - ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con), - ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con), - ifConEqSpec = to_eq_spec (dataConEqSpec data_con), - ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con), - ifConArgTys = map toIfaceType (dataConOrigArgTys data_con), + ifConUnivTvs = toIfaceTvBndrs univ_tvs, + ifConExTvs = toIfaceTvBndrs ex_tvs, + ifConEqSpec = to_eq_spec eq_spec, + ifConCtxt = toIfaceContext theta, + ifConArgTys = map toIfaceType arg_tys, ifConFields = map getOccName (dataConFieldLabels data_con), ifConStricts = dataConStrictMarks data_con } + where + (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) = dataConFullSig data_con to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec] @@ -1401,6 +1403,8 @@ tyThingToIfaceDecl (ATyCon tycon) famInstToIface (Just (famTyCon, instTys)) = Just (toIfaceTyCon famTyCon, map toIfaceType instTys) +tyThingToIfaceDecl c@(ACoAxiom _) = pprPanic "tyThingToIfaceDecl (ACoCon _)" (ppr c) + tyThingToIfaceDecl (ADataCon dc) = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier @@ -1565,6 +1569,8 @@ coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn, -- construct the same ru_rough field as we have right now; -- see tcIfaceRule do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty)) + do_arg (Coercion co) = IfaceType (coToIfaceType co) + do_arg arg = toIfaceExpr arg -- Compute orphanhood. See Note [Orphans] in IfaceSyn @@ -1584,15 +1590,16 @@ bogusIfaceRule id_name --------------------- toIfaceExpr :: CoreExpr -> IfaceExpr -toIfaceExpr (Var v) = toIfaceVar v -toIfaceExpr (Lit l) = IfaceLit l -toIfaceExpr (Type ty) = IfaceType (toIfaceType ty) -toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b) -toIfaceExpr (App f a) = toIfaceApp f [a] -toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as) -toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e) -toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co) -toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e) +toIfaceExpr (Var v) = toIfaceVar v +toIfaceExpr (Lit l) = IfaceLit l +toIfaceExpr (Type ty) = IfaceType (toIfaceType ty) +toIfaceExpr (Coercion co) = IfaceCo (coToIfaceType co) +toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b) +toIfaceExpr (App f a) = toIfaceApp f [a] +toIfaceExpr (Case s x _ as) = IfaceCase (toIfaceExpr s) (getFS x) (map toIfaceAlt as) +toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e) +toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (coToIfaceType co) +toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e) --------------------- toIfaceNote :: Note -> IfaceNote