Commit b095c97d authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improve constraint tuples (Trac #10451)

* Increase max constraint tuple size to 16
* Produce a civilised error message if the max
  size is exceeded
parent 1189196c
......@@ -18,7 +18,7 @@ mAX_TUPLE_SIZE = 62 -- Should really match the number
-- of decls in Data.Tuple
mAX_CTUPLE_SIZE :: Int -- Constraint tuples
mAX_CTUPLE_SIZE = 8 -- Should match the number of decls in GHC.Classes
mAX_CTUPLE_SIZE = 16 -- Should match the number of decls in GHC.Classes
-- | Default maximum depth for both class instance search and type family
-- reduction. See also Trac #5395.
......
......@@ -61,6 +61,8 @@ import TysWiredIn
import BasicTypes
import SrcLoc
import DynFlags ( ExtensionFlag( Opt_DataKinds ), getDynFlags )
import Constants ( mAX_CTUPLE_SIZE )
import ErrUtils( MsgDoc )
import Unique
import UniqSupply
import Outputable
......@@ -569,11 +571,14 @@ finish_tuple hs_ty tup_sort tau_tys exp_kind
= do { traceTc "finish_tuple" (ppr res_kind $$ ppr exp_kind $$ ppr exp_kind)
; checkExpectedKind hs_ty res_kind exp_kind
; tycon <- case tup_sort of
ConstraintTuple -> tcLookupTyCon (cTupleTyConName arity)
BoxedTuple -> do { let tc = tupleTyCon Boxed arity
; checkWiredInTyCon tc
; return tc }
UnboxedTuple -> return (tupleTyCon Unboxed arity)
ConstraintTuple
| arity > mAX_CTUPLE_SIZE
-> failWith (bigConstraintTuple arity)
| otherwise -> tcLookupTyCon (cTupleTyConName arity)
BoxedTuple -> do { let tc = tupleTyCon Boxed arity
; checkWiredInTyCon tc
; return tc }
UnboxedTuple -> return (tupleTyCon Unboxed arity)
; return (mkTyConApp tycon tau_tys) }
where
arity = length tau_tys
......@@ -582,6 +587,12 @@ finish_tuple hs_ty tup_sort tau_tys exp_kind
BoxedTuple -> liftedTypeKind
ConstraintTuple -> constraintKind
bigConstraintTuple :: Arity -> MsgDoc
bigConstraintTuple arity
= hang (ptext (sLit "Constraint tuple arity too large:") <+> int arity
<+> parens (ptext (sLit "max arity =") <+> int mAX_CTUPLE_SIZE))
2 (ptext (sLit "Instead, use a nested tuple"))
---------------------------
tcInferApps :: Outputable a
=> a
......
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