Overloaded BindN, BindNReturn, and MergeSourcesN members for applicative CE's

src/fsharp/ConstraintSolver.fs

@@ -379,6 +379,8 @@ let IsNumericType g ty = IsNonDecimalNumericType g ty || isDecimalTy g ty
 
 let IsRelationalType g ty = IsNumericType g ty || isStringTy g ty || isCharTy g ty || isBoolTy g ty
 
+let IsEncodedTuple tupInfo g ty = tyconRefEq g ty (if evalTupInfoIsStruct tupInfo then g.struct_tuple8_tcr else g.ref_tuple8_tcr)
+
 // Get measure of type, float<_> or float32<_> or decimal<_> but not float=float<1> or float32=float32<1> or decimal=decimal<1> 
 let GetMeasureOfType g ty =
     match ty with 
@@ -1025,6 +1027,15 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr
         -> SolveTypeEqualsType csenv ndeep m2 trace None ms (TType_measure Measure.One)
 
     | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2  -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2
+
+    // Catch System.Tuple<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'TRest> arising from SRTP constructions
+    | TType_app (tc1, [a1;b1;c1;d1;e1;f1;g1;rest1]), TType_tuple (tupInfo, [a2;b2;c2;d2;e2;f2;g2;h2]) when IsEncodedTuple tupInfo g tc1 ->
+        match stripTyEqnsA csenv.g canShortcut rest1 with
+        | TType_app (_, [h1]) -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None [a1;b1;c1;d1;e1;f1;g1;h1] [a2;b2;c2;d2;e2;f2;g2;h2]
+        | _ -> localAbortD
+    | TType_app (tc1, [a1;b1;c1;d1;e1;f1;g1;rest1]), TType_tuple (tupInfo, a2::b2::c2::d2::e2::f2::g2::rest2) when IsEncodedTuple tupInfo g tc1 ->
+        SolveTypeEqualsTypeEqns csenv ndeep m2 trace None [a1;b1;c1;d1;e1;f1;g1;rest1] [a2;b2;c2;d2;e2;f2;g2;TType_tuple (tupInfo, rest2)]
+
     | TType_app (_, _), TType_app (_, _)   ->  localAbortD
     | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2)      -> 
         if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else

src/fsharp/Optimizer.fs

@@ -1596,7 +1596,8 @@ let ExpandStructuralBindingRaw cenv expr =
     assert cenv.settings.ExpandStructuralValues()
     match expr with
     | Expr.Let (TBind(v, rhs, tgtSeqPtOpt), body, m, _) 
-        when (isRefTupleExpr rhs &&
+        when (isAnyTupleTy cenv.g v.Type &&
+              isRefTupleExpr rhs &&
               CanExpandStructuralBinding v) ->
           let args = tryDestRefTupleExpr rhs
           if List.forall ExprIsValue args then

src/fsharp/TypeChecker.fs

@@ -8461,93 +8461,162 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder
         // or
         //     build.Bind(build.MergeSources(expr1, expr2), ...)
         | SynExpr.LetOrUseBang(letSpBind, false, isFromSource, letPat, letRhsExpr, andBangBindings, innerComp, letBindRange) ->
+
+            /// gets the tuple-arity of a method assuming that methods' first parameter is a tuple
+            let tupleArity (meth: MethInfo) =
+                let ps = meth.GetParamTypes(cenv.amap, letBindRange, [])
+                //dprintfn "discovered %A params for %s" ps meth.DisplayName
+                match ps with
+                // this is the case when an N-member is present, we assume it works for all sizes
+                | [ [ TType_var _typar ] ] -> Some Int32.MaxValue
+                // this is a 'bind', ie a set of inputs that are tupled + a function that consumes them
+                | [ [TType_tuple(_info, types); TType_fun (TType_tuple(_, funDomainTypes), _range) ] ] when (List.length types) = (List.length funDomainTypes) -> Some (List.length types)
+                // this is a 'normal' call, like MergeSources4(a,b,c,d) that has 4 parameters applied
+                | [ nonTupledParams ] -> Some (List.length nonTupledParams)
+                | _ -> None
+
             if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then
                 if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), letBindRange))
                 let bindRange = match letSpBind with DebugPointAtBinding m -> m | _ -> letRhsExpr.Range
                 let sources = (letRhsExpr :: [for (_, _, _, _, andExpr, _) in andBangBindings -> andExpr ]) |> List.map (mkSourceExprConditional isFromSource)
                 let pats = letPat :: [for (_, _, _, andPat, _, _) in andBangBindings -> andPat ]
                 let sourcesRange = sources |> List.map (fun e -> e.Range) |> List.reduce unionRanges
 
