Type checking of type signatures in interface files
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcIface (
tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
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)
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)
, md_rules = rules
, md_vect_info = vect_info
, md_exports = exports
- , md_modBreaks = emptyModBreaks
}
}
\end{code}
do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
; ty <- tcIfaceType if_ty
; return (tv,ty) }
-\end{code}
+\end{code}
%************************************************************************
; rhs' <- tcIfaceExpr rhs
; return (bndrs', args', rhs') }
; let mb_tcs = map ifTopFreeName args
- ; lcl <- getLclEnv
; returnM (Rule { ru_name = name, ru_fn = fn, ru_act = act,
ru_bndrs = bndrs', ru_args = args',
ru_rhs = rhs',
\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, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
+ ; return $ VectInfo
+ { vectInfoVar = mkVarEnv vVars
+ , vectInfoTyCon = mkNameEnv vTyCons
+ , vectInfoDataCon = mkNameEnv (concat vDataCons)
+ , vectInfoPADFun = mkNameEnv vPAs
+ , 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))
+ ; paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
+ ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
+ ; let { tycon = lookupTyCon name
+ ; vTycon = lookupTyCon vName
+ ; paTycon = lookupVar paName
+ ; isoTycon = lookupVar isoName
+ }
+ ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
+ ; return ((name, (tycon, vTycon)), -- (T, T_v)
+ vDataCons, -- list of (Ci, Ci_v)
+ (vName, (vTycon, paTycon)), -- (T_v, paT)
+ (name, (tycon, isoTycon))) -- (T, isoT)
+ }
+ vectTyConReuseMapping name
+ = do { paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
+ ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
+ ; let { tycon = lookupTyCon name
+ ; paTycon = lookupVar paName
+ ; 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, paTycon)), -- (T, paT)
+ (name, (tycon, isoTycon))) -- (T, isoT)
}
- lookup name = case lookupTypeEnv typeEnv name of
- Just (AnId var) -> var
- Just _ ->
- panic "TcIface.tcIfaceVectInfo: wrong TyThing"
- Nothing ->
- panic "TcIface.tcIfaceVectInfo: unknown name"
+ vectDataConMapping datacon
+ = do { let name = dataConName datacon
+ ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
+ ; let vDataCon = lookupDataCon vName
+ ; return (name, (datacon, vDataCon))
+ }
+ --
+ 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}
%************************************************************************
= 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)
-- corresponds to the datacon in this case alternative
in
extendIfaceIdEnv [case_bndr'] $
- mappM (tcIfaceAlt tc_app) alts `thenM` \ alts' ->
- tcIfaceType ty `thenM` \ ty' ->
+ mappM (tcIfaceAlt scrut' tc_app) alts `thenM` \ alts' ->
+ tcIfaceType ty `thenM` \ ty' ->
returnM (Case scrut' case_bndr' ty' alts')
tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
IfaceCoreNote n -> returnM (Note (CoreNote n) expr')
-------------------------
-tcIfaceAlt _ (IfaceDefault, names, rhs)
+tcIfaceAlt _ _ (IfaceDefault, names, rhs)
= ASSERT( null names )
tcIfaceExpr rhs `thenM` \ rhs' ->
returnM (DEFAULT, [], rhs')
-tcIfaceAlt _ (IfaceLitAlt lit, names, rhs)
+tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
= ASSERT( null names )
tcIfaceExpr rhs `thenM` \ rhs' ->
returnM (LitAlt lit, [], rhs')
-- A case alternative is made quite a bit more complicated
-- by the fact that we omit type annotations because we can
-- work them out. True enough, but its not that easy!
-tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
+tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
= do { con <- tcIfaceDataCon data_occ
- ; ASSERT2( con `elem` tyConDataCons tycon,
- ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) )
- tcIfaceDataAlt con inst_tys arg_strs rhs }
+#ifdef DEBUG
+ ; ifM (not (con `elem` tyConDataCons tycon))
+ (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
+#endif
+ ; tcIfaceDataAlt con inst_tys arg_strs rhs }
-tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
+tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
= ASSERT( isTupleTyCon tycon )
do { let [data_con] = tyConDataCons tycon
; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
-- Wired-in things include TyCons, DataCons, and Ids
= do { ifCheckWiredInThing name; return thing }
| otherwise
- = do { (eps,hpt) <- getEpsAndHpt
- ; dflags <- getDOpts
- ; case lookupType dflags hpt (eps_PTE eps) name of {
- Just thing -> return thing ;
- Nothing -> do
-
- { env <- getGblEnv
- ; case if_rec_types env of {
+ = do { env <- getGblEnv
+ ; case if_rec_types env of { -- Note [Tying the knot]
Just (mod, get_type_env)
| nameIsLocalOrFrom mod name
-> do -- It's defined in the module being compiled
; other -> do
+ { (eps,hpt) <- getEpsAndHpt
+ ; dflags <- getDOpts
+ ; case lookupType dflags hpt (eps_PTE eps) name of {
+ Just thing -> return thing ;
+ Nothing -> do
+
{ mb_thing <- importDecl name -- It's imported; go get it
; case mb_thing of
Failed err -> failIfM err
Succeeded thing -> return thing
}}}}}
+-- Note [Tying the knot]
+-- ~~~~~~~~~~~~~~~~~~~~~
+-- The if_rec_types field is used in two situations:
+--
+-- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
+-- Then we look up M.T in M's type environment, which is splatted into if_rec_types
+-- after we've built M's type envt.
+--
+-- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
+-- is up to date. So we call typecheckIface on M.hi. This splats M.T into
+-- if_rec_types so that the (lazily typechecked) decls see all the other decls
+--
+-- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
+-- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
+-- emasculated form (e.g. lacking data constructors).
+
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
projects / ghc-hetmet.git / blobdiff