X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcIfaceSig.lhs;h=566e676b70ce8fe0ba19212711d978419c576132;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=ac0a5ad51ef1fa4dc0012253afe8a3ce5e0e3c8a;hpb=8f7ac3fe40d3d55743b824deab655d0797a1c55f;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs index ac0a5ad..566e676 100644 --- a/ghc/compiler/typecheck/TcIfaceSig.lhs +++ b/ghc/compiler/typecheck/TcIfaceSig.lhs @@ -1,48 +1,50 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[TcIfaceSig]{Type checking of type signatures in interface files} \begin{code} -#include "HsVersions.h" - module TcIfaceSig ( tcInterfaceSigs ) where -IMP_Ubiq() +#include "HsVersions.h" +import HsSyn ( HsDecl(..), IfaceSig(..) ) import TcMonad -import TcMonoType ( tcHsType ) -import TcEnv ( tcLookupGlobalValue, tcExtendTyVarEnv, tcExtendGlobalValEnv, - tcLookupTyConByKey, tcLookupGlobalValueMaybe, tcLookupLocalValue +import TcMonoType ( tcHsType, tcHsTypeKind, tcTyVarScope ) +import TcEnv ( tcExtendTyVarEnv, tcExtendGlobalValEnv, tcSetGlobalValEnv, + tcLookupTyConByKey, tcLookupGlobalValueMaybe, + tcExplicitLookupGlobal, badCon, badPrimOp, + GlobalValueEnv ) -import TcKind ( TcKind, kindToTcKind ) +import TcType ( TcKind, kindToTcKind ) -import HsSyn ( IfaceSig(..), HsDecl(..), TyDecl, ClassDecl, InstDecl, DefaultDecl, HsBinds, - Fake, InPat, HsType ) -import RnHsSyn ( RenamedHsDecl(..) ) +import RnHsSyn ( RenamedHsDecl ) import HsCore -import HsDecls ( HsIdInfo(..) ) -import Literal ( Literal(..) ) +import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) ) +import CallConv ( cCallConv ) +import Const ( Con(..), Literal(..) ) import CoreSyn +import CoreUtils ( coreExprType ) import CoreUnfold -import MagicUFs ( MagicUnfoldingFun ) -import SpecEnv ( SpecEnv ) +import WwLib ( mkWrapper ) import PrimOp ( PrimOp(..) ) -import Id ( GenId, mkImported, mkUserId, isPrimitiveId_maybe ) -import Type ( mkSynTy ) -import TyVar ( mkTyVar ) -import Name ( Name ) +import Id ( Id, mkImportedId, mkUserId, + isPrimitiveId_maybe, isDataConId_maybe + ) +import IdInfo +import DataCon ( dataConSig, dataConArgTys ) +import SpecEnv ( addToSpecEnv ) +import Type ( mkSynTy, mkTyVarTys, splitAlgTyConApp ) +import Var ( mkTyVar, tyVarKind ) +import VarEnv +import Name ( Name, NamedThing(..) ) import Unique ( rationalTyConKey ) -import TysWiredIn ( integerTy ) -import PragmaInfo ( PragmaInfo(..) ) +import TysWiredIn ( integerTy, stringTy ) import ErrUtils ( pprBagOfErrors ) -import Maybes ( maybeToBool ) -import Pretty -import PprStyle ( PprStyle(..) ) -import Util ( zipWithEqual, panic, pprTrace, pprPanic ) - -import IdInfo +import Maybes ( maybeToBool, MaybeErr(..) ) +import Outputable +import Util ( zipWithEqual ) \end{code} Ultimately, type signatures in interfaces will have pragmatic @@ -53,91 +55,130 @@ As always, we do not have to worry about user-pragmas in interface signatures. \begin{code} -tcInterfaceSigs :: [RenamedHsDecl] -> TcM s [Id] - -- Ignore non-sig-decls in these decls - -tcInterfaceSigs (SigD (IfaceSig name ty id_infos src_loc) : rest) - = tcAddSrcLoc src_loc $ - tcHsType ty `thenTc` \ sigma_ty -> - tcIdInfo name noIdInfo id_infos `thenTc` \ id_info' -> - let - sig_id = mkImported name sigma_ty id_info' - in - tcInterfaceSigs rest `thenTc` \ sig_ids -> +tcInterfaceSigs :: GlobalValueEnv -- Envt to use when checking unfoldings + -> [RenamedHsDecl] -- Ignore non-sig-decls in these decls + -> TcM s [Id] + + +tcInterfaceSigs unf_env (SigD (IfaceSig name ty id_infos src_loc) : rest) + = tcAddSrcLoc src_loc ( + tcAddErrCtxt (ifaceSigCtxt name) ( + tcHsType ty `thenTc` \ sigma_ty -> + tcIdInfo unf_env name sigma_ty noIdInfo id_infos `thenTc` \ id_info -> + returnTc (mkImportedId name sigma_ty id_info) + )) `thenTc` \ sig_id -> + tcInterfaceSigs unf_env rest `thenTc` \ sig_ids -> returnTc (sig_id : sig_ids) -tcInterfaceSigs (other_decl : rest) = tcInterfaceSigs rest +tcInterfaceSigs unf_env (other_decl : rest) = tcInterfaceSigs unf_env rest -tcInterfaceSigs [] = returnTc [] +tcInterfaceSigs unf_env [] = returnTc [] \end{code} \begin{code} -tcIdInfo name info [] = returnTc info - -tcIdInfo name info (HsArity arity : rest) - = tcIdInfo name (info `addArityInfo` arity) rest - -tcIdInfo name info (HsUpdate upd : rest) - = tcIdInfo name (info `addUpdateInfo` upd) rest - -tcIdInfo name info (HsFBType fb : rest) - = tcIdInfo name (info `addFBTypeInfo` fb) rest +tcIdInfo unf_env name ty info info_ins + = foldlTc tcPrag noIdInfo info_ins + where + tcPrag info (HsArity arity) = returnTc (arity `setArityInfo` info) + tcPrag info (HsUpdate upd) = returnTc (upd `setUpdateInfo` info) + tcPrag info (HsNoCafRefs) = returnTc (NoCafRefs `setCafInfo` info) + + tcPrag info (HsUnfold inline_prag maybe_expr) + = (case maybe_expr of + Just expr -> tcPragExpr unf_env name expr + Nothing -> returnNF_Tc Nothing + ) `thenNF_Tc` \ maybe_expr' -> + let + -- maybe_expr doesn't get looked at if the unfolding + -- is never inspected; so the typecheck doesn't even happen + unfold_info = case maybe_expr' of + Nothing -> NoUnfolding + Just expr' -> mkUnfolding expr' + info1 = unfold_info `setUnfoldingInfo` info + + info2 = inline_prag `setInlinePragInfo` info1 + in + returnTc info2 + + tcPrag info (HsStrictness strict) + = tcStrictness unf_env ty info strict + + tcPrag info (HsSpecialise tyvars tys rhs) + = tcTyVarScope tyvars $ \ tyvars' -> + mapAndUnzipTc tcHsTypeKind tys `thenTc` \ (kinds, tys') -> + -- Assume that the kinds match the kinds of the + -- type variables of the function; this is, after all, an + -- interface file generated by the compiler! + + tcPragExpr unf_env name rhs `thenNF_Tc` \ maybe_rhs' -> + let + -- If spec_env isn't looked at, none of this + -- actually takes place + spec_env = specInfo info + spec_env' = case maybe_rhs' of + Nothing -> spec_env + Just rhs' -> case addToSpecEnv True {- overlap ok -} spec_env tyvars' tys' rhs' of + Succeeded spec_env' -> spec_env' + Failed err -> pprTrace "tcIdInfo: bad specialisation" + (ppr name <+> ppr err) $ + spec_env + in + returnTc (spec_env' `setSpecInfo` info) +\end{code} -tcIdInfo name info (HsArgUsage au : rest) - = tcIdInfo name (info `addArgUsageInfo` au) rest +\begin{code} +tcStrictness unf_env ty info (HsStrictnessInfo demands maybe_worker) + = tcWorker unf_env maybe_worker `thenNF_Tc` \ maybe_worker_id -> + uniqSMToTcM (mkWrapper ty demands) `thenNF_Tc` \ wrap_fn -> + let + -- Watch out! We can't pull on maybe_worker_id too eagerly! + info' = case maybe_worker_id of + Just worker_id -> setUnfoldingInfo (mkUnfolding (wrap_fn worker_id)) $ + setInlinePragInfo IWantToBeINLINEd info -tcIdInfo name info (HsDeforest df : rest) - = tcIdInfo name (info `addDeforestInfo` df) rest + Nothing -> info -tcIdInfo name info (HsUnfold expr : rest) - = tcUnfolding name expr `thenNF_Tc` \ unfold_info -> - tcIdInfo name (info `addUnfoldInfo` unfold_info) rest + has_worker = maybeToBool maybe_worker_id + in + returnTc (StrictnessInfo demands has_worker `setStrictnessInfo` info') -tcIdInfo name info (HsStrictness strict : rest) - = tcStrictness strict `thenTc` \ strict_info -> - tcIdInfo name (info `addStrictnessInfo` strict_info) rest +-- Boring to write these out, but the result type differs from the arg type... +tcStrictness unf_env ty info HsBottom + = returnTc (BottomGuaranteed `setStrictnessInfo` info) \end{code} \begin{code} -tcStrictness (StrictnessInfo demands (Just worker)) - = tcWorker worker `thenNF_Tc` \ maybe_worker_id -> - returnTc (StrictnessInfo demands maybe_worker_id) - --- Boring to write these out, but the result type differe from the arg type... -tcStrictness (StrictnessInfo demands Nothing) = returnTc (StrictnessInfo demands Nothing) -tcStrictness NoStrictnessInfo = returnTc NoStrictnessInfo -tcStrictness BottomGuaranteed = returnTc BottomGuaranteed -\end{code} +tcWorker unf_env Nothing = returnNF_Tc Nothing -\begin{code} -tcWorker worker - = tcLookupGlobalValueMaybe worker `thenNF_Tc` \ maybe_worker_id -> - returnNF_Tc (trace_maybe maybe_worker_id) +tcWorker unf_env (Just (worker_name,_)) + = returnNF_Tc (trace_maybe maybe_worker_id) where + maybe_worker_id = tcExplicitLookupGlobal unf_env worker_name + -- The trace is so we can see what's getting dropped - trace_maybe Nothing = pprTrace "tcWorker failed:" (ppr PprDebug worker) Nothing + trace_maybe Nothing = pprTrace "tcWorker failed:" (ppr worker_name) Nothing trace_maybe (Just x) = Just x \end{code} -tcLookupGlobalValue worker - For unfoldings we try to do the job lazily, so that we never type check an unfolding that isn't going to be looked at. \begin{code} -tcUnfolding name core_expr +tcPragExpr :: GlobalValueEnv -> Name -> UfExpr Name -> NF_TcM s (Maybe CoreExpr) +tcPragExpr unf_env name core_expr = forkNF_Tc ( recoverNF_Tc no_unfolding ( + tcSetGlobalValEnv unf_env $ tcCoreExpr core_expr `thenTc` \ core_expr' -> - returnTc (mkUnfolding False core_expr') + returnTc (Just core_expr') )) where -- The trace tells what wasn't available, for the benefit of -- compiler hackers who want to improve it! no_unfolding = getErrsTc `thenNF_Tc` \ (warns,errs) -> returnNF_Tc (pprTrace "tcUnfolding failed with:" - (ppHang (ppr PprDebug name) 4 (pprBagOfErrors PprDebug errs)) - NoUnfolding) + (hang (ppr name) 4 (pprBagOfErrors errs)) + Nothing) \end{code} @@ -152,10 +193,10 @@ tcVar name = tcLookupGlobalValueMaybe name `thenNF_Tc` \ maybe_id -> case maybe_id of { Just id -> returnTc id; - Nothing -> failTc (noDecl name) + Nothing -> failWithTc (noDecl name) } -noDecl name sty = ppCat [ppStr "Warning: no binding for", ppr sty name] +noDecl name = hsep [ptext SLIT("Warning: no binding for"), ppr name] \end{code} UfCore expressions. @@ -163,60 +204,48 @@ UfCore expressions. \begin{code} tcCoreExpr :: UfExpr Name -> TcM s CoreExpr +tcCoreExpr (UfType ty) + = tcHsTypeKind ty `thenTc` \ (_, ty') -> + -- It might not be of kind type + returnTc (Type ty') + tcCoreExpr (UfVar name) = tcVar name `thenTc` \ id -> returnTc (Var id) --- rationalTy isn't built in so we have to construct it --- (the "ty" part of the incoming literal is simply bottom) -tcCoreExpr (UfLit (NoRepRational lit _)) - = tcLookupTyConByKey rationalTyConKey `thenNF_Tc` \ rational_tycon -> +tcCoreExpr (UfCon con args) + = tcUfCon con `thenTc` \ con' -> + mapTc tcCoreExpr args `thenTc` \ args' -> + returnTc (Con con' args') + +tcCoreExpr (UfTuple name args) + = tcUfDataCon name `thenTc` \ con -> + mapTc tcCoreExpr args `thenTc` \ args' -> let - rational_ty = mkSynTy rational_tycon [] + -- Put the missing type arguments back in + con_args = map (Type . coreExprType) args' ++ args' in - returnTc (Lit (NoRepRational lit rational_ty)) - --- Similarly for integers, except that it is wired in -tcCoreExpr (UfLit (NoRepInteger lit _)) - = returnTc (Lit (NoRepInteger lit integerTy)) - -tcCoreExpr (UfLit other_lit) - = returnTc (Lit other_lit) + returnTc (Con con con_args) -tcCoreExpr (UfCon con args) - = tcVar con `thenTc` \ con_id -> - mapTc tcCoreArg args `thenTc` \ args' -> - returnTc (Con con_id args') - -tcCoreExpr (UfPrim prim args) - = tcCorePrim prim `thenTc` \ primop -> - mapTc tcCoreArg args `thenTc` \ args' -> - returnTc (Prim primop args') +tcCoreExpr (UfLam bndr body) + = tcCoreLamBndr bndr $ \ bndr' -> + tcCoreExpr body `thenTc` \ body' -> + returnTc (Lam bndr' body') tcCoreExpr (UfApp fun arg) = tcCoreExpr fun `thenTc` \ fun' -> - tcCoreArg arg `thenTc` \ arg' -> + tcCoreExpr arg `thenTc` \ arg' -> returnTc (App fun' arg') -tcCoreExpr (UfCase scrut alts) - = tcCoreExpr scrut `thenTc` \ scrut' -> - tcCoreAlts alts `thenTc` \ alts' -> - returnTc (Case scrut' alts') - -tcCoreExpr (UfSCC cc expr) - = tcCoreExpr expr `thenTc` \ expr' -> - returnTc (SCC cc expr') - -tcCoreExpr(UfCoerce coercion ty body) - = tcCoercion coercion `thenTc` \ coercion' -> - tcHsType ty `thenTc` \ ty' -> - tcCoreExpr body `thenTc` \ body' -> - returnTc (Coerce coercion' ty' body') - -tcCoreExpr (UfLam bndr body) - = tcCoreLamBndr bndr $ \ bndr' -> - tcCoreExpr body `thenTc` \ body' -> - returnTc (Lam bndr' body') +tcCoreExpr (UfCase scrut case_bndr alts) + = tcCoreExpr scrut `thenTc` \ scrut' -> + let + scrut_ty = coreExprType scrut' + case_bndr' = mkUserId case_bndr scrut_ty + in + tcExtendGlobalValEnv [case_bndr'] $ + mapTc (tcCoreAlt scrut_ty) alts `thenTc` \ alts' -> + returnTc (Case scrut' case_bndr' alts') tcCoreExpr (UfLet (UfNonRec bndr rhs) body) = tcCoreExpr rhs `thenTc` \ rhs' -> @@ -231,31 +260,81 @@ tcCoreExpr (UfLet (UfRec pairs) body) returnTc (Let (Rec (bndrs' `zip` rhss')) body') where (bndrs, rhss) = unzip pairs + +tcCoreExpr (UfNote note expr) + = tcCoreExpr expr `thenTc` \ expr' -> + case note of + UfCoerce to_ty -> tcHsTypeKind to_ty `thenTc` \ (_,to_ty') -> + returnTc (Note (Coerce to_ty' (coreExprType expr')) expr') + UfInlineCall -> returnTc (Note InlineCall expr') + UfSCC cc -> returnTc (Note (SCC cc) expr') + +tcCoreNote (UfSCC cc) = returnTc (SCC cc) +tcCoreNote UfInlineCall = returnTc InlineCall + + +-- rationalTy isn't built in so, we have to construct it +-- (the "ty" part of the incoming literal is simply bottom) +tcUfCon (UfLitCon (NoRepRational lit _)) + = tcLookupTyConByKey rationalTyConKey `thenNF_Tc` \ rational_tycon -> + let + rational_ty = mkSynTy rational_tycon [] + in + returnTc (Literal (NoRepRational lit rational_ty)) + +-- Similarly for integers and strings, except that they are wired in +tcUfCon (UfLitCon (NoRepInteger lit _)) + = returnTc (Literal (NoRepInteger lit integerTy)) +tcUfCon (UfLitCon (NoRepStr lit _)) + = returnTc (Literal (NoRepStr lit stringTy)) + +tcUfCon (UfLitCon other_lit) + = returnTc (Literal other_lit) + +-- The dreaded lit-lits are also similar, except here the type +-- is read in explicitly rather than being implicit +tcUfCon (UfLitLitCon lit ty) + = tcHsType ty `thenTc` \ ty' -> + returnTc (Literal (MachLitLit lit ty')) + +tcUfCon (UfDataCon name) = tcUfDataCon name + +tcUfCon (UfPrimOp name) + = tcVar name `thenTc` \ op_id -> + case isPrimitiveId_maybe op_id of + Just op -> returnTc (PrimOp op) + Nothing -> failWithTc (badPrimOp name) + +tcUfCon (UfCCallOp str casm gc) + = returnTc (PrimOp (CCallOp (Left str) casm gc cCallConv)) + +tcUfDataCon name + = tcVar name `thenTc` \ con_id -> + case isDataConId_maybe con_id of + Just con -> returnTc (DataCon con) + Nothing -> failWithTc (badCon name) \end{code} \begin{code} tcCoreLamBndr (UfValBinder name ty) thing_inside = tcHsType ty `thenTc` \ ty' -> let - id = mkUserId name ty' NoPragmaInfo + id = mkUserId name ty' in tcExtendGlobalValEnv [id] $ - thing_inside (ValBinder id) + thing_inside id tcCoreLamBndr (UfTyBinder name kind) thing_inside = let tyvar = mkTyVar name kind in tcExtendTyVarEnv [name] [(kindToTcKind kind, tyvar)] $ - thing_inside (TyBinder tyvar) + thing_inside tyvar -tcCoreLamBndr (UfUsageBinder name) thing_inside - = error "tcCoreLamBndr: usage" - tcCoreValBndr (UfValBinder name ty) thing_inside = tcHsType ty `thenTc` \ ty' -> let - id = mkUserId name ty' NoPragmaInfo + id = mkUserId name ty' in tcExtendGlobalValEnv [id] $ thing_inside id @@ -263,57 +342,70 @@ tcCoreValBndr (UfValBinder name ty) thing_inside tcCoreValBndrs bndrs thing_inside -- Expect them all to be ValBinders = mapTc tcHsType tys `thenTc` \ tys' -> let - ids = zipWithEqual "tcCoreValBndr" mk_id names tys' - mk_id name ty' = mkUserId name ty' NoPragmaInfo + ids = zipWithEqual "tcCoreValBndr" mkUserId names tys' in tcExtendGlobalValEnv ids $ thing_inside ids where - names = map (\ (UfValBinder name _) -> name) bndrs - tys = map (\ (UfValBinder _ ty) -> ty) bndrs + names = [name | UfValBinder name _ <- bndrs] + tys = [ty | UfValBinder _ ty <- bndrs] \end{code} \begin{code} -tcCoreArg (UfVarArg v) = tcVar v `thenTc` \ v' -> returnTc (VarArg v') -tcCoreArg (UfTyArg ty) = tcHsType ty `thenTc` \ ty' -> returnTc (TyArg ty') -tcCoreArg (UfLitArg lit) = returnTc (LitArg lit) -tcCoreArg (UfUsageArg u) = error "tcCoreArg: usage" - -tcCoreAlts (UfAlgAlts alts deflt) - = mapTc tc_alt alts `thenTc` \ alts' -> - tcCoreDefault deflt `thenTc` \ deflt' -> - returnTc (AlgAlts alts' deflt') - where - tc_alt (con, bndrs, rhs) = tcVar con `thenTc` \ con' -> - tcCoreValBndrs bndrs $ \ bndrs' -> - tcCoreExpr rhs `thenTc` \ rhs' -> - returnTc (con', bndrs', rhs') - -tcCoreAlts (UfPrimAlts alts deflt) - = mapTc tc_alt alts `thenTc` \ alts' -> - tcCoreDefault deflt `thenTc` \ deflt' -> - returnTc (PrimAlts alts' deflt') - where - tc_alt (lit, rhs) = tcCoreExpr rhs `thenTc` \ rhs' -> - returnTc (lit, rhs') - -tcCoreDefault UfNoDefault = returnTc NoDefault -tcCoreDefault (UfBindDefault bndr rhs) = tcCoreValBndr bndr $ \ bndr' -> - tcCoreExpr rhs `thenTc` \ rhs' -> - returnTc (BindDefault bndr' rhs') - -tcCoercion (UfIn n) = tcVar n `thenTc` \ n' -> returnTc (CoerceIn n') -tcCoercion (UfOut n) = tcVar n `thenTc` \ n' -> returnTc (CoerceOut n') +tcCoreAlt scrut_ty (UfDefault, names, rhs) + = ASSERT( null names ) + tcCoreExpr rhs `thenTc` \ rhs' -> + returnTc (DEFAULT, [], rhs') + +tcCoreAlt scrut_ty (UfLitCon lit, names, rhs) + = ASSERT( null names ) + tcCoreExpr rhs `thenTc` \ rhs' -> + returnTc (Literal lit, [], rhs') + +tcCoreAlt scrut_ty (UfLitLitCon str ty, names, rhs) + = ASSERT( null names ) + tcCoreExpr rhs `thenTc` \ rhs' -> + tcHsType ty `thenTc` \ ty' -> + returnTc (Literal (MachLitLit str ty'), [], rhs') -tcCorePrim (UfOtherOp op) - = tcVar op `thenTc` \ op_id -> - case isPrimitiveId_maybe op_id of - Just prim_op -> returnTc prim_op - Nothing -> pprPanic "tcCorePrim" (ppr PprDebug op_id) +-- 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! +tcCoreAlt scrut_ty (UfDataCon con_name, names, rhs) + = tcVar con_name `thenTc` \ con_id -> + let + con = case isDataConId_maybe con_id of + Just con -> con + Nothing -> pprPanic "tcCoreAlt" (ppr con_id) + + (main_tyvars, _, ex_tyvars, _, _, _) = dataConSig con + + (tycon, inst_tys, cons) = splitAlgTyConApp scrut_ty + 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 = drop (length ex_tyvars) names + arg_ids +#ifdef DEBUG + | length id_names /= length arg_tys + = pprPanic "tcCoreAlts" (ppr (con_name, names, rhs) $$ + (ppr main_tyvars <+> ppr ex_tyvars) $$ + ppr arg_tys) + | otherwise +#endif + = zipWithEqual "tcCoreAlts" mkUserId id_names arg_tys + in + ASSERT( con `elem` cons && length inst_tys == length main_tyvars ) + tcExtendTyVarEnv (map getName ex_tyvars') + [ (kindToTcKind (tyVarKind tv), tv) + | tv <- ex_tyvars'] $ + tcExtendGlobalValEnv arg_ids $ + tcCoreExpr rhs `thenTc` \ rhs' -> + returnTc (DataCon con, ex_tyvars' ++ arg_ids, rhs') +\end{code} -tcCorePrim (UfCCallOp str casm gc arg_tys res_ty) - = mapTc tcHsType arg_tys `thenTc` \ arg_tys' -> - tcHsType res_ty `thenTc` \ res_ty' -> - returnTc (CCallOp str casm gc arg_tys' res_ty') +\begin{code} +ifaceSigCtxt sig_name + = hsep [ptext SLIT("In an interface-file signature for"), ppr sig_name] \end{code}