-                let numSources = sources.Length
-                let bindReturnNName = "Bind"+string numSources+"Return"
-                let bindNName = "Bind"+string numSources
+                let requiredArity = List.length sources
+                let numericBindNReturnName = sprintf "Bind%dReturn" requiredArity
+                let numericBindNName = sprintf "Bind%d" requiredArity
+                let bindNReturnName = "BindNReturn"
+                let bindNName = "BindN"
 
-                // Check if this is a Bind2Return etc.
-                let hasBindReturnN = not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindReturnNName builderTy))
-                if hasBindReturnN && Option.isSome (convertSimpleReturnToExpr varSpace innerComp) then 
-                    let consumePat = SynPat.Tuple(false, pats, letPat.Range)
+                let hasNumericBindNReturn =
+                    TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad numericBindNReturnName builderTy
+                    |> isNil
+                    |> not
+
+                let bindNReturnArities =
+                    TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AllResults cenv env bindRange ad bindNReturnName builderTy
+                    |> List.choose tupleArity
 
+                // dprintfn "BindNReturnArities = %A" bindNReturnArities
+
+                let hasRequiredBindNReturnArity =
+                    bindNReturnArities
+                    |> List.contains requiredArity
+
+                if (hasRequiredBindNReturnArity || hasNumericBindNReturn) && Option.isSome (convertSimpleReturnToExpr varSpace innerComp) then
+                    let consumePat = SynPat.Tuple(false, pats, letPat.Range)
+                    let bindNReturnTupleArg = SynExpr.Tuple(false, sources, [], sourcesRange)
                     // Add the variables to the query variable space, on demand
                     let varSpace = 
                         addVarsToVarSpace varSpace (fun _mCustomOp env -> 
                                 use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
                                 let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (consumePat, None) 
                                 vspecs, envinner)
 
-                    Some (transBind q varSpace bindRange bindNName sources consumePat letSpBind innerComp translatedCtxt)
+                    let memberName, args = if hasNumericBindNReturn then (numericBindNName, sources) else (bindNName, [bindNReturnTupleArg])
+                    Some (transBind q varSpace bindRange memberName args consumePat letSpBind innerComp translatedCtxt)
 
                 else
+                    let bindNArities =
+                        TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AllResults cenv env bindRange ad bindNName builderTy
+                        |> List.choose tupleArity
 
-                    // Check if this is a Bind2 etc.
-                    let hasBindN = not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindNName builderTy))
-                    if hasBindN then 
-                        let consumePat = SynPat.Tuple(false, pats, letPat.Range)
+                    // dprintfn "BindNArities = %A" bindNArities
 
+                    // Check if this is a BindN etc.
+                    let hasRequiredBindNArity =
+                        bindNArities
+                        |> List.contains requiredArity
+
+                    let hasRequiredNumericBindN =
+                        TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AllResults cenv env bindRange ad numericBindNName builderTy
+                        |> isNil
+                        |> not
+
+                    if (hasRequiredBindNArity || hasRequiredNumericBindN) then
+                        let consumePat = SynPat.Tuple(false, pats, letPat.Range)
+                        let bindNTupleArg = SynExpr.Tuple(false, sources, [], sourcesRange)
                         // Add the variables to the query variable space, on demand
                         let varSpace = 
                             addVarsToVarSpace varSpace (fun _mCustomOp env -> 
                                     use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
                                     let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (consumePat, None) 
                                     vspecs, envinner)
-
-                        Some (transBind q varSpace bindRange bindNName sources consumePat letSpBind innerComp translatedCtxt)
+                        let memberName, args = if hasRequiredNumericBindN then (numericBindNName, sources) else (bindNName, [bindNTupleArg])
+                        Some (transBind q varSpace bindRange memberName args consumePat letSpBind innerComp translatedCtxt)
                     else
+                        let mergeSourcesName = "MergeSources"
+                        let mergeSourcesNName = "MergeSourcesN"
+
+                        let numericMergeSourcesName i =
+                            if i = 2 then mergeSourcesName else "MergeSources"+(string i)
+
+                        let maxMergeSourcesNumeric =
+                            let rec loop (n: int) =
+                                 let mergeSourcesName = numericMergeSourcesName n
+                                 if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then
+                                     (n-1)
+                                 else
+                                     loop (n+1)
+                            loop 2
 
-                        // Look for the maximum supported MergeSources, MergeSources3, ... 
-                        let mkMergeSourcesName n = if n = 2 then "MergeSources" else "MergeSources"+(string n)
+                        let mergeSourcesNArities =
+                            TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AllResults cenv env bindRange ad mergeSourcesNName builderTy
+                            |> List.choose tupleArity
 
-                        let maxMergeSources =
-                            let rec loop (n: int) = 
-                                let mergeSourcesName = mkMergeSourcesName n
-                                if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then
-                                    (n-1)
-                                else
-                                    loop (n+1)
-                            loop 2
+                        // dprintfn "MergeSourcesNArities = %A" mergeSourcesNArities
+
+                        let hasMergeSourcesN =
+                            not (isNil mergeSourcesNArities)
 
-                        if maxMergeSources = 1 then error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange))
+                        let maxMergeSourcesN = if hasMergeSourcesN then  List.max mergeSourcesNArities else 1
 
-                        let rec mergeSources (sourcesAndPats: (SynExpr * SynPat) list) = 
+                        if maxMergeSourcesN = 1 && maxMergeSourcesNumeric = 1 then error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(numericBindNName), bindRange))
+
+                        let rec mergeSources (sourcesAndPats: (SynExpr * SynPat) list) =
                             let numSourcesAndPats = sourcesAndPats.Length
+                            // dprintfn "handling %d patterns" numSourcesAndPats
                             assert (numSourcesAndPats <> 0)
-                            if numSourcesAndPats = 1 then 
+                            if numSourcesAndPats = 1 then
+                                // dprintfn "one pat remaining, returning it"
                                 sourcesAndPats.[0]
-
-                            elif numSourcesAndPats <= maxMergeSources then 
-
-                                // Call MergeSources2(e1, e2), MergeSources3(e1, e2, e3) etc
-                                let mergeSourcesName = mkMergeSourcesName numSourcesAndPats
-
+                            elif numSourcesAndPats = 2 then
+                                // dprintfn "two pats left, calling MergeSources"
+                                // call MergeSources
                                 if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then
                                     error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange))
-
                                 let source = mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats)
-                                let pat = SynPat.Tuple(false, List.map snd sourcesAndPats, letPat.Range)
-                                source, pat
-
+                                let consumePat = SynPat.Tuple(false, List.map snd sourcesAndPats, letPat.Range)
+                                source, consumePat
+                            // we can handle this call with a MergeSources# call
+                            elif numSourcesAndPats <= maxMergeSourcesNumeric then
+                                // dprintfn "can handle all pats, calling MergeSources%d with %d pats" numSourcesAndPats numSourcesAndPats
+                                // Call MergeSources%d
+                                let memberName = numericMergeSourcesName numSourcesAndPats
+                                if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad memberName builderTy) then
+                                    error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange))
+                                let source = mkSynCall memberName sourcesRange (List.map fst sourcesAndPats)
+                                let consumePat = SynPat.Tuple(false, List.map snd sourcesAndPats, letPat.Range)
+                                source, consumePat
+                            // we can handle this call with a MergeSourcesN call
+                            elif numSourcesAndPats <= maxMergeSourcesN then
+                                // dprintfn "can handle all pats, calling MergeSourcesN with %d pats" numSourcesAndPats
+                                // Call MergeSourcesN
+
+                                if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesNName builderTy) then
+                                    error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange))
+                                let source = mkSynCall mergeSourcesNName sourcesRange (List.map fst sourcesAndPats)
+                                let consumePat = SynPat.Tuple(false, List.map snd sourcesAndPats, letPat.Range)
+                                source, consumePat
                             else
