diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index a7bcc1f9f87..011b6f0a5ac 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -863,6 +863,20 @@ let (|ExprAsUseBang|_|) expr = trivia = { LetOrUseBangKeyword = mBind }) -> ValueSome(spBind, isFromSource, pat, rhsExpr, andBangs, innerComp, mBind) | _ -> ValueNone +[] +let (|ExprAsLetBang|_|) expr = + match expr with + | SynExpr.LetOrUseBang( + bindDebugPoint = spBind + isUse = false + isFromSource = isFromSource + pat = letPat + rhs = letRhsExpr + andBangs = andBangBindings + body = innerComp + trivia = { LetOrUseBangKeyword = mBind }) -> ValueSome(spBind, isFromSource, letPat, letRhsExpr, andBangBindings, innerComp, mBind) + | _ -> ValueNone + // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) // This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay // NOTE: we should probably suppress these sequence points altogether @@ -1764,51 +1778,6 @@ let rec TryTranslateComputationExpression |> addBindDebugPoint spBind ) - // 'let! pat = expr in expr' - // --> build.Bind(e1, (fun _argN -> match _argN with pat -> expr)) - // or - // --> build.BindReturn(e1, (fun _argN -> match _argN with pat -> expr-without-return)) - | SynExpr.LetOrUseBang( - bindDebugPoint = spBind - isUse = false - isFromSource = isFromSource - pat = pat - rhs = rhsExpr - andBangs = [] - body = innerComp - trivia = { LetOrUseBangKeyword = mBind }) -> - - if ceenv.isQuery then - error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - - // 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 cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No - - vspecs, envinner) - - let rhsExpr = - mkSourceExprConditional isFromSource rhsExpr ceenv.sourceMethInfo ceenv.builderValName - - Some( - TranslateComputationExpressionBind - ceenv - comp - q - varSpace - mBind - (addBindDebugPoint spBind) - "Bind" - [ rhsExpr ] - pat - innerComp - translatedCtxt - ) - // 'use! pat = e1 in e2' --> build.Bind(e1, (function _argN -> match _argN with pat -> build.Using(x, (fun _argN -> match _argN with pat -> e2)))) | ExprAsUseBang(spBind, isFromSource, pat, rhsExpr, andBangs, innerComp, mBind) -> if ceenv.isQuery then @@ -1870,66 +1839,21 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcInvalidUseBangBindingNoAndBangs (), m)) + // 'let! pat = expr in expr' --> + // --> build.Bind(e1, (fun _argN -> match _argN with pat -> expr)) + // or + // --> build.BindReturn(e1, (fun _argN -> match _argN with pat -> expr-without-return)) // 'let! pat1 = expr1 and! pat2 = expr2 in ...' --> // build.BindN(expr1, expr2, ...) // or // build.BindNReturn(expr1, expr2, ...) // or // build.Bind(build.MergeSources(expr1, expr2), ...) - | SynExpr.LetOrUseBang( - bindDebugPoint = spBind - isUse = false - isFromSource = isFromSource - pat = letPat - rhs = letRhsExpr - andBangs = andBangBindings - body = innerComp - trivia = { LetOrUseBangKeyword = mBind }) -> - if not (cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang) then - let andBangRange = - match andBangBindings with - | [] -> comp.Range - | h :: _ -> h.Trivia.AndBangKeyword - - error (Error(FSComp.SR.tcAndBangNotSupported (), andBangRange)) - - if ceenv.isQuery then - error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - - let sources = - (letRhsExpr - :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) - |> List.map (fun expr -> mkSourceExprConditional isFromSource expr ceenv.sourceMethInfo ceenv.builderValName) - - let pats = - letPat :: [ for SynExprAndBang(pat = 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 - - // Check if this is a Bind2Return etc. - let hasBindReturnN = - not ( - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mBind - ceenv.ad - bindReturnNName - ceenv.builderTy - ) - ) - - if - hasBindReturnN - && Option.isSome (convertSimpleReturnToExpr ceenv comp varSpace innerComp) - then - let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) + | ExprAsLetBang(spBind, isFromSource, letPat, letRhsExpr, andBangBindings, innerComp, mBind) -> + match andBangBindings with + | [] -> + if ceenv.isQuery then + error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) // Add the variables to the query variable space, on demand let varSpace = @@ -1937,10 +1861,13 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv letPat None TcTrueMatchClause.No vspecs, envinner) + let rhsExpr = + mkSourceExprConditional isFromSource letRhsExpr ceenv.sourceMethInfo ceenv.builderValName + Some( TranslateComputationExpressionBind ceenv @@ -1949,17 +1876,40 @@ let rec TryTranslateComputationExpression varSpace mBind (addBindDebugPoint spBind) - bindNName - sources - consumePat + "Bind" + [ rhsExpr ] + letPat innerComp translatedCtxt ) + | _ -> + if not (cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang) then + let andBangRange = + match andBangBindings with + | [] -> comp.Range + | h :: _ -> h.Trivia.AndBangKeyword - else + error (Error(FSComp.SR.tcAndBangNotSupported (), andBangRange)) + + if ceenv.isQuery then + error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - // Check if this is a Bind2 etc. - let hasBindN = + let sources = + (letRhsExpr + :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) + |> List.map (fun expr -> mkSourceExprConditional isFromSource expr ceenv.sourceMethInfo ceenv.builderValName) + + let pats = + letPat :: [ for SynExprAndBang(pat = 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 + + // Check if this is a Bind2Return etc. + let hasBindReturnN = not ( isNil ( TryFindIntrinsicOrExtensionMethInfo @@ -1968,12 +1918,15 @@ let rec TryTranslateComputationExpression ceenv.env mBind ceenv.ad - bindNName + bindReturnNName ceenv.builderTy ) ) - if hasBindN then + if + hasBindReturnN + && Option.isSome (convertSimpleReturnToExpr ceenv comp varSpace innerComp) + then let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) // Add the variables to the query variable space, on demand @@ -2001,110 +1954,152 @@ let rec TryTranslateComputationExpression translatedCtxt ) else + // Check if this is a Bind2 etc. + let hasBindN = + not ( + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mBind + ceenv.ad + bindNName + ceenv.builderTy + ) + ) - // Look for the maximum supported MergeSources, MergeSources3, ... - let mkMergeSourcesName n = - if n = 2 then - "MergeSources" - else - "MergeSources" + (string n) - - let maxMergeSources = - let rec loop (n: int) = - let mergeSourcesName = mkMergeSourcesName n - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mBind - ceenv.ad - mergeSourcesName - ceenv.builderTy - ) - then - (n - 1) + if hasBindN then + let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) + + // 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 cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No + + vspecs, envinner) + + Some( + TranslateComputationExpressionBind + ceenv + comp + q + varSpace + mBind + (addBindDebugPoint spBind) + bindNName + sources + consumePat + innerComp + translatedCtxt + ) + else + // Look for the maximum supported MergeSources, MergeSources3, ... + let mkMergeSourcesName n = + if n = 2 then + "MergeSources" else - loop (n + 1) + "MergeSources" + (string n) + + let maxMergeSources = + let rec loop (n: int) = + let mergeSourcesName = mkMergeSourcesName n + + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mBind + ceenv.ad + mergeSourcesName + ceenv.builderTy + ) + then + (n - 1) + else + loop (n + 1) - loop 2 + loop 2 - if maxMergeSources = 1 then - error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) + if maxMergeSources = 1 then + error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) - let rec mergeSources (sourcesAndPats: (SynExpr * SynPat) list) = - let numSourcesAndPats = sourcesAndPats.Length - assert (numSourcesAndPats <> 0) + let rec mergeSources (sourcesAndPats: (SynExpr * SynPat) list) = + let numSourcesAndPats = sourcesAndPats.Length + assert (numSourcesAndPats <> 0) - if numSourcesAndPats = 1 then - sourcesAndPats[0] + if numSourcesAndPats = 1 then + sourcesAndPats[0] - elif numSourcesAndPats <= maxMergeSources then + elif numSourcesAndPats <= maxMergeSources then - // Call MergeSources2(e1, e2), MergeSources3(e1, e2, e3) etc - let mergeSourcesName = mkMergeSourcesName numSourcesAndPats + // Call MergeSources2(e1, e2), MergeSources3(e1, e2, e3) etc + let mergeSourcesName = mkMergeSourcesName numSourcesAndPats - requireBuilderMethod mergeSourcesName mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind + requireBuilderMethod mergeSourcesName mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind - let source = - mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) ceenv.builderValName + let source = + mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) ceenv.builderValName - let pat = SynPat.Tuple(false, List.map snd sourcesAndPats, [], letPat.Range) - source, pat + let pat = SynPat.Tuple(false, List.map snd sourcesAndPats, [], letPat.Range) + source, pat - else + else - // Call MergeSourcesMax(e1, e2, e3, e4, (...)) - let nowSourcesAndPats, laterSourcesAndPats = - List.splitAt (maxMergeSources - 1) sourcesAndPats + // Call MergeSourcesMax(e1, e2, e3, e4, (...)) + let nowSourcesAndPats, laterSourcesAndPats = + List.splitAt (maxMergeSources - 1) sourcesAndPats - let mergeSourcesName = mkMergeSourcesName maxMergeSources + let mergeSourcesName = mkMergeSourcesName maxMergeSources - requireBuilderMethod mergeSourcesName mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind + requireBuilderMethod mergeSourcesName mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind - let laterSource, laterPat = mergeSources laterSourcesAndPats + let laterSource, laterPat = mergeSources laterSourcesAndPats - let source = - mkSynCall - mergeSourcesName - sourcesRange - (List.map fst nowSourcesAndPats @ [ laterSource ]) - ceenv.builderValName + let source = + mkSynCall + mergeSourcesName + sourcesRange + (List.map fst nowSourcesAndPats @ [ laterSource ]) + ceenv.builderValName - let pat = - SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) + let pat = + SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) - source, pat + source, pat - let mergedSources, consumePat = mergeSources (List.zip sources pats) + let mergedSources, consumePat = mergeSources (List.zip sources pats) - // Add the variables to the query variable space, on demand - let varSpace = - addVarsToVarSpace varSpace (fun _mCustomOp env -> - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + // 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 cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No - vspecs, envinner) + vspecs, envinner) - // Build the 'Bind' call - Some( - TranslateComputationExpressionBind - ceenv - comp - q - varSpace - mBind - (addBindDebugPoint spBind) - "Bind" - [ mergedSources ] - consumePat - innerComp - translatedCtxt - ) + // Build the 'Bind' call + Some( + TranslateComputationExpressionBind + ceenv + comp + q + varSpace + mBind + (addBindDebugPoint spBind) + "Bind" + [ mergedSources ] + consumePat + innerComp + translatedCtxt + ) | SynExpr.Match(spMatch, expr, clauses, m, trivia) -> if ceenv.isQuery then