Improve constraint tuples (Trac #10451)
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 1 Jun 2015 23:40:44 +0000 (00:40 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 1 Jun 2015 23:50:47 +0000 (00:50 +0100)
* Increase max constraint tuple size to 16
* Produce a civilised error message if the max
  size is exceeded

compiler/main/Constants.hs
compiler/typecheck/TcHsType.hs

index 22bd4e6..229e007 100644 (file)
@@ -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 =      -- 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.
index 785dce7..15d647b 100644 (file)
@@ -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