Fix loading VectInfo for type constructors

3 files changed, 33 insertions, 14 deletions

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index bf8aeeac40..063158cf4e 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 125b885256..4007cd514f 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 fd2b647046..a9684a6a91 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]