Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b2f995de8db003c128b09f13f63ba053db3285a6 >--------------------------------------------------------------- commit b2f995de8db003c128b09f13f63ba053db3285a6 Author: Manuel M T Chakravarty <[email protected]> Date: Mon Nov 14 00:26:06 2011 +1100 Fix loading VectInfo for type constructors >--------------------------------------------------------------- compiler/iface/LoadIface.lhs | 2 +- compiler/iface/TcIface.lhs | 41 ++++++++++++++++++++++++++++---------- compiler/iface/TcIface.lhs-boot | 4 +- 3 files changed, 33 insertions(+), 14 deletions(-) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index bf8aeea..063158c 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -250,7 +250,7 @@ loadInterface doc_str mod from ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface) ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface) - ; new_eps_vect_info <- tcIfaceVectInfo mod (mi_vect_info iface) + ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) (mi_vect_info iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 125b885..4007cd5 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -273,7 +273,7 @@ typecheckIface iface ; anns <- tcIfaceAnnotations (mi_anns iface) -- Vectorisation information - ; vect_info <- tcIfaceVectInfo (mi_module iface) (mi_vect_info iface) + ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env (mi_vect_info iface) -- Exports ; exports <- ifaceExportNames (mi_exports iface) @@ -712,14 +712,21 @@ tcIfaceAnnTarget (ModuleTarget mod) = do %************************************************************************ \begin{code} -tcIfaceVectInfo :: Module -> IfaceVectInfo -> IfL VectInfo -tcIfaceVectInfo mod (IfaceVectInfo - { ifaceVectInfoVar = vars - , ifaceVectInfoTyCon = tycons - , ifaceVectInfoTyConReuse = tyconsReuse - , ifaceVectInfoScalarVars = scalarVars - , ifaceVectInfoScalarTyCons = scalarTyCons - }) +-- We need access to the type environment as we need to look up information about type constructors +-- (i.e., their data constructors and whether they are class type constructors) and about classes +-- (i.e., their selector ids). If a vectorised type constructor or class is defined in the same +-- module as where it is vectorised, we cannot look that information up from the type constructor +-- that we obtained via a 'forkM'ed 'tcIfaceTyCon' without recursively loading the interface that +-- we are already type checking again and again and again... +-- +tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo +tcIfaceVectInfo mod typeEnv (IfaceVectInfo + { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse + , ifaceVectInfoScalarVars = scalarVars + , ifaceVectInfoScalarTyCons = scalarTyCons + }) = do { let scalarTyConsSet = mkNameSet scalarTyCons ; vVars <- mapM vectVarMapping vars ; tyConRes1 <- mapM vectTyConMapping tycons @@ -752,8 +759,18 @@ tcIfaceVectInfo mod (IfaceVectInfo vectTyConMapping name = do { vName <- lookupOrig mod (mkLocalisedOccName mod mkVectTyConOcc name) - ; tycon <- forkM (text ("vect tycon") <+> ppr name) $ - tcIfaceTyCon (IfaceTc name) + + -- we need a fully defined version of the type constructor to be able to extract + -- its data constructors etc. + ; tycon <- do { let mb_tycon = lookupTypeEnv typeEnv name + ; case mb_tycon of + -- tycon is local + Just (ATyCon tycon) -> return tycon + -- name is not a tycon => internal inconsistency + Just _ -> notATyConErr + -- tycon is external + Nothing -> tcIfaceTyCon (IfaceTc name) + } ; vTycon <- forkM (text ("vect vTycon") <+> ppr vName) $ tcIfaceTyCon (IfaceTc vName) @@ -766,6 +783,8 @@ tcIfaceVectInfo mod (IfaceVectInfo , vDataCons -- list of (Ci, Ci_v) ) } + where + notATyConErr = pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name) vectTyConReuseMapping scalarNames name = do { tycon <- forkM (text ("vect reuse tycon") <+> ppr name) $ diff --git a/compiler/iface/TcIface.lhs-boot b/compiler/iface/TcIface.lhs-boot index fd2b647..a9684a6 100644 --- a/compiler/iface/TcIface.lhs-boot +++ b/compiler/iface/TcIface.lhs-boot @@ -7,13 +7,13 @@ import TcRnTypes ( IfL ) import InstEnv ( Instance ) import FamInstEnv ( FamInst ) import CoreSyn ( CoreRule ) -import HscTypes ( VectInfo, IfaceVectInfo ) +import HscTypes ( TypeEnv, VectInfo, IfaceVectInfo ) import Module ( Module ) import Annotations ( Annotation ) tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] -tcIfaceVectInfo :: Module -> IfaceVectInfo -> IfL VectInfo +tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo tcIfaceInst :: IfaceInst -> IfL Instance tcIfaceFamInst :: IfaceFamInst -> IfL FamInst tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
