diff options
Diffstat (limited to 'compiler/GHC/Tc/Gen/HsType.hs')
| -rw-r--r-- | compiler/GHC/Tc/Gen/HsType.hs | 35 |
1 files changed, 11 insertions, 24 deletions
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index e599ad56f8..9c67345b7f 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -71,6 +71,7 @@ module GHC.Tc.Gen.HsType ( import GHC.Prelude import GHC.Hs +import GHC.Rename.Utils import GHC.Tc.Utils.Monad import GHC.Tc.Types.Origin import GHC.Core.Predicate @@ -103,8 +104,6 @@ import GHC.Types.Var.Env import GHC.Builtin.Types import GHC.Types.Basic import GHC.Types.SrcLoc -import GHC.Settings.Constants ( mAX_CTUPLE_SIZE ) -import GHC.Utils.Error( MsgDoc ) import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set @@ -1133,16 +1132,8 @@ tc_hs_type mode rn_ty@(HsTupleTy _ HsBoxedOrConstraintTuple hs_tys) exp_kind ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind } -tc_hs_type mode rn_ty@(HsTupleTy _ hs_tup_sort tys) exp_kind - = tc_tuple rn_ty mode tup_sort tys exp_kind - where - tup_sort = case hs_tup_sort of -- Fourth case dealt with above - HsUnboxedTuple -> UnboxedTuple - HsBoxedTuple -> BoxedTuple - HsConstraintTuple -> ConstraintTuple -#if __GLASGOW_HASKELL__ <= 810 - _ -> panic "tc_hs_type HsTupleTy" -#endif +tc_hs_type mode rn_ty@(HsTupleTy _ HsUnboxedTuple tys) exp_kind + = tc_tuple rn_ty mode UnboxedTuple tys exp_kind tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind = do { let arity = length hs_tys @@ -1173,6 +1164,7 @@ tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind ; let kind_con = tupleTyCon Boxed arity ty_con = promotedTupleDataCon Boxed arity tup_k = mkTyConApp kind_con ks + ; checkTupSize arity ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind } where arity = length tys @@ -1327,33 +1319,28 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do -- Drop any uses of 1-tuple constraints here. -- See Note [Ignore unary constraint tuples] -> check_expected_kind tau_ty constraintKind - | arity > mAX_CTUPLE_SIZE - -> failWith (bigConstraintTuple arity) | otherwise - -> let tycon = cTupleTyCon arity in - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> do let tycon = cTupleTyCon arity + checkCTupSize arity + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity + checkTupSize arity checkWiredInTyCon tycon check_expected_kind (mkTyConApp tycon tau_tys) liftedTypeKind - UnboxedTuple -> + UnboxedTuple -> do let tycon = tupleTyCon Unboxed arity tau_reps = map kindRep tau_kinds -- See also Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon arg_tys = tau_reps ++ tau_tys - res_kind = unboxedTupleKind tau_reps in + res_kind = unboxedTupleKind tau_reps + checkTupSize arity check_expected_kind (mkTyConApp tycon arg_tys) res_kind where arity = length tau_tys check_expected_kind ty act_kind = checkExpectedKind rn_ty ty act_kind exp_kind -bigConstraintTuple :: Arity -> MsgDoc -bigConstraintTuple arity - = hang (text "Constraint tuple arity too large:" <+> int arity - <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) - 2 (text "Instead, use a nested tuple") - {- Note [Ignore unary constraint tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |