Implement DAML constraint tuples as LF structs. (#3667)

* Constraint tuples

* LF Tuples -> Structs

* A couple that got away

* Dead code elim

* Better documentation for constraint tuple projection functions

* strict -> struct

* readability on constraint tuple projection conversion

* Add mkIndexedField

compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs

@@ -538,6 +538,10 @@ convertTypeDef env o@(ATyCon t) = withRange (convNameLoc t) $ if
     | isTypeSynonymTyCon t
     -> pure []
 
+    -- Constraint tuples are represented by LF structs.
+    | isConstraintTupleTyCon t
+    -> pure []
+
     -- Enum types. These are algebraic types without any type arguments,
     -- with two or more constructors that have no arguments.
     | isEnumTyCon t
@@ -685,6 +689,11 @@ convertBind env (name, x)
     -- lifter or DAML-LF supports local recursion.
     | (as, Let (Rec [(f, Lam v y)]) (Var f')) <- collectBinders x, f == f'
     = convertBind env $ (,) name $ mkLams as $ Lam v $ Let (NonRec f $ mkVarApps (Var name) as) y
+
+    -- | Constraint tuple projections are turned into LF struct projections at use site.
+    | ConstraintTupleProjectionName _ _ <- name
+    = pure []
+
     | otherwise
     = withRange (convNameLoc name) $ do
     x' <- convertExpr env x
@@ -750,7 +759,7 @@ convertExpr env0 e = do
             let tupleType = TypeConApp tupleTyCon (map snd fields)
             pure $ ETmLam (varV1, TStruct fields) $ ERecCon tupleType $ zipWithFrom mkFieldProj (1 :: Int) fields
         where
-            mkFieldProj i (name, _typ) = (mkField ("_" <> T.pack (show i)), EStructProj name (EVar varV1))
+            mkFieldProj i (name, _typ) = (mkIndexedField i, EStructProj name (EVar varV1))
     go env (VarIn GHC_Types "primitive") (LType (isStrLitTy -> Just y) : LType t : args)
         = fmap (, args) $ convertPrim (envLfVersion env) (unpackFS y) <$> convertType env t
     go env (VarIn GHC_Types "external") (LType (isStrLitTy -> Just y) : LType t : args)
@@ -802,6 +811,13 @@ convertExpr env0 e = do
         t2' <- convertType env t2
         pure (x' `ETyApp` t1' `ETyApp` t2' `ETmApp` EBuiltin (BEText (unpackCStringUtf8 s)))
 
+    go env (ConstraintTupleProjection index arity) args
+        | (LExpr x : args') <- drop arity args -- drop the type arguments
+        = fmap (, args') $ do
+            let fieldName = mkIndexedField index
+            x' <- convertExpr env x
+            pure $ EStructProj fieldName x'
+
     -- conversion of bodies of $con2tag functions
     go env (VarIn GHC_Base "getTag") (LType (TypeCon t _) : LExpr x : args) = fmap (, args) $ do
         x' <- convertExpr env x
@@ -1021,6 +1037,10 @@ convertExpr env0 e = do
     go env o@(Coercion _) args = unhandled "Coercion" o
     go _ x args = unhandled "Expression" x
 
+-- | Is this a constraint tuple?
+isConstraintTupleTyCon :: TyCon -> Bool
+isConstraintTupleTyCon = maybe False (== ConstraintTuple) . tyConTuple_maybe
+
 -- | Is this an enum type?
 isEnumTyCon :: TyCon -> Bool
 isEnumTyCon tycon =
@@ -1053,11 +1073,15 @@ conHasLabels = notNull . ctorLabels
 isEnumCon :: DataCon -> Bool
 isEnumCon = isEnumTyCon . dataConTyCon
 
+isConstraintTupleCon :: DataCon -> Bool
+isConstraintTupleCon = isConstraintTupleTyCon . dataConTyCon
+
 isSimpleRecordCon :: DataCon -> Bool
 isSimpleRecordCon con =
     (conHasLabels con || conHasNoArgs con)
     && conIsSingle con
     && not (isEnumCon con)
+    && not (isConstraintTupleCon con)
 
 isVariantRecordCon :: DataCon -> Bool
 isVariantRecordCon con = conHasLabels con && not (conIsSingle con)
@@ -1068,11 +1092,13 @@ data DataConClass
     | SimpleRecordCon -- ^ constructor for a record type
     | SimpleVariantCon -- ^ constructor for a variant type with no synthetic record type
     | VariantRecordCon -- ^ constructor for a variant type with a synthetic record type
+    | ConstraintTupleCon -- ^ constructor for a constraint tuple
     deriving (Eq, Show)
 
 classifyDataCon :: DataCon -> DataConClass
 classifyDataCon con
     | isEnumCon con = EnumCon
+    | isConstraintTupleCon con = ConstraintTupleCon
     | isSimpleRecordCon con = SimpleRecordCon
     | isVariantRecordCon con = VariantRecordCon
     | otherwise = SimpleVariantCon
@@ -1114,6 +1140,9 @@ convertDataCon env m con args
                 unless (null args) $ unhandled "enum constructor with arguments" xargs
                 pure $ EEnumCon qTCon ctorName
 
+            ConstraintTupleCon -> do
+                pure $ EStructCon (zipExact fldNames tmArgs)
+
             SimpleVariantCon ->
                 fmap (EVariantCon tcon ctorName) $ case tmArgs of
                     [] -> pure EUnit
@@ -1357,7 +1386,7 @@ packageNameToPkgRef env =
 convertTyCon :: Env -> TyCon -> ConvertM LF.Type
 convertTyCon env t
     | t == unitTyCon = pure TUnit
-    | isTupleTyCon t, arity >= 2 = TCon <$> qDA_Types env (mkTypeCon ["Tuple" <> T.pack (show arity)])
+    | isTupleTyCon t, not (isConstraintTupleTyCon t), arity >= 2 = TCon <$> qDA_Types env (mkTypeCon ["Tuple" <> T.pack (show arity)])
     | t == listTyCon = pure (TBuiltin BTList)
     | t == boolTyCon = pure TBool
     | t == intTyCon || t == intPrimTyCon = pure TInt64
@@ -1421,6 +1450,11 @@ convertType env o@(TypeCon t ts)
         t2 <- convertType env t2
         pure $ TStruct [(mkField f1, t1), (mkField f2, t2)]
     | tyConFlavour t == TypeSynonymFlavour = convertType env $ expandTypeSynonyms o
+    | isConstraintTupleTyCon t = do
+        fieldTys <- mapM (convertType env) ts
+        let fieldNames = map mkIndexedField [1..]
+        pure $ TStruct (zip fieldNames fieldTys)
+
     | otherwise = mkTApps <$> convertTyCon env t <*> mapM (convertType env) ts
 convertType env t | Just (v, t') <- splitForAllTy_maybe t
   = TForall <$> convTypeVar v <*> convertType env t'
@@ -1512,7 +1546,7 @@ ctorLabels con =
       -- If we omit this workaround, `GHC.Tuple.Unit` gets translated into a
       -- variant rather than a record and the `SugarUnit` test will fail.
       || (getOccFS con == "Unit" && nameModule (getName con) == gHC_TUPLE)
-    = map (mkField . T.cons '_' . T.pack . show) [1..dataConSourceArity con]
+    = map mkIndexedField [1..dataConSourceArity con]
     | flv == NewtypeFlavour && null lbls
     = [mkField "unpack"]
     | otherwise

compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion/UtilGHC.hs

@@ -29,6 +29,8 @@ import qualified Data.Text.Encoding as T
 import Control.Exception
 import GHC.Ptr(Ptr(..))
 import System.IO.Unsafe
+import Text.Read (readMaybe)
+import Control.Monad (guard)
 
 
 ----------------------------------------------------------------------
@@ -97,6 +99,32 @@ pattern DA_Internal_LF <- ModuleIn DamlStdlib "DA.Internal.LF"
 pattern DA_Internal_Prelude <- ModuleIn DamlStdlib "DA.Internal.Prelude"
 pattern DA_Internal_Record <- ModuleIn DamlStdlib "DA.Internal.Record"
 
+-- | Break down a constraint tuple projection function name
+-- into an (index, arity) pair. These names have the form
+-- "$p1(%,%)" "$p2(%,%)" "$p1(%,,%)" etc.
+constraintTupleProjection_maybe :: T.Text -> Maybe (Int, Int)
+constraintTupleProjection_maybe t1 = do
+    t2 <- T.stripPrefix "$p" t1
+    t3 <- T.stripSuffix "%)" t2
+    let (tIndex, tRest) = T.breakOn "(%" t3
+    tCommas <- T.stripPrefix "(%" tRest
+    guard (all (== ',') (T.unpack tCommas))
+    index <- readMaybe (T.unpack tIndex)
+    pure (index, T.length tCommas + 1)
+
+pattern ConstraintTupleProjectionFS :: Int -> Int -> FastString
+pattern ConstraintTupleProjectionFS index arity <-
+    (constraintTupleProjection_maybe . fsToText -> Just (index, arity))
+
+pattern ConstraintTupleProjectionName :: Int -> Int -> Var
+pattern ConstraintTupleProjectionName index arity <-
+    NameIn GHC_Classes (ConstraintTupleProjectionFS index arity)
+
+pattern ConstraintTupleProjection :: Int -> Int -> GHC.Expr Var
+pattern ConstraintTupleProjection index arity <-
+    Var (ConstraintTupleProjectionName index arity)
+
+
 subst :: [(TyVar, GHC.Type)] -> GHC.Type -> GHC.Type
 subst env = transform $ \t ->
     case getTyVar_maybe t of

compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion/UtilLF.hs

@@ -37,6 +37,9 @@ mkModName = ModuleName
 mkField :: T.Text -> FieldName
 mkField = FieldName
 
+mkIndexedField :: Int -> FieldName
+mkIndexedField i = mkField ("_" <> T.pack (show i))
+
 mkVariantCon :: T.Text -> VariantConName
 mkVariantCon = VariantConName
 

compiler/damlc/daml-prim-src/GHC/Classes.daml

@@ -438,3 +438,323 @@ instance NumericScale 35 where numericScale _ = 35; numericScalePrivate _ = ()
 instance NumericScale 36 where numericScale _ = 36; numericScalePrivate _ = ()
 instance NumericScale 37 where numericScale _ = 37; numericScalePrivate _ = ()
 #endif
+
+
+-- Constraint tuples
+
+class ()
+class (c1, c2)     => (c1, c2)
+class (c1, c2, c3) => (c1, c2, c3)
+class (c1, c2, c3, c4) => (c1, c2, c3, c4)
+class (c1, c2, c3, c4, c5) => (c1, c2, c3, c4, c5)
+class (c1, c2, c3, c4, c5, c6) => (c1, c2, c3, c4, c5, c6)
+class (c1, c2, c3, c4, c5, c6, c7) => (c1, c2, c3, c4, c5, c6, c7)
+class (c1, c2, c3, c4, c5, c6, c7, c8) => (c1, c2, c3, c4, c5, c6, c7, c8)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17,c18)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59, c60)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59, c60)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59, c60, c61)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59, c60, c61)
+class (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59, c60, c61, c62)
+   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,
+       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,
+       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,
+       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,
+       c59, c60, c61, c62)

compiler/damlc/tests/daml-test-files/ConstraintTuples.daml

@@ -0,0 +1,27 @@
+-- Copyright (c) 2019, Digital Asset (Switzerland) GmbH and/or its affiliates.
+-- All rights reserved.
+
+daml 1.2
+module ConstraintTuples where
+
+type Eq2 a b = (Eq a, Eq b)
+type Eq3 a b c = (Eq a, Eq b, Eq c)
+type Eq4 a b c d = (Eq a, Eq b, Eq c, Eq d)
+
+eq2 : Eq2 a b => a -> a -> b -> b -> Bool
+eq2 x1 x2 y1 y2 = (x1 == x2) && (y1 == y2)
+
+eq2' : (Eq a, Eq b) => a -> a -> b -> b -> Bool
+eq2' = eq2
+
+eq3 : Eq3 a b c => a -> a -> b -> b -> c -> c -> Bool
+eq3 x1 x2 y1 y2 z1 z2 = (x1 == x2) && (y1 == y2) && (z1 == z2)
+
+eq3' : (Eq a, Eq b, Eq c) => a -> a -> b -> b -> c -> c -> Bool
+eq3' = eq3
+
+eq4 : Eq4 a b c d => a -> a -> b -> b -> c -> c -> d -> d -> Bool
+eq4 x1 x2 y1 y2 z1 z2 w1 w2 = (x1 == x2) && (y1 == y2) && (z1 == z2) && (w1 == w2)
+
+eq4' : (Eq a, Eq b, Eq c, Eq d) => a -> a -> b -> b -> c -> c -> d -> d -> Bool
+eq4' = eq4