-
+                                // split into multiple MergeSourcesN calls
                                 // Call MergeSourcesMax(e1, e2, e3, e4, (...))
-                                let nowSourcesAndPats, laterSourcesAndPats = List.splitAt (maxMergeSources - 1) sourcesAndPats
-                                let mergeSourcesName = mkMergeSourcesName maxMergeSources
+                                let splitPoint = if maxMergeSourcesNumeric <> 1 then maxMergeSourcesNumeric else maxMergeSourcesN
+                                let nowSourcesAndPats, laterSourcesAndPats = List.splitAt (splitPoint - 1) sourcesAndPats
+                                // dprintfn "cannot handle all pats, handling %d pats" (nowSourcesAndPats.Length)
 
-                                if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then
-                                    error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange))
-
-                                let laterSource, laterPat = mergeSources laterSourcesAndPats
-                                let source = mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [laterSource])
-                                let pat = SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [laterPat], letPat.Range)
-                                source, pat
+                                let laterSourceAndPat = mergeSources laterSourcesAndPats
+                                mergeSources (nowSourcesAndPats @ [laterSourceAndPat])
 
                         let mergedSources, consumePat = mergeSources (List.zip sources pats)
 
@@ -8750,7 +8819,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder
             | _ -> 
                 // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore comp
                 if isQuery && checkForBinaryApp comp then 
-                    trans true q varSpace (SynExpr.ImplicitZero comp.Range) translatedCtxt  
+                    trans true q varSpace (SynExpr.ImplicitZero comp.Range) translatedCtxt 
                 else
                     if isQuery && not comp.IsArbExprAndThusAlreadyReportedError then 
                         match comp with 
@@ -8766,9 +8835,9 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder
                         translatedCtxt fillExpr) 
 
     and transBind q varSpace bindRange bindName bindArgs (consumePat: SynPat) spBind (innerComp: SynExpr) translatedCtxt = 
-
-        let innerRange = innerComp.Range
 
+        let innerRange = innerComp.Range
+
         let innerCompReturn = 
             if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then
                 convertSimpleReturnToExpr varSpace innerComp
@@ -8784,7 +8853,9 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder
             // Build the `BindReturn` call
             let dataCompPriorToOp =
                 let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [Clause(consumePat, None, innerExpr, innerRange, DebugPointForTarget.Yes)], spBind, innerRange)
-                translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [consumeExpr]))
+                let bindCall = mkSynCall bindName bindRange (bindArgs @ [consumeExpr])
+                //dprintfn "BindReturn call:\n%A" bindCall
+                translatedCtxt bindCall
 
             match customOpInfo with 
             | None -> dataCompPriorToOp
@@ -8906,6 +8977,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder
         | [] -> quotedSynExpr
         | _ -> mkSynCall "Run" mBuilderVal [quotedSynExpr]
 
+    // dprintfn "Tranlated CE to\n%A\n" runExpr
+
     let lambdaExpr = 
         let mBuilderVal = mBuilderVal.MakeSynthetic()
         SynExpr.Lambda (false, false, SynSimplePats.SimplePats ([mkSynSimplePatVar false (mkSynId mBuilderVal builderValName)], mBuilderVal), runExpr, mBuilderVal)