diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs
index 51f8de5dec4d4be5f32d485784df8dc1b91f8655..e23f7035d379287b444cf1e1c9f9f6aae43ae0e3 100644
--- a/ghc/compiler/typecheck/TcMonoType.lhs
+++ b/ghc/compiler/typecheck/TcMonoType.lhs
@@ -5,7 +5,7 @@
\begin{code}
module TcMonoType ( tcHsType, tcHsSigType, tcHsBoxedSigType,
- tcHsConSigType, tcContext, tcClassContext,
+ tcContext, tcClassContext,
-- Kind checking
kcHsTyVar, kcHsTyVars, mkTyClTyVars,
@@ -188,13 +188,14 @@ kcHsType (HsTupleTy (HsTupCon _ Boxed) tys)
= mapTc kcBoxedType tys `thenTc_`
returnTc boxedTypeKind
-kcHsType (HsTupleTy (HsTupCon _ Unboxed) tys)
- = mapTc kcTypeType tys `thenTc_`
- returnTc unboxedTypeKind
+kcHsType ty@(HsTupleTy (HsTupCon _ Unboxed) tys)
+ = failWithTc (unboxedTupleErr ty)
+ -- Unboxed tuples are illegal everywhere except
+ -- just after a function arrow (see kcFunResType)
kcHsType (HsFunTy ty1 ty2)
= kcTypeType ty1 `thenTc_`
- kcTypeType ty2 `thenTc_`
+ kcFunResType ty2 `thenTc_`
returnTc boxedTypeKind
kcHsType (HsPredTy pred)
@@ -219,17 +220,27 @@ kcHsType (HsForAllTy (Just tv_names) context ty)
= kcHsTyVars tv_names `thenNF_Tc` \ kind_env ->
tcExtendKindEnv kind_env $
kcHsContext context `thenTc_`
- kcHsType ty `thenTc` \ kind ->
- -- Context behaves like a function type
- -- This matters. Return-unboxed-tuple analysis can
- -- give overloaded functions like
- -- f :: forall a. Num a => (# a->a, a->a #)
- -- And we want these to get through the type checker
- returnTc (if null context then
- kind
- else
- boxedTypeKind)
+ -- Context behaves like a function type
+ -- This matters. Return-unboxed-tuple analysis can
+ -- give overloaded functions like
+ -- f :: forall a. Num a => (# a->a, a->a #)
+ -- And we want these to get through the type checker
+ if null context then
+ kcHsType ty
+ else
+ kcFunResType ty `thenTc_`
+ returnTc boxedTypeKind
+
+kcFunResType :: RenamedHsType -> TcM s TcKind
+-- The only place an unboxed tuple type is allowed
+-- is at the right hand end of an arrow
+kcFunResType (HsTupleTy (HsTupCon _ Unboxed) tys)
+ = mapTc kcTypeType tys `thenTc_`
+ returnTc unboxedTypeKind
+
+kcFunResType ty = kcHsType ty
+
---------------------------
kcHsContext ctxt = mapTc_ kcHsPred ctxt
@@ -281,14 +292,6 @@ tcHsBoxedSigType ty
= kcBoxedType ty `thenTc_`
tcHsType ty `thenTc` \ ty' ->
returnTc (hoistForAllTys ty')
-
-tcHsConSigType :: RenamedHsType -> TcM s Type
--- Used for constructor arguments, which must not
--- be unboxed tuples
-tcHsConSigType ty
- = kcTypeType ty `thenTc_`
- tcHsArgType ty `thenTc` \ ty' ->
- returnTc (hoistForAllTys ty')
\end{code}
@@ -296,17 +299,6 @@ tcHsType, the main work horse
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\begin{code}
-tcHsArgType :: RenamedHsType -> TcM s TcType
--- Used the for function and constructor arguments,
--- which are not allowed to be unboxed tuples
--- This is a bit ad hoc; we don't have a separate kind
--- for unboxed tuples
-tcHsArgType ty
- = tcHsType ty `thenTc` \ tau_ty ->
- checkTc (not (isUnboxedTupleType tau_ty))
- (unboxedTupleErr ty) `thenTc_`
- returnTc tau_ty
-
tcHsType :: RenamedHsType -> TcM s Type
tcHsType ty@(HsTyVar name)
= tc_app ty []
@@ -320,7 +312,7 @@ tcHsType (HsTupleTy (HsTupCon _ boxity) tys)
returnTc (mkTupleTy boxity (length tys) tau_tys)
tcHsType (HsFunTy ty1 ty2)
- = tcHsArgType ty1 `thenTc` \ tau_ty1 ->
+ = tcHsType ty1 `thenTc` \ tau_ty1 ->
tcHsType ty2 `thenTc` \ tau_ty2 ->
returnTc (mkFunTy tau_ty1 tau_ty2)
@@ -352,7 +344,7 @@ tcHsType (HsUsgForAllTy uv_name ty)
tcHsType full_ty@(HsForAllTy (Just tv_names) ctxt ty)
= kcTyVarScope tv_names
- (kcHsContext ctxt `thenTc_` kcHsType ty) `thenTc` \ tv_kinds ->
+ (kcHsContext ctxt `thenTc_` kcFunResType ty) `thenTc` \ tv_kinds ->
let
forall_tyvars = mkImmutTyVars tv_kinds
in
diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
index a16fb0ffe1dfd941ca18b089560ec8857d4af85d..f0518d3e1b468c7dd558e122aadb146250175e26 100644
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs
@@ -128,7 +128,7 @@ tcGroup unf_env scc
rec_details = mkNameEnv rec_details_list
tyclss, all_tyclss :: [(Name, TyThing)]
- tyclss = map (buildTyConOrClass is_rec kind_env rec_vrcs rec_details) decls
+ tyclss = map (buildTyConOrClass is_rec kind_env rec_vrcs rec_details) decls
-- Add the tycons that come from the classes
-- We want them in the environment because
@@ -145,7 +145,7 @@ tcGroup unf_env scc
mapTc (tcTyClDecl1 unf_env) decls `thenTc` \ tycls_details ->
tcGetEnv `thenNF_Tc` \ env ->
returnTc (tycls_details, env)
- ) `thenTc` \ (_, env) ->
+ ) `thenTc` \ (_, env) ->
returnTc env
where
is_rec = case scc of
diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index 8e9a9ee1cc074bf098250eb8aa7564db71e5b620..16d18454e34684b57a09b68157e31d7a579c30cc 100644
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -20,7 +20,7 @@ import RnHsSyn ( RenamedTyClDecl, RenamedConDecl, RenamedContext )
import TcHsSyn ( TcMonoBinds, idsToMonoBinds )
import BasicTypes ( NewOrData(..) )
-import TcMonoType ( tcHsType, tcHsConSigType, tcHsBoxedSigType, kcTyVarScope, tcClassContext,
+import TcMonoType ( tcHsType, tcHsSigType, tcHsBoxedSigType, kcTyVarScope, tcClassContext,
kcHsContext, kcHsSigType, mkImmutTyVars
)
import TcEnv ( tcExtendTyVarEnv, tcLookupTy, tcLookupValueByKey, TyThing(..), TyThingDetails(..) )
@@ -154,7 +154,7 @@ tcConDecl new_or_data tycon tyvars ctxt (ConDecl name wkr_name ex_tvs ex_ctxt de
RecCon fields -> tc_rec_con ex_tyvars ex_theta fields
where
tc_sig_type = case new_or_data of
- DataType -> tcHsConSigType
+ DataType -> tcHsSigType
NewType -> tcHsBoxedSigType
-- Can't allow an unboxed type here, because we're effectively
-- going to remove the constructor while coercing it to a boxed type.
diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs
index 193f8fc974cff08624c0a929b9f6e1e7fea742da..53e282ce784da214bbb51612d1d208e0e14441fa 100644
--- a/ghc/compiler/types/TypeRep.lhs
+++ b/ghc/compiler/types/TypeRep.lhs
@@ -202,7 +202,7 @@ boxity :: BX = * -- Boxed
There's a little subtyping at the kind level:
forall b. Type b <: OpenKind
-That is, a type of kind (Type b) OK in a context requiring an AnyBox.
+That is, a type of kind (Type b) is OK in a context requiring an OpenKind
OpenKind, written '?', is used as the kind for certain type variables,
in two situations: