\section[TcIfaceSig]{Type checking of type signatures in interface files}
\begin{code}
-module TcIfaceSig ( tcInterfaceSigs, tcDelay, tcVar, tcCoreExpr, tcCoreLamBndrs ) where
+module TcIfaceSig ( tcInterfaceSigs,
+ tcDelay,
+ tcVar,
+ tcCoreExpr,
+ tcCoreLamBndrs,
+ tcCoreBinds ) where
#include "HsVersions.h"
import Module ( Module )
import MkId ( mkFCallId )
import IdInfo
-import TyCon ( tyConDataCons )
-import DataCon ( DataCon, dataConId, dataConSig, dataConArgTys )
-import Type ( mkTyVarTys, splitTyConApp )
+import TyCon ( tyConDataCons, tyConTyVars )
+import DataCon ( DataCon, dataConWorkId, dataConExistentialTyVars, dataConArgTys )
+import Type ( Type, mkTyVarTys, splitTyConApp )
import TysWiredIn ( tupleCon )
import Var ( mkTyVar, tyVarKind )
import Name ( Name, nameIsLocalOrFrom )
returnTc info2
tcPrag info (HsStrictness strict_info)
- = returnTc (info `setNewStrictnessInfo` Just strict_info)
+ = returnTc (info `setAllStrictnessInfo` Just strict_info)
tcPrag info (HsWorker nm arity)
= tcWorkerInfo unf_env ty info nm arity
-- Check for type consistency in the unfolding
tcGetSrcLoc `thenNF_Tc` \ src_loc ->
- getDOptsTc `thenTc` \ dflags ->
+ getDOptsTc `thenNF_Tc` \ dflags ->
case lintUnfolding dflags src_loc in_scope_vars core_expr' of
(Nothing,_) -> returnTc (Just core_expr') -- ignore warnings
(Just fail_msg,_) -> failWithTc ((doc <+> text "failed Lint") $$ fail_msg)
in
returnTc (mkApps (Var con_id) con_args)
where
- con_id = dataConId (tupleCon boxity arity)
+ con_id = dataConWorkId (tupleCon boxity arity)
tcCoreExpr (UfLam bndr body)
tcCoreAlt scrut_ty alt@(con, names, rhs)
= tcConAlt con `thenTc` \ con ->
let
- (main_tyvars, _, ex_tyvars, _, _, _) = dataConSig con
-
- (tycon, inst_tys) = splitTyConApp scrut_ty -- NB: not tcSplitTyConApp
+ ex_tyvars = dataConExistentialTyVars con
+ (tycon, inst_tys) = splitTyConApp scrut_ty -- NB: not tcSplitTyConApp
-- We are looking at Core here
- ex_tyvars' = [mkTyVar name (tyVarKind tv) | (name,tv) <- names `zip` ex_tyvars]
- ex_tys' = mkTyVarTys ex_tyvars'
- arg_tys = dataConArgTys con (inst_tys ++ ex_tys')
- id_names = dropList ex_tyvars names
+ main_tyvars = tyConTyVars tycon
+ ex_tyvars' = [mkTyVar name (tyVarKind tv) | (name,tv) <- names `zip` ex_tyvars]
+ ex_tys' = mkTyVarTys ex_tyvars'
+ arg_tys = dataConArgTys con (inst_tys ++ ex_tys')
+ id_names = dropList ex_tyvars names
arg_ids
#ifdef DEBUG
| not (equalLength id_names arg_tys)
Nothing -> pprPanic "tcCoreAlt" (ppr con_id))
\end{code}
+%************************************************************************
+%* *
+\subsection{Core decls}
+%* *
+%************************************************************************
+
+
+\begin{code}
+tcCoreBinds :: [RenamedTyClDecl]
+ -> TcM [(Id, Type, CoreExpr)]
+tcCoreBinds ls = mapTc tcOne ls
+ where
+ tcOne (CoreDecl { tcdName = nm, tcdType = ty, tcdRhs = rhs }) =
+ tcVar nm `thenTc` \ i ->
+ tcIfaceType ty `thenTc` \ ty' ->
+ tcCoreExpr rhs `thenTc` \ rhs' ->
+ returnTc (i,ty',rhs')
+
+\end{code}
+
+
+
\begin{code}
ifaceSigCtxt sig_name
= hsep [ptext SLIT("In an interface-file signature for"), ppr sig_name]