diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 45a35970af7..a7bcc1f9f87 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -849,6 +849,20 @@ let (|OptionalSequential|) e = | SynExpr.Sequential(debugPoint = _sp; isTrueSeq = true; expr1 = dataComp1; expr2 = dataComp2) -> (dataComp1, Some dataComp2) | _ -> (e, None) +[] +let (|ExprAsUseBang|_|) expr = + match expr with + | SynExpr.LetOrUseBang( + bindDebugPoint = spBind + isUse = true + isFromSource = isFromSource + pat = pat + rhs = rhsExpr + andBangs = andBangs + body = innerComp + trivia = { LetOrUseBangKeyword = mBind }) -> ValueSome(spBind, isFromSource, pat, rhsExpr, andBangs, 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 @@ -910,6 +924,11 @@ let inline addVarsToVarSpace (varSpace: LazyWithContext id ) +/// Checks if a builder method exists and reports an error if it doesn't +let requireBuilderMethod methodName m1 cenv env ad builderTy m2 = + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m1 ad methodName builderTy) then + error (Error(FSComp.SR.tcRequireBuilderMethod methodName, m2)) + /// /// Try translate the syntax sugar /// @@ -1211,19 +1230,7 @@ let rec TryTranslateComputationExpression let mPat = pat.Range - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mFor - ceenv.ad - "For" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("For"), mFor)) + requireBuilderMethod "For" mFor cenv ceenv.env ceenv.ad ceenv.builderTy mFor // Add the variables to the query variable space, on demand let varSpace = @@ -1296,33 +1303,8 @@ let rec TryTranslateComputationExpression if ceenv.isQuery then error (Error(FSComp.SR.tcNoWhileInQuery (), mWhile)) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mWhile - ceenv.ad - "While" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("While"), mWhile)) - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mWhile - ceenv.ad - "Delay" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mWhile)) + requireBuilderMethod "While" mWhile cenv ceenv.env ceenv.ad ceenv.builderTy mWhile + requireBuilderMethod "Delay" mWhile cenv ceenv.env ceenv.ad ceenv.builderTy mWhile // 'while' is hit just before each time the guard is called let guardExpr = @@ -1451,33 +1433,8 @@ let rec TryTranslateComputationExpression if ceenv.isQuery then error (Error(FSComp.SR.tcNoTryFinallyInQuery (), mTry)) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mTry - ceenv.ad - "TryFinally" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("TryFinally"), mTry)) - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mTry - ceenv.ad - "Delay" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) + requireBuilderMethod "TryFinally" mTry cenv ceenv.env ceenv.ad ceenv.builderTy mTry + requireBuilderMethod "Delay" mTry cenv ceenv.env ceenv.ad ceenv.builderTy mTry let innerExpr = TranslateComputationExpressionNoQueryOps ceenv innerComp @@ -1618,34 +1575,8 @@ let rec TryTranslateComputationExpression | SynExpr.YieldOrReturnFrom(trivia = yieldOrReturnFrom) -> yieldOrReturnFrom.YieldOrReturnFromKeyword | expr -> expr.Range - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - m - ceenv.ad - "Combine" - ceenv.builderTy - ) - then - - error (Error(FSComp.SR.tcRequireBuilderMethod "Combine", combineDelayRange)) - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - m - ceenv.ad - "Delay" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod "Delay", combineDelayRange)) + requireBuilderMethod "Combine" m cenv ceenv.env ceenv.ad ceenv.builderTy combineDelayRange + requireBuilderMethod "Delay" m cenv ceenv.env ceenv.ad ceenv.builderTy combineDelayRange let combineCall = mkSynCall @@ -1748,19 +1679,7 @@ let rec TryTranslateComputationExpression ) | None -> let elseComp = - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - trivia.IfToThenRange - ceenv.ad - "Zero" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), trivia.IfToThenRange)) + requireBuilderMethod "Zero" trivia.IfToThenRange cenv ceenv.env ceenv.ad ceenv.builderTy trivia.IfToThenRange mkSynCall "Zero" trivia.IfToThenRange [] ceenv.builderValName @@ -1838,19 +1757,7 @@ let rec TryTranslateComputationExpression innerCompRange ) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mBind - ceenv.ad - "Using" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) + requireBuilderMethod "Using" mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind Some( translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ] ceenv.builderValName) @@ -1903,102 +1810,59 @@ let rec TryTranslateComputationExpression ) // 'use! pat = e1 in e2' --> build.Bind(e1, (function _argN -> match _argN with pat -> build.Using(x, (fun _argN -> match _argN with pat -> e2)))) - | SynExpr.LetOrUseBang( - bindDebugPoint = spBind - isUse = true - isFromSource = isFromSource - pat = SynPat.Named(ident = SynIdent(id, _); isThisVal = false) as pat - rhs = rhsExpr - andBangs = [] - body = innerComp - trivia = { LetOrUseBangKeyword = mBind }) - | SynExpr.LetOrUseBang( - bindDebugPoint = spBind - isUse = true - isFromSource = isFromSource - pat = SynPat.LongIdent(longDotId = SynLongIdent(id = [ id ])) as pat - rhs = rhsExpr - andBangs = [] - body = innerComp - trivia = { LetOrUseBangKeyword = mBind }) -> - + | ExprAsUseBang(spBind, isFromSource, pat, rhsExpr, andBangs, innerComp, mBind) -> if ceenv.isQuery then error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mBind - ceenv.ad - "Using" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mBind - ceenv.ad - "Bind" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), mBind)) + match pat, andBangs with + | (SynPat.Named(ident = SynIdent(id, _); isThisVal = false) | SynPat.LongIdent(longDotId = SynLongIdent(id = [ id ]))), [] -> + // Valid pattern case - handle with Using + Bind + requireBuilderMethod "Using" mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind + requireBuilderMethod "Bind" mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind - let bindExpr = - let consumeExpr = - SynExpr.MatchLambda( - false, - mBind, - [ - SynMatchClause( - pat, - None, - TranslateComputationExpressionNoQueryOps ceenv innerComp, - innerComp.Range, - DebugPointAtTarget.Yes, - SynMatchClauseTrivia.Zero - ) - ], - DebugPointAtBinding.NoneAtInvisible, - mBind - ) - - let consumeExpr = - mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] ceenv.builderValName + let bindExpr = + let consumeExpr = + SynExpr.MatchLambda( + false, + mBind, + [ + SynMatchClause( + pat, + None, + TranslateComputationExpressionNoQueryOps ceenv innerComp, + innerComp.Range, + DebugPointAtTarget.Yes, + SynMatchClauseTrivia.Zero + ) + ], + DebugPointAtBinding.NoneAtInvisible, + mBind + ) - let consumeExpr = - SynExpr.MatchLambda( - false, - mBind, - [ - SynMatchClause(pat, None, consumeExpr, id.idRange, DebugPointAtTarget.No, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, - mBind - ) + let consumeExpr = + mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] ceenv.builderValName - let rhsExpr = - mkSourceExprConditional isFromSource rhsExpr ceenv.sourceMethInfo ceenv.builderValName + let consumeExpr = + SynExpr.MatchLambda( + false, + mBind, + [ + SynMatchClause(pat, None, consumeExpr, id.idRange, DebugPointAtTarget.No, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + mBind + ) - mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] ceenv.builderValName - |> addBindDebugPoint spBind + let rhsExpr = + mkSourceExprConditional isFromSource rhsExpr ceenv.sourceMethInfo ceenv.builderValName - Some(translatedCtxt bindExpr) + mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] ceenv.builderValName + |> addBindDebugPoint spBind - // 'use! pat = e1 ... in e2' where 'pat' is not a simple name -> error - | SynExpr.LetOrUseBang(isUse = true; andBangs = andBangs; trivia = { LetOrUseBangKeyword = mBind }) -> - if isNil andBangs then - error (Error(FSComp.SR.tcInvalidUseBangBinding (), mBind)) - else + Some(translatedCtxt bindExpr) + | _pat, [] -> error (Error(FSComp.SR.tcInvalidUseBangBinding (), mBind)) + | _pat, _ands -> + // Has andBangs let m = match andBangs with | [] -> comp.Range @@ -2182,19 +2046,7 @@ let rec TryTranslateComputationExpression // Call MergeSources2(e1, e2), MergeSources3(e1, e2, e3) etc let mergeSourcesName = mkMergeSourcesName numSourcesAndPats - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mBind - ceenv.ad - mergeSourcesName - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) + requireBuilderMethod mergeSourcesName mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind let source = mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) ceenv.builderValName @@ -2210,19 +2062,7 @@ let rec TryTranslateComputationExpression let mergeSourcesName = mkMergeSourcesName maxMergeSources - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mBind - ceenv.ad - mergeSourcesName - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) + requireBuilderMethod mergeSourcesName mBind cenv ceenv.env ceenv.ad ceenv.builderTy mBind let laterSource, laterPat = mergeSources laterSourcesAndPats @@ -2285,19 +2125,7 @@ let rec TryTranslateComputationExpression if ceenv.isQuery then error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchBangKeyword)) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - trivia.MatchBangKeyword - ceenv.ad - "Bind" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), trivia.MatchBangKeyword)) + requireBuilderMethod "Bind" trivia.MatchBangKeyword cenv ceenv.env ceenv.ad ceenv.builderTy trivia.MatchBangKeyword let clauses = clauses @@ -2335,33 +2163,8 @@ let rec TryTranslateComputationExpression let consumeExpr = SynExpr.MatchLambda(true, mTryToLast, clauses, spWith2, mTryToLast) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mTry - ceenv.ad - "TryWith" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("TryWith"), mTry)) - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - mTry - ceenv.ad - "Delay" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) + requireBuilderMethod "TryWith" mTry cenv ceenv.env ceenv.ad ceenv.builderTy mTry + requireBuilderMethod "Delay" mTry cenv ceenv.env ceenv.ad ceenv.builderTy mTry let innerExpr = TranslateComputationExpressionNoQueryOps ceenv innerComp @@ -2386,19 +2189,7 @@ let rec TryTranslateComputationExpression let yieldFromExpr = mkSourceExpr synYieldExpr ceenv.sourceMethInfo ceenv.builderValName - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - m - ceenv.ad - "YieldFrom" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("YieldFrom"), m)) + requireBuilderMethod "YieldFrom" m cenv ceenv.env ceenv.ad ceenv.builderTy m let yieldFromCall = mkSynCall "YieldFrom" synYieldExpr.Range [ yieldFromExpr ] ceenv.builderValName @@ -2418,19 +2209,7 @@ let rec TryTranslateComputationExpression if ceenv.isQuery then error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - m - ceenv.ad - "ReturnFrom" - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("ReturnFrom"), m)) + requireBuilderMethod "ReturnFrom" m cenv ceenv.env ceenv.ad ceenv.builderTy m let returnFromCall = mkSynCall "ReturnFrom" synReturnExpr.Range [ returnFromExpr ] ceenv.builderValName @@ -2449,19 +2228,7 @@ let rec TryTranslateComputationExpression if ceenv.isQuery && not isYield then error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - ceenv.env - m - ceenv.ad - methName - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod methName, m)) + requireBuilderMethod methName m cenv ceenv.env ceenv.ad ceenv.builderTy m let yieldOrReturnCall = mkSynCall methName synYieldOrReturnExpr.Range [ synYieldOrReturnExpr ] ceenv.builderValName @@ -2731,19 +2498,7 @@ and TranslateComputationExpressionBind | _ -> - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - ceenv.cenv - ceenv.env - bindRange - ceenv.ad - bindName - ceenv.builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod (bindName), bindRange)) + requireBuilderMethod bindName bindRange ceenv.cenv ceenv.env ceenv.ad ceenv.builderTy bindRange // Build the `Bind` call TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill ->