Commit 0aa61e36 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-02-20 15:35:28 by simonpj]

Use tcIfaceType
parent dc41be9f
......@@ -10,11 +10,7 @@ module TcIfaceSig ( tcInterfaceSigs, tcVar, tcCoreExpr, tcCoreLamBndrs ) where
import HsSyn ( TyClDecl(..), HsTupCon(..) )
import TcMonad
import TcMonoType ( tcHsType )
-- NB: all the tyars in interface files are kinded,
-- so tcHsType will do the Right Thing without
-- having to mess about with zonking
import TcMonoType ( tcIfaceType )
import TcEnv ( TcEnv, RecTcEnv, tcExtendTyVarEnv,
tcExtendGlobalValEnv, tcSetEnv,
tcLookupGlobal_maybe, tcLookupRecId_maybe
......@@ -66,7 +62,7 @@ tcInterfaceSigs unf_env decls
do_one name ty id_infos src_loc
= tcAddSrcLoc src_loc $
tcAddErrCtxt (ifaceSigCtxt name) $
tcHsType ty `thenTc` \ sigma_ty ->
tcIfaceType ty `thenTc` \ sigma_ty ->
tcIdInfo unf_env in_scope_vars name
sigma_ty id_infos `thenTc` \ id_info ->
returnTc (mkId name sigma_ty id_info)
......@@ -184,7 +180,7 @@ UfCore expressions.
tcCoreExpr :: UfExpr Name -> TcM CoreExpr
tcCoreExpr (UfType ty)
= tcHsType ty `thenTc` \ ty' ->
= tcIfaceType ty `thenTc` \ ty' ->
-- It might not be of kind type
returnTc (Type ty')
......@@ -198,11 +194,11 @@ tcCoreExpr (UfLit lit)
-- The dreaded lit-lits are also similar, except here the type
-- is read in explicitly rather than being implicit
tcCoreExpr (UfLitLit lit ty)
= tcHsType ty `thenTc` \ ty' ->
= tcIfaceType ty `thenTc` \ ty' ->
returnTc (Lit (MachLitLit lit ty'))
tcCoreExpr (UfCCall cc ty)
= tcHsType ty `thenTc` \ ty' ->
= tcIfaceType ty `thenTc` \ ty' ->
tcGetUnique `thenNF_Tc` \ u ->
returnTc (Var (mkCCallOpId u cc ty'))
......@@ -254,7 +250,7 @@ tcCoreExpr (UfLet (UfRec pairs) body)
tcCoreExpr (UfNote note expr)
= tcCoreExpr expr `thenTc` \ expr' ->
case note of
UfCoerce to_ty -> tcHsType to_ty `thenTc` \ to_ty' ->
UfCoerce to_ty -> tcIfaceType to_ty `thenTc` \ to_ty' ->
returnTc (Note (Coerce to_ty'
(exprType expr')) expr')
UfInlineCall -> returnTc (Note InlineCall expr')
......@@ -264,7 +260,7 @@ tcCoreExpr (UfNote note expr)
\begin{code}
tcCoreLamBndr (UfValBinder name ty) thing_inside
= tcHsType ty `thenTc` \ ty' ->
= tcIfaceType ty `thenTc` \ ty' ->
let
id = mkVanillaId name ty'
in
......@@ -284,7 +280,7 @@ tcCoreLamBndrs (b:bs) thing_inside
thing_inside (b':bs')
tcCoreValBndr (UfValBinder name ty) thing_inside
= tcHsType ty `thenTc` \ ty' ->
= tcIfaceType ty `thenTc` \ ty' ->
let
id = mkVanillaId name ty'
in
......@@ -292,7 +288,7 @@ tcCoreValBndr (UfValBinder name ty) thing_inside
thing_inside id
tcCoreValBndrs bndrs thing_inside -- Expect them all to be ValBinders
= mapTc tcHsType tys `thenTc` \ tys' ->
= mapTc tcIfaceType tys `thenTc` \ tys' ->
let
ids = zipWithEqual "tcCoreValBndr" mkVanillaId names tys'
in
......@@ -317,7 +313,7 @@ tcCoreAlt scrut_ty (UfLitAlt lit, names, rhs)
tcCoreAlt scrut_ty (UfLitLitAlt str ty, names, rhs)
= ASSERT( null names )
tcCoreExpr rhs `thenTc` \ rhs' ->
tcHsType ty `thenTc` \ ty' ->
tcIfaceType ty `thenTc` \ ty' ->
returnTc (LitAlt (MachLitLit str ty'), [], rhs')
-- A case alternative is made quite a bit more complicated
......
......@@ -4,7 +4,7 @@
\section[TcMonoType]{Typechecking user-specified @MonoTypes@}
\begin{code}
module TcMonoType ( tcHsType, tcHsRecType,
module TcMonoType ( tcHsType, tcHsRecType, tcIfaceType,
tcHsSigType, tcHsLiftedSigType,
tcRecClassContext, checkAmbiguity,
......@@ -290,14 +290,25 @@ tcHsSigType and tcHsLiftedSigType are used for type signatures written by the pr
\begin{code}
tcHsSigType, tcHsLiftedSigType :: RenamedHsType -> TcM Type
-- Do kind checking, and hoist for-alls to the top
tcHsSigType ty = kcTypeType ty `thenTc_` tcHsType ty
tcHsLiftedSigType ty = kcLiftedType ty `thenTc_` tcHsType ty
tcHsSigType ty = kcTypeType ty `thenTc_` tcHsType ty
tcHsLiftedSigType ty = kcLiftedType ty `thenTc_` tcHsType ty
tcHsType :: RenamedHsType -> TcM Type
tcHsRecType :: RecFlag -> RenamedHsType -> TcM Type
-- Don't do kind checking, but do hoist for-alls to the top
-- These are used in type and class decls, where kinding is
-- done in advance
tcHsType ty = tc_type NonRecursive ty `thenTc` \ ty' -> returnTc (hoistForAllTys ty')
tcHsRecType wimp_out ty = tc_type wimp_out ty `thenTc` \ ty' -> returnTc (hoistForAllTys ty')
-- In interface files the type is already kinded,
-- and we definitely don't want to hoist for-alls.
-- Otherwise we'll change
-- dmfail :: forall m:(*->*) Monad m => forall a:* => String -> m a
-- into
-- dmfail :: forall m:(*->*) a:* Monad m => String -> m a
-- which definitely isn't right!
tcIfaceType ty = tc_type NonRecursive ty
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment