projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Outputable.cparen
[ghc-hetmet.git]
/
compiler
/
iface
/
TcIface.lhs
diff --git
a/compiler/iface/TcIface.lhs
b/compiler/iface/TcIface.lhs
index
53a9a59
..
b82685b
100644
(file)
--- a/
compiler/iface/TcIface.lhs
+++ b/
compiler/iface/TcIface.lhs
@@
-209,7
+209,8
@@
typecheckIface iface
, md_insts = insts
, md_fam_insts = fam_insts
, md_rules = rules
, md_insts = insts
, md_fam_insts = fam_insts
, md_rules = rules
- , md_exports = exports
+ , md_exports = exports
+ , md_modBreaks = emptyModBreaks
}
}
\end{code}
}
}
\end{code}
@@
-222,11
+223,14
@@
typecheckIface iface
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-tcHiBootIface :: Module -> TcRn ModDetails
+tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
-- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports
-- Return the ModDetails, empty if no hi-boot iface
-- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports
-- Return the ModDetails, empty if no hi-boot iface
-tcHiBootIface mod
+tcHiBootIface hsc_src mod
+ | isHsBoot hsc_src -- Already compiling a hs-boot file
+ = return emptyModDetails
+ | otherwise
= do { traceIf (text "loadHiBootInterface" <+> ppr mod)
; mode <- getGhcMode
= do { traceIf (text "loadHiBootInterface" <+> ppr mod)
; mode <- getGhcMode
@@
-378,7
+382,7
@@
tcIfaceDecl ignore_prags
= bindIfaceTyVars tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_tyki <- tcIfaceType rdr_rhs_ty
= bindIfaceTyVars tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_tyki <- tcIfaceType rdr_rhs_ty
- ; let rhs = if isOpen then OpenSynTyCon rhs_tyki
+ ; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
else SynonymTyCon rhs_tyki
; return (ATyCon (buildSynTyCon tc_name tyvars rhs))
}
else SynonymTyCon rhs_tyki
; return (ATyCon (buildSynTyCon tc_name tyvars rhs))
}
@@
-404,8
+408,8
@@
tcIfaceDecl ignore_prags
= do { op_name <- lookupIfaceTop occ
; op_ty <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
-- Must be done lazily for just the same reason as the
= do { op_name <- lookupIfaceTop occ
; op_ty <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
-- Must be done lazily for just the same reason as the
- -- context of a data decl: the type sig might mention the
- -- class being defined
+ -- type of a data con; to avoid sucking in types that
+ -- it mentions unless it's necessray to do so
; return (op_name, dm, op_ty) }
mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
; return (op_name, dm, op_ty) }
mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
@@
-447,8
+451,8
@@
tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
ifConArgTys = args, ifConFields = field_lbls,
ifConStricts = stricts})
ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
ifConArgTys = args, ifConFields = field_lbls,
ifConStricts = stricts})
- = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
- bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
+ = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
+ bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
{ name <- lookupIfaceTop occ
; eq_spec <- tcIfaceEqSpec spec
; theta <- tcIfaceCtxt ctxt -- Laziness seems not worth the bother here
{ name <- lookupIfaceTop occ
; eq_spec <- tcIfaceEqSpec spec
; theta <- tcIfaceCtxt ctxt -- Laziness seems not worth the bother here
@@
-497,7
+501,7
@@
tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
= do { dfun <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
tcIfaceExtId dfun_occ
; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
= do { dfun <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
tcIfaceExtId dfun_occ
; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
- ; return (mkImportedInstance cls mb_tcs' orph dfun oflag) }
+ ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon,
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon,
@@
-542,12
+546,13
@@
tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
; return (bndrs', args', rhs') }
; let mb_tcs = map ifTopFreeName args
; lcl <- getLclEnv
; return (bndrs', args', rhs') }
; let mb_tcs = map ifTopFreeName args
; lcl <- getLclEnv
- ; let this_module = if_mod lcl
; returnM (Rule { ru_name = name, ru_fn = fn, ru_act = act,
ru_bndrs = bndrs', ru_args = args',
; returnM (Rule { ru_name = name, ru_fn = fn, ru_act = act,
ru_bndrs = bndrs', ru_args = args',
- ru_rhs = rhs', ru_orph = orph,
+ ru_rhs = rhs',
ru_rough = mb_tcs,
ru_rough = mb_tcs,
- ru_local = nameModule fn == this_module }) }
+ ru_local = False }) } -- An imported RULE is never for a local Id
+ -- or, even if it is (module loop, perhaps)
+ -- we'll just leave it in the non-local set
where
-- This function *must* mirror exactly what Rules.topFreeName does
-- We could have stored the ru_rough field in the iface file
where
-- This function *must* mirror exactly what Rules.topFreeName does
-- We could have stored the ru_rough field in the iface file
@@
-1010,8
+1015,11
@@
bindIfaceTyVars bndrs thing_inside
(occs,kinds) = unzip bndrs
mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
(occs,kinds) = unzip bndrs
mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
-mk_iface_tyvar name ifKind = do { kind <- tcIfaceType ifKind
- ; return (Var.mkTyVar name kind)
- }
+mk_iface_tyvar name ifKind
+ = do { kind <- tcIfaceType ifKind
+ ; if isCoercionKind kind then
+ return (Var.mkCoVar name kind)
+ else
+ return (Var.mkTyVar name kind) }
\end{code}
\end{code}