From 6be1c608db61a8b219d51b24ab1e21ef9157848d Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 14:30:57 +0200 Subject: [PATCH 01/12] Refactor CE checking --- .../CheckComputationExpressions.fs | 4119 +++++++++-------- 1 file changed, 2120 insertions(+), 1999 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 55ed6c9761d..e7c2e08f3b6 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -24,6 +24,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps +open System.Collections.Generic type cenv = TcFileState @@ -45,82 +46,17 @@ let inline TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) ( /// Ignores an attribute let inline IgnoreAttribute _ = None -[] -let (|ExprAsPat|_|) (f: SynExpr) = - match f with - | SingleIdent v1 - | SynExprParen(SingleIdent v1, _, _, _) -> ValueSome(mkSynPatVar None v1) - | SynExprParen(SynExpr.Tuple(false, elems, commas, _), _, _, _) -> - let elems = elems |> List.map (|SingleIdent|_|) - - if elems |> List.forall (fun x -> x.IsSome) then - ValueSome(SynPat.Tuple(false, (elems |> List.map (fun x -> mkSynPatVar None x.Value)), commas, f.Range)) - else - ValueNone - | _ -> ValueNone - -// For join clauses that join on nullable, we syntactically insert the creation of nullable values on the appropriate side of the condition, -// then pull the syntax apart again -[] -let (|JoinRelation|_|) cenv env (expr: SynExpr) = - let m = expr.Range - let ad = env.eAccessRights - - let isOpName opName vref s = - (s = opName) - && match - ResolveExprLongIdent - cenv.tcSink - cenv.nameResolver - m - ad - env.eNameResEnv - TypeNameResolutionInfo.Default - [ ident (opName, m) ] - None - with - | Result(_, Item.Value vref2, []) -> valRefEq cenv.g vref vref2 - | _ -> false - - match expr with - | BinOpExpr(opId, a, b) when isOpName opNameEquals cenv.g.equals_operator_vref opId.idText -> ValueSome(a, b) - - | BinOpExpr(opId, a, b) when isOpName opNameEqualsNullable cenv.g.equals_nullable_operator_vref opId.idText -> - - let a = - SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [ MangledGlobalName; "System" ] "Nullable", a, a.Range) - - ValueSome(a, b) - - | BinOpExpr(opId, a, b) when isOpName opNameNullableEquals cenv.g.nullable_equals_operator_vref opId.idText -> - - let b = - SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [ MangledGlobalName; "System" ] "Nullable", b, b.Range) - - ValueSome(a, b) +let arbPat (m: range) = + mkSynPatVar None (mkSynId (m.MakeSynthetic()) "_missingVar") - | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText -> - - ValueSome(a, b) - - | _ -> ValueNone - -let (|ForEachThen|_|) synExpr = - match synExpr with - | SynExpr.ForEach(_spFor, - _spIn, - SeqExprOnly false, - isFromSource, - pat1, - expr1, - SynExpr.Sequential(isTrueSeq = true; expr1 = clause; expr2 = rest), - _) -> Some(isFromSource, pat1, expr1, clause, rest) - | _ -> None +let arbKeySelectors m = + mkSynBifix m "=" (arbExpr ("_keySelectors", m)) (arbExpr ("_keySelector2", m)) -let (|CustomOpId|_|) isCustomOperation predicate synExpr = - match synExpr with - | SingleIdent nm when isCustomOperation nm && predicate nm -> Some nm - | _ -> None +// Flag that a debug point should get emitted prior to both the evaluation of 'rhsExpr' and the call to Using +let inline addBindDebugPoint spBind e = + match spBind with + | DebugPointAtBinding.Yes m -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, e) + | _ -> e let inline mkSynDelay2 (e: SynExpr) = mkSynDelay (e.Range.MakeSynthetic()) e @@ -149,40 +85,37 @@ let mkSourceExprConditional isFromSource callExpr sourceMethInfo builderValName else callExpr -let hasMethInfo nm cenv env mBuilderVal ad builderTy = - match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad nm builderTy with - | [] -> false - | _ -> true - -/// Used for all computation expressions except sequence expressions -let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv (mWhole, interpExpr: Expr, builderTy, comp: SynExpr) = - let overallTy = overallTy.Commit +let inline mkSynLambda p e m = + SynExpr.Lambda(false, false, p, e, None, m, SynExprLambdaTrivia.Zero) - let g = cenv.g - let ad = env.eAccessRights +let mkExprForVarSpace m (patvs: Val list) = + match patvs with + | [] -> SynExpr.Const(SynConst.Unit, m) + | [ v ] -> SynExpr.Ident v.Id + | vs -> SynExpr.Tuple(false, (vs |> List.map (fun v -> SynExpr.Ident(v.Id))), [], m) - let builderValName = CompilerGeneratedName "builder" - let mBuilderVal = interpExpr.Range +let mkSimplePatForVarSpace m (patvs: Val list) = + let spats = + match patvs with + | [] -> [] + | [ v ] -> [ mkSynSimplePatVar false v.Id ] + | vs -> vs |> List.map (fun v -> mkSynSimplePatVar false v.Id) - // Give bespoke error messages for the FSharp.Core "query" builder - let isQuery = - match stripDebugPoints interpExpr with - // An unparameterized custom builder, e.g., `query`, `async`. - | Expr.Val(vref, _, m) - // A parameterized custom builder, e.g., `builder<…>`, `builder ()`. - | Expr.App(funcExpr = Expr.Val(vref, _, m)) when not vref.IsMember || vref.IsConstructor -> - let item = Item.CustomBuilder(vref.DisplayName, vref) - CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - valRefEq cenv.g vref cenv.g.query_value_vref - | _ -> false + SynSimplePats.SimplePats(spats, [], m) - let sourceMethInfo = - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Source" builderTy +let mkPatForVarSpace m (patvs: Val list) = + match patvs with + | [] -> SynPat.Const(SynConst.Unit, m) + | [ v ] -> mkSynPatVar None v.Id + | vs -> SynPat.Tuple(false, (vs |> List.map (fun x -> mkSynPatVar None x.Id)), [], m) - /// Decide if the builder is an auto-quote builder - let isAutoQuote = hasMethInfo "Quote" cenv env mBuilderVal ad builderTy +let hasMethInfo nm cenv env mBuilderVal ad builderTy = + match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad nm builderTy with + | [] -> false + | _ -> true - let customOperationMethods = +let getCustomOperationMethods (cenv: TcFileState) (env: TcEnv) ad mBuilderVal builderTy = + let allMethInfos = AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader @@ -192,286 +125,259 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv IgnoreOverrides mBuilderVal builderTy - |> List.choose (fun methInfo -> - if not (IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo) then - None - else - let nameSearch = + + [ for methInfo in allMethInfos do + if IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo then + let nameSearch = + TryBindMethInfoAttribute + cenv.g + mBuilderVal + cenv.g.attrib_CustomOperationAttribute + methInfo + IgnoreAttribute // We do not respect this attribute for IL methods + (fun attr -> + // NOTE: right now, we support of custom operations with spaces in them ([]) + // In the parameterless CustomOperationAttribute - we use the method name, and also allow it to be ````-quoted (member _.``foo bar`` _ = ...) + match attr with + // Empty string and parameterless constructor - we use the method name + | Attrib(unnamedArgs = [ AttribStringArg "" ]) // Empty string as parameter + | Attrib(unnamedArgs = []) -> // No parameters, same as empty string for compat reasons. + Some methInfo.LogicalName + // Use the specified name + | Attrib(unnamedArgs = [ AttribStringArg msg ]) -> Some msg + | _ -> None) + IgnoreAttribute // We do not respect this attribute for provided methods + + match nameSearch with + | None -> () + | Some nm -> + let joinConditionWord = TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo IgnoreAttribute // We do not respect this attribute for IL methods - (fun attr -> - // NOTE: right now, we support of custom operations with spaces in them ([]) - // In the parameterless CustomOperationAttribute - we use the method name, and also allow it to be ````-quoted (member _.``foo bar`` _ = ...) - match attr with - // Empty string and parameterless constructor - we use the method name - | Attrib(unnamedArgs = [ AttribStringArg "" ]) // Empty string as parameter - | Attrib(unnamedArgs = []) -> // No parameters, same as empty string for compat reasons. - Some methInfo.LogicalName - // Use the specified name - | Attrib(unnamedArgs = [ AttribStringArg msg ]) -> Some msg - | _ -> None) + (function + | Attrib(propVal = ExtractAttribNamedArg "JoinConditionWord" (AttribStringArg s)) -> Some s + | _ -> None) IgnoreAttribute // We do not respect this attribute for provided methods - match nameSearch with - | None -> None - | Some nm -> - let joinConditionWord = - TryBindMethInfoAttribute - cenv.g - mBuilderVal - cenv.g.attrib_CustomOperationAttribute - methInfo - IgnoreAttribute // We do not respect this attribute for IL methods - (function - | Attrib(propVal = ExtractAttribNamedArg "JoinConditionWord" (AttribStringArg s)) -> Some s - | _ -> None) - IgnoreAttribute // We do not respect this attribute for provided methods - - let flagSearch (propName: string) = - TryBindMethInfoAttribute - cenv.g - mBuilderVal - cenv.g.attrib_CustomOperationAttribute - methInfo - IgnoreAttribute // We do not respect this attribute for IL methods - (function - | Attrib(propVal = ExtractAttribNamedArg propName (AttribBoolArg b)) -> Some b - | _ -> None) - IgnoreAttribute // We do not respect this attribute for provided methods - - let maintainsVarSpaceUsingBind = - defaultArg (flagSearch "MaintainsVariableSpaceUsingBind") false - - let maintainsVarSpace = defaultArg (flagSearch "MaintainsVariableSpace") false - let allowInto = defaultArg (flagSearch "AllowIntoPattern") false - let isLikeZip = defaultArg (flagSearch "IsLikeZip") false - let isLikeJoin = defaultArg (flagSearch "IsLikeJoin") false - let isLikeGroupJoin = defaultArg (flagSearch "IsLikeGroupJoin") false - - Some( - nm, - maintainsVarSpaceUsingBind, - maintainsVarSpace, - allowInto, - isLikeZip, - isLikeJoin, - isLikeGroupJoin, - joinConditionWord, + let flagSearch (propName: string) = + TryBindMethInfoAttribute + cenv.g + mBuilderVal + cenv.g.attrib_CustomOperationAttribute methInfo - )) - - let customOperationMethodsIndexedByKeyword = - if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then - customOperationMethods - |> Seq.groupBy (fun (nm, _, _, _, _, _, _, _, _) -> nm) - |> Seq.map (fun (nm, group) -> (nm, group |> Seq.toList)) - else - customOperationMethods - |> Seq.groupBy (fun (nm, _, _, _, _, _, _, _, _) -> nm) - |> Seq.map (fun (nm, g) -> (nm, Seq.toList g)) - |> dict - - // Check for duplicates by method name (keywords and method names must be 1:1) - let customOperationMethodsIndexedByMethodName = - if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then - customOperationMethods - |> Seq.groupBy (fun (_, _, _, _, _, _, _, _, methInfo) -> methInfo.LogicalName) - |> Seq.map (fun (nm, group) -> (nm, group |> Seq.toList)) - else - customOperationMethods - |> Seq.groupBy (fun (_, _, _, _, _, _, _, _, methInfo) -> methInfo.LogicalName) - |> Seq.map (fun (nm, g) -> (nm, Seq.toList g)) - |> dict - - /// Decide if the identifier represents a use of a custom query operator - let tryGetDataForCustomOperation (nm: Ident) = - let isOpDataCountAllowed opDatas = - match opDatas with - | [ _ ] -> true - | _ :: _ -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations - | _ -> false - - match customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with - | true, opDatas when isOpDataCountAllowed opDatas -> - for opData in opDatas do - let (opName, - maintainsVarSpaceUsingBind, - maintainsVarSpace, - _allowInto, - isLikeZip, - isLikeJoin, - isLikeGroupJoin, - _joinConditionWord, - methInfo) = - opData - - if - (maintainsVarSpaceUsingBind && maintainsVarSpace) - || (isLikeZip && isLikeJoin) - || (isLikeZip && isLikeGroupJoin) - || (isLikeJoin && isLikeGroupJoin) - then - errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) + IgnoreAttribute // We do not respect this attribute for IL methods + (function + | Attrib(propVal = ExtractAttribNamedArg propName (AttribBoolArg b)) -> Some b + | _ -> None) + IgnoreAttribute // We do not respect this attribute for provided methods - if not (cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations) then - match customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with - | true, [ _ ] -> () - | _ -> errorR (Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) + let maintainsVarSpaceUsingBind = + defaultArg (flagSearch "MaintainsVariableSpaceUsingBind") false - Some opDatas - | true, opData :: _ -> - errorR (Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) - Some [ opData ] - | _ -> None + let maintainsVarSpace = defaultArg (flagSearch "MaintainsVariableSpace") false + let allowInto = defaultArg (flagSearch "AllowIntoPattern") false + let isLikeZip = defaultArg (flagSearch "IsLikeZip") false + let isLikeJoin = defaultArg (flagSearch "IsLikeJoin") false + let isLikeGroupJoin = defaultArg (flagSearch "IsLikeGroupJoin") false - /// Decide if the identifier represents a use of a custom query operator - let hasCustomOperations () = - if isNil customOperationMethods then - CustomOperationsMode.Denied - else - CustomOperationsMode.Allowed - - let isCustomOperation nm = - tryGetDataForCustomOperation nm |> Option.isSome - - let customOperationCheckValidity m f opDatas = - let vs = opDatas |> List.map f - let v0 = vs[0] - - let (opName, - _maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - _methInfo) = - opDatas[0] - - if not (List.allEqual vs) then - errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, m)) - - v0 - - // Check for the MaintainsVariableSpace on custom operation - let customOperationMaintainsVarSpace (nm: Ident) = - match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> - opDatas - |> customOperationCheckValidity - nm.idRange - (fun - (_nm, - _maintainsVarSpaceUsingBind, - maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - _methInfo) -> maintainsVarSpace) + nm, + maintainsVarSpaceUsingBind, + maintainsVarSpace, + allowInto, + isLikeZip, + isLikeJoin, + isLikeGroupJoin, + joinConditionWord, + methInfo ] + +/// Decide if the identifier represents a use of a custom query operator +let tryGetDataForCustomOperation + (nm: Ident) + (cenv: TcFileState) + (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + = + + let isOpDataCountAllowed opDatas = + match opDatas with + | [ _ ] -> true + | _ :: _ -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations + | _ -> false - let customOperationMaintainsVarSpaceUsingBind (nm: Ident) = - match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> - opDatas - |> customOperationCheckValidity - nm.idRange - (fun - (_nm, - maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - _methInfo) -> maintainsVarSpaceUsingBind) + match customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with + | true, opDatas when isOpDataCountAllowed opDatas -> + for opData in opDatas do + let (opName, + maintainsVarSpaceUsingBind, + maintainsVarSpace, + _allowInto, + isLikeZip, + isLikeJoin, + isLikeGroupJoin, + _joinConditionWord, + methInfo) = + opData - let customOperationIsLikeZip (nm: Ident) = - match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> - opDatas - |> customOperationCheckValidity - nm.idRange - (fun - (_nm, - _maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - _methInfo) -> isLikeZip) + if + (maintainsVarSpaceUsingBind && maintainsVarSpace) + || (isLikeZip && isLikeJoin) + || (isLikeZip && isLikeGroupJoin) + || (isLikeJoin && isLikeGroupJoin) + then + errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) - let customOperationIsLikeJoin (nm: Ident) = - match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> - opDatas - |> customOperationCheckValidity - nm.idRange - (fun - (_nm, - _maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - _isLikeZip, - isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - _methInfo) -> isLikeJoin) + if not (cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations) then + match customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with + | true, [ _ ] -> () + | _ -> errorR (Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) - let customOperationIsLikeGroupJoin (nm: Ident) = - match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> - opDatas - |> customOperationCheckValidity - nm.idRange - (fun - (_nm, - _maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - isLikeGroupJoin, - _joinConditionWord, - _methInfo) -> isLikeGroupJoin) + Some opDatas + | true, opData :: _ -> + errorR (Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) + Some [ opData ] + | _ -> None - let customOperationJoinConditionWord (nm: Ident) = - match tryGetDataForCustomOperation nm with - | Some opDatas -> - opDatas - |> customOperationCheckValidity - nm.idRange - (fun - (_nm, - _maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - joinConditionWord, - _methInfo) -> joinConditionWord) - |> function - | None -> "on" - | Some v -> v - | _ -> "on" - - let customOperationAllowsInto (nm: Ident) = - match tryGetDataForCustomOperation nm with +let isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm = + tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName + |> Option.isSome + +let customOperationCheckValidity m f opDatas = + let vs = List.map f opDatas + let v0 = vs[0] + + let (opName, + _maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + _methInfo) = + opDatas[0] + + if not (List.allEqual vs) then + errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, m)) + v0 + +// Check for the MaintainsVariableSpace on custom operation +let customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> false + | Some opDatas -> + opDatas + |> customOperationCheckValidity + nm.idRange + (fun + (_nm, + _maintainsVarSpaceUsingBind, + maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + _methInfo) -> maintainsVarSpace) + +let customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> false + | Some opDatas -> + opDatas + |> customOperationCheckValidity + nm.idRange + (fun + (_nm, + maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + _methInfo) -> maintainsVarSpaceUsingBind) + +let customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> false + | Some opDatas -> + opDatas + |> customOperationCheckValidity + nm.idRange + (fun + (_nm, + _maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + _methInfo) -> isLikeZip) + +let customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> false + | Some opDatas -> + opDatas + |> customOperationCheckValidity + nm.idRange + (fun + (_nm, + _maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + _isLikeZip, + isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + _methInfo) -> isLikeJoin) + +let customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> false + | Some opDatas -> + opDatas + |> customOperationCheckValidity + nm.idRange + (fun + (_nm, + _maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + isLikeGroupJoin, + _joinConditionWord, + _methInfo) -> isLikeGroupJoin) + +let customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | Some opDatas -> + opDatas + |> customOperationCheckValidity + nm.idRange + (fun + (_nm, + _maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + joinConditionWord, + _methInfo) -> joinConditionWord) + |> function + | None -> "on" + | Some v -> v + | _ -> "on" + +let customOperationAllowsInto cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with | None -> false | Some opDatas -> opDatas @@ -488,61 +394,62 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv _joinConditionWord, _methInfo) -> allowInto) - let customOpUsageText nm = - match tryGetDataForCustomOperation nm with - | Some((_nm, - _maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - isLikeZip, - isLikeJoin, - isLikeGroupJoin, - _joinConditionWord, - _methInfo) :: _) -> - if isLikeGroupJoin then - Some( - FSComp.SR.customOperationTextLikeGroupJoin ( - nm.idText, - customOperationJoinConditionWord nm, - customOperationJoinConditionWord nm - ) +let customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | Some((_nm, + _maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + isLikeZip, + isLikeJoin, + isLikeGroupJoin, + _joinConditionWord, + _methInfo) :: _) -> + if isLikeGroupJoin then + Some( + FSComp.SR.customOperationTextLikeGroupJoin ( + nm.idText, + customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm, + customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm ) - elif isLikeJoin then - Some( - FSComp.SR.customOperationTextLikeJoin ( - nm.idText, - customOperationJoinConditionWord nm, - customOperationJoinConditionWord nm - ) + ) + elif isLikeJoin then + Some( + FSComp.SR.customOperationTextLikeJoin ( + nm.idText, + customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm, + customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm ) - elif isLikeZip then - Some(FSComp.SR.customOperationTextLikeZip (nm.idText)) - else - None - | _ -> None - - /// Inside the 'query { ... }' use a modified name environment that contains fake 'CustomOperation' entries - /// for all custom operations. This adds them to the completion lists and prevents them being used as values inside - /// the query. - let env = - if List.isEmpty customOperationMethods then - env + ) + elif isLikeZip then + Some(FSComp.SR.customOperationTextLikeZip (nm.idText)) else - { env with - eNameResEnv = - (env.eNameResEnv, customOperationMethods) - ||> Seq.fold (fun nenv (nm, _, _, _, _, _, _, _, methInfo) -> - AddFakeNameToNameEnv - nm - nenv - (Item.CustomOperation(nm, (fun () -> customOpUsageText (ident (nm, mBuilderVal))), Some methInfo))) - } + None + | _ -> None - // Environment is needed for completions - CallEnvSink cenv.tcSink (comp.Range, env.NameEnv, ad) +let tryGetArgAttribsForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | Some argInfos -> + argInfos + |> List.map + (fun + (_nm, + __maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + methInfo) -> + match methInfo.GetParamAttribs(cenv.amap, mWhole) with + | [ curriedArgInfo ] -> Some curriedArgInfo // one for the actual argument group + | _ -> None) + |> Some + | _ -> None - let tryGetArgAttribsForCustomOperator (nm: Ident) = - match tryGetDataForCustomOperation nm with +let tryGetArgInfosForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with | Some argInfos -> argInfos |> List.map @@ -556,124 +463,198 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv _isLikeGroupJoin, _joinConditionWord, methInfo) -> - match methInfo.GetParamAttribs(cenv.amap, mWhole) with - | [ curriedArgInfo ] -> Some curriedArgInfo // one for the actual argument group + match methInfo with + | FSMeth(_, _, vref, _) -> + match ArgInfosOfMember cenv.g vref with + | [ curriedArgInfo ] -> Some curriedArgInfo + | _ -> None | _ -> None) |> Some | _ -> None - let tryGetArgInfosForCustomOperator (nm: Ident) = - match tryGetDataForCustomOperation nm with - | Some argInfos -> - argInfos - |> List.map - (fun - (_nm, - __maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - methInfo) -> - match methInfo with - | FSMeth(_, _, vref, _) -> - match ArgInfosOfMember cenv.g vref with - | [ curriedArgInfo ] -> Some curriedArgInfo - | _ -> None - | _ -> None) - |> Some - | _ -> None +let tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole (nm: Ident) = + match tryGetArgAttribsForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm with + | None -> None + | Some argInfosForOverloads -> + let nums = + argInfosForOverloads + |> List.map (function + | None -> -1 + | Some argInfos -> List.length argInfos) + + // Prior to 'OverloadsForCustomOperations' we count exact arguments. + // + // With 'OverloadsForCustomOperations' we don't compute an exact expected argument count + // if any arguments are optional, out or ParamArray. + let isSpecial = + if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then + argInfosForOverloads + |> List.exists (fun info -> + match info with + | None -> false + | Some args -> + args + |> List.exists + (fun (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo)) -> + isParamArrayArg || isOutArg || optArgInfo.IsOptional)) + else + false + + if not isSpecial && nums |> List.forall (fun v -> v >= 0 && v = nums[0]) then + Some(max (nums[0] - 1) 0) // drop the computation context argument + else + None + +// Check for the [] attribute on an argument position +let isCustomOperationProjectionParameter cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName i (nm: Ident) = + match tryGetArgInfosForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm with + | None -> false + | Some argInfosForOverloads -> + let vs = + argInfosForOverloads + |> List.map (function + | None -> false + | Some argInfos -> + i < argInfos.Length + && let _, argInfo = List.item i argInfos in + HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) + + if List.allEqual vs then + vs[0] + else + let opDatas = (tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName).Value + let opName, _, _, _, _, _, _, _j, _ = opDatas[0] + errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) + false + +[] +let (|ExprAsPat|_|) (f: SynExpr) = + match f with + | SingleIdent v1 + | SynExprParen(SingleIdent v1, _, _, _) -> ValueSome(mkSynPatVar None v1) + | SynExprParen(SynExpr.Tuple(false, elems, commas, _), _, _, _) -> + let elems = elems |> List.map (|SingleIdent|_|) + + if elems |> List.forall (fun x -> x.IsSome) then + ValueSome(SynPat.Tuple(false, (elems |> List.map (fun x -> mkSynPatVar None x.Value)), commas, f.Range)) + else + ValueNone + | _ -> ValueNone + +// For join clauses that join on nullable, we syntactically insert the creation of nullable values on the appropriate side of the condition, +// then pull the syntax apart again +[] +let (|JoinRelation|_|) cenv env (expr: SynExpr) = + let m = expr.Range + let ad = env.eAccessRights + + let isOpName opName vref s = + (s = opName) + && match + ResolveExprLongIdent + cenv.tcSink + cenv.nameResolver + m + ad + env.eNameResEnv + TypeNameResolutionInfo.Default + [ ident (opName, m) ] + None + with + | Result(_, Item.Value vref2, []) -> valRefEq cenv.g vref vref2 + | _ -> false + + match expr with + | BinOpExpr(opId, a, b) when isOpName opNameEquals cenv.g.equals_operator_vref opId.idText -> ValueSome(a, b) + + | BinOpExpr(opId, a, b) when isOpName opNameEqualsNullable cenv.g.equals_nullable_operator_vref opId.idText -> + + let a = + SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [ MangledGlobalName; "System" ] "Nullable", a, a.Range) + + ValueSome(a, b) + + | BinOpExpr(opId, a, b) when isOpName opNameNullableEquals cenv.g.nullable_equals_operator_vref opId.idText -> + + let b = + SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [ MangledGlobalName; "System" ] "Nullable", b, b.Range) + + ValueSome(a, b) - let tryExpectedArgCountForCustomOperator (nm: Ident) = - match tryGetArgAttribsForCustomOperator nm with - | None -> None - | Some argInfosForOverloads -> - let nums = - argInfosForOverloads - |> List.map (function - | None -> -1 - | Some argInfos -> List.length argInfos) - - // Prior to 'OverloadsForCustomOperations' we count exact arguments. - // - // With 'OverloadsForCustomOperations' we don't compute an exact expected argument count - // if any arguments are optional, out or ParamArray. - let isSpecial = - if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then - argInfosForOverloads - |> List.exists (fun info -> - match info with - | None -> false - | Some args -> - args - |> List.exists - (fun (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo)) -> - isParamArrayArg || isOutArg || optArgInfo.IsOptional)) - else - false + | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText -> - if not isSpecial && nums |> List.forall (fun v -> v >= 0 && v = nums[0]) then - Some(max (nums[0] - 1) 0) // drop the computation context argument - else - None + ValueSome(a, b) - // Check for the [] attribute on an argument position - let isCustomOperationProjectionParameter i (nm: Ident) = - match tryGetArgInfosForCustomOperator nm with - | None -> false - | Some argInfosForOverloads -> - let vs = - argInfosForOverloads - |> List.map (function - | None -> false - | Some argInfos -> - i < argInfos.Length - && let _, argInfo = List.item i argInfos in - HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) + | _ -> ValueNone - if List.allEqual vs then - vs[0] - else - let opDatas = (tryGetDataForCustomOperation nm).Value - let opName, _, _, _, _, _, _, _j, _ = opDatas[0] - errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) - false +let (|ForEachThen|_|) synExpr = + match synExpr with + | SynExpr.ForEach(_spFor, + _spIn, + SeqExprOnly false, + isFromSource, + pat1, + expr1, + SynExpr.Sequential(isTrueSeq = true; expr1 = clause; expr2 = rest), + _) -> Some(isFromSource, pat1, expr1, clause, rest) + | _ -> None + +let (|CustomOpId|_|) isCustomOperation predicate synExpr = + match synExpr with + | SingleIdent nm when isCustomOperation nm && predicate nm -> Some nm + | _ -> None - // e1 in e2 ('in' is parsed as 'JOIN_IN') - let (|InExpr|_|) synExpr = +// e1 in e2 ('in' is parsed as 'JOIN_IN') +let (|InExpr|_|) synExpr = + match synExpr with + | SynExpr.JoinIn(e1, _, e2, mApp) -> Some(e1, e2, mApp) + | _ -> None + +// e1 on e2 (note: 'on' is the 'JoinConditionWord') +let (|OnExpr|_|) (env: TcEnv) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm synExpr = + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> None + | Some _ -> match synExpr with - | SynExpr.JoinIn(e1, _, e2, mApp) -> Some(e1, e2, mApp) + | SynExpr.App(funcExpr = SynExpr.App(funcExpr = e1; argExpr = SingleIdent opName); argExpr = e2) when + opName.idText = customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + -> + let item = Item.CustomOperation(opName.idText, (fun () -> None), None) + CallNameResolutionSink cenv.tcSink (opName.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) + Some(e1, e2) | _ -> None - // e1 on e2 (note: 'on' is the 'JoinConditionWord') - let (|OnExpr|_|) nm synExpr = - match tryGetDataForCustomOperation nm with - | None -> None - | Some _ -> - match synExpr with - | SynExpr.App(funcExpr = SynExpr.App(funcExpr = e1; argExpr = SingleIdent opName); argExpr = e2) when - opName.idText = customOperationJoinConditionWord nm - -> - let item = Item.CustomOperation(opName.idText, (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (opName.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) - Some(e1, e2) - | _ -> None - - // e1 into e2 - let (|IntoSuffix|_|) (e: SynExpr) = - match e with - | SynExpr.App(funcExpr = SynExpr.App(funcExpr = x; argExpr = SingleIdent nm2); argExpr = ExprAsPat intoPat) when - nm2.idText = CustomOperations.Into - -> - Some(x, nm2.idRange, intoPat) +// e1 into e2 +let (|IntoSuffix|_|) (e: SynExpr) = + match e with + | SynExpr.App(funcExpr = SynExpr.App(funcExpr = x; argExpr = SingleIdent nm2); argExpr = ExprAsPat intoPat) when + nm2.idText = CustomOperations.Into + -> + Some(x, nm2.idRange, intoPat) + | _ -> None + +let JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName detector synExpr = + match synExpr with + | SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, ExprAsPat innerSourcePat, mJoinCore) -> + Some(nm, innerSourcePat, mJoinCore, false) + // join with bad pattern (gives error on "join" and continues) + | SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, _innerSourcePatExpr, mJoinCore) -> + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) + Some(nm, arbPat mJoinCore, mJoinCore, true) + // join (without anything after - gives error on "join" and continues) + | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm -> + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) + Some(nm, arbPat synExpr.Range, synExpr.Range, true) | _ -> None + // JoinOrGroupJoinOp customOperationIsLikeJoin + +let (|JoinOp|_|) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = + JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) synExpr - let arbPat (m: range) = - mkSynPatVar None (mkSynId (m.MakeSynthetic()) "_missingVar") +let (|GroupJoinOp|_|) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = + JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) synExpr - let MatchIntoSuffixOrRecover alreadyGivenError (nm: Ident) synExpr = +let MatchIntoSuffixOrRecover cenv (env: TcEnv) customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError (nm: Ident) synExpr = match synExpr with | IntoSuffix(x, intoWordRange, intoPat) -> // record the "into" as a custom operation for colorization @@ -682,70 +663,46 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv (x, intoPat, alreadyGivenError) | _ -> if not alreadyGivenError then - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) (synExpr, arbPat synExpr.Range, true) - let MatchOnExprOrRecover alreadyGivenError nm (onExpr: SynExpr) = - match onExpr with - | OnExpr nm (innerSource, SynExprParen(keySelectors, _, _, _)) -> (innerSource, keySelectors) - | _ -> - if not alreadyGivenError then - suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv onExpr) - |> ignore - - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) - - (arbExpr ("_innerSource", onExpr.Range), - mkSynBifix onExpr.Range "=" (arbExpr ("_keySelectors", onExpr.Range)) (arbExpr ("_keySelector2", onExpr.Range))) - - let JoinOrGroupJoinOp detector synExpr = - match synExpr with - | SynExpr.App(_, _, CustomOpId isCustomOperation detector nm, ExprAsPat innerSourcePat, mJoinCore) -> - Some(nm, innerSourcePat, mJoinCore, false) - // join with bad pattern (gives error on "join" and continues) - | SynExpr.App(_, _, CustomOpId isCustomOperation detector nm, _innerSourcePatExpr, mJoinCore) -> - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) - Some(nm, arbPat mJoinCore, mJoinCore, true) - // join (without anything after - gives error on "join" and continues) - | CustomOpId isCustomOperation detector nm -> - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) - Some(nm, arbPat synExpr.Range, synExpr.Range, true) - | _ -> None - // JoinOrGroupJoinOp customOperationIsLikeJoin - - let (|JoinOp|_|) synExpr = - JoinOrGroupJoinOp customOperationIsLikeJoin synExpr +let MatchOnExprOrRecover cenv (env: TcEnv) tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm (onExpr: SynExpr) = + match onExpr with + | OnExpr (env: TcEnv) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm (innerSource, SynExprParen(keySelectors, _, _, _)) -> (innerSource, keySelectors) + | _ -> + if not alreadyGivenError then + suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv onExpr) + |> ignore - let (|GroupJoinOp|_|) synExpr = - JoinOrGroupJoinOp customOperationIsLikeGroupJoin synExpr + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) - let arbKeySelectors m = - mkSynBifix m "=" (arbExpr ("_keySelectors", m)) (arbExpr ("_keySelector2", m)) + (arbExpr ("_innerSource", onExpr.Range), + mkSynBifix onExpr.Range "=" (arbExpr ("_keySelectors", onExpr.Range)) (arbExpr ("_keySelector2", onExpr.Range))) - let (|JoinExpr|_|) synExpr = +let (|JoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = match synExpr with - | InExpr(JoinOp(nm, innerSourcePat, _, alreadyGivenError), onExpr, mJoinCore) -> - let innerSource, keySelectors = MatchOnExprOrRecover alreadyGivenError nm onExpr + | InExpr(JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, _, alreadyGivenError), onExpr, mJoinCore) -> + let innerSource, keySelectors = MatchOnExprOrRecover cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm onExpr Some(nm, innerSourcePat, innerSource, keySelectors, mJoinCore) - | JoinOp(nm, innerSourcePat, mJoinCore, alreadyGivenError) -> + | JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, mJoinCore, alreadyGivenError) -> if alreadyGivenError then - errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) Some(nm, innerSourcePat, arbExpr ("_innerSource", synExpr.Range), arbKeySelectors synExpr.Range, mJoinCore) | _ -> None - let (|GroupJoinExpr|_|) synExpr = +let (|GroupJoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = match synExpr with - | InExpr(GroupJoinOp(nm, innerSourcePat, _, alreadyGivenError), intoExpr, mGroupJoinCore) -> + | InExpr(GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, _, alreadyGivenError), intoExpr, mGroupJoinCore) -> let onExpr, intoPat, alreadyGivenError = - MatchIntoSuffixOrRecover alreadyGivenError nm intoExpr + MatchIntoSuffixOrRecover cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm intoExpr - let innerSource, keySelectors = MatchOnExprOrRecover alreadyGivenError nm onExpr + let innerSource, keySelectors = MatchOnExprOrRecover cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm onExpr Some(nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) - | GroupJoinOp(nm, innerSourcePat, mGroupJoinCore, alreadyGivenError) -> + | GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, mGroupJoinCore, alreadyGivenError) -> if alreadyGivenError then - errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) Some( nm, @@ -757,40 +714,40 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv ) | _ -> None - let (|JoinOrGroupJoinOrZipClause|_|) synExpr = +let (|JoinOrGroupJoinOrZipClause|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = match synExpr with // join innerSourcePat in innerSource on (keySelector1 = keySelector2) - | JoinExpr(nm, innerSourcePat, innerSource, keySelectors, mJoinCore) -> + | JoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, innerSource, keySelectors, mJoinCore) -> Some(nm, innerSourcePat, innerSource, Some keySelectors, None, mJoinCore) // groupJoin innerSourcePat in innerSource on (keySelector1 = keySelector2) into intoPat - | GroupJoinExpr(nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) -> + | GroupJoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) -> Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) // zip intoPat in secondSource - | InExpr(SynExpr.App(_, _, CustomOpId isCustomOperation customOperationIsLikeZip nm, ExprAsPat secondSourcePat, _), + | InExpr(SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, ExprAsPat secondSourcePat, _), secondSource, mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) // zip (without secondSource or in - gives error) - | CustomOpId isCustomOperation customOperationIsLikeZip nm -> - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm -> + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) Some(nm, arbPat synExpr.Range, arbExpr ("_secondSource", synExpr.Range), None, None, synExpr.Range) // zip secondSource (without in - gives error) - | SynExpr.App(_, _, CustomOpId isCustomOperation customOperationIsLikeZip nm, ExprAsPat secondSourcePat, mZipCore) -> - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText nm)), mZipCore)) + | SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, ExprAsPat secondSourcePat, mZipCore) -> + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), mZipCore)) Some(nm, secondSourcePat, arbExpr ("_innerSource", synExpr.Range), None, None, mZipCore) | _ -> None - let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) strict synExpr = +let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName strict synExpr = match synExpr with | ForEachThen(isFromSource, firstSourcePat, firstSource, - JoinOrGroupJoinOrZipClause(nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore), + JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore), innerComp) when (let _firstSourceSimplePats, later1 = use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink @@ -800,8 +757,8 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv -> Some(isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp) - | JoinOrGroupJoinOrZipClause(nm, pat2, expr2, expr3, pat3opt, mOpCore) when strict -> - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + | JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, pat2, expr2, expr3, pat3opt, mOpCore) when strict -> + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) Some( true, @@ -818,1172 +775,1188 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv | _ -> None - let (|StripApps|) e = - let rec strip e = - match e with - | SynExpr.FromParseError(SynExpr.App(funcExpr = f; argExpr = arg), _) - | SynExpr.App(funcExpr = f; argExpr = arg) -> - let g, acc = strip f - g, (arg :: acc) - | _ -> e, [] - - let g, acc = strip e - g, List.rev acc - - let (|OptionalIntoSuffix|) e = +let (|StripApps|) e = + let rec strip e = match e with - | IntoSuffix(body, intoWordRange, intoInfo) -> (body, Some(intoWordRange, intoInfo)) - | body -> (body, None) - - let (|CustomOperationClause|_|) e = - match e with - | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when isCustomOperation nm -> - // Now we know we have a custom operation, commit the name resolution - let intoInfoOpt = - match intoOpt with - | Some(intoWordRange, intoInfo) -> - let item = Item.CustomOperation("into", (fun () -> None), None) - - CallNameResolutionSink - cenv.tcSink - (intoWordRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - - Some intoInfo - | None -> None + | SynExpr.FromParseError(SynExpr.App(funcExpr = f; argExpr = arg), _) + | SynExpr.App(funcExpr = f; argExpr = arg) -> + let g, acc = strip f + g, (arg :: acc) + | _ -> e, [] + + let g, acc = strip e + g, List.rev acc + +let (|OptionalIntoSuffix|) e = + match e with + | IntoSuffix(body, intoWordRange, intoInfo) -> (body, Some(intoWordRange, intoInfo)) + | body -> (body, None) + +let (|CustomOperationClause|_|) cenv (env: TcEnv) customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName e = + match e with + | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> + // Now we know we have a custom operation, commit the name resolution + let intoInfoOpt = + match intoOpt with + | Some(intoWordRange, intoInfo) -> + let item = Item.CustomOperation("into", (fun () -> None), None) + + CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + + Some intoInfo + | None -> None - Some(nm, Option.get (tryGetDataForCustomOperation nm), core, core.Range, intoInfoOpt) - | _ -> None + Some( + nm, + Option.get ( + tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName + ), + core, + core.Range, + intoInfoOpt + ) + | _ -> None - let mkSynLambda p e m = - SynExpr.Lambda(false, false, p, e, None, m, SynExprLambdaTrivia.Zero) +let (|OptionalSequential|) e = + match e with + | SynExpr.Sequential(debugPoint = _sp; isTrueSeq = true; expr1 = dataComp1; expr2 = dataComp2) -> (dataComp1, Some dataComp2) + | _ -> (e, None) + +// "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 +let rangeForCombine innerComp1 = + let m = + match innerComp1 with + | SynExpr.IfThenElse(trivia = { IfToThenRange = mIfToThen }) -> mIfToThen + | SynExpr.Match(matchDebugPoint = DebugPointAtBinding.Yes mMatch) -> mMatch + | SynExpr.TryWith(trivia = { TryKeyword = mTry }) -> mTry + | SynExpr.TryFinally(trivia = { TryKeyword = mTry }) -> mTry + | SynExpr.For(forDebugPoint = DebugPointAtFor.Yes mBind) -> mBind + | SynExpr.ForEach(forDebugPoint = DebugPointAtFor.Yes mBind) -> mBind + | SynExpr.While(whileDebugPoint = DebugPointAtWhile.Yes mWhile) -> mWhile + | _ -> innerComp1.Range + + m.NoteSourceConstruct(NotedSourceConstruct.Combine) + +// Check for 'where x > y', 'select x, y' and other mis-applications of infix operators, give a good error message, and return a flag +let checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole comp = + match comp with + | StripApps(SingleIdent nm, [ StripApps(SingleIdent nm2, args); arg2 ]) when + IsLogicalInfixOpName nm.idText + && (match tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm2 with + | Some n -> n > 0 + | _ -> false) + && not (List.isEmpty args) + -> + let estimatedRangeOfIntendedLeftAndRightArguments = + unionRanges (List.last args).Range arg2.Range + + errorR (Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator (), estimatedRangeOfIntendedLeftAndRightArguments)) + true + | SynExpr.Tuple(false, StripApps(SingleIdent nm2, args) :: _, _, m) when + (match tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm2 with + | Some n -> n > 0 + | _ -> false) + && not (List.isEmpty args) + -> + let estimatedRangeOfIntendedLeftAndRightArguments = + unionRanges (List.last args).Range m.EndRange + + errorR (Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator (), estimatedRangeOfIntendedLeftAndRightArguments)) + true + | _ -> false + +let inline addVarsToVarSpace (varSpace: LazyWithContext) f = + LazyWithContext.Create( + (fun m -> + let (patvs: Val list, env) = varSpace.Force m + let vs, envinner = f m env + + let patvs = + List.append + patvs + (vs + |> List.filter (fun v -> not (patvs |> List.exists (fun v2 -> v.LogicalName = v2.LogicalName)))) + + patvs, envinner), + id + ) + +/// +/// Try translate the syntax sugar +/// +/// +/// +/// a flag indicating if custom operators are allowed. They are not allowed inside try/with, try/finally, if/then/else etc. +/// a lazy data structure indicating the variables bound so far in the overall computation +/// the computation expression being analyzed +/// represents the translation of the context in which the computation expression 'comp' occurs, +/// up to a hole to be filled by (part of) the results of translating 'comp'. +/// +let rec TryTranslateComputationExpression + (cenv: TcFileState) + env + tpenv + (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + (firstTry: CompExprTranslationPass) + (q: CustomOperationsMode) + (varSpace: LazyWithContext<(Val list * TcEnv), range>) + (comp: SynExpr) + (translatedCtxt: SynExpr -> SynExpr) + : SynExpr option = + // Guard the stack for deeply nested computation expressions + cenv.stackGuard.Guard + <| fun () -> - let mkExprForVarSpace m (patvs: Val list) = - match patvs with - | [] -> SynExpr.Const(SynConst.Unit, m) - | [ v ] -> SynExpr.Ident v.Id - | vs -> SynExpr.Tuple(false, (vs |> List.map (fun v -> SynExpr.Ident(v.Id))), [], m) + match comp with - let mkSimplePatForVarSpace m (patvs: Val list) = - let spats = - match patvs with - | [] -> [] - | [ v ] -> [ mkSynSimplePatVar false v.Id ] - | vs -> vs |> List.map (fun v -> mkSynSimplePatVar false v.Id) + // for firstSourcePat in firstSource do + // join secondSourcePat in expr2 on (expr3 = expr4) + // ... + // --> + // join expr1 expr2 (fun firstSourcePat -> expr3) (fun secondSourcePat -> expr4) (fun firstSourcePat secondSourcePat -> ...) + + // for firstSourcePat in firstSource do + // groupJoin secondSourcePat in expr2 on (expr3 = expr4) into groupPat + // ... + // --> + // groupJoin expr1 expr2 (fun firstSourcePat -> expr3) (fun secondSourcePat -> expr4) (fun firstSourcePat groupPat -> ...) + + // for firstSourcePat in firstSource do + // zip secondSource into secondSourcePat + // ... + // --> + // zip expr1 expr2 (fun pat1 pat3 -> ...) + | ForEachThenJoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName true (isFromSource, + firstSourcePat, + firstSource, + nm, + secondSourcePat, + secondSource, + keySelectorsOpt, + secondResultPatOpt, + mOpCore, + innerComp) -> + match q with + | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), nm.idRange)) + | CustomOperationsMode.Allowed -> + + let firstSource = + mkSourceExprConditional isFromSource firstSource sourceMethInfo builderValName + + let secondSource = mkSourceExpr secondSource sourceMethInfo builderValName + + // Add the variables to the variable space, on demand + let varSpaceWithFirstVars = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - SynSimplePats.SimplePats(spats, [], m) + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv firstSourcePat None - let mkPatForVarSpace m (patvs: Val list) = - match patvs with - | [] -> SynPat.Const(SynConst.Unit, m) - | [ v ] -> mkSynPatVar None v.Id - | vs -> SynPat.Tuple(false, (vs |> List.map (fun x -> mkSynPatVar None x.Id)), [], m) + vspecs, envinner) - let (|OptionalSequential|) e = - match e with - | SynExpr.Sequential(debugPoint = _sp; isTrueSeq = true; expr1 = dataComp1; expr2 = dataComp2) -> (dataComp1, Some dataComp2) - | _ -> (e, None) - - // "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 - let rangeForCombine innerComp1 = - let m = - match innerComp1 with - | SynExpr.IfThenElse(trivia = { IfToThenRange = mIfToThen }) -> mIfToThen - | SynExpr.Match(matchDebugPoint = DebugPointAtBinding.Yes mMatch) -> mMatch - | SynExpr.TryWith(trivia = { TryKeyword = mTry }) -> mTry - | SynExpr.TryFinally(trivia = { TryKeyword = mTry }) -> mTry - | SynExpr.For(forDebugPoint = DebugPointAtFor.Yes mBind) -> mBind - | SynExpr.ForEach(forDebugPoint = DebugPointAtFor.Yes mBind) -> mBind - | SynExpr.While(whileDebugPoint = DebugPointAtWhile.Yes mWhile) -> mWhile - | _ -> innerComp1.Range - - m.NoteSourceConstruct(NotedSourceConstruct.Combine) - - // Check for 'where x > y', 'select x, y' and other mis-applications of infix operators, give a good error message, and return a flag - let checkForBinaryApp comp = - match comp with - | StripApps(SingleIdent nm, [ StripApps(SingleIdent nm2, args); arg2 ]) when - IsLogicalInfixOpName nm.idText - && (match tryExpectedArgCountForCustomOperator nm2 with - | Some n -> n > 0 - | _ -> false) - && not (List.isEmpty args) - -> - let estimatedRangeOfIntendedLeftAndRightArguments = - unionRanges (List.last args).Range arg2.Range - - errorR (Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator (), estimatedRangeOfIntendedLeftAndRightArguments)) - true - | SynExpr.Tuple(false, StripApps(SingleIdent nm2, args) :: _, _, m) when - (match tryExpectedArgCountForCustomOperator nm2 with - | Some n -> n > 0 - | _ -> false) - && not (List.isEmpty args) - -> - let estimatedRangeOfIntendedLeftAndRightArguments = - unionRanges (List.last args).Range m.EndRange + let varSpaceWithSecondVars = + addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - errorR (Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator (), estimatedRangeOfIntendedLeftAndRightArguments)) - true - | _ -> false + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv secondSourcePat None - let addVarsToVarSpace (varSpace: LazyWithContext) f = - LazyWithContext.Create( - (fun m -> - let (patvs: Val list, env) = varSpace.Force m - let vs, envinner = f m env + vspecs, envinner) - let patvs = - List.append - patvs - (vs - |> List.filter (fun v -> not (patvs |> List.exists (fun v2 -> v.LogicalName = v2.LogicalName)))) + let varSpaceWithGroupJoinVars = + match secondResultPatOpt with + | Some pat3 -> + addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - patvs, envinner), - id - ) + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat3 None - // Flag that a debug point should get emitted prior to both the evaluation of 'rhsExpr' and the call to Using - let addBindDebugPoint spBind e = - match spBind with - | DebugPointAtBinding.Yes m -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, e) - | _ -> e + vspecs, envinner) + | None -> varSpace - let emptyVarSpace = LazyWithContext.NotLazy([], env) + let firstSourceSimplePats, later1 = + SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat - // If there are no 'yield' in the computation expression, and the builder supports 'Yield', - // then allow the type-directed rule interpreting non-unit-typed expressions in statement - // positions as 'yield'. 'yield!' may be present in the computation expression. - let enableImplicitYield = - cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield - && (hasMethInfo "Yield" cenv env mBuilderVal ad builderTy - && hasMethInfo "Combine" cenv env mBuilderVal ad builderTy - && hasMethInfo "Delay" cenv env mBuilderVal ad builderTy - && YieldFree cenv comp) + let secondSourceSimplePats, later2 = + SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat - let origComp = comp + if Option.isSome later1 then + errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), firstSourcePat.Range)) - /// - /// Try translate the syntax sugar - /// - /// - /// a flag indicating if custom operators are allowed. They are not allowed inside try/with, try/finally, if/then/else etc. - /// a lazy data structure indicating the variables bound so far in the overall computation - /// the computation expression being analyzed - /// represents the translation of the context in which the computation expression 'comp' occurs, - /// up to a hole to be filled by (part of) the results of translating 'comp'. - let rec tryTrans - (firstTry: CompExprTranslationPass) - (q: CustomOperationsMode) - (varSpace: LazyWithContext<(Val list * TcEnv), range>) - (comp: SynExpr) - (translatedCtxt: SynExpr -> SynExpr) - : SynExpr option = - // Guard the stack for deeply nested computation expressions - cenv.stackGuard.Guard - <| fun () -> + if Option.isSome later2 then + errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondSourcePat.Range)) - match comp with + // check 'join' or 'groupJoin' or 'zip' is permitted for this builder + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> error (Error(FSComp.SR.tcMissingCustomOperation (nm.idText), nm.idRange)) + | Some opDatas -> + let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] - // for firstSourcePat in firstSource do - // join secondSourcePat in expr2 on (expr3 = expr4) - // ... - // --> - // join expr1 expr2 (fun firstSourcePat -> expr3) (fun secondSourcePat -> expr4) (fun firstSourcePat secondSourcePat -> ...) - - // for firstSourcePat in firstSource do - // groupJoin secondSourcePat in expr2 on (expr3 = expr4) into groupPat - // ... - // --> - // groupJoin expr1 expr2 (fun firstSourcePat -> expr3) (fun secondSourcePat -> expr4) (fun firstSourcePat groupPat -> ...) - - // for firstSourcePat in firstSource do - // zip secondSource into secondSourcePat - // ... - // --> - // zip expr1 expr2 (fun pat1 pat3 -> ...) - | ForEachThenJoinOrGroupJoinOrZipClause true (isFromSource, - firstSourcePat, - firstSource, - nm, - secondSourcePat, - secondSource, - keySelectorsOpt, - secondResultPatOpt, - mOpCore, - innerComp) -> - match q with - | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), nm.idRange)) - | CustomOperationsMode.Allowed -> - - let firstSource = - mkSourceExprConditional isFromSource firstSource sourceMethInfo builderValName - - let secondSource = mkSourceExpr secondSource sourceMethInfo builderValName - - // Add the variables to the variable space, on demand - let varSpaceWithFirstVars = - addVarsToVarSpace varSpace (fun _mCustomOp env -> - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + // Record the resolution of the custom operation for posterity + let item = + Item.CustomOperation(opName, (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), Some methInfo) - let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv firstSourcePat None + // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations + // of type variables in the quick info provided in the IDE. + CallNameResolutionSink + cenv.tcSink + (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - vspecs, envinner) + let mkJoinExpr keySelector1 keySelector2 innerPat e = + let mSynthetic = mOpCore.MakeSynthetic() - let varSpaceWithSecondVars = - addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + mkSynCall + methInfo.DisplayName + mOpCore + [ + firstSource + secondSource + mkSynLambda firstSourceSimplePats keySelector1 mSynthetic + mkSynLambda secondSourceSimplePats keySelector2 mSynthetic + mkSynLambda firstSourceSimplePats (mkSynLambda innerPat e mSynthetic) mSynthetic + ] - let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv secondSourcePat None + let mkZipExpr e = + let mSynthetic = mOpCore.MakeSynthetic() - vspecs, envinner) + mkSynCall + methInfo.DisplayName + mOpCore + [ + firstSource + secondSource + mkSynLambda firstSourceSimplePats (mkSynLambda secondSourceSimplePats e mSynthetic) mSynthetic + ] - let varSpaceWithGroupJoinVars = - match secondResultPatOpt with - | Some pat3 -> - addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + // wraps given expression into sequence with result produced by arbExpr so result will look like: + // l; SynExpr.ArbitraryAfterError (...) + // this allows to handle cases like 'on (a > b)' // '>' is not permitted as correct join relation + // after wrapping a and b can still be typechecked (so we'll have correct completion inside 'on' part) + // but presence of SynExpr.ArbitraryAfterError allows to avoid errors about incompatible types in cases like + // query { + // for a in [1] do + // join b in [""] on (a > b) + // } + // if we typecheck raw 'a' and 'b' then we'll end up with 2 errors: + // 1. incorrect join relation + // 2. incompatible types: int and string + // with SynExpr.ArbitraryAfterError we have only first one + let wrapInArbErrSequence l caption = + SynExpr.Sequential( + DebugPointAtSequential.SuppressNeither, + true, + l, + (arbExpr (caption, l.Range.EndRange)), + l.Range, + SynExprSequentialTrivia.Zero + ) - let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv pat3 None + let mkOverallExprGivenVarSpaceExpr, varSpaceInner = + + let isNullableOp opId = + match ConvertValLogicalNameToDisplayNameCore opId with + | "?=" + | "=?" + | "?=?" -> true + | _ -> false + + match secondResultPatOpt, keySelectorsOpt with + // groupJoin + | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> + let secondResultSimplePats, later3 = + SimplePatsOfPat cenv.synArgNameGenerator secondResultPat + + if Option.isSome later3 then + errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondResultPat.Range)) + + match relExpr with + | JoinRelation cenv env (keySelector1, keySelector2) -> + mkJoinExpr keySelector1 keySelector2 secondResultSimplePats, varSpaceWithGroupJoinVars + | BinOpExpr(opId, l, r) -> + if isNullableOp opId.idText then + // When we cannot resolve NullableOps, recommend the relevant namespace to be added + errorR ( + Error( + FSComp.SR.cannotResolveNullableOperators ( + ConvertValLogicalNameToDisplayNameCore opId.idText + ), + relExpr.Range + ) + ) + else + errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - vspecs, envinner) - | None -> varSpace + let l = wrapInArbErrSequence l "_keySelector1" + let r = wrapInArbErrSequence r "_keySelector2" + // this is not correct JoinRelation but it is still binary operation + // we've already reported error now we can use operands of binary operation as join components + mkJoinExpr l r secondResultSimplePats, varSpaceWithGroupJoinVars + | _ -> + errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) + // since the shape of relExpr doesn't match our expectations (JoinRelation) + // then we assume that this is l.h.s. of the join relation + // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in GroupJoin method + mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondResultSimplePats, + varSpaceWithGroupJoinVars + + | None, Some relExpr when customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> + match relExpr with + | JoinRelation cenv env (keySelector1, keySelector2) -> + mkJoinExpr keySelector1 keySelector2 secondSourceSimplePats, varSpaceWithSecondVars + | BinOpExpr(opId, l, r) -> + if isNullableOp opId.idText then + // When we cannot resolve NullableOps, recommend the relevant namespace to be added + errorR ( + Error( + FSComp.SR.cannotResolveNullableOperators ( + ConvertValLogicalNameToDisplayNameCore opId.idText + ), + relExpr.Range + ) + ) + else + errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) + // this is not correct JoinRelation but it is still binary operation + // we've already reported error now we can use operands of binary operation as join components + let l = wrapInArbErrSequence l "_keySelector1" + let r = wrapInArbErrSequence r "_keySelector2" + mkJoinExpr l r secondSourceSimplePats, varSpaceWithGroupJoinVars + | _ -> + errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) + // since the shape of relExpr doesn't match our expectations (JoinRelation) + // then we assume that this is l.h.s. of the join relation + // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in Join method + mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondSourceSimplePats, + varSpaceWithGroupJoinVars - let firstSourceSimplePats, later1 = - SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat + | None, None when customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> mkZipExpr, varSpaceWithSecondVars - let secondSourceSimplePats, later2 = - SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat + | _ -> + assert false + failwith "unreachable" + + // Case from C# spec: A query expression with a join clause with an into followed by something other than a select clause + // Case from C# spec: A query expression with a join clause without an into followed by something other than a select clause + let valsInner, _env = varSpaceInner.Force mOpCore + let varSpaceExpr = mkExprForVarSpace mOpCore valsInner + let varSpacePat = mkPatForVarSpace mOpCore valsInner + let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr builderValName + + let consumingExpr = + SynExpr.ForEach( + DebugPointAtFor.No, + DebugPointAtInOrTo.No, + SeqExprOnly false, + false, + varSpacePat, + joinExpr, + innerComp, + mOpCore + ) - if Option.isSome later1 then - errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), firstSourcePat.Range)) + Some(TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) - if Option.isSome later2 then - errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondSourcePat.Range)) + | SynExpr.ForEach(spFor, spIn, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _mEntireForEach) -> + let sourceExpr = + match RewriteRangeExpr sourceExpr with + | Some e -> e + | None -> sourceExpr - // check 'join' or 'groupJoin' or 'zip' is permitted for this builder - match tryGetDataForCustomOperation nm with - | None -> error (Error(FSComp.SR.tcMissingCustomOperation (nm.idText), nm.idRange)) - | Some opDatas -> - let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] + let wrappedSourceExpr = + mkSourceExprConditional isFromSource sourceExpr sourceMethInfo builderValName - // Record the resolution of the custom operation for posterity - let item = - Item.CustomOperation(opName, (fun () -> customOpUsageText nm), Some methInfo) + let mFor = + match spFor with + | DebugPointAtFor.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.For) + | DebugPointAtFor.No -> pat.Range - // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations - // of type variables in the quick info provided in the IDE. - CallNameResolutionSink - cenv.tcSink - (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + // For computation expressions, 'in' or 'to' is hit on each MoveNext. + // To support this a named debug point for the "in" keyword is available to inlined code. + match spIn with + | DebugPointAtInOrTo.Yes mIn -> + cenv.namedDebugPointsForInlinedCode[{ + Range = mFor + Name = "ForLoop.InOrToKeyword" + }] <- mIn + | _ -> () - let mkJoinExpr keySelector1 keySelector2 innerPat e = - let mSynthetic = mOpCore.MakeSynthetic() + let mPat = pat.Range - mkSynCall - methInfo.DisplayName - mOpCore - [ - firstSource - secondSource - mkSynLambda firstSourceSimplePats keySelector1 mSynthetic - mkSynLambda secondSourceSimplePats keySelector2 mSynthetic - mkSynLambda firstSourceSimplePats (mkSynLambda innerPat e mSynthetic) mSynthetic - ] - - let mkZipExpr e = - let mSynthetic = mOpCore.MakeSynthetic() + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("For"), mFor)) - mkSynCall - methInfo.DisplayName - mOpCore - [ - firstSource - secondSource - mkSynLambda firstSourceSimplePats (mkSynLambda secondSourceSimplePats e mSynthetic) mSynthetic - ] - - // wraps given expression into sequence with result produced by arbExpr so result will look like: - // l; SynExpr.ArbitraryAfterError (...) - // this allows to handle cases like 'on (a > b)' // '>' is not permitted as correct join relation - // after wrapping a and b can still be typechecked (so we'll have correct completion inside 'on' part) - // but presence of SynExpr.ArbitraryAfterError allows to avoid errors about incompatible types in cases like - // query { - // for a in [1] do - // join b in [""] on (a > b) - // } - // if we typecheck raw 'a' and 'b' then we'll end up with 2 errors: - // 1. incorrect join relation - // 2. incompatible types: int and string - // with SynExpr.ArbitraryAfterError we have only first one - let wrapInArbErrSequence l caption = - SynExpr.Sequential( - DebugPointAtSequential.SuppressNeither, - true, - l, - (arbExpr (caption, l.Range.EndRange)), - l.Range, - SynExprSequentialTrivia.Zero - ) + // Add the variables to the query variable space, on demand + let varSpace = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let mkOverallExprGivenVarSpaceExpr, varSpaceInner = - - let isNullableOp opId = - match ConvertValLogicalNameToDisplayNameCore opId with - | "?=" - | "=?" - | "?=?" -> true - | _ -> false - - match secondResultPatOpt, keySelectorsOpt with - // groupJoin - | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin nm -> - let secondResultSimplePats, later3 = - SimplePatsOfPat cenv.synArgNameGenerator secondResultPat - - if Option.isSome later3 then - errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondResultPat.Range)) - - match relExpr with - | JoinRelation cenv env (keySelector1, keySelector2) -> - mkJoinExpr keySelector1 keySelector2 secondResultSimplePats, varSpaceWithGroupJoinVars - | BinOpExpr(opId, l, r) -> - if isNullableOp opId.idText then - // When we cannot resolve NullableOps, recommend the relevant namespace to be added - errorR ( - Error( - FSComp.SR.cannotResolveNullableOperators ( - ConvertValLogicalNameToDisplayNameCore opId.idText - ), - relExpr.Range - ) - ) - else - errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - - let l = wrapInArbErrSequence l "_keySelector1" - let r = wrapInArbErrSequence r "_keySelector2" - // this is not correct JoinRelation but it is still binary operation - // we've already reported error now we can use operands of binary operation as join components - mkJoinExpr l r secondResultSimplePats, varSpaceWithGroupJoinVars - | _ -> - errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - // since the shape of relExpr doesn't match our expectations (JoinRelation) - // then we assume that this is l.h.s. of the join relation - // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in GroupJoin method - mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondResultSimplePats, - varSpaceWithGroupJoinVars - - | None, Some relExpr when customOperationIsLikeJoin nm -> - match relExpr with - | JoinRelation cenv env (keySelector1, keySelector2) -> - mkJoinExpr keySelector1 keySelector2 secondSourceSimplePats, varSpaceWithSecondVars - | BinOpExpr(opId, l, r) -> - if isNullableOp opId.idText then - // When we cannot resolve NullableOps, recommend the relevant namespace to be added - errorR ( - Error( - FSComp.SR.cannotResolveNullableOperators ( - ConvertValLogicalNameToDisplayNameCore opId.idText - ), - relExpr.Range - ) - ) - else - errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - // this is not correct JoinRelation but it is still binary operation - // we've already reported error now we can use operands of binary operation as join components - let l = wrapInArbErrSequence l "_keySelector1" - let r = wrapInArbErrSequence r "_keySelector2" - mkJoinExpr l r secondSourceSimplePats, varSpaceWithGroupJoinVars - | _ -> - errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - // since the shape of relExpr doesn't match our expectations (JoinRelation) - // then we assume that this is l.h.s. of the join relation - // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in Join method - mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondSourceSimplePats, - varSpaceWithGroupJoinVars + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat None - | None, None when customOperationIsLikeZip nm -> mkZipExpr, varSpaceWithSecondVars + vspecs, envinner) - | _ -> - assert false - failwith "unreachable" - - // Case from C# spec: A query expression with a join clause with an into followed by something other than a select clause - // Case from C# spec: A query expression with a join clause without an into followed by something other than a select clause - let valsInner, _env = varSpaceInner.Force mOpCore - let varSpaceExpr = mkExprForVarSpace mOpCore valsInner - let varSpacePat = mkPatForVarSpace mOpCore valsInner - let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr builderValName - - let consumingExpr = - SynExpr.ForEach( - DebugPointAtFor.No, - DebugPointAtInOrTo.No, - SeqExprOnly false, - false, - varSpacePat, - joinExpr, - innerComp, - mOpCore - ) + Some( + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp (fun innerCompR -> - Some(trans CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) + let forCall = + mkSynCall + "For" + mFor + [ + wrappedSourceExpr + SynExpr.MatchLambda( + false, + mPat, + [ + SynMatchClause(pat, None, innerCompR, mPat, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + mFor + ) + ] + builderValName - | SynExpr.ForEach(spFor, spIn, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _mEntireForEach) -> - let sourceExpr = - match RewriteRangeExpr sourceExpr with - | Some e -> e - | None -> sourceExpr + let forCall = + match spFor with + | DebugPointAtFor.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, false, forCall) + | DebugPointAtFor.No -> forCall - let wrappedSourceExpr = - mkSourceExprConditional isFromSource sourceExpr sourceMethInfo builderValName + translatedCtxt forCall) + ) - let mFor = - match spFor with - | DebugPointAtFor.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.For) - | DebugPointAtFor.No -> pat.Range + | SynExpr.For( + forDebugPoint = spFor + toDebugPoint = spTo + ident = id + identBody = start + direction = dir + toBody = finish + doBody = innerComp + range = m) -> + let mFor = + match spFor with + | DebugPointAtFor.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.For) + | _ -> m - // For computation expressions, 'in' or 'to' is hit on each MoveNext. - // To support this a named debug point for the "in" keyword is available to inlined code. - match spIn with - | DebugPointAtInOrTo.Yes mIn -> - cenv.namedDebugPointsForInlinedCode[{ - Range = mFor - Name = "ForLoop.InOrToKeyword" - }] <- mIn - | _ -> () + if isQuery then + errorR (Error(FSComp.SR.tcNoIntegerForLoopInQuery (), mFor)) - let mPat = pat.Range + let reduced = + elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("For"), mFor)) + Some(TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace reduced translatedCtxt) - // Add the variables to the query variable space, on demand - let varSpace = - addVarsToVarSpace varSpace (fun _mCustomOp env -> - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + | SynExpr.While(spWhile, guardExpr, innerComp, _) -> + let mGuard = guardExpr.Range - let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv pat None + let mWhile = + match spWhile with + | DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) + | _ -> mGuard - vspecs, envinner) + if isQuery then + error (Error(FSComp.SR.tcNoWhileInQuery (), mWhile)) - Some( - trans CompExprTranslationPass.Initial q varSpace innerComp (fun innerCompR -> + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "While" builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("While"), mWhile)) - let forCall = - mkSynCall - "For" - mFor - [ - wrappedSourceExpr - SynExpr.MatchLambda( - false, - mPat, - [ - SynMatchClause(pat, None, innerCompR, mPat, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, - mFor - ) - ] - builderValName + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "Delay" builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mWhile)) - let forCall = - match spFor with - | DebugPointAtFor.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, false, forCall) - | DebugPointAtFor.No -> forCall + // 'while' is hit just before each time the guard is called + let guardExpr = + match spWhile with + | DebugPointAtWhile.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) + | DebugPointAtWhile.No -> guardExpr - translatedCtxt forCall) - ) + Some( + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> + translatedCtxt ( + mkSynCall + "While" + mWhile + [ + mkSynDelay2 guardExpr + mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] builderValName + ] + builderValName + )) + ) - | SynExpr.For( - forDebugPoint = spFor - toDebugPoint = spTo - ident = id - identBody = start - direction = dir - toBody = finish - doBody = innerComp - range = m) -> - let mFor = - match spFor with - | DebugPointAtFor.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.For) - | _ -> m + | SynExpr.WhileBang(spWhile, guardExpr, innerComp, mOrig) -> + let mGuard = guardExpr.Range - if isQuery then - errorR (Error(FSComp.SR.tcNoIntegerForLoopInQuery (), mFor)) + let mWhile = + match spWhile with + | DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) + | _ -> mGuard - let reduced = - elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m) + let mGuard = mGuard.MakeSynthetic() - Some(trans CompExprTranslationPass.Initial q varSpace reduced translatedCtxt) + // 'while!' is hit just before each time the guard is called + let guardExpr = + match spWhile with + | DebugPointAtWhile.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) + | DebugPointAtWhile.No -> guardExpr - | SynExpr.While(spWhile, guardExpr, innerComp, _) -> - let mGuard = guardExpr.Range + let rewrittenWhileExpr = + let idFirst = mkSynId mGuard (CompilerGeneratedName "first") + let patFirst = mkSynPatVar None idFirst - let mWhile = - match spWhile with - | DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) - | _ -> mGuard + let body = + let idCond = mkSynId mGuard (CompilerGeneratedName "cond") + let patCond = mkSynPatVar None idCond - if isQuery then - error (Error(FSComp.SR.tcNoWhileInQuery (), mWhile)) + let condBinding = + mkSynBinding + (Xml.PreXmlDoc.Empty, patCond) + (None, + false, + true, + mGuard, + DebugPointAtBinding.NoneAtSticky, + None, + SynExpr.Ident idFirst, + mGuard, + [], + [], + None, + SynBindingTrivia.Zero) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "While" builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("While"), mWhile)) + let setCondExpr = SynExpr.Set(SynExpr.Ident idCond, SynExpr.Ident idFirst, mGuard) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "Delay" builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mWhile)) + let bindCondExpr = + SynExpr.LetOrUseBang( + DebugPointAtBinding.NoneAtSticky, + false, + true, + patFirst, + guardExpr, + [], + setCondExpr, + mGuard, + SynExprLetOrUseBangTrivia.Zero + ) - // 'while' is hit just before each time the guard is called - let guardExpr = - match spWhile with - | DebugPointAtWhile.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) - | DebugPointAtWhile.No -> guardExpr + let whileExpr = + SynExpr.While( + DebugPointAtWhile.No, + SynExpr.Ident idCond, + SynExpr.Sequential( + DebugPointAtSequential.SuppressBoth, + true, + innerComp, + bindCondExpr, + mWhile, + SynExprSequentialTrivia.Zero + ), + mOrig + ) - Some( - trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> - translatedCtxt ( - mkSynCall - "While" - mWhile - [ - mkSynDelay2 guardExpr - mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] builderValName - ] - builderValName - )) + SynExpr.LetOrUse(false, false, [ condBinding ], whileExpr, mGuard, SynExprLetOrUseTrivia.Zero) + + SynExpr.LetOrUseBang( + DebugPointAtBinding.NoneAtSticky, + false, + true, + patFirst, + guardExpr, + [], + body, + mGuard, + SynExprLetOrUseBangTrivia.Zero ) - | SynExpr.WhileBang(spWhile, guardExpr, innerComp, mOrig) -> - let mGuard = guardExpr.Range - - let mWhile = - match spWhile with - | DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) - | _ -> mGuard - - let mGuard = mGuard.MakeSynthetic() - - // 'while!' is hit just before each time the guard is called - let guardExpr = - match spWhile with - | DebugPointAtWhile.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) - | DebugPointAtWhile.No -> guardExpr - - let rewrittenWhileExpr = - let idFirst = mkSynId mGuard (CompilerGeneratedName "first") - let patFirst = mkSynPatVar None idFirst - - let body = - let idCond = mkSynId mGuard (CompilerGeneratedName "cond") - let patCond = mkSynPatVar None idCond - - let condBinding = - mkSynBinding - (Xml.PreXmlDoc.Empty, patCond) - (None, - false, - true, - mGuard, - DebugPointAtBinding.NoneAtSticky, - None, - SynExpr.Ident idFirst, - mGuard, - [], - [], - None, - SynBindingTrivia.Zero) - - let setCondExpr = SynExpr.Set(SynExpr.Ident idCond, SynExpr.Ident idFirst, mGuard) - - let bindCondExpr = - SynExpr.LetOrUseBang( - DebugPointAtBinding.NoneAtSticky, - false, - true, - patFirst, - guardExpr, - [], - setCondExpr, - mGuard, - SynExprLetOrUseBangTrivia.Zero - ) + TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace rewrittenWhileExpr translatedCtxt - let whileExpr = - SynExpr.While( - DebugPointAtWhile.No, - SynExpr.Ident idCond, - SynExpr.Sequential( - DebugPointAtSequential.SuppressBoth, - true, - innerComp, - bindCondExpr, - mWhile, - SynExprSequentialTrivia.Zero - ), - mOrig - ) + | SynExpr.TryFinally(innerComp, unwindExpr, _mTryToLast, spTry, spFinally, trivia) -> - SynExpr.LetOrUse(false, false, [ condBinding ], whileExpr, mGuard, SynExprLetOrUseTrivia.Zero) + let mTry = + match spTry with + | DebugPointAtTry.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Try) + | _ -> trivia.TryKeyword - SynExpr.LetOrUseBang( - DebugPointAtBinding.NoneAtSticky, - false, - true, - patFirst, - guardExpr, - [], - body, - mGuard, - SynExprLetOrUseBangTrivia.Zero - ) + let mFinally = + match spFinally with + | DebugPointAtFinally.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Finally) + | _ -> trivia.FinallyKeyword - tryTrans CompExprTranslationPass.Initial q varSpace rewrittenWhileExpr translatedCtxt + // Put down a debug point for the 'finally' + let unwindExpr2 = + match spFinally with + | DebugPointAtFinally.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFinally, true, unwindExpr) + | DebugPointAtFinally.No -> unwindExpr - | SynExpr.TryFinally(innerComp, unwindExpr, _mTryToLast, spTry, spFinally, trivia) -> + if isQuery then + error (Error(FSComp.SR.tcNoTryFinallyInQuery (), mTry)) - let mTry = - match spTry with - | DebugPointAtTry.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Try) - | _ -> trivia.TryKeyword + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryFinally" builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("TryFinally"), mTry)) - let mFinally = - match spFinally with - | DebugPointAtFinally.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Finally) - | _ -> trivia.FinallyKeyword + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) - // Put down a debug point for the 'finally' - let unwindExpr2 = - match spFinally with - | DebugPointAtFinally.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFinally, true, unwindExpr) - | DebugPointAtFinally.No -> unwindExpr + let innerExpr = TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp - if isQuery then - error (Error(FSComp.SR.tcNoTryFinallyInQuery (), mTry)) + let innerExpr = + match spTry with + | DebugPointAtTry.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mTry, true, innerExpr) + | _ -> innerExpr - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryFinally" builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("TryFinally"), mTry)) + Some( + translatedCtxt ( + mkSynCall + "TryFinally" + mTry + [ + mkSynCall "Delay" mTry [ mkSynDelay innerComp.Range innerExpr ] builderValName + mkSynDelay2 unwindExpr2 + ] + builderValName + ) + ) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) + | SynExpr.Paren(range = m) -> error (Error(FSComp.SR.tcConstructIsAmbiguousInComputationExpression (), m)) - let innerExpr = transNoQueryOps innerComp + // In some cases the node produced by `mkSynCall "Zero" m []` may be discarded in the case + // of implicit yields - for example "list { 1; 2 }" when each expression checks as an implicit yield. + // If it is not discarded, the syntax node will later be checked and the existence/non-existence of the Zero method + // will be checked/reported appropriately (though the error message won't mention computation expressions + // like our other error messages for missing methods). + | SynExpr.ImplicitZero m -> + if + (not enableImplicitYield) + && isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy) + then + match origComp with + // builder { } + // + // The compiler inserts a dummy () in CheckExpressions.fs for + // empty-bodied computation expressions. In this case, the user + // has not actually written any "control construct" in the body, + // and so we use a more specific error message for clarity. + | SynExpr.Const(SynConst.Unit, mUnit) when + cenv.g.langVersion.SupportsFeature LanguageFeature.EmptyBodiedComputationExpressions + && Range.equals mUnit range0 + -> + error (Error(FSComp.SR.tcEmptyBodyRequiresBuilderZeroMethod (), mWhole)) + | _ -> error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), m)) + + Some(translatedCtxt (mkSynCall "Zero" m [] builderValName)) + + | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (_, _, _, _, _, mClause), _) when firstTry = CompExprTranslationPass.Initial -> + + // 'join' clauses preceded by 'let' and other constructs get processed by repackaging with a 'for' loop. + let patvs, _env = varSpace.Force comp.Range + let varSpaceExpr = mkExprForVarSpace mClause patvs + let varSpacePat = mkPatForVarSpace mClause patvs - let innerExpr = - match spTry with - | DebugPointAtTry.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mTry, true, innerExpr) - | _ -> innerExpr + let dataCompPrior = + translatedCtxt (TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause))) - Some( - translatedCtxt ( - mkSynCall - "TryFinally" - mTry - [ - mkSynCall "Delay" mTry [ mkSynDelay innerComp.Range innerExpr ] builderValName - mkSynDelay2 unwindExpr2 - ] - builderValName - ) + // Rebind using for ... + let rebind = + SynExpr.ForEach( + DebugPointAtFor.No, + DebugPointAtInOrTo.No, + SeqExprOnly false, + false, + varSpacePat, + dataCompPrior, + comp, + comp.Range ) - | SynExpr.Paren(range = m) -> error (Error(FSComp.SR.tcConstructIsAmbiguousInComputationExpression (), m)) + // Retry with the 'for' loop packaging. Set firstTry=false just in case 'join' processing fails + TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Subsequent q varSpace rebind id - // In some cases the node produced by `mkSynCall "Zero" m []` may be discarded in the case - // of implicit yields - for example "list { 1; 2 }" when each expression checks as an implicit yield. - // If it is not discarded, the syntax node will later be checked and the existence/non-existence of the Zero method - // will be checked/reported appropriately (though the error message won't mention computation expressions - // like our other error messages for missing methods). - | SynExpr.ImplicitZero m -> - if - (not enableImplicitYield) - && isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy) - then - match origComp with - // builder { } - // - // The compiler inserts a dummy () in CheckExpressions.fs for - // empty-bodied computation expressions. In this case, the user - // has not actually written any "control construct" in the body, - // and so we use a more specific error message for clarity. - | SynExpr.Const(SynConst.Unit, mUnit) when - g.langVersion.SupportsFeature LanguageFeature.EmptyBodiedComputationExpressions - && Range.equals mUnit range0 - -> - error (Error(FSComp.SR.tcEmptyBodyRequiresBuilderZeroMethod (), mWhole)) - | _ -> error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), m)) - - Some(translatedCtxt (mkSynCall "Zero" m [] builderValName)) - - | OptionalSequential(JoinOrGroupJoinOrZipClause(_, _, _, _, _, mClause), _) when firstTry = CompExprTranslationPass.Initial -> - - // 'join' clauses preceded by 'let' and other constructs get processed by repackaging with a 'for' loop. + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, _, opExpr, mClause, _), _) -> + + match q with + | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), opExpr.Range)) + | CustomOperationsMode.Allowed -> let patvs, _env = varSpace.Force comp.Range let varSpaceExpr = mkExprForVarSpace mClause patvs - let varSpacePat = mkPatForVarSpace mClause patvs - let dataCompPrior = - translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause))) + let dataCompPriorToOp = + let isYield = not (customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + translatedCtxt (TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause))) - // Rebind using for ... - let rebind = - SynExpr.ForEach( - DebugPointAtFor.No, - DebugPointAtInOrTo.No, - SeqExprOnly false, - false, - varSpacePat, - dataCompPrior, - comp, - comp.Range - ) + // Now run the consumeCustomOpClauses + Some(ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompPriorToOp comp false mClause) - // Retry with the 'for' loop packaging. Set firstTry=false just in case 'join' processing fails - tryTrans CompExprTranslationPass.Subsequent q varSpace rebind id + | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, _) -> - | OptionalSequential(CustomOperationClause(nm, _, opExpr, mClause, _), _) -> + // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 + if isQuery && checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole innerComp1 then + Some(TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt) - match q with - | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), opExpr.Range)) - | CustomOperationsMode.Allowed -> - let patvs, _env = varSpace.Force comp.Range - let varSpaceExpr = mkExprForVarSpace mClause patvs + else - let dataCompPriorToOp = - let isYield = not (customOperationMaintainsVarSpaceUsingBind nm) - translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause))) + if isQuery && not (innerComp1.IsArbExprAndThusAlreadyReportedError) then + match innerComp1 with + | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential + | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), innerComp1.RangeOfFirstPortion)) - // Now run the consumeCustomOpClauses - Some(consumeCustomOpClauses q varSpace dataCompPriorToOp comp false mClause) + match TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial CustomOperationsMode.Denied varSpace innerComp1 id with + | Some c -> + // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) + let m1 = rangeForCombine innerComp1 - | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, _) -> + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + env + m + ad + "Combine" + builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Combine"), m)) - // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 - if isQuery && checkForBinaryApp innerComp1 then - Some(trans CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt) + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), m)) - else + let combineCall = + mkSynCall + "Combine" + m1 + [ + c + mkSynCall "Delay" m1 [ mkSynDelay innerComp2.Range (TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp2) ] builderValName + ] + builderValName - if isQuery && not (innerComp1.IsArbExprAndThusAlreadyReportedError) then - match innerComp1 with - | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential - | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), innerComp1.RangeOfFirstPortion)) - - match tryTrans CompExprTranslationPass.Initial CustomOperationsMode.Denied varSpace innerComp1 id with - | Some c -> - // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) - let m1 = rangeForCombine innerComp1 - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - m - ad - "Combine" - builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Combine"), m)) + Some(translatedCtxt combineCall) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), m)) + | None -> + // "do! expr; cexpr" is treated as { let! () = expr in cexpr } + match innerComp1 with + | SynExpr.DoBang(rhsExpr, m) -> + let sp = + match sp with + | DebugPointAtSequential.SuppressExpr -> DebugPointAtBinding.NoneAtDo + | DebugPointAtSequential.SuppressBoth -> DebugPointAtBinding.NoneAtDo + | DebugPointAtSequential.SuppressStmt -> DebugPointAtBinding.Yes m + | DebugPointAtSequential.SuppressNeither -> DebugPointAtBinding.Yes m - let combineCall = - mkSynCall - "Combine" - m1 - [ - c - mkSynCall "Delay" m1 [ mkSynDelay innerComp2.Range (transNoQueryOps innerComp2) ] builderValName - ] - builderValName + Some( + TranslateComputationExpression + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + CompExprTranslationPass.Initial + q + varSpace + (SynExpr.LetOrUseBang( + sp, + false, + true, + SynPat.Const(SynConst.Unit, rhsExpr.Range), + rhsExpr, + [], + innerComp2, + m, + SynExprLetOrUseBangTrivia.Zero + )) + translatedCtxt + ) - Some(translatedCtxt combineCall) + // "expr; cexpr" is treated as sequential execution + | _ -> + Some( + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp2 (fun holeFill -> + let fillExpr = + if enableImplicitYield then + // When implicit yields are enabled, then if the 'innerComp1' checks as type + // 'unit' we interpret the expression as a sequential, and when it doesn't + // have type 'unit' we interpret it as a 'Yield + Combine'. + let combineExpr = + let m1 = rangeForCombine innerComp1 + let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] builderValName + + mkSynCall + "Combine" + m1 + [ + implicitYieldExpr + mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] builderValName + ] + builderValName + + SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) + else + SynExpr.Sequential(sp, true, innerComp1, holeFill, m, SynExprSequentialTrivia.Zero) - | None -> - // "do! expr; cexpr" is treated as { let! () = expr in cexpr } - match innerComp1 with - | SynExpr.DoBang(rhsExpr, m) -> - let sp = - match sp with - | DebugPointAtSequential.SuppressExpr -> DebugPointAtBinding.NoneAtDo - | DebugPointAtSequential.SuppressBoth -> DebugPointAtBinding.NoneAtDo - | DebugPointAtSequential.SuppressStmt -> DebugPointAtBinding.Yes m - | DebugPointAtSequential.SuppressNeither -> DebugPointAtBinding.Yes m - - Some( - trans - CompExprTranslationPass.Initial - q - varSpace - (SynExpr.LetOrUseBang( - sp, - false, - true, - SynPat.Const(SynConst.Unit, rhsExpr.Range), - rhsExpr, - [], - innerComp2, - m, - SynExprLetOrUseBangTrivia.Zero - )) - translatedCtxt - ) + translatedCtxt fillExpr) + ) - // "expr; cexpr" is treated as sequential execution - | _ -> - Some( - trans CompExprTranslationPass.Initial q varSpace innerComp2 (fun holeFill -> - let fillExpr = - if enableImplicitYield then - // When implicit yields are enabled, then if the 'innerComp1' checks as type - // 'unit' we interpret the expression as a sequential, and when it doesn't - // have type 'unit' we interpret it as a 'Yield + Combine'. - let combineExpr = - let m1 = rangeForCombine innerComp1 - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] builderValName - - mkSynCall - "Combine" - m1 - [ - implicitYieldExpr - mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] builderValName - ] - builderValName - - SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) - else - SynExpr.Sequential(sp, true, innerComp1, holeFill, m, SynExprSequentialTrivia.Zero) - - translatedCtxt fillExpr) - ) + | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> + match elseCompOpt with + | Some elseComp -> + if isQuery then + error (Error(FSComp.SR.tcIfThenElseMayNotBeUsedWithinQueries (), trivia.IfToThenRange)) + + Some( + translatedCtxt ( + SynExpr.IfThenElse( + guardExpr, + TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole thenComp, + Some(TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole elseComp), + spIfToThen, + isRecovery, + mIfToEndOfElseBranch, + trivia + ) + ) + ) + | None -> + let elseComp = + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + env + trivia.IfToThenRange + ad + "Zero" + builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), trivia.IfToThenRange)) - | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> - match elseCompOpt with - | Some elseComp -> - if isQuery then - error (Error(FSComp.SR.tcIfThenElseMayNotBeUsedWithinQueries (), trivia.IfToThenRange)) + mkSynCall "Zero" trivia.IfToThenRange [] builderValName - Some( + Some( + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> translatedCtxt ( SynExpr.IfThenElse( guardExpr, - transNoQueryOps thenComp, - Some(transNoQueryOps elseComp), + holeFill, + Some elseComp, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia ) + )) + ) + + // 'let binds in expr' + | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> + + // For 'query' check immediately + if isQuery then + match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with + | [ NormalizedBinding(_, SynBindingKind.Normal, false, false, _, _, _, _, _, _, _, _) ] when not isRec -> () + | normalizedBindings -> + let failAt m = + error (Error(FSComp.SR.tcNonSimpleLetBindingInQuery (), m)) + + match normalizedBindings with + | NormalizedBinding(mBinding = mBinding) :: _ -> failAt mBinding + | _ -> failAt m + + // Add the variables to the query variable space, on demand + let varSpace = + addVarsToVarSpace varSpace (fun mQueryOp env -> + // Normalize the bindings before detecting the bound variables + match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with + | [ NormalizedBinding(kind = SynBindingKind.Normal; shouldInline = false; isMutable = false; pat = pat) ] -> + // successful case + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat None + + vspecs, envinner + | _ -> + // error case + error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings (), mQueryOp))) + + Some( + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> + translatedCtxt (SynExpr.LetOrUse(isRec, false, binds, holeFill, m, trivia))) + ) + + // 'use x = expr in expr' + | SynExpr.LetOrUse( + isUse = true + bindings = [ SynBinding(kind = SynBindingKind.Normal; headPat = pat; expr = rhsExpr; debugPoint = spBind) ] + body = innerComp) -> + let mBind = + match spBind with + | DebugPointAtBinding.Yes m -> m + | _ -> rhsExpr.Range + + if isQuery then + error (Error(FSComp.SR.tcUseMayNotBeUsedInQueries (), mBind)) + + let innerCompRange = innerComp.Range + + let consumeExpr = + SynExpr.MatchLambda( + false, + innerCompRange, + [ + SynMatchClause( + pat, + None, + TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, + innerCompRange, + DebugPointAtTarget.Yes, + SynMatchClauseTrivia.Zero ) - ) - | None -> - let elseComp = - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - trivia.IfToThenRange - ad - "Zero" - builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), trivia.IfToThenRange)) + ], + DebugPointAtBinding.NoneAtInvisible, + innerCompRange + ) - mkSynCall "Zero" trivia.IfToThenRange [] builderValName + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) - Some( - trans CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> - translatedCtxt ( - SynExpr.IfThenElse( - guardExpr, - holeFill, - Some elseComp, - spIfToThen, - isRecovery, - mIfToEndOfElseBranch, - trivia - ) - )) - ) + Some( + translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ] builderValName) + |> addBindDebugPoint spBind + ) - // 'let binds in expr' - | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> + // '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) -> - // For 'query' check immediately - if isQuery then - match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with - | [ NormalizedBinding(_, SynBindingKind.Normal, false, false, _, _, _, _, _, _, _, _) ] when not isRec -> () - | normalizedBindings -> - let failAt m = - error (Error(FSComp.SR.tcNonSimpleLetBindingInQuery (), m)) + let mBind = + match spBind with + | DebugPointAtBinding.Yes m -> m + | _ -> rhsExpr.Range - match normalizedBindings with - | NormalizedBinding(mBinding = mBinding) :: _ -> failAt mBinding - | _ -> failAt m + if isQuery then + error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - // Add the variables to the query variable space, on demand - let varSpace = - addVarsToVarSpace varSpace (fun mQueryOp env -> - // Normalize the bindings before detecting the bound variables - match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with - | [ NormalizedBinding(kind = SynBindingKind.Normal; shouldInline = false; isMutable = false; pat = pat) ] -> - // successful case - 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 g) env tpenv pat None + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat None - vspecs, envinner - | _ -> - // error case - error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings (), mQueryOp))) + vspecs, envinner) - Some( - trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> - translatedCtxt (SynExpr.LetOrUse(isRec, false, binds, holeFill, m, trivia))) - ) + let rhsExpr = + mkSourceExprConditional isFromSource rhsExpr sourceMethInfo builderValName - // 'use x = expr in expr' - | SynExpr.LetOrUse( - isUse = true - bindings = [ SynBinding(kind = SynBindingKind.Normal; headPat = pat; expr = rhsExpr; debugPoint = spBind) ] - body = innerComp) -> - let mBind = - match spBind with - | DebugPointAtBinding.Yes m -> m - | _ -> rhsExpr.Range + Some( + TranslateComputationExpressionBind + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + 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)))) + | SynExpr.LetOrUseBang( + bindDebugPoint = spBind + isUse = true + isFromSource = isFromSource + pat = SynPat.Named(ident = SynIdent(id, _); isThisVal = false) as pat + rhs = rhsExpr + andBangs = [] + body = innerComp) + | SynExpr.LetOrUseBang( + bindDebugPoint = spBind + isUse = true + isFromSource = isFromSource + pat = SynPat.LongIdent(longDotId = SynLongIdent(id = [ id ])) as pat + rhs = rhsExpr + andBangs = [] + body = innerComp) -> + + let mBind = + match spBind with + | DebugPointAtBinding.Yes m -> m + | _ -> rhsExpr.Range + + if isQuery then + error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - if isQuery then - error (Error(FSComp.SR.tcUseMayNotBeUsedInQueries (), mBind)) + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) - let innerCompRange = innerComp.Range + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Bind" builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), mBind)) + let bindExpr = let consumeExpr = SynExpr.MatchLambda( false, - innerCompRange, + mBind, [ SynMatchClause( pat, None, - transNoQueryOps innerComp, - innerCompRange, + TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, + innerComp.Range, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero ) ], DebugPointAtBinding.NoneAtInvisible, - innerCompRange + mBind ) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) - - Some( - translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ] builderValName) - |> 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) -> - - let mBind = - match spBind with - | DebugPointAtBinding.Yes m -> m - | _ -> rhsExpr.Range - - if 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 g) env tpenv pat None + let consumeExpr = + mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] builderValName - vspecs, envinner) + let consumeExpr = + SynExpr.MatchLambda( + false, + mBind, + [ + SynMatchClause(pat, None, consumeExpr, id.idRange, DebugPointAtTarget.No, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + mBind + ) let rhsExpr = mkSourceExprConditional isFromSource rhsExpr sourceMethInfo builderValName - Some(transBind 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)))) - | SynExpr.LetOrUseBang( - bindDebugPoint = spBind - isUse = true - isFromSource = isFromSource - pat = SynPat.Named(ident = SynIdent(id, _); isThisVal = false) as pat - rhs = rhsExpr - andBangs = [] - body = innerComp) - | SynExpr.LetOrUseBang( - bindDebugPoint = spBind - isUse = true - isFromSource = isFromSource - pat = SynPat.LongIdent(longDotId = SynLongIdent(id = [ id ])) as pat - rhs = rhsExpr - andBangs = [] - body = innerComp) -> - - let mBind = - match spBind with - | DebugPointAtBinding.Yes m -> m - | _ -> rhsExpr.Range - - if isQuery then - error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) - - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Bind" builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), mBind)) - - let bindExpr = - let consumeExpr = - SynExpr.MatchLambda( - false, - mBind, - [ - SynMatchClause( - pat, - None, - transNoQueryOps innerComp, - innerComp.Range, - DebugPointAtTarget.Yes, - SynMatchClauseTrivia.Zero - ) - ], - DebugPointAtBinding.NoneAtInvisible, - mBind - ) + mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] builderValName + |> addBindDebugPoint spBind - let consumeExpr = - mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] builderValName + Some(translatedCtxt bindExpr) - let consumeExpr = - SynExpr.MatchLambda( - false, - mBind, - [ - SynMatchClause(pat, None, consumeExpr, id.idRange, DebugPointAtTarget.No, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, + // 'use! pat = e1 ... in e2' where 'pat' is not a simple name --> error + | SynExpr.LetOrUseBang(isUse = true; pat = pat; andBangs = andBangs) -> + if isNil andBangs then + error (Error(FSComp.SR.tcInvalidUseBangBinding (), pat.Range)) + else + error (Error(FSComp.SR.tcInvalidUseBangBindingNoAndBangs (), comp.Range)) + + // '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 + range = letBindRange) -> + if not (cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang) then + error (Error(FSComp.SR.tcAndBangNotSupported (), comp.Range)) + + if isQuery then + error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), letBindRange)) + + let mBind = + match spBind with + | DebugPointAtBinding.Yes m -> m + | _ -> letRhsExpr.Range + + let sources = + (letRhsExpr + :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) + |> List.map (fun expr -> mkSourceExprConditional isFromSource expr sourceMethInfo 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 + env mBind - ) - - let rhsExpr = - mkSourceExprConditional isFromSource rhsExpr sourceMethInfo builderValName - - mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] builderValName - |> addBindDebugPoint spBind - - Some(translatedCtxt bindExpr) - - // 'use! pat = e1 ... in e2' where 'pat' is not a simple name --> error - | SynExpr.LetOrUseBang(isUse = true; pat = pat; andBangs = andBangs) -> - if isNil andBangs then - error (Error(FSComp.SR.tcInvalidUseBangBinding (), pat.Range)) - else - error (Error(FSComp.SR.tcInvalidUseBangBindingNoAndBangs (), comp.Range)) - - // '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 - range = letBindRange) -> - if not (cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang) then - error (Error(FSComp.SR.tcAndBangNotSupported (), comp.Range)) + ad + bindReturnNName + builderTy + ) + ) - if isQuery then - error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), letBindRange)) + if hasBindReturnN && Option.isSome (convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp) then + let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) - let mBind = - match spBind with - | DebugPointAtBinding.Yes m -> m - | _ -> letRhsExpr.Range + // Add the variables to the query variable space, on demand + let varSpace = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let sources = - (letRhsExpr - :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) - |> List.map (fun expr -> mkSourceExprConditional isFromSource expr sourceMethInfo builderValName) + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv consumePat None - let pats = - letPat :: [ for SynExprAndBang(pat = andPat) in andBangBindings -> andPat ] + vspecs, envinner) - let sourcesRange = sources |> List.map (fun e -> e.Range) |> List.reduce unionRanges + Some( + TranslateComputationExpressionBind + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) - let numSources = sources.Length - let bindReturnNName = "Bind" + string numSources + "Return" - let bindNName = "Bind" + string numSources + else - // Check if this is a Bind2Return etc. - let hasBindReturnN = + // Check if this is a Bind2 etc. + let hasBindN = not ( isNil ( TryFindIntrinsicOrExtensionMethInfo @@ -1992,12 +1965,12 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv env mBind ad - bindReturnNName + bindNName builderTy ) ) - if hasBindReturnN && Option.isSome (convertSimpleReturnToExpr varSpace innerComp) then + if hasBindN then let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) // Add the variables to the query variable space, on demand @@ -2006,335 +1979,327 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv consumePat None + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv consumePat None vspecs, envinner) - Some(transBind q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) - + Some( + TranslateComputationExpressionBind + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) else - // Check if this is a Bind2 etc. - let hasBindN = - not ( - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - mBind - ad - bindNName - builderTy - ) - ) - - 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 g) env tpenv consumePat None - - vspecs, envinner) - - Some(transBind 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" + // 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 + env + mBind + ad + mergeSourcesName + builderTy + ) + then + (n - 1) else - "MergeSources" + (string n) - - let maxMergeSources = - let rec loop (n: int) = - let mergeSourcesName = mkMergeSourcesName n - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - mBind - ad - mergeSourcesName - builderTy - ) - then - (n - 1) - else - loop (n + 1) + 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 - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - mBind - ad - mergeSourcesName - builderTy - ) - then - error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + env + mBind + ad + mergeSourcesName + builderTy + ) + then + error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) - let source = - mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) builderValName + let source = + mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) 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 - - let mergeSourcesName = mkMergeSourcesName maxMergeSources - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - mBind - ad - mergeSourcesName - builderTy - ) - then - error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) + // Call MergeSourcesMax(e1, e2, e3, e4, (...)) + let nowSourcesAndPats, laterSourcesAndPats = + List.splitAt (maxMergeSources - 1) sourcesAndPats - let laterSource, laterPat = mergeSources laterSourcesAndPats + let mergeSourcesName = mkMergeSourcesName maxMergeSources - let source = - mkSynCall + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + env + mBind + ad mergeSourcesName - sourcesRange - (List.map fst nowSourcesAndPats @ [ laterSource ]) - builderValName - - let pat = - SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) - - source, pat - - 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 + builderTy + ) + then + error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) - let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv consumePat None + let laterSource, laterPat = mergeSources laterSourcesAndPats - vspecs, envinner) + let source = + mkSynCall + mergeSourcesName + sourcesRange + (List.map fst nowSourcesAndPats @ [ laterSource ]) + builderValName - // Build the 'Bind' call - Some( - transBind - q - varSpace - mBind - (addBindDebugPoint spBind) - "Bind" - [ mergedSources ] - consumePat - innerComp - translatedCtxt - ) + let pat = + SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) - | SynExpr.Match(spMatch, expr, clauses, m, trivia) -> - if isQuery then - error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchKeyword)) + source, pat - let clauses = - clauses - |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> - SynMatchClause(pat, cond, transNoQueryOps innerComp, patm, sp, trivia)) + let mergedSources, consumePat = mergeSources (List.zip sources pats) - Some(translatedCtxt (SynExpr.Match(spMatch, expr, clauses, m, trivia))) + // Add the variables to the query variable space, on demand + let varSpace = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) - // FUTURE: consider allowing translation to BindReturn - | SynExpr.MatchBang(spMatch, expr, clauses, _m, trivia) -> - let inputExpr = mkSourceExpr expr sourceMethInfo builderValName + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv consumePat None - if isQuery then - error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchBangKeyword)) + vspecs, envinner) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - trivia.MatchBangKeyword - ad + // Build the 'Bind' call + Some( + TranslateComputationExpressionBind + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + q + varSpace + mBind + (addBindDebugPoint spBind) "Bind" - builderTy + [ mergedSources ] + consumePat + innerComp + translatedCtxt ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), trivia.MatchBangKeyword)) - let clauses = - clauses - |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> - SynMatchClause(pat, cond, transNoQueryOps innerComp, patm, sp, trivia)) + | SynExpr.Match(spMatch, expr, clauses, m, trivia) -> + if isQuery then + error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchKeyword)) - let consumeExpr = - SynExpr.MatchLambda( - false, - trivia.MatchBangKeyword, - clauses, - DebugPointAtBinding.NoneAtInvisible, + let clauses = + clauses + |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> + SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, patm, sp, trivia)) + + Some(translatedCtxt (SynExpr.Match(spMatch, expr, clauses, m, trivia))) + + // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) + // FUTURE: consider allowing translation to BindReturn + | SynExpr.MatchBang(spMatch, expr, clauses, _m, trivia) -> + let inputExpr = mkSourceExpr expr sourceMethInfo builderValName + + if isQuery then + error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchBangKeyword)) + + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + env trivia.MatchBangKeyword - ) + ad + "Bind" + builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), trivia.MatchBangKeyword)) - let callExpr = - mkSynCall "Bind" trivia.MatchBangKeyword [ inputExpr; consumeExpr ] builderValName - |> addBindDebugPoint spMatch + let clauses = + clauses + |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> + SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, patm, sp, trivia)) + + let consumeExpr = + SynExpr.MatchLambda( + false, + trivia.MatchBangKeyword, + clauses, + DebugPointAtBinding.NoneAtInvisible, + trivia.MatchBangKeyword + ) - Some(translatedCtxt callExpr) + let callExpr = + mkSynCall "Bind" trivia.MatchBangKeyword [ inputExpr; consumeExpr ] builderValName + |> addBindDebugPoint spMatch - | SynExpr.TryWith(innerComp, clauses, mTryToLast, spTry, spWith, trivia) -> - let mTry = - match spTry with - | DebugPointAtTry.Yes _ -> trivia.TryKeyword.NoteSourceConstruct(NotedSourceConstruct.Try) - | _ -> trivia.TryKeyword + Some(translatedCtxt callExpr) - let spWith2 = - match spWith with - | DebugPointAtWith.Yes _ -> DebugPointAtBinding.Yes trivia.WithKeyword - | _ -> DebugPointAtBinding.NoneAtInvisible + | SynExpr.TryWith(innerComp, clauses, mTryToLast, spTry, spWith, trivia) -> + let mTry = + match spTry with + | DebugPointAtTry.Yes _ -> trivia.TryKeyword.NoteSourceConstruct(NotedSourceConstruct.Try) + | _ -> trivia.TryKeyword - if isQuery then - error (Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries (), mTry)) + let spWith2 = + match spWith with + | DebugPointAtWith.Yes _ -> DebugPointAtBinding.Yes trivia.WithKeyword + | _ -> DebugPointAtBinding.NoneAtInvisible - let clauses = - clauses - |> List.map (fun (SynMatchClause(pat, cond, clauseComp, patm, sp, trivia)) -> - SynMatchClause(pat, cond, transNoQueryOps clauseComp, patm, sp, trivia)) + if isQuery then + error (Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries (), mTry)) - let consumeExpr = - SynExpr.MatchLambda(true, mTryToLast, clauses, spWith2, mTryToLast) + let clauses = + clauses + |> List.map (fun (SynMatchClause(pat, cond, clauseComp, patm, sp, trivia)) -> + SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole clauseComp, patm, sp, trivia)) - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryWith" builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("TryWith"), mTry)) + let consumeExpr = + SynExpr.MatchLambda(true, mTryToLast, clauses, spWith2, mTryToLast) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryWith" builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("TryWith"), mTry)) - let innerExpr = transNoQueryOps innerComp + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) - let innerExpr = - match spTry with - | DebugPointAtTry.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mTry, true, innerExpr) - | _ -> innerExpr + let innerExpr = TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp - let callExpr = - mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ] builderValName; consumeExpr ] builderValName + let innerExpr = + match spTry with + | DebugPointAtTry.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mTry, true, innerExpr) + | _ -> innerExpr - Some(translatedCtxt callExpr) + let callExpr = + mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ] builderValName; consumeExpr ] builderValName - | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, m) -> - let yieldFromExpr = mkSourceExpr synYieldExpr sourceMethInfo builderValName + Some(translatedCtxt callExpr) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("YieldFrom"), m)) + | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, m) -> + let yieldFromExpr = mkSourceExpr synYieldExpr sourceMethInfo builderValName - let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] builderValName + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("YieldFrom"), m)) - let yieldFromCall = - if IsControlFlowExpression synYieldExpr then - yieldFromCall - else - SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldFromCall) + let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] builderValName - Some(translatedCtxt yieldFromCall) + let yieldFromCall = + if IsControlFlowExpression synYieldExpr then + yieldFromCall + else + SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldFromCall) - | SynExpr.YieldOrReturnFrom((false, _), synReturnExpr, m) -> - let returnFromExpr = mkSourceExpr synReturnExpr sourceMethInfo builderValName + Some(translatedCtxt yieldFromCall) - if isQuery then - error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) + | SynExpr.YieldOrReturnFrom((false, _), synReturnExpr, m) -> + let returnFromExpr = mkSourceExpr synReturnExpr sourceMethInfo builderValName - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "ReturnFrom" builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod ("ReturnFrom"), m)) + if isQuery then + error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) - let returnFromCall = mkSynCall "ReturnFrom" m [ returnFromExpr ] builderValName + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "ReturnFrom" builderTy + ) + then + error (Error(FSComp.SR.tcRequireBuilderMethod ("ReturnFrom"), m)) - let returnFromCall = - if IsControlFlowExpression synReturnExpr then - returnFromCall - else - SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnFromCall) + let returnFromCall = mkSynCall "ReturnFrom" m [ returnFromExpr ] builderValName - Some(translatedCtxt returnFromCall) + let returnFromCall = + if IsControlFlowExpression synReturnExpr then + returnFromCall + else + SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnFromCall) - | SynExpr.YieldOrReturn((isYield, _), synYieldOrReturnExpr, m) -> - let methName = (if isYield then "Yield" else "Return") + Some(translatedCtxt returnFromCall) - if isQuery && not isYield then - error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) + | SynExpr.YieldOrReturn((isYield, _), synYieldOrReturnExpr, m) -> + let methName = (if isYield then "Yield" else "Return") - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) - then - error (Error(FSComp.SR.tcRequireBuilderMethod (methName), m)) + if isQuery && not isYield then + error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) - let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] builderValName + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod (methName), m)) - let yieldOrReturnCall = - if IsControlFlowExpression synYieldOrReturnExpr then - yieldOrReturnCall - else - SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldOrReturnCall) + let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] builderValName + + let yieldOrReturnCall = + if IsControlFlowExpression synYieldOrReturnExpr then + yieldOrReturnCall + else + SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldOrReturnCall) - Some(translatedCtxt yieldOrReturnCall) + Some(translatedCtxt yieldOrReturnCall) - | _ -> None + | _ -> None - and consumeCustomOpClauses q (varSpace: LazyWithContext<_, _>) dataCompPrior compClausesExpr lastUsesBind mClause = +and ConsumeCustomOpClauses + (cenv: TcFileState) + (env: TcEnv) + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + (comp: SynExpr) + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + (varSpace: LazyWithContext<_, _>) + dataCompPrior + compClausesExpr + lastUsesBind + mClause = // Substitute 'yield ' into the context @@ -2345,36 +2310,36 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv match compClausesExpr with // Detect one custom operation... This clause will always match at least once... - | OptionalSequential(CustomOperationClause(nm, opDatas, opExpr, mClause, optionalIntoPat), optionalCont) -> + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, opDatas, opExpr, mClause, optionalIntoPat), optionalCont) -> let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] - let isLikeZip = customOperationIsLikeZip nm - let isLikeJoin = customOperationIsLikeJoin nm - let isLikeGroupJoin = customOperationIsLikeZip nm + let isLikeZip = customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + let isLikeJoin = customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + let isLikeGroupJoin = customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm // Record the resolution of the custom operation for posterity let item = - Item.CustomOperation(opName, (fun () -> customOpUsageText nm), Some methInfo) + Item.CustomOperation(opName, (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), Some methInfo) // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) if isLikeZip || isLikeJoin || isLikeGroupJoin then - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) match optionalCont with | None -> // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it RecordNameAndTypeResolutions cenv env tpenv opExpr dataCompPrior - | Some contExpr -> consumeCustomOpClauses q varSpace dataCompPrior contExpr lastUsesBind mClause + | Some contExpr -> ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompPrior contExpr lastUsesBind mClause else - let maintainsVarSpace = customOperationMaintainsVarSpace nm - let maintainsVarSpaceUsingBind = customOperationMaintainsVarSpaceUsingBind nm + let maintainsVarSpace = customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + let maintainsVarSpaceUsingBind = customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - let expectedArgCount = tryExpectedArgCountForCustomOperator nm + let expectedArgCount = tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm let dataCompAfterOp = match opExpr with @@ -2389,7 +2354,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv let args = args |> List.mapi (fun i arg -> - if isCustomOperationProjectionParameter (i + 1) nm then + if isCustomOperationProjectionParameter cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (i + 1) nm then SynExpr.Lambda( false, false, @@ -2437,7 +2402,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv // Rebind the into pattern and process the rest of the clauses match optionalIntoPat with | Some intoPat -> - if not (customOperationAllowsInto nm) then + if not (customOperationAllowsInto cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) then error (Error(FSComp.SR.tcOperatorDoesntAcceptInto (nm.idText), intoPat.Range)) // Rebind using either for ... or let!.... @@ -2466,7 +2431,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv intoPat.Range ) - trans CompExprTranslationPass.Initial q emptyVarSpace rebind id + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q (LazyWithContext.NotLazy([], env)) rebind id // select a.Name; ... // distinct; ... @@ -2474,9 +2439,9 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv // Process the rest of the clauses | None -> if maintainsVarSpace || maintainsVarSpaceUsingBind then - consumeCustomOpClauses q varSpace dataCompAfterOp contExpr maintainsVarSpaceUsingBind mClause + ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompAfterOp contExpr maintainsVarSpaceUsingBind mClause else - consumeCustomOpClauses q emptyVarSpace dataCompAfterOp contExpr false mClause + ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q (LazyWithContext.NotLazy([], env)) dataCompAfterOp contExpr false mClause // No more custom operator clauses in compClausesExpr, but there may be clauses like join, yield etc. // Bind/iterate the dataCompPrior and use compClausesExpr as the body. @@ -2507,101 +2472,40 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv compClausesExpr.Range ) - trans CompExprTranslationPass.Initial q varSpace rebind id - - and transNoQueryOps comp = - trans CompExprTranslationPass.Initial CustomOperationsMode.Denied emptyVarSpace comp id - - and trans firstTry q varSpace comp translatedCtxt = - cenv.stackGuard.Guard - <| fun () -> - match tryTrans firstTry q varSpace comp translatedCtxt with - | Some e -> e - | None -> - // This only occurs in final position in a sequence - match comp with - // "do! expr;" in final position is treated as { let! () = expr in return () } when Return is provided (and no Zero with Default attribute is available) or as { let! () = expr in zero } otherwise - | SynExpr.DoBang(rhsExpr, m) -> - let mUnit = rhsExpr.Range - let rhsExpr = mkSourceExpr rhsExpr sourceMethInfo builderValName - - if isQuery then - error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), m)) - - let bodyExpr = - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - m - ad - "Return" - builderTy - ) - then - SynExpr.ImplicitZero m - else - match - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy - with - | minfo :: _ when MethInfoHasAttribute cenv.g m cenv.g.attrib_DefaultValueAttribute minfo -> - SynExpr.ImplicitZero m - | _ -> SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) - - let letBangBind = - SynExpr.LetOrUseBang( - DebugPointAtBinding.NoneAtDo, - false, - false, - SynPat.Const(SynConst.Unit, mUnit), - rhsExpr, - [], - bodyExpr, - m, - SynExprLetOrUseBangTrivia.Zero - ) - - trans CompExprTranslationPass.Initial q varSpace letBangBind translatedCtxt - - // "expr;" in final position is treated as { expr; zero } - // Suppress the sequence point on the "zero" - | _ -> - // 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 CompExprTranslationPass.Initial q varSpace (SynExpr.ImplicitZero comp.Range) translatedCtxt - else - if isQuery && not comp.IsArbExprAndThusAlreadyReportedError then - match comp with - | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential - | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), comp.RangeOfFirstPortion)) - - trans CompExprTranslationPass.Initial q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> - let fillExpr = - if enableImplicitYield then - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ comp ] builderValName - - SynExpr.SequentialOrImplicitYield( - DebugPointAtSequential.SuppressExpr, - comp, - holeFill, - implicitYieldExpr, - comp.Range - ) - else - SynExpr.Sequential( - DebugPointAtSequential.SuppressExpr, - true, - comp, - holeFill, - comp.Range, - SynExprSequentialTrivia.Zero - ) - - translatedCtxt fillExpr) - - and transBind + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace rebind id + + and TranslateComputationExpressionNoQueryOps + (cenv: TcFileState) + (env: TcEnv) + (tpenv: UnscopedTyparEnv) + (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + comp = + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial CustomOperationsMode.Denied (LazyWithContext.NotLazy([], env)) comp id + + and TranslateComputationExpressionBind + (cenv: TcFileState) + (env: TcEnv) + (tpenv: UnscopedTyparEnv) + (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole q varSpace bindRange @@ -2617,7 +2521,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv let innerCompReturn = if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then - convertSimpleReturnToExpr varSpace innerComp + convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp else None @@ -2653,7 +2557,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv | None -> dataCompPriorToOp | Some(innerComp, mClause) -> // If the `BindReturn` was forced by a custom operation, continue to process the clauses of the CustomOp - consumeCustomOpClauses q varSpace dataCompPriorToOp innerComp false mClause + ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompPriorToOp innerComp false mClause | _ -> @@ -2665,27 +2569,37 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv error (Error(FSComp.SR.tcRequireBuilderMethod (bindName), bindRange)) // Build the `Bind` call - trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> - let consumeExpr = - SynExpr.MatchLambda( - false, - consumePat.Range, - [ - SynMatchClause(consumePat, None, holeFill, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, - innerRange - ) + TranslateComputationExpression + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> + let consumeExpr = + SynExpr.MatchLambda( + false, + consumePat.Range, + [ + SynMatchClause(consumePat, None, holeFill, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + innerRange + ) - let bindCall = - mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName + let bindCall = + mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName - translatedCtxt (bindCall |> addBindDebugPoint)) + translatedCtxt (bindCall |> addBindDebugPoint)) /// This function is for desugaring into .Bind{N}Return calls if possible /// The outer option indicates if .BindReturn is possible. When it returns None, .BindReturn cannot be used /// The inner option indicates if a custom operation is involved inside - and convertSimpleReturnToExpr varSpace innerComp = + and convertSimpleReturnToExpr + (cenv: TcFileState) + (env: TcEnv) + (tpenv: UnscopedTyparEnv) + (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + comp + varSpace + innerComp = match innerComp with | SynExpr.YieldOrReturn((false, _), returnExpr, m) -> let returnExpr = SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnExpr) @@ -2695,7 +2609,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp2, patm, sp, trivia)) -> - match convertSimpleReturnToExpr varSpace innerComp2 with + match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp2 with | None -> None // failure | Some(_, Some _) -> None // custom op on branch = failure | Some(innerExpr2, None) -> Some(SynMatchClause(pat, cond, innerExpr2, patm, sp, trivia))) @@ -2706,7 +2620,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv None | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> - match convertSimpleReturnToExpr varSpace thenComp with + match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace thenComp with | None -> None | Some(_, Some _) -> None | Some(thenExpr, None) -> @@ -2715,7 +2629,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv // When we are missing an 'else' part alltogether in case of 'if cond then return exp', we fallback from BindReturn into regular Bind+Return | None -> None | Some elseComp -> - match convertSimpleReturnToExpr varSpace elseComp with + match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace elseComp with | None -> None // failure | Some(_, Some _) -> None // custom op on branch = failure | Some(elseExpr, None) -> Some(Some elseExpr) @@ -2726,12 +2640,12 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv Some(SynExpr.IfThenElse(guardExpr, thenExpr, elseExprOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia), None) | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> - match convertSimpleReturnToExpr varSpace innerComp with + match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp with | None -> None | Some(_, Some _) -> None | Some(innerExpr, None) -> Some(SynExpr.LetOrUse(isRec, false, binds, innerExpr, m, trivia), None) - | OptionalSequential(CustomOperationClause(nm, _, _, mClause, _), _) when customOperationMaintainsVarSpaceUsingBind nm -> + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, _, _, mClause, _), _) when customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> let patvs, _env = varSpace.Force comp.Range let varSpaceExpr = mkExprForVarSpace mClause patvs @@ -2741,9 +2655,9 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, trivia) -> // Check the first part isn't a computation expression construct - if isSimpleExpr innerComp1 then + if (isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1) then // Check the second part is a simple return - match convertSimpleReturnToExpr varSpace innerComp2 with + match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp2 with | None -> None | Some(innerExpr2, optionalCont) -> Some(SynExpr.Sequential(sp, true, innerComp1, innerExpr2, m, trivia), optionalCont) else @@ -2752,41 +2666,248 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv | _ -> None /// Check if an expression has no computation expression constructs - and isSimpleExpr comp = + and isSimpleExpr (cenv: TcFileState) env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp = match comp with - | ForEachThenJoinOrGroupJoinOrZipClause false _ -> false + | ForEachThenJoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName false _ -> false | SynExpr.ForEach _ -> false | SynExpr.For _ -> false | SynExpr.While _ -> false | SynExpr.WhileBang _ -> false | SynExpr.TryFinally _ -> false | SynExpr.ImplicitZero _ -> false - | OptionalSequential(JoinOrGroupJoinOrZipClause _, _) -> false - | OptionalSequential(CustomOperationClause _, _) -> false - | SynExpr.Sequential(expr1 = innerComp1; expr2 = innerComp2) -> isSimpleExpr innerComp1 && isSimpleExpr innerComp2 + | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, _) -> false + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, _) -> false + | SynExpr.Sequential(expr1 = innerComp1; expr2 = innerComp2) -> + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1 + && isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp2 | SynExpr.IfThenElse(thenExpr = thenComp; elseExpr = elseCompOpt) -> - isSimpleExpr thenComp + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName thenComp && (match elseCompOpt with | None -> true - | Some c -> isSimpleExpr c) - | SynExpr.LetOrUse(body = innerComp) -> isSimpleExpr innerComp + | Some c -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName c) + | SynExpr.LetOrUse(body = innerComp) -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp | SynExpr.LetOrUseBang _ -> false | SynExpr.Match(clauses = clauses) -> clauses - |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> isSimpleExpr innerComp) + |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp) | SynExpr.MatchBang _ -> false | SynExpr.TryWith(tryExpr = innerComp; withCases = clauses) -> - isSimpleExpr innerComp + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp && clauses - |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> isSimpleExpr clauseComp) + |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName clauseComp) | SynExpr.YieldOrReturnFrom _ -> false | SynExpr.YieldOrReturn _ -> false | SynExpr.DoBang _ -> false | _ -> true +and TranslateComputationExpression + (cenv: TcFileState) + (env: TcEnv) + (tpenv: UnscopedTyparEnv) + (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + firstTry + q + varSpace + comp + translatedCtxt = + + cenv.stackGuard.Guard + <| fun () -> + match TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole firstTry q varSpace comp translatedCtxt with + | Some e -> e + | None -> + // This only occurs in final position in a sequence + match comp with + // "do! expr;" in final position is treated as { let! () = expr in return () } when Return is provided (and no Zero with Default attribute is available) or as { let! () = expr in zero } otherwise + | SynExpr.DoBang(rhsExpr, m) -> + let mUnit = rhsExpr.Range + let rhsExpr = mkSourceExpr rhsExpr sourceMethInfo builderValName + + if isQuery then + error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), m)) + + let bodyExpr = + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Return" builderTy + ) + then + SynExpr.ImplicitZero m + else + match + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy + with + | minfo :: _ when MethInfoHasAttribute cenv.g m cenv.g.attrib_DefaultValueAttribute minfo -> SynExpr.ImplicitZero m + | _ -> SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) + + let letBangBind = + SynExpr.LetOrUseBang( + DebugPointAtBinding.NoneAtDo, + false, + false, + SynPat.Const(SynConst.Unit, mUnit), + rhsExpr, + [], + bodyExpr, + m, + SynExprLetOrUseBangTrivia.Zero + ) + + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace letBangBind translatedCtxt + + // "expr;" in final position is treated as { expr; zero } + // Suppress the sequence point on the "zero" + | _ -> + // 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 cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole comp + then + TranslateComputationExpression + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + CompExprTranslationPass.Initial + q + varSpace + (SynExpr.ImplicitZero comp.Range) + translatedCtxt + else + if isQuery && not comp.IsArbExprAndThusAlreadyReportedError then + match comp with + | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential + | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), comp.RangeOfFirstPortion)) + + TranslateComputationExpression + cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + CompExprTranslationPass.Initial + q + varSpace + (SynExpr.ImplicitZero comp.Range) + (fun holeFill -> + let fillExpr = + if enableImplicitYield then + let implicitYieldExpr = mkSynCall "Yield" comp.Range [ comp ] builderValName + + SynExpr.SequentialOrImplicitYield( + DebugPointAtSequential.SuppressExpr, + comp, + holeFill, + implicitYieldExpr, + comp.Range + ) + else + SynExpr.Sequential( + DebugPointAtSequential.SuppressExpr, + true, + comp, + holeFill, + comp.Range, + SynExprSequentialTrivia.Zero + ) + + translatedCtxt fillExpr) + +/// Used for all computation expressions except sequence expressions +let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv (mWhole, interpExpr: Expr, builderTy, comp: SynExpr) = + let overallTy = overallTy.Commit + + let ad = env.eAccessRights + + let builderValName = CompilerGeneratedName "builder" + let mBuilderVal = interpExpr.Range + + // Give bespoke error messages for the FSharp.Core "query" builder + let isQuery = + match stripDebugPoints interpExpr with + // An unparameterized custom builder, e.g., `query`, `async`. + | Expr.Val(vref, _, m) + // A parameterized custom builder, e.g., `builder<…>`, `builder ()`. + | Expr.App(funcExpr = Expr.Val(vref, _, m)) when not vref.IsMember || vref.IsConstructor -> + let item = Item.CustomBuilder(vref.DisplayName, vref) + CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + valRefEq cenv.g vref cenv.g.query_value_vref + | _ -> false + + let sourceMethInfo = + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Source" builderTy + + /// Decide if the builder is an auto-quote builder + let isAutoQuote = hasMethInfo "Quote" cenv env mBuilderVal ad builderTy + + let customOperationMethods = getCustomOperationMethods cenv env ad mBuilderVal builderTy + + /// Decide if the identifier represents a use of a custom query operator + let hasCustomOperations = + match customOperationMethods with + | [] -> CustomOperationsMode.Denied + | _ -> CustomOperationsMode.Allowed + + let customOperationMethodsIndexedByKeyword = + if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then + customOperationMethods + |> Seq.groupBy (fun (nm, _, _, _, _, _, _, _, _) -> nm) + |> Seq.map (fun (nm, group) -> (nm, Seq.toList group)) + else + customOperationMethods + |> Seq.groupBy (fun (nm, _, _, _, _, _, _, _, _) -> nm) + |> Seq.map (fun (nm, group) -> (nm, Seq.toList group)) + |> dict + + // Check for duplicates by method name (keywords and method names must be 1:1) + let customOperationMethodsIndexedByMethodName = + if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then + customOperationMethods + |> Seq.groupBy (fun (_, _, _, _, _, _, _, _, methInfo) -> methInfo.LogicalName) + |> Seq.map (fun (nm, group) -> (nm, Seq.toList group)) + else + customOperationMethods + |> Seq.groupBy (fun (_, _, _, _, _, _, _, _, methInfo) -> methInfo.LogicalName) + |> Seq.map (fun (nm, group) -> (nm, Seq.toList group)) + |> dict + + /// Inside the 'query { ... }' use a modified name environment that contains fake 'CustomOperation' entries + /// for all custom operations. This adds them to the completion lists and prevents them being used as values inside + /// the query. + let env = + if List.isEmpty customOperationMethods then + env + else + { env with + eNameResEnv = + (env.eNameResEnv, customOperationMethods) + ||> Seq.fold (fun nenv (nm, _, _, _, _, _, _, _, methInfo) -> + AddFakeNameToNameEnv + nm + nenv + (Item.CustomOperation(nm, (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (ident (nm, mBuilderVal))), Some methInfo))) + } + + // Environment is needed for completions + CallEnvSink cenv.tcSink (comp.Range, env.NameEnv, ad) + + // If there are no 'yield' in the computation expression, and the builder supports 'Yield', + // then allow the type-directed rule interpreting non-unit-typed expressions in statement + // positions as 'yield'. 'yield!' may be present in the computation expression. + let enableImplicitYield = + cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + && (hasMethInfo "Yield" cenv env mBuilderVal ad builderTy + && hasMethInfo "Combine" cenv env mBuilderVal ad builderTy + && hasMethInfo "Delay" cenv env mBuilderVal ad builderTy + && YieldFree cenv comp) + + let origComp = comp + let basicSynExpr = - trans CompExprTranslationPass.Initial (hasCustomOperations ()) (LazyWithContext.NotLazy([], env)) comp id + TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial hasCustomOperations (LazyWithContext.NotLazy([], env)) comp id let mDelayOrQuoteOrRun = mBuilderVal @@ -2836,7 +2957,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv | _ -> env let lambdaExpr, tpenv = - TcExpr cenv (MustEqual(mkFunTy g builderTy overallTy)) env tpenv lambdaExpr + TcExpr cenv (MustEqual(mkFunTy cenv.g builderTy overallTy)) env tpenv lambdaExpr // beta-var-reduce to bind the builder using a 'let' binding let coreExpr = From 7d44ef848c5e7370b5401e7a1a13e06c08d7db32 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 14:48:34 +0200 Subject: [PATCH 02/12] Remove XML comment --- .../Expressions/CheckComputationExpressions.fs | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index e7c2e08f3b6..db7207acc54 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -883,17 +883,6 @@ let inline addVarsToVarSpace (varSpace: LazyWithContext id ) -/// -/// Try translate the syntax sugar -/// -/// -/// -/// a flag indicating if custom operators are allowed. They are not allowed inside try/with, try/finally, if/then/else etc. -/// a lazy data structure indicating the variables bound so far in the overall computation -/// the computation expression being analyzed -/// represents the translation of the context in which the computation expression 'comp' occurs, -/// up to a hole to be filled by (part of) the results of translating 'comp'. -/// let rec TryTranslateComputationExpression (cenv: TcFileState) env From e8bcec3fecb4cebe8640dabc39a7595b53ba8fb1 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 14:52:33 +0200 Subject: [PATCH 03/12] Update XML comment --- .../CheckComputationExpressions.fs | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index db7207acc54..1d8512c98f2 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -883,6 +883,30 @@ let inline addVarsToVarSpace (varSpace: LazyWithContext id ) +/// +/// Try translate the syntax sugar +/// +/// File typecheck state +/// Typechecking environment +/// Unscoped type paramenters environment +/// Cache for custom operations, indexed by keyword +/// Cache for custom operations, indexed by method name +/// Source method info +/// Builder name +/// Accessor domain +/// Builder type +/// Indicates if it's query +/// Indicates if implicit yield is enabled +/// Original computation expression +/// Range of the whole expression +/// Flag if it's inital check +/// a flag indicating if custom operators are allowed. They are not allowed inside try/with, try/finally, if/then/else etc. +/// a lazy data structure indicating the variables bound so far in the overall computation +/// the computation expression being analyzed +/// represents the translation of the context in which the computation expression 'comp' occurs, +/// up to a hole to be filled by (part of) the results of translating 'comp'. +/// +/// let rec TryTranslateComputationExpression (cenv: TcFileState) env From 129cc16087dbf09fea88238052c344d986a07889 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 15:42:39 +0200 Subject: [PATCH 04/12] Fantomas --- .../CheckComputationExpressions.fs | 2809 ++++++++++++----- 1 file changed, 1992 insertions(+), 817 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 1d8512c98f2..4a272c109ae 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -86,7 +86,7 @@ let mkSourceExprConditional isFromSource callExpr sourceMethInfo builderValName callExpr let inline mkSynLambda p e m = - SynExpr.Lambda(false, false, p, e, None, m, SynExprLambdaTrivia.Zero) + SynExpr.Lambda(false, false, p, e, None, m, SynExprLambdaTrivia.Zero) let mkExprForVarSpace m (patvs: Val list) = match patvs with @@ -126,80 +126,84 @@ let getCustomOperationMethods (cenv: TcFileState) (env: TcEnv) ad mBuilderVal bu mBuilderVal builderTy - [ for methInfo in allMethInfos do - if IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo then - let nameSearch = - TryBindMethInfoAttribute - cenv.g - mBuilderVal - cenv.g.attrib_CustomOperationAttribute - methInfo - IgnoreAttribute // We do not respect this attribute for IL methods - (fun attr -> - // NOTE: right now, we support of custom operations with spaces in them ([]) - // In the parameterless CustomOperationAttribute - we use the method name, and also allow it to be ````-quoted (member _.``foo bar`` _ = ...) - match attr with - // Empty string and parameterless constructor - we use the method name - | Attrib(unnamedArgs = [ AttribStringArg "" ]) // Empty string as parameter - | Attrib(unnamedArgs = []) -> // No parameters, same as empty string for compat reasons. - Some methInfo.LogicalName - // Use the specified name - | Attrib(unnamedArgs = [ AttribStringArg msg ]) -> Some msg - | _ -> None) - IgnoreAttribute // We do not respect this attribute for provided methods - - match nameSearch with - | None -> () - | Some nm -> - let joinConditionWord = - TryBindMethInfoAttribute - cenv.g - mBuilderVal - cenv.g.attrib_CustomOperationAttribute - methInfo - IgnoreAttribute // We do not respect this attribute for IL methods - (function - | Attrib(propVal = ExtractAttribNamedArg "JoinConditionWord" (AttribStringArg s)) -> Some s - | _ -> None) - IgnoreAttribute // We do not respect this attribute for provided methods - - let flagSearch (propName: string) = + [ + for methInfo in allMethInfos do + if IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo then + let nameSearch = TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo IgnoreAttribute // We do not respect this attribute for IL methods - (function - | Attrib(propVal = ExtractAttribNamedArg propName (AttribBoolArg b)) -> Some b - | _ -> None) + (fun attr -> + // NOTE: right now, we support of custom operations with spaces in them ([]) + // In the parameterless CustomOperationAttribute - we use the method name, and also allow it to be ````-quoted (member _.``foo bar`` _ = ...) + match attr with + // Empty string and parameterless constructor - we use the method name + | Attrib(unnamedArgs = [ AttribStringArg "" ]) // Empty string as parameter + | Attrib(unnamedArgs = []) -> // No parameters, same as empty string for compat reasons. + Some methInfo.LogicalName + // Use the specified name + | Attrib(unnamedArgs = [ AttribStringArg msg ]) -> Some msg + | _ -> None) IgnoreAttribute // We do not respect this attribute for provided methods - let maintainsVarSpaceUsingBind = - defaultArg (flagSearch "MaintainsVariableSpaceUsingBind") false - - let maintainsVarSpace = defaultArg (flagSearch "MaintainsVariableSpace") false - let allowInto = defaultArg (flagSearch "AllowIntoPattern") false - let isLikeZip = defaultArg (flagSearch "IsLikeZip") false - let isLikeJoin = defaultArg (flagSearch "IsLikeJoin") false - let isLikeGroupJoin = defaultArg (flagSearch "IsLikeGroupJoin") false - - nm, - maintainsVarSpaceUsingBind, - maintainsVarSpace, - allowInto, - isLikeZip, - isLikeJoin, - isLikeGroupJoin, - joinConditionWord, - methInfo ] + match nameSearch with + | None -> () + | Some nm -> + let joinConditionWord = + TryBindMethInfoAttribute + cenv.g + mBuilderVal + cenv.g.attrib_CustomOperationAttribute + methInfo + IgnoreAttribute // We do not respect this attribute for IL methods + (function + | Attrib(propVal = ExtractAttribNamedArg "JoinConditionWord" (AttribStringArg s)) -> Some s + | _ -> None) + IgnoreAttribute // We do not respect this attribute for provided methods + + let flagSearch (propName: string) = + TryBindMethInfoAttribute + cenv.g + mBuilderVal + cenv.g.attrib_CustomOperationAttribute + methInfo + IgnoreAttribute // We do not respect this attribute for IL methods + (function + | Attrib(propVal = ExtractAttribNamedArg propName (AttribBoolArg b)) -> Some b + | _ -> None) + IgnoreAttribute // We do not respect this attribute for provided methods + + let maintainsVarSpaceUsingBind = + defaultArg (flagSearch "MaintainsVariableSpaceUsingBind") false + + let maintainsVarSpace = defaultArg (flagSearch "MaintainsVariableSpace") false + let allowInto = defaultArg (flagSearch "AllowIntoPattern") false + let isLikeZip = defaultArg (flagSearch "IsLikeZip") false + let isLikeJoin = defaultArg (flagSearch "IsLikeJoin") false + let isLikeGroupJoin = defaultArg (flagSearch "IsLikeGroupJoin") false + + nm, + maintainsVarSpaceUsingBind, + maintainsVarSpace, + allowInto, + isLikeZip, + isLikeJoin, + isLikeGroupJoin, + joinConditionWord, + methInfo + ] /// Decide if the identifier represents a use of a custom query operator let tryGetDataForCustomOperation (nm: Ident) (cenv: TcFileState) - (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByKeyword: + IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: + IDictionary * MethInfo>>) = let isOpDataCountAllowed opDatas = @@ -212,14 +216,14 @@ let tryGetDataForCustomOperation | true, opDatas when isOpDataCountAllowed opDatas -> for opData in opDatas do let (opName, - maintainsVarSpaceUsingBind, - maintainsVarSpace, - _allowInto, - isLikeZip, - isLikeJoin, - isLikeGroupJoin, - _joinConditionWord, - methInfo) = + maintainsVarSpaceUsingBind, + maintainsVarSpace, + _allowInto, + isLikeZip, + isLikeJoin, + isLikeGroupJoin, + _joinConditionWord, + methInfo) = opData if @@ -262,6 +266,7 @@ let customOperationCheckValidity m f opDatas = if not (List.allEqual vs) then errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, m)) + v0 // Check for the MaintainsVariableSpace on custom operation @@ -274,16 +279,21 @@ let customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword nm.idRange (fun (_nm, - _maintainsVarSpaceUsingBind, - maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - _methInfo) -> maintainsVarSpace) - -let customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = + _maintainsVarSpaceUsingBind, + maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + _methInfo) -> maintainsVarSpace) + +let customOperationMaintainsVarSpaceUsingBind + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + (nm: Ident) + = match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with | None -> false | Some opDatas -> @@ -377,22 +387,22 @@ let customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword | _ -> "on" let customOperationAllowsInto cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with - | None -> false - | Some opDatas -> - opDatas - |> customOperationCheckValidity - nm.idRange - (fun - (_nm, - _maintainsVarSpaceUsingBind, - _maintainsVarSpace, - allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - _methInfo) -> allowInto) + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | None -> false + | Some opDatas -> + opDatas + |> customOperationCheckValidity + nm.idRange + (fun + (_nm, + _maintainsVarSpaceUsingBind, + _maintainsVarSpace, + allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + _methInfo) -> allowInto) let customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm = match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with @@ -409,16 +419,32 @@ let customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperatio Some( FSComp.SR.customOperationTextLikeGroupJoin ( nm.idText, - customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm, - customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOperationJoinConditionWord + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm, + customOperationJoinConditionWord + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm ) ) elif isLikeJoin then Some( FSComp.SR.customOperationTextLikeJoin ( nm.idText, - customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm, - customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOperationJoinConditionWord + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm, + customOperationJoinConditionWord + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm ) ) elif isLikeZip then @@ -427,7 +453,13 @@ let customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperatio None | _ -> None -let tryGetArgAttribsForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole (nm: Ident) = +let tryGetArgAttribsForCustomOperator + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + mWhole + (nm: Ident) + = match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with | Some argInfos -> argInfos @@ -449,31 +481,39 @@ let tryGetArgAttribsForCustomOperator cenv customOperationMethodsIndexedByKeywor | _ -> None let tryGetArgInfosForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with - | Some argInfos -> - argInfos - |> List.map - (fun - (_nm, - __maintainsVarSpaceUsingBind, - _maintainsVarSpace, - _allowInto, - _isLikeZip, - _isLikeJoin, - _isLikeGroupJoin, - _joinConditionWord, - methInfo) -> - match methInfo with - | FSMeth(_, _, vref, _) -> - match ArgInfosOfMember cenv.g vref with - | [ curriedArgInfo ] -> Some curriedArgInfo - | _ -> None - | _ -> None) - |> Some - | _ -> None + match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + | Some argInfos -> + argInfos + |> List.map + (fun + (_nm, + __maintainsVarSpaceUsingBind, + _maintainsVarSpace, + _allowInto, + _isLikeZip, + _isLikeJoin, + _isLikeGroupJoin, + _joinConditionWord, + methInfo) -> + match methInfo with + | FSMeth(_, _, vref, _) -> + match ArgInfosOfMember cenv.g vref with + | [ curriedArgInfo ] -> Some curriedArgInfo + | _ -> None + | _ -> None) + |> Some + | _ -> None -let tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole (nm: Ident) = - match tryGetArgAttribsForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm with +let tryExpectedArgCountForCustomOperator + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + mWhole + (nm: Ident) + = + match + tryGetArgAttribsForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm + with | None -> None | Some argInfosForOverloads -> let nums = @@ -494,9 +534,8 @@ let tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKey | None -> false | Some args -> args - |> List.exists - (fun (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo)) -> - isParamArrayArg || isOutArg || optArgInfo.IsOptional)) + |> List.exists (fun (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo)) -> + isParamArrayArg || isOutArg || optArgInfo.IsOptional)) else false @@ -506,7 +545,13 @@ let tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKey None // Check for the [] attribute on an argument position -let isCustomOperationProjectionParameter cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName i (nm: Ident) = +let isCustomOperationProjectionParameter + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + i + (nm: Ident) + = match tryGetArgInfosForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm with | None -> false | Some argInfosForOverloads -> @@ -517,12 +562,15 @@ let isCustomOperationProjectionParameter cenv customOperationMethodsIndexedByKey | Some argInfos -> i < argInfos.Length && let _, argInfo = List.item i argInfos in - HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) + HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) if List.allEqual vs then vs[0] else - let opDatas = (tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName).Value + let opDatas = + (tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) + .Value + let opName, _, _, _, _, _, _, _j, _ = opDatas[0] errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) false @@ -617,7 +665,11 @@ let (|OnExpr|_|) (env: TcEnv) cenv customOperationMethodsIndexedByKeyword custom | Some _ -> match synExpr with | SynExpr.App(funcExpr = SynExpr.App(funcExpr = e1; argExpr = SingleIdent opName); argExpr = e2) when - opName.idText = customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + opName.idText = customOperationJoinConditionWord + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm -> let item = Item.CustomOperation(opName.idText, (fun () -> None), None) CallNameResolutionSink cenv.tcSink (opName.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) @@ -634,146 +686,356 @@ let (|IntoSuffix|_|) (e: SynExpr) = | _ -> None let JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName detector synExpr = - match synExpr with - | SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, ExprAsPat innerSourcePat, mJoinCore) -> - Some(nm, innerSourcePat, mJoinCore, false) - // join with bad pattern (gives error on "join" and continues) - | SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, _innerSourcePatExpr, mJoinCore) -> - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) - Some(nm, arbPat mJoinCore, mJoinCore, true) - // join (without anything after - gives error on "join" and continues) - | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm -> - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) - Some(nm, arbPat synExpr.Range, synExpr.Range, true) - | _ -> None - // JoinOrGroupJoinOp customOperationIsLikeJoin + match synExpr with + | SynExpr.App(_, + _, + CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, + ExprAsPat innerSourcePat, + mJoinCore) -> Some(nm, innerSourcePat, mJoinCore, false) + // join with bad pattern (gives error on "join" and continues) + | SynExpr.App(_, + _, + CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, + _innerSourcePatExpr, + mJoinCore) -> + errorR ( + Error( + FSComp.SR.tcBinaryOperatorRequiresVariable ( + nm.idText, + Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + ), + nm.idRange + ) + ) + + Some(nm, arbPat mJoinCore, mJoinCore, true) + // join (without anything after - gives error on "join" and continues) + | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm -> + errorR ( + Error( + FSComp.SR.tcBinaryOperatorRequiresVariable ( + nm.idText, + Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + ), + nm.idRange + ) + ) + + Some(nm, arbPat synExpr.Range, synExpr.Range, true) + | _ -> None +// JoinOrGroupJoinOp customOperationIsLikeJoin let (|JoinOp|_|) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = - JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) synExpr + JoinOrGroupJoinOp + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + (customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) + synExpr let (|GroupJoinOp|_|) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = - JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) synExpr + JoinOrGroupJoinOp + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + (customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) + synExpr + +let MatchIntoSuffixOrRecover + cenv + (env: TcEnv) + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + alreadyGivenError + (nm: Ident) + synExpr + = + match synExpr with + | IntoSuffix(x, intoWordRange, intoPat) -> + // record the "into" as a custom operation for colorization + let item = Item.CustomOperation("into", (fun () -> None), None) + CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + (x, intoPat, alreadyGivenError) + | _ -> + if not alreadyGivenError then + errorR ( + Error( + FSComp.SR.tcOperatorIncorrectSyntax ( + nm.idText, + Option.get ( + customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + ) + ), + nm.idRange + ) + ) -let MatchIntoSuffixOrRecover cenv (env: TcEnv) customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError (nm: Ident) synExpr = - match synExpr with - | IntoSuffix(x, intoWordRange, intoPat) -> - // record the "into" as a custom operation for colorization - let item = Item.CustomOperation("into", (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - (x, intoPat, alreadyGivenError) - | _ -> - if not alreadyGivenError then - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) - - (synExpr, arbPat synExpr.Range, true) - -let MatchOnExprOrRecover cenv (env: TcEnv) tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm (onExpr: SynExpr) = + (synExpr, arbPat synExpr.Range, true) + +let MatchOnExprOrRecover + cenv + (env: TcEnv) + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + alreadyGivenError + nm + (onExpr: SynExpr) + = match onExpr with - | OnExpr (env: TcEnv) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm (innerSource, SynExprParen(keySelectors, _, _, _)) -> (innerSource, keySelectors) + | OnExpr (env: TcEnv) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm (innerSource, + SynExprParen(keySelectors, + _, + _, + _)) -> + (innerSource, keySelectors) | _ -> if not alreadyGivenError then suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv onExpr) |> ignore - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) + errorR ( + Error( + FSComp.SR.tcOperatorIncorrectSyntax ( + nm.idText, + Option.get ( + customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + ) + ), + nm.idRange + ) + ) (arbExpr ("_innerSource", onExpr.Range), - mkSynBifix onExpr.Range "=" (arbExpr ("_keySelectors", onExpr.Range)) (arbExpr ("_keySelector2", onExpr.Range))) + mkSynBifix onExpr.Range "=" (arbExpr ("_keySelectors", onExpr.Range)) (arbExpr ("_keySelector2", onExpr.Range))) let (|JoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = - match synExpr with - | InExpr(JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, _, alreadyGivenError), onExpr, mJoinCore) -> - let innerSource, keySelectors = MatchOnExprOrRecover cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm onExpr - Some(nm, innerSourcePat, innerSource, keySelectors, mJoinCore) - | JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, mJoinCore, alreadyGivenError) -> - if alreadyGivenError then - errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) - - Some(nm, innerSourcePat, arbExpr ("_innerSource", synExpr.Range), arbKeySelectors synExpr.Range, mJoinCore) - | _ -> None - -let (|GroupJoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = - match synExpr with - | InExpr(GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, _, alreadyGivenError), intoExpr, mGroupJoinCore) -> - let onExpr, intoPat, alreadyGivenError = - MatchIntoSuffixOrRecover cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm intoExpr - - let innerSource, keySelectors = MatchOnExprOrRecover cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName alreadyGivenError nm onExpr - Some(nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) - | GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, mGroupJoinCore, alreadyGivenError) -> - if alreadyGivenError then - errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) - - Some( - nm, - innerSourcePat, - arbExpr ("_innerSource", synExpr.Range), - arbKeySelectors synExpr.Range, - arbPat synExpr.Range, - mGroupJoinCore + match synExpr with + | InExpr(JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + innerSourcePat, + _, + alreadyGivenError), + onExpr, + mJoinCore) -> + let innerSource, keySelectors = + MatchOnExprOrRecover + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + alreadyGivenError + nm + onExpr + + Some(nm, innerSourcePat, innerSource, keySelectors, mJoinCore) + | JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + innerSourcePat, + mJoinCore, + alreadyGivenError) -> + if alreadyGivenError then + errorR ( + Error( + FSComp.SR.tcOperatorRequiresIn ( + nm.idText, + Option.get ( + customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + ) + ), + nm.idRange + ) ) - | _ -> None -let (|JoinOrGroupJoinOrZipClause|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = - - match synExpr with - // join innerSourcePat in innerSource on (keySelector1 = keySelector2) - | JoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, innerSource, keySelectors, mJoinCore) -> - Some(nm, innerSourcePat, innerSource, Some keySelectors, None, mJoinCore) + Some(nm, innerSourcePat, arbExpr ("_innerSource", synExpr.Range), arbKeySelectors synExpr.Range, mJoinCore) + | _ -> None - // groupJoin innerSourcePat in innerSource on (keySelector1 = keySelector2) into intoPat - | GroupJoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) -> - Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) +let (|GroupJoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = + match synExpr with + | InExpr(GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + innerSourcePat, + _, + alreadyGivenError), + intoExpr, + mGroupJoinCore) -> + let onExpr, intoPat, alreadyGivenError = + MatchIntoSuffixOrRecover + cenv + env + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + alreadyGivenError + nm + intoExpr + + let innerSource, keySelectors = + MatchOnExprOrRecover + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + alreadyGivenError + nm + onExpr + + Some(nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) + | GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + innerSourcePat, + mGroupJoinCore, + alreadyGivenError) -> + if alreadyGivenError then + errorR ( + Error( + FSComp.SR.tcOperatorRequiresIn ( + nm.idText, + Option.get ( + customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + ) + ), + nm.idRange + ) + ) - // zip intoPat in secondSource - | InExpr(SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, ExprAsPat secondSourcePat, _), - secondSource, - mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) + Some( + nm, + innerSourcePat, + arbExpr ("_innerSource", synExpr.Range), + arbKeySelectors synExpr.Range, + arbPat synExpr.Range, + mGroupJoinCore + ) + | _ -> None - // zip (without secondSource or in - gives error) - | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm -> - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) - Some(nm, arbPat synExpr.Range, arbExpr ("_secondSource", synExpr.Range), None, None, synExpr.Range) +let (|JoinOrGroupJoinOrZipClause|_|) + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + synExpr + = - // zip secondSource (without in - gives error) - | SynExpr.App(_, _, CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, ExprAsPat secondSourcePat, mZipCore) -> - errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), mZipCore)) - Some(nm, secondSourcePat, arbExpr ("_innerSource", synExpr.Range), None, None, mZipCore) + match synExpr with + // join innerSourcePat in innerSource on (keySelector1 = keySelector2) + | JoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + innerSourcePat, + innerSource, + keySelectors, + mJoinCore) -> + Some(nm, innerSourcePat, innerSource, Some keySelectors, None, mJoinCore) + + // groupJoin innerSourcePat in innerSource on (keySelector1 = keySelector2) into intoPat + | GroupJoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + innerSourcePat, + innerSource, + keySelectors, + intoPat, + mGroupJoinCore) -> + Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) + + // zip intoPat in secondSource + | InExpr(SynExpr.App(_, + _, + CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, + ExprAsPat secondSourcePat, + _), + secondSource, + mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) + + // zip (without secondSource or in - gives error) + | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm -> + errorR ( + Error( + FSComp.SR.tcOperatorIncorrectSyntax ( + nm.idText, + Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + ), + nm.idRange + ) + ) - | _ -> None + Some(nm, arbPat synExpr.Range, arbExpr ("_secondSource", synExpr.Range), None, None, synExpr.Range) + + // zip secondSource (without in - gives error) + | SynExpr.App(_, + _, + CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, + ExprAsPat secondSourcePat, + mZipCore) -> + errorR ( + Error( + FSComp.SR.tcOperatorIncorrectSyntax ( + nm.idText, + Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + ), + mZipCore + ) + ) -let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName strict synExpr = - match synExpr with - | ForEachThen(isFromSource, - firstSourcePat, - firstSource, - JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore), - innerComp) when - (let _firstSourceSimplePats, later1 = - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat - - Option.isNone later1) - -> - Some(isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp) + Some(nm, secondSourcePat, arbExpr ("_innerSource", synExpr.Range), None, None, mZipCore) - | JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, pat2, expr2, expr3, pat3opt, mOpCore) when strict -> - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) + | _ -> None - Some( - true, - arbPat synExpr.Range, - arbExpr ("_outerSource", synExpr.Range), - nm, - pat2, - expr2, - expr3, - pat3opt, - mOpCore, - arbExpr ("_innerComp", synExpr.Range) +let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + strict + synExpr + = + match synExpr with + | ForEachThen(isFromSource, + firstSourcePat, + firstSource, + JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + secondSourcePat, + secondSource, + keySelectorsOpt, + pat3opt, + mOpCore), + innerComp) when + (let _firstSourceSimplePats, later1 = + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat + + Option.isNone later1) + -> + Some(isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp) + + | JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + pat2, + expr2, + expr3, + pat3opt, + mOpCore) when + strict + -> + errorR ( + Error( + FSComp.SR.tcBinaryOperatorRequiresBody ( + nm.idText, + Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + ), + nm.idRange ) + ) - | _ -> None + Some( + true, + arbPat synExpr.Range, + arbExpr ("_outerSource", synExpr.Range), + nm, + pat2, + expr2, + expr3, + pat3opt, + mOpCore, + arbExpr ("_innerComp", synExpr.Range) + ) + + | _ -> None let (|StripApps|) e = let rec strip e = @@ -794,7 +1056,9 @@ let (|OptionalIntoSuffix|) e = let (|CustomOperationClause|_|) cenv (env: TcEnv) customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName e = match e with - | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> + | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when + isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + -> // Now we know we have a custom operation, commit the name resolution let intoInfoOpt = match intoOpt with @@ -844,7 +1108,14 @@ let checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperatio match comp with | StripApps(SingleIdent nm, [ StripApps(SingleIdent nm2, args); arg2 ]) when IsLogicalInfixOpName nm.idText - && (match tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm2 with + && (match + tryExpectedArgCountForCustomOperator + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + mWhole + nm2 + with | Some n -> n > 0 | _ -> false) && not (List.isEmpty args) @@ -855,9 +1126,16 @@ let checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperatio errorR (Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator (), estimatedRangeOfIntendedLeftAndRightArguments)) true | SynExpr.Tuple(false, StripApps(SingleIdent nm2, args) :: _, _, m) when - (match tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm2 with - | Some n -> n > 0 - | _ -> false) + (match + tryExpectedArgCountForCustomOperator + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + mWhole + nm2 + with + | Some n -> n > 0 + | _ -> false) && not (List.isEmpty args) -> let estimatedRangeOfIntendedLeftAndRightArguments = @@ -911,8 +1189,10 @@ let rec TryTranslateComputationExpression (cenv: TcFileState) env tpenv - (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByKeyword: + IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: + IDictionary * MethInfo>>) sourceMethInfo builderValName ad @@ -951,15 +1231,15 @@ let rec TryTranslateComputationExpression // --> // zip expr1 expr2 (fun pat1 pat3 -> ...) | ForEachThenJoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName true (isFromSource, - firstSourcePat, - firstSource, - nm, - secondSourcePat, - secondSource, - keySelectorsOpt, - secondResultPatOpt, - mOpCore, - innerComp) -> + firstSourcePat, + firstSource, + nm, + secondSourcePat, + secondSource, + keySelectorsOpt, + secondResultPatOpt, + mOpCore, + innerComp) -> match q with | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), nm.idRange)) | CustomOperationsMode.Allowed -> @@ -1013,20 +1293,25 @@ let rec TryTranslateComputationExpression errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondSourcePat.Range)) // check 'join' or 'groupJoin' or 'zip' is permitted for this builder - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with + match + tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName + with | None -> error (Error(FSComp.SR.tcMissingCustomOperation (nm.idText), nm.idRange)) | Some opDatas -> let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] // Record the resolution of the custom operation for posterity let item = - Item.CustomOperation(opName, (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), Some methInfo) + Item.CustomOperation( + opName, + (fun () -> + customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), + Some methInfo + ) // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink - cenv.tcSink - (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let mkJoinExpr keySelector1 keySelector2 innerPat e = let mSynthetic = mOpCore.MakeSynthetic() @@ -1088,7 +1373,13 @@ let rec TryTranslateComputationExpression match secondResultPatOpt, keySelectorsOpt with // groupJoin - | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> + | Some secondResultPat, Some relExpr when + customOperationIsLikeGroupJoin + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm + -> let secondResultSimplePats, later3 = SimplePatsOfPat cenv.synArgNameGenerator secondResultPat @@ -1103,9 +1394,7 @@ let rec TryTranslateComputationExpression // When we cannot resolve NullableOps, recommend the relevant namespace to be added errorR ( Error( - FSComp.SR.cannotResolveNullableOperators ( - ConvertValLogicalNameToDisplayNameCore opId.idText - ), + FSComp.SR.cannotResolveNullableOperators (ConvertValLogicalNameToDisplayNameCore opId.idText), relExpr.Range ) ) @@ -1125,7 +1414,13 @@ let rec TryTranslateComputationExpression mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondResultSimplePats, varSpaceWithGroupJoinVars - | None, Some relExpr when customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> + | None, Some relExpr when + customOperationIsLikeJoin + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm + -> match relExpr with | JoinRelation cenv env (keySelector1, keySelector2) -> mkJoinExpr keySelector1 keySelector2 secondSourceSimplePats, varSpaceWithSecondVars @@ -1134,9 +1429,7 @@ let rec TryTranslateComputationExpression // When we cannot resolve NullableOps, recommend the relevant namespace to be added errorR ( Error( - FSComp.SR.cannotResolveNullableOperators ( - ConvertValLogicalNameToDisplayNameCore opId.idText - ), + FSComp.SR.cannotResolveNullableOperators (ConvertValLogicalNameToDisplayNameCore opId.idText), relExpr.Range ) ) @@ -1155,7 +1448,14 @@ let rec TryTranslateComputationExpression mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondSourceSimplePats, varSpaceWithGroupJoinVars - | None, None when customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> mkZipExpr, varSpaceWithSecondVars + | None, None when + customOperationIsLikeZip + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm + -> + mkZipExpr, varSpaceWithSecondVars | _ -> assert false @@ -1180,7 +1480,27 @@ let rec TryTranslateComputationExpression mOpCore ) - Some(TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) + Some( + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpaceInner + consumingExpr + translatedCtxt + ) | SynExpr.ForEach(spFor, spIn, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _mEntireForEach) -> let sourceExpr = @@ -1208,9 +1528,7 @@ let rec TryTranslateComputationExpression let mPat = pat.Range - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("For"), mFor)) // Add the variables to the query variable space, on demand @@ -1224,32 +1542,50 @@ let rec TryTranslateComputationExpression vspecs, envinner) Some( - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp (fun innerCompR -> - - let forCall = - mkSynCall - "For" - mFor - [ - wrappedSourceExpr - SynExpr.MatchLambda( - false, - mPat, - [ - SynMatchClause(pat, None, innerCompR, mPat, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, - mFor - ) - ] - builderValName + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + innerComp + (fun innerCompR -> + + let forCall = + mkSynCall + "For" + mFor + [ + wrappedSourceExpr + SynExpr.MatchLambda( + false, + mPat, + [ + SynMatchClause(pat, None, innerCompR, mPat, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + mFor + ) + ] + builderValName - let forCall = - match spFor with - | DebugPointAtFor.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, false, forCall) - | DebugPointAtFor.No -> forCall + let forCall = + match spFor with + | DebugPointAtFor.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, false, forCall) + | DebugPointAtFor.No -> forCall - translatedCtxt forCall) + translatedCtxt forCall) ) | SynExpr.For( @@ -1272,7 +1608,27 @@ let rec TryTranslateComputationExpression let reduced = elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m) - Some(TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace reduced translatedCtxt) + Some( + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + reduced + translatedCtxt + ) | SynExpr.While(spWhile, guardExpr, innerComp, _) -> let mGuard = guardExpr.Range @@ -1286,16 +1642,12 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcNoWhileInQuery (), mWhile)) if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "While" builderTy - ) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "While" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("While"), mWhile)) if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "Delay" builderTy - ) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "Delay" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mWhile)) @@ -1306,17 +1658,35 @@ let rec TryTranslateComputationExpression | DebugPointAtWhile.No -> guardExpr Some( - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> - translatedCtxt ( - mkSynCall - "While" - mWhile - [ - mkSynDelay2 guardExpr - mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] builderValName - ] - builderValName - )) + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + innerComp + (fun holeFill -> + translatedCtxt ( + mkSynCall + "While" + mWhile + [ + mkSynDelay2 guardExpr + mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] builderValName + ] + builderValName + )) ) | SynExpr.WhileBang(spWhile, guardExpr, innerComp, mOrig) -> @@ -1347,17 +1717,17 @@ let rec TryTranslateComputationExpression mkSynBinding (Xml.PreXmlDoc.Empty, patCond) (None, - false, - true, - mGuard, - DebugPointAtBinding.NoneAtSticky, - None, - SynExpr.Ident idFirst, - mGuard, - [], - [], - None, - SynBindingTrivia.Zero) + false, + true, + mGuard, + DebugPointAtBinding.NoneAtSticky, + None, + SynExpr.Ident idFirst, + mGuard, + [], + [], + None, + SynBindingTrivia.Zero) let setCondExpr = SynExpr.Set(SynExpr.Ident idCond, SynExpr.Ident idFirst, mGuard) @@ -1403,7 +1773,25 @@ let rec TryTranslateComputationExpression SynExprLetOrUseBangTrivia.Zero ) - TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace rewrittenWhileExpr translatedCtxt + TryTranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + rewrittenWhileExpr + translatedCtxt | SynExpr.TryFinally(innerComp, unwindExpr, _mTryToLast, spTry, spFinally, trivia) -> @@ -1427,18 +1815,29 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcNoTryFinallyInQuery (), mTry)) if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryFinally" builderTy - ) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryFinally" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("TryFinally"), mTry)) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) - let innerExpr = TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp + let innerExpr = + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + innerComp let innerExpr = match spTry with @@ -1486,7 +1885,13 @@ let rec TryTranslateComputationExpression Some(translatedCtxt (mkSynCall "Zero" m [] builderValName)) - | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (_, _, _, _, _, mClause), _) when firstTry = CompExprTranslationPass.Initial -> + | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (_, + _, + _, + _, + _, + mClause), + _) when firstTry = CompExprTranslationPass.Initial -> // 'join' clauses preceded by 'let' and other constructs get processed by repackaging with a 'for' loop. let patvs, _env = varSpace.Force comp.Range @@ -1494,7 +1899,23 @@ let rec TryTranslateComputationExpression let varSpacePat = mkPatForVarSpace mClause patvs let dataCompPrior = - translatedCtxt (TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause))) + translatedCtxt ( + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause)) + ) // Rebind using for ... let rebind = @@ -1510,9 +1931,32 @@ let rec TryTranslateComputationExpression ) // Retry with the 'for' loop packaging. Set firstTry=false just in case 'join' processing fails - TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Subsequent q varSpace rebind id - - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, _, opExpr, mClause, _), _) -> + TryTranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Subsequent + q + varSpace + rebind + id + + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + _, + opExpr, + mClause, + _), + _) -> match q with | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), opExpr.Range)) @@ -1521,17 +1965,86 @@ let rec TryTranslateComputationExpression let varSpaceExpr = mkExprForVarSpace mClause patvs let dataCompPriorToOp = - let isYield = not (customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) - translatedCtxt (TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause))) - + let isYield = + not ( + customOperationMaintainsVarSpaceUsingBind + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm + ) + + translatedCtxt ( + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause)) + ) + // Now run the consumeCustomOpClauses - Some(ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompPriorToOp comp false mClause) + Some( + ConsumeCustomOpClauses + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + varSpace + dataCompPriorToOp + comp + false + mClause + ) | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, _) -> // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 - if isQuery && checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole innerComp1 then - Some(TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt) + if + isQuery + && checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole innerComp1 + then + Some( + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + innerComp2 + translatedCtxt + ) else @@ -1540,29 +2053,40 @@ let rec TryTranslateComputationExpression | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), innerComp1.RangeOfFirstPortion)) - match TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial CustomOperationsMode.Denied varSpace innerComp1 id with + match + TryTranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + CustomOperationsMode.Denied + varSpace + innerComp1 + id + with | Some c -> // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) let m1 = rangeForCombine innerComp1 if isNil ( - TryFindIntrinsicOrExtensionMethInfo - ResultCollectionSettings.AtMostOneResult - cenv - env - m - ad - "Combine" - builderTy + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Combine" builderTy ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Combine"), m)) if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy - ) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), m)) @@ -1572,7 +2096,29 @@ let rec TryTranslateComputationExpression m1 [ c - mkSynCall "Delay" m1 [ mkSynDelay innerComp2.Range (TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp2) ] builderValName + mkSynCall + "Delay" + m1 + [ + mkSynDelay + innerComp2.Range + (TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + innerComp2) + ] + builderValName ] builderValName @@ -1591,7 +2137,19 @@ let rec TryTranslateComputationExpression Some( TranslateComputationExpression - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole CompExprTranslationPass.Initial q varSpace @@ -1612,30 +2170,48 @@ let rec TryTranslateComputationExpression // "expr; cexpr" is treated as sequential execution | _ -> Some( - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp2 (fun holeFill -> - let fillExpr = - if enableImplicitYield then - // When implicit yields are enabled, then if the 'innerComp1' checks as type - // 'unit' we interpret the expression as a sequential, and when it doesn't - // have type 'unit' we interpret it as a 'Yield + Combine'. - let combineExpr = - let m1 = rangeForCombine innerComp1 - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] builderValName - - mkSynCall - "Combine" - m1 - [ - implicitYieldExpr - mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] builderValName - ] - builderValName - - SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) - else - SynExpr.Sequential(sp, true, innerComp1, holeFill, m, SynExprSequentialTrivia.Zero) - - translatedCtxt fillExpr) + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + innerComp2 + (fun holeFill -> + let fillExpr = + if enableImplicitYield then + // When implicit yields are enabled, then if the 'innerComp1' checks as type + // 'unit' we interpret the expression as a sequential, and when it doesn't + // have type 'unit' we interpret it as a 'Yield + Combine'. + let combineExpr = + let m1 = rangeForCombine innerComp1 + let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] builderValName + + mkSynCall + "Combine" + m1 + [ + implicitYieldExpr + mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] builderValName + ] + builderValName + + SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) + else + SynExpr.Sequential(sp, true, innerComp1, holeFill, m, SynExprSequentialTrivia.Zero) + + translatedCtxt fillExpr) ) | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> @@ -1648,8 +2224,38 @@ let rec TryTranslateComputationExpression translatedCtxt ( SynExpr.IfThenElse( guardExpr, - TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole thenComp, - Some(TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole elseComp), + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + thenComp, + Some( + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + elseComp + ), spIfToThen, isRecovery, mIfToEndOfElseBranch, @@ -1676,18 +2282,36 @@ let rec TryTranslateComputationExpression mkSynCall "Zero" trivia.IfToThenRange [] builderValName Some( - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> - translatedCtxt ( - SynExpr.IfThenElse( - guardExpr, - holeFill, - Some elseComp, - spIfToThen, - isRecovery, - mIfToEndOfElseBranch, - trivia - ) - )) + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + thenComp + (fun holeFill -> + translatedCtxt ( + SynExpr.IfThenElse( + guardExpr, + holeFill, + Some elseComp, + spIfToThen, + isRecovery, + mIfToEndOfElseBranch, + trivia + ) + )) ) // 'let binds in expr' @@ -1723,8 +2347,25 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings (), mQueryOp))) Some( - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> - translatedCtxt (SynExpr.LetOrUse(isRec, false, binds, holeFill, m, trivia))) + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + innerComp + (fun holeFill -> translatedCtxt (SynExpr.LetOrUse(isRec, false, binds, holeFill, m, trivia))) ) // 'use x = expr in expr' @@ -1750,7 +2391,21 @@ let rec TryTranslateComputationExpression SynMatchClause( pat, None, - TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + innerComp, innerCompRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero @@ -1760,9 +2415,7 @@ let rec TryTranslateComputationExpression innerCompRange ) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) Some( @@ -1775,13 +2428,7 @@ let rec TryTranslateComputationExpression // 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) -> + bindDebugPoint = spBind; isUse = false; isFromSource = isFromSource; pat = pat; rhs = rhsExpr; andBangs = []; body = innerComp) -> let mBind = match spBind with @@ -1806,8 +2453,30 @@ let rec TryTranslateComputationExpression Some( TranslateComputationExpressionBind - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole - q varSpace mBind (addBindDebugPoint spBind) "Bind" [ rhsExpr ] pat innerComp translatedCtxt) + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + 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)))) | SynExpr.LetOrUseBang( @@ -1835,14 +2504,10 @@ let rec TryTranslateComputationExpression if isQuery then error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Bind" builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Bind" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), mBind)) let bindExpr = @@ -1854,7 +2519,21 @@ let rec TryTranslateComputationExpression SynMatchClause( pat, None, - TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + innerComp, innerComp.Range, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero @@ -1921,7 +2600,7 @@ let rec TryTranslateComputationExpression let sources = (letRhsExpr - :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) + :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) |> List.map (fun expr -> mkSourceExprConditional isFromSource expr sourceMethInfo builderValName) let pats = @@ -1948,7 +2627,20 @@ let rec TryTranslateComputationExpression ) ) - if hasBindReturnN && Option.isSome (convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp) then + if + hasBindReturnN + && Option.isSome ( + convertSimpleReturnToExpr + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + varSpace + innerComp + ) + then let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) // Add the variables to the query variable space, on demand @@ -1963,8 +2655,30 @@ let rec TryTranslateComputationExpression Some( TranslateComputationExpressionBind - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole - q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + varSpace + mBind + (addBindDebugPoint spBind) + bindNName + sources + consumePat + innerComp + translatedCtxt + ) else @@ -1998,8 +2712,30 @@ let rec TryTranslateComputationExpression Some( TranslateComputationExpressionBind - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole - q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + varSpace + mBind + (addBindDebugPoint spBind) + bindNName + sources + consumePat + innerComp + translatedCtxt + ) else // Look for the maximum supported MergeSources, MergeSources3, ... @@ -2091,11 +2827,7 @@ let rec TryTranslateComputationExpression let laterSource, laterPat = mergeSources laterSourcesAndPats let source = - mkSynCall - mergeSourcesName - sourcesRange - (List.map fst nowSourcesAndPats @ [ laterSource ]) - builderValName + mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [ laterSource ]) builderValName let pat = SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) @@ -2117,7 +2849,20 @@ let rec TryTranslateComputationExpression // Build the 'Bind' call Some( TranslateComputationExpressionBind - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole q varSpace mBind @@ -2136,7 +2881,28 @@ let rec TryTranslateComputationExpression let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> - SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, patm, sp, trivia)) + SynMatchClause( + pat, + cond, + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + innerComp, + patm, + sp, + trivia + )) Some(translatedCtxt (SynExpr.Match(spMatch, expr, clauses, m, trivia))) @@ -2165,16 +2931,31 @@ let rec TryTranslateComputationExpression let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> - SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp, patm, sp, trivia)) + SynMatchClause( + pat, + cond, + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + innerComp, + patm, + sp, + trivia + )) let consumeExpr = - SynExpr.MatchLambda( - false, - trivia.MatchBangKeyword, - clauses, - DebugPointAtBinding.NoneAtInvisible, - trivia.MatchBangKeyword - ) + SynExpr.MatchLambda(false, trivia.MatchBangKeyword, clauses, DebugPointAtBinding.NoneAtInvisible, trivia.MatchBangKeyword) let callExpr = mkSynCall "Bind" trivia.MatchBangKeyword [ inputExpr; consumeExpr ] builderValName @@ -2199,24 +2980,56 @@ let rec TryTranslateComputationExpression let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, clauseComp, patm, sp, trivia)) -> - SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole clauseComp, patm, sp, trivia)) + SynMatchClause( + pat, + cond, + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + clauseComp, + patm, + sp, + trivia + )) let consumeExpr = SynExpr.MatchLambda(true, mTryToLast, clauses, spWith2, mTryToLast) if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryWith" builderTy - ) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryWith" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("TryWith"), mTry)) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) - let innerExpr = TranslateComputationExpressionNoQueryOps cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole innerComp + let innerExpr = + TranslateComputationExpressionNoQueryOps + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + innerComp let innerExpr = match spTry with @@ -2231,9 +3044,7 @@ let rec TryTranslateComputationExpression | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, m) -> let yieldFromExpr = mkSourceExpr synYieldExpr sourceMethInfo builderValName - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("YieldFrom"), m)) let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] builderValName @@ -2253,9 +3064,7 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "ReturnFrom" builderTy - ) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "ReturnFrom" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("ReturnFrom"), m)) @@ -2275,9 +3084,7 @@ let rec TryTranslateComputationExpression if isQuery && not isYield then error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) - if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) - then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod (methName), m)) let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] builderValName @@ -2312,187 +3119,353 @@ and ConsumeCustomOpClauses dataCompPrior compClausesExpr lastUsesBind - mClause = + mClause + = - // Substitute 'yield ' into the context + // Substitute 'yield ' into the context - let patvs, _env = varSpace.Force comp.Range - let varSpaceSimplePat = mkSimplePatForVarSpace mClause patvs - let varSpacePat = mkPatForVarSpace mClause patvs + let patvs, _env = varSpace.Force comp.Range + let varSpaceSimplePat = mkSimplePatForVarSpace mClause patvs + let varSpacePat = mkPatForVarSpace mClause patvs - match compClausesExpr with + match compClausesExpr with - // Detect one custom operation... This clause will always match at least once... - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, opDatas, opExpr, mClause, optionalIntoPat), optionalCont) -> + // Detect one custom operation... This clause will always match at least once... + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + opDatas, + opExpr, + mClause, + optionalIntoPat), + optionalCont) -> - let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] - let isLikeZip = customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - let isLikeJoin = customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - let isLikeGroupJoin = customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] - // Record the resolution of the custom operation for posterity - let item = - Item.CustomOperation(opName, (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), Some methInfo) + let isLikeZip = + customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations - // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + let isLikeJoin = + customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - if isLikeZip || isLikeJoin || isLikeGroupJoin then - errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm)), nm.idRange)) + let isLikeGroupJoin = + customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - match optionalCont with - | None -> - // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it - RecordNameAndTypeResolutions cenv env tpenv opExpr + // Record the resolution of the custom operation for posterity + let item = + Item.CustomOperation( + opName, + (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), + Some methInfo + ) + + // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations + // of type variables in the quick info provided in the IDE. + CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + + if isLikeZip || isLikeJoin || isLikeGroupJoin then + errorR ( + Error( + FSComp.SR.tcBinaryOperatorRequiresBody ( + nm.idText, + Option.get ( + customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + ) + ), + nm.idRange + ) + ) + + match optionalCont with + | None -> + // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it + RecordNameAndTypeResolutions cenv env tpenv opExpr + dataCompPrior + | Some contExpr -> + ConsumeCustomOpClauses + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + varSpace dataCompPrior - | Some contExpr -> ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompPrior contExpr lastUsesBind mClause - else + contExpr + lastUsesBind + mClause + else - let maintainsVarSpace = customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - let maintainsVarSpaceUsingBind = customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - - let expectedArgCount = tryExpectedArgCountForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm - - let dataCompAfterOp = - match opExpr with - | StripApps(SingleIdent nm, args) -> - let argCountsMatch = - match expectedArgCount with - | Some n -> n = args.Length - | None -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations - - if argCountsMatch then - // Check for the [] attribute on each argument position - let args = - args - |> List.mapi (fun i arg -> - if isCustomOperationProjectionParameter cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (i + 1) nm then - SynExpr.Lambda( - false, - false, - varSpaceSimplePat, - arg, - None, - arg.Range.MakeSynthetic(), - SynExprLambdaTrivia.Zero - ) - else - arg) + let maintainsVarSpace = + customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + + let maintainsVarSpaceUsingBind = + customOperationMaintainsVarSpaceUsingBind + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm + + let expectedArgCount = + tryExpectedArgCountForCustomOperator + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + mWhole + nm + + let dataCompAfterOp = + match opExpr with + | StripApps(SingleIdent nm, args) -> + let argCountsMatch = + match expectedArgCount with + | Some n -> n = args.Length + | None -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations + + if argCountsMatch then + // Check for the [] attribute on each argument position + let args = + args + |> List.mapi (fun i arg -> + if + isCustomOperationProjectionParameter + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + (i + 1) + nm + then + SynExpr.Lambda( + false, + false, + varSpaceSimplePat, + arg, + None, + arg.Range.MakeSynthetic(), + SynExprLambdaTrivia.Zero + ) + else + arg) - mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) builderValName - else - let expectedArgCount = defaultArg expectedArgCount 0 + mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) builderValName + else + let expectedArgCount = defaultArg expectedArgCount 0 - errorR ( - Error( - FSComp.SR.tcCustomOperationHasIncorrectArgCount (nm.idText, expectedArgCount, args.Length), - nm.idRange - ) - ) + errorR ( + Error(FSComp.SR.tcCustomOperationHasIncorrectArgCount (nm.idText, expectedArgCount, args.Length), nm.idRange) + ) - mkSynCall - methInfo.DisplayName - mClause - ([ dataCompPrior ] - @ List.init expectedArgCount (fun i -> arbExpr ("_arg" + string i, mClause))) - builderValName - | _ -> failwith "unreachable" + mkSynCall + methInfo.DisplayName + mClause + ([ dataCompPrior ] + @ List.init expectedArgCount (fun i -> arbExpr ("_arg" + string i, mClause))) + builderValName + | _ -> failwith "unreachable" - match optionalCont with - | None -> - match optionalIntoPat with - | Some intoPat -> errorR (Error(FSComp.SR.tcIntoNeedsRestOfQuery (), intoPat.Range)) - | None -> () - - dataCompAfterOp - - | Some contExpr -> - - // select a.Name into name; ... - // distinct into d; ... - // - // Rebind the into pattern and process the rest of the clauses - match optionalIntoPat with - | Some intoPat -> - if not (customOperationAllowsInto cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) then - error (Error(FSComp.SR.tcOperatorDoesntAcceptInto (nm.idText), intoPat.Range)) - - // Rebind using either for ... or let!.... - let rebind = - if maintainsVarSpaceUsingBind then - SynExpr.LetOrUseBang( - DebugPointAtBinding.NoneAtLet, - false, - false, - intoPat, - dataCompAfterOp, - [], - contExpr, - intoPat.Range, - SynExprLetOrUseBangTrivia.Zero - ) - else - SynExpr.ForEach( - DebugPointAtFor.No, - DebugPointAtInOrTo.No, - SeqExprOnly false, - false, - intoPat, - dataCompAfterOp, - contExpr, - intoPat.Range - ) + match optionalCont with + | None -> + match optionalIntoPat with + | Some intoPat -> errorR (Error(FSComp.SR.tcIntoNeedsRestOfQuery (), intoPat.Range)) + | None -> () - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q (LazyWithContext.NotLazy([], env)) rebind id + dataCompAfterOp - // select a.Name; ... - // distinct; ... - // - // Process the rest of the clauses - | None -> - if maintainsVarSpace || maintainsVarSpaceUsingBind then - ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompAfterOp contExpr maintainsVarSpaceUsingBind mClause + | Some contExpr -> + + // select a.Name into name; ... + // distinct into d; ... + // + // Rebind the into pattern and process the rest of the clauses + match optionalIntoPat with + | Some intoPat -> + if + not ( + customOperationAllowsInto + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + nm + ) + then + error (Error(FSComp.SR.tcOperatorDoesntAcceptInto (nm.idText), intoPat.Range)) + + // Rebind using either for ... or let!.... + let rebind = + if maintainsVarSpaceUsingBind then + SynExpr.LetOrUseBang( + DebugPointAtBinding.NoneAtLet, + false, + false, + intoPat, + dataCompAfterOp, + [], + contExpr, + intoPat.Range, + SynExprLetOrUseBangTrivia.Zero + ) else - ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q (LazyWithContext.NotLazy([], env)) dataCompAfterOp contExpr false mClause + SynExpr.ForEach( + DebugPointAtFor.No, + DebugPointAtInOrTo.No, + SeqExprOnly false, + false, + intoPat, + dataCompAfterOp, + contExpr, + intoPat.Range + ) - // No more custom operator clauses in compClausesExpr, but there may be clauses like join, yield etc. - // Bind/iterate the dataCompPrior and use compClausesExpr as the body. - | _ -> - // Rebind using either for ... or let!.... - let rebind = - if lastUsesBind then - SynExpr.LetOrUseBang( - DebugPointAtBinding.NoneAtLet, - false, - false, - varSpacePat, - dataCompPrior, - [], - compClausesExpr, - compClausesExpr.Range, - SynExprLetOrUseBangTrivia.Zero - ) - else - SynExpr.ForEach( - DebugPointAtFor.No, - DebugPointAtInOrTo.No, - SeqExprOnly false, - false, - varSpacePat, - dataCompPrior, - compClausesExpr, - compClausesExpr.Range - ) + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + (LazyWithContext.NotLazy([], env)) + rebind + id - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace rebind id + // select a.Name; ... + // distinct; ... + // + // Process the rest of the clauses + | None -> + if maintainsVarSpace || maintainsVarSpaceUsingBind then + ConsumeCustomOpClauses + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + varSpace + dataCompAfterOp + contExpr + maintainsVarSpaceUsingBind + mClause + else + ConsumeCustomOpClauses + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + (LazyWithContext.NotLazy([], env)) + dataCompAfterOp + contExpr + false + mClause + + // No more custom operator clauses in compClausesExpr, but there may be clauses like join, yield etc. + // Bind/iterate the dataCompPrior and use compClausesExpr as the body. + | _ -> + // Rebind using either for ... or let!.... + let rebind = + if lastUsesBind then + SynExpr.LetOrUseBang( + DebugPointAtBinding.NoneAtLet, + false, + false, + varSpacePat, + dataCompPrior, + [], + compClausesExpr, + compClausesExpr.Range, + SynExprLetOrUseBangTrivia.Zero + ) + else + SynExpr.ForEach( + DebugPointAtFor.No, + DebugPointAtInOrTo.No, + SeqExprOnly false, + false, + varSpacePat, + dataCompPrior, + compClausesExpr, + compClausesExpr.Range + ) - and TranslateComputationExpressionNoQueryOps - (cenv: TcFileState) - (env: TcEnv) - (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + rebind + id + +and TranslateComputationExpressionNoQueryOps + (cenv: TcFileState) + (env: TcEnv) + (tpenv: UnscopedTyparEnv) + (customOperationMethodsIndexedByKeyword: + IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: + IDictionary * MethInfo>>) + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + comp + = + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad @@ -2501,225 +3474,336 @@ and ConsumeCustomOpClauses enableImplicitYield origComp mWhole - comp = - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial CustomOperationsMode.Denied (LazyWithContext.NotLazy([], env)) comp id - - and TranslateComputationExpressionBind - (cenv: TcFileState) - (env: TcEnv) - (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + CompExprTranslationPass.Initial + CustomOperationsMode.Denied + (LazyWithContext.NotLazy([], env)) comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - q - varSpace - bindRange - addBindDebugPoint - bindName - (bindArgs: SynExpr list) - (consumePat: SynPat) - (innerComp: SynExpr) - translatedCtxt - = - - let innerRange = innerComp.Range - - let innerCompReturn = - if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then - convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp - else - None + id + +and TranslateComputationExpressionBind + (cenv: TcFileState) + (env: TcEnv) + (tpenv: UnscopedTyparEnv) + (customOperationMethodsIndexedByKeyword: + IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: + IDictionary * MethInfo>>) + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + varSpace + bindRange + addBindDebugPoint + bindName + (bindArgs: SynExpr list) + (consumePat: SynPat) + (innerComp: SynExpr) + translatedCtxt + = - match innerCompReturn with - | Some(innerExpr, customOpInfo) when - (let bindName = bindName + "Return" + let innerRange = innerComp.Range + + let innerCompReturn = + if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then + convertSimpleReturnToExpr + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + varSpace + innerComp + else + None - not ( - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy - ) - )) - -> + match innerCompReturn with + | Some(innerExpr, customOpInfo) when + (let bindName = bindName + "Return" - let bindName = bindName + "Return" + not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy))) + -> + + let bindName = bindName + "Return" + + // Build the `BindReturn` call + let dataCompPriorToOp = + let consumeExpr = + SynExpr.MatchLambda( + false, + consumePat.Range, + [ + SynMatchClause(consumePat, None, innerExpr, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + innerRange + ) + + translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName) + + match customOpInfo with + | None -> dataCompPriorToOp + | Some(innerComp, mClause) -> + // If the `BindReturn` was forced by a custom operation, continue to process the clauses of the CustomOp + ConsumeCustomOpClauses + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + q + varSpace + dataCompPriorToOp + innerComp + false + mClause - // Build the `BindReturn` call - let dataCompPriorToOp = + | _ -> + + if + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy) + then + error (Error(FSComp.SR.tcRequireBuilderMethod (bindName), bindRange)) + + // Build the `Bind` call + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + innerComp + (fun holeFill -> let consumeExpr = SynExpr.MatchLambda( false, consumePat.Range, [ - SynMatchClause(consumePat, None, innerExpr, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) + SynMatchClause(consumePat, None, holeFill, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) ], DebugPointAtBinding.NoneAtInvisible, innerRange ) - translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName) - - match customOpInfo with - | None -> dataCompPriorToOp - | Some(innerComp, mClause) -> - // If the `BindReturn` was forced by a custom operation, continue to process the clauses of the CustomOp - ConsumeCustomOpClauses cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole q varSpace dataCompPriorToOp innerComp false mClause - - | _ -> - - if - isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy - ) - then - error (Error(FSComp.SR.tcRequireBuilderMethod (bindName), bindRange)) - - // Build the `Bind` call - TranslateComputationExpression - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole - CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> - let consumeExpr = - SynExpr.MatchLambda( - false, - consumePat.Range, - [ - SynMatchClause(consumePat, None, holeFill, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, - innerRange - ) + let bindCall = + mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName - let bindCall = - mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName + translatedCtxt (bindCall |> addBindDebugPoint)) - translatedCtxt (bindCall |> addBindDebugPoint)) +/// This function is for desugaring into .Bind{N}Return calls if possible +/// The outer option indicates if .BindReturn is possible. When it returns None, .BindReturn cannot be used +/// The inner option indicates if a custom operation is involved inside +and convertSimpleReturnToExpr + (cenv: TcFileState) + (env: TcEnv) + (tpenv: UnscopedTyparEnv) + (customOperationMethodsIndexedByKeyword: + IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: + IDictionary * MethInfo>>) + comp + varSpace + innerComp + = + match innerComp with + | SynExpr.YieldOrReturn((false, _), returnExpr, m) -> + let returnExpr = SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnExpr) + Some(returnExpr, None) - /// This function is for desugaring into .Bind{N}Return calls if possible - /// The outer option indicates if .BindReturn is possible. When it returns None, .BindReturn cannot be used - /// The inner option indicates if a custom operation is involved inside - and convertSimpleReturnToExpr - (cenv: TcFileState) - (env: TcEnv) - (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) - comp - varSpace - innerComp = - match innerComp with - | SynExpr.YieldOrReturn((false, _), returnExpr, m) -> - let returnExpr = SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnExpr) - Some(returnExpr, None) + | SynExpr.Match(spMatch, expr, clauses, m, trivia) -> + let clauses = + clauses + |> List.map (fun (SynMatchClause(pat, cond, innerComp2, patm, sp, trivia)) -> + match + convertSimpleReturnToExpr + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + varSpace + innerComp2 + with + | None -> None // failure + | Some(_, Some _) -> None // custom op on branch = failure + | Some(innerExpr2, None) -> Some(SynMatchClause(pat, cond, innerExpr2, patm, sp, trivia))) + + if clauses |> List.forall Option.isSome then + Some(SynExpr.Match(spMatch, expr, (clauses |> List.map Option.get), m, trivia), None) + else + None - | SynExpr.Match(spMatch, expr, clauses, m, trivia) -> - let clauses = - clauses - |> List.map (fun (SynMatchClause(pat, cond, innerComp2, patm, sp, trivia)) -> - match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp2 with + | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> + match + convertSimpleReturnToExpr + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + varSpace + thenComp + with + | None -> None + | Some(_, Some _) -> None + | Some(thenExpr, None) -> + let elseExprOptOpt = + match elseCompOpt with + // When we are missing an 'else' part alltogether in case of 'if cond then return exp', we fallback from BindReturn into regular Bind+Return + | None -> None + | Some elseComp -> + match + convertSimpleReturnToExpr + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + varSpace + elseComp + with | None -> None // failure | Some(_, Some _) -> None // custom op on branch = failure - | Some(innerExpr2, None) -> Some(SynMatchClause(pat, cond, innerExpr2, patm, sp, trivia))) + | Some(elseExpr, None) -> Some(Some elseExpr) - if clauses |> List.forall Option.isSome then - Some(SynExpr.Match(spMatch, expr, (clauses |> List.map Option.get), m, trivia), None) - else - None - - | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> - match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace thenComp with + match elseExprOptOpt with | None -> None - | Some(_, Some _) -> None - | Some(thenExpr, None) -> - let elseExprOptOpt = - match elseCompOpt with - // When we are missing an 'else' part alltogether in case of 'if cond then return exp', we fallback from BindReturn into regular Bind+Return - | None -> None - | Some elseComp -> - match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace elseComp with - | None -> None // failure - | Some(_, Some _) -> None // custom op on branch = failure - | Some(elseExpr, None) -> Some(Some elseExpr) - - match elseExprOptOpt with - | None -> None - | Some elseExprOpt -> - Some(SynExpr.IfThenElse(guardExpr, thenExpr, elseExprOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia), None) + | Some elseExprOpt -> + Some(SynExpr.IfThenElse(guardExpr, thenExpr, elseExprOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia), None) + + | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> + match + convertSimpleReturnToExpr + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + varSpace + innerComp + with + | None -> None + | Some(_, Some _) -> None + | Some(innerExpr, None) -> Some(SynExpr.LetOrUse(isRec, false, binds, innerExpr, m, trivia), None) + + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, + _, + _, + mClause, + _), + _) when + customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + -> - | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> - match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp with + let patvs, _env = varSpace.Force comp.Range + let varSpaceExpr = mkExprForVarSpace mClause patvs + + Some(varSpaceExpr, Some(innerComp, mClause)) + + | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, trivia) -> + + // Check the first part isn't a computation expression construct + if (isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1) then + // Check the second part is a simple return + match + convertSimpleReturnToExpr + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + comp + varSpace + innerComp2 + with | None -> None - | Some(_, Some _) -> None - | Some(innerExpr, None) -> Some(SynExpr.LetOrUse(isRec, false, binds, innerExpr, m, trivia), None) - - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, _, _, mClause, _), _) when customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm -> - - let patvs, _env = varSpace.Force comp.Range - let varSpaceExpr = mkExprForVarSpace mClause patvs - - Some(varSpaceExpr, Some(innerComp, mClause)) - - | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, trivia) -> - - // Check the first part isn't a computation expression construct - if (isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1) then - // Check the second part is a simple return - match convertSimpleReturnToExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp varSpace innerComp2 with - | None -> None - | Some(innerExpr2, optionalCont) -> Some(SynExpr.Sequential(sp, true, innerComp1, innerExpr2, m, trivia), optionalCont) - else - None + | Some(innerExpr2, optionalCont) -> Some(SynExpr.Sequential(sp, true, innerComp1, innerExpr2, m, trivia), optionalCont) + else + None - | _ -> None + | _ -> None - /// Check if an expression has no computation expression constructs - and isSimpleExpr (cenv: TcFileState) env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp = +/// Check if an expression has no computation expression constructs +and isSimpleExpr (cenv: TcFileState) env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp = - match comp with - | ForEachThenJoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName false _ -> false - | SynExpr.ForEach _ -> false - | SynExpr.For _ -> false - | SynExpr.While _ -> false - | SynExpr.WhileBang _ -> false - | SynExpr.TryFinally _ -> false - | SynExpr.ImplicitZero _ -> false - | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, _) -> false - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, _) -> false - | SynExpr.Sequential(expr1 = innerComp1; expr2 = innerComp2) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1 - && isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp2 - | SynExpr.IfThenElse(thenExpr = thenComp; elseExpr = elseCompOpt) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName thenComp - && (match elseCompOpt with - | None -> true - | Some c -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName c) - | SynExpr.LetOrUse(body = innerComp) -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp - | SynExpr.LetOrUseBang _ -> false - | SynExpr.Match(clauses = clauses) -> - clauses - |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp) - | SynExpr.MatchBang _ -> false - | SynExpr.TryWith(tryExpr = innerComp; withCases = clauses) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp - && clauses - |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName clauseComp) - | SynExpr.YieldOrReturnFrom _ -> false - | SynExpr.YieldOrReturn _ -> false - | SynExpr.DoBang _ -> false - | _ -> true + match comp with + | ForEachThenJoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName false _ -> + false + | SynExpr.ForEach _ -> false + | SynExpr.For _ -> false + | SynExpr.While _ -> false + | SynExpr.WhileBang _ -> false + | SynExpr.TryFinally _ -> false + | SynExpr.ImplicitZero _ -> false + | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, + _) -> false + | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, + _) -> false + | SynExpr.Sequential(expr1 = innerComp1; expr2 = innerComp2) -> + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1 + && isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp2 + | SynExpr.IfThenElse(thenExpr = thenComp; elseExpr = elseCompOpt) -> + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName thenComp + && (match elseCompOpt with + | None -> true + | Some c -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName c) + | SynExpr.LetOrUse(body = innerComp) -> + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp + | SynExpr.LetOrUseBang _ -> false + | SynExpr.Match(clauses = clauses) -> + clauses + |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp) + | SynExpr.MatchBang _ -> false + | SynExpr.TryWith(tryExpr = innerComp; withCases = clauses) -> + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp + && clauses + |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> + isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName clauseComp) + | SynExpr.YieldOrReturnFrom _ -> false + | SynExpr.YieldOrReturn _ -> false + | SynExpr.DoBang _ -> false + | _ -> true and TranslateComputationExpression (cenv: TcFileState) (env: TcEnv) (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: IDictionary * MethInfo>>) + (customOperationMethodsIndexedByKeyword: + IDictionary * MethInfo>>) + (customOperationMethodsIndexedByMethodName: + IDictionary * MethInfo>>) sourceMethInfo builderValName ad @@ -2732,11 +3816,32 @@ and TranslateComputationExpression q varSpace comp - translatedCtxt = + translatedCtxt + = cenv.stackGuard.Guard <| fun () -> - match TryTranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole firstTry q varSpace comp translatedCtxt with + match + TryTranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + firstTry + q + varSpace + comp + translatedCtxt + with | Some e -> e | None -> // This only occurs in final position in a sequence @@ -2776,7 +3881,25 @@ and TranslateComputationExpression SynExprLetOrUseBangTrivia.Zero ) - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial q varSpace letBangBind translatedCtxt + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + q + varSpace + letBangBind + translatedCtxt // "expr;" in final position is treated as { expr; zero } // Suppress the sequence point on the "zero" @@ -2787,7 +3910,19 @@ and TranslateComputationExpression && checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole comp then TranslateComputationExpression - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole CompExprTranslationPass.Initial q varSpace @@ -2800,7 +3935,19 @@ and TranslateComputationExpression | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), comp.RangeOfFirstPortion)) TranslateComputationExpression - cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole CompExprTranslationPass.Initial q varSpace @@ -2856,7 +4003,8 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv /// Decide if the builder is an auto-quote builder let isAutoQuote = hasMethInfo "Quote" cenv env mBuilderVal ad builderTy - let customOperationMethods = getCustomOperationMethods cenv env ad mBuilderVal builderTy + let customOperationMethods = + getCustomOperationMethods cenv env ad mBuilderVal builderTy /// Decide if the identifier represents a use of a custom query operator let hasCustomOperations = @@ -2901,7 +4049,16 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv AddFakeNameToNameEnv nm nenv - (Item.CustomOperation(nm, (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (ident (nm, mBuilderVal))), Some methInfo))) + (Item.CustomOperation( + nm, + (fun () -> + customOpUsageText + cenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + (ident (nm, mBuilderVal))), + Some methInfo + ))) } // Environment is needed for completions @@ -2920,7 +4077,25 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv let origComp = comp let basicSynExpr = - TranslateComputationExpression cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName sourceMethInfo builderValName ad builderTy isQuery enableImplicitYield origComp mWhole CompExprTranslationPass.Initial hasCustomOperations (LazyWithContext.NotLazy([], env)) comp id + TranslateComputationExpression + cenv + env + tpenv + customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName + sourceMethInfo + builderValName + ad + builderTy + isQuery + enableImplicitYield + origComp + mWhole + CompExprTranslationPass.Initial + hasCustomOperations + (LazyWithContext.NotLazy([], env)) + comp + id let mDelayOrQuoteOrRun = mBuilderVal From 3ce2df32e9da271af22055900e5007fa9cf63bbd Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 16:00:42 +0200 Subject: [PATCH 05/12] Enable minidumps collection on crash --- azure-pipelines-PR.yml | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index 9723c7356df..55d86b296d4 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -411,6 +411,9 @@ stages: - script: eng\CIBuild.cmd -compressallmetadata -configuration $(_configuration) -$(_testKind) env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 2 # Heap dump, 1 for mini, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build / Integration Test continueOnError: true @@ -433,6 +436,15 @@ stages: ArtifactName: 'Windows $(_configuration) $(_testKind) test binlogs' ArtifactType: Container parallel: true + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: always() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true - task: PublishBuildArtifacts@1 displayName: Publish Test Logs inputs: @@ -476,6 +488,10 @@ stages: clean: true - script: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclr displayName: Build / Test + env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 2 # Heap dump, 1 for mini, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp - task: PublishTestResults@2 displayName: Publish Test Results inputs: @@ -484,6 +500,15 @@ stages: searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: always() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true - task: PublishBuildArtifacts@1 displayName: Publish Test Logs inputs: @@ -516,6 +541,9 @@ stages: clean: true - script: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclr env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 2 # Heap dump, 1 for mini, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp COMPlus_DefaultStackSize: 1000000 displayName: Build / Test - task: PublishTestResults@2 @@ -526,6 +554,15 @@ stages: searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: always() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true - task: PublishBuildArtifacts@1 displayName: Publish Test Logs inputs: From 30cad0e30d89e80547d54c8ad1a5ac82ff5e3645 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 16:02:32 +0200 Subject: [PATCH 06/12] Enable minidumps collection on crash --- azure-pipelines-PR.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index 55d86b296d4..e971adfba83 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -490,7 +490,7 @@ stages: displayName: Build / Test env: DOTNET_DbgEnableMiniDump: 1 - DOTNET_DbgMiniDumpType: 2 # Heap dump, 1 for mini, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp - task: PublishTestResults@2 displayName: Publish Test Results From 8daea8aaa10fee398603fe199d917ded92e9727e Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 16:06:23 +0200 Subject: [PATCH 07/12] Enable minidumps collection on crash --- azure-pipelines-PR.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index e971adfba83..3adf34bcf63 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -412,7 +412,7 @@ stages: - script: eng\CIBuild.cmd -compressallmetadata -configuration $(_configuration) -$(_testKind) env: DOTNET_DbgEnableMiniDump: 1 - DOTNET_DbgMiniDumpType: 2 # Heap dump, 1 for mini, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build / Integration Test @@ -542,7 +542,7 @@ stages: - script: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclr env: DOTNET_DbgEnableMiniDump: 1 - DOTNET_DbgMiniDumpType: 2 # Heap dump, 1 for mini, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp COMPlus_DefaultStackSize: 1000000 displayName: Build / Test From 00ecd2b7e70c85005a3fe90387645029a1c4f12c Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 16:21:58 +0200 Subject: [PATCH 08/12] Leave dump collection only on windows --- azure-pipelines-PR.yml | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index 3adf34bcf63..c67617d53c6 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -488,10 +488,6 @@ stages: clean: true - script: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclr displayName: Build / Test - env: - DOTNET_DbgEnableMiniDump: 1 - DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp - task: PublishTestResults@2 displayName: Publish Test Results inputs: @@ -500,15 +496,6 @@ stages: searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() - - task: PublishBuildArtifacts@1 - displayName: Publish Dumps - condition: always() - continueOnError: true - inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' - ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' - ArtifactType: Container - parallel: true - task: PublishBuildArtifacts@1 displayName: Publish Test Logs inputs: @@ -541,9 +528,6 @@ stages: clean: true - script: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclr env: - DOTNET_DbgEnableMiniDump: 1 - DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp COMPlus_DefaultStackSize: 1000000 displayName: Build / Test - task: PublishTestResults@2 @@ -554,15 +538,6 @@ stages: searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() - - task: PublishBuildArtifacts@1 - displayName: Publish Dumps - condition: always() - continueOnError: true - inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' - ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' - ArtifactType: Container - parallel: true - task: PublishBuildArtifacts@1 displayName: Publish Test Logs inputs: From d8e2d2d9b6d8c7498e3a5d3240b92253ba128327 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 17:09:18 +0200 Subject: [PATCH 09/12] Try to upload dumps only on failure --- azure-pipelines-PR.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index c67617d53c6..ddf1004d2b2 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -438,7 +438,7 @@ stages: parallel: true - task: PublishBuildArtifacts@1 displayName: Publish Dumps - condition: always() + condition: failed() continueOnError: true inputs: PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' From fa1e329b1094adc917257125dafb9d188d8f3f59 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 30 Jul 2024 17:38:38 +0200 Subject: [PATCH 10/12] Added dump collection to more legs --- azure-pipelines-PR.yml | 66 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index ddf1004d2b2..89e50496e2f 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -228,6 +228,9 @@ stages: - script: eng\CIBuild.cmd -compressallmetadata -configuration Release /p:FSharpLangVersion=preview env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -240,6 +243,15 @@ stages: ArtifactName: 'Windows Release build binlogs' ArtifactType: Container parallel: true + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: failed() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true - job: WindowsNoRealsig_testCoreclr pool: @@ -256,6 +268,9 @@ stages: - script: eng\CIBuild.cmd -compressallmetadata -buildnorealsig -testCoreclr -configuration Release env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -268,6 +283,15 @@ stages: ArtifactName: 'Windows Release build binlogs' ArtifactType: Container parallel: true + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: failed() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true - job: WindowsNoRealsig_testDesktop pool: @@ -284,6 +308,9 @@ stages: - script: eng\CIBuild.cmd -compressallmetadata -buildnorealsig -testDesktop -configuration Release env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -296,6 +323,15 @@ stages: ArtifactName: 'Windows Release build binlogs' ArtifactType: Container parallel: true + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: failed() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true - job: WindowsStrictIndentation pool: @@ -312,6 +348,9 @@ stages: - script: eng\CIBuild.cmd -compressallmetadata -configuration Release /p:AdditionalFscCmdFlags=--strict-indentation+ env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -324,6 +363,15 @@ stages: ArtifactName: 'Windows Release build binlogs' ArtifactType: Container parallel: true + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: failed() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true - job: WindowsNoStrictIndentation pool: @@ -336,6 +384,9 @@ stages: - script: eng\CIBuild.cmd -compressallmetadata -configuration Release /p:AdditionalFscCmdFlags=--strict-indentation- env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -348,6 +399,15 @@ stages: ArtifactName: 'Windows Release build binlogs' ArtifactType: Container parallel: true + - task: PublishBuildArtifacts@1 + displayName: Publish Dumps + condition: failed() + continueOnError: true + inputs: + PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' + ArtifactType: Container + parallel: true # Windows With Compressed Metadata - job: WindowsCompressedMetadata @@ -398,12 +458,18 @@ stages: # yes, this is miserable, but - https://github.com/dotnet/arcade/issues/13239 - script: eng\CIBuild.cmd -compressallmetadata -configuration $(_configuration) -$(_testKind) env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build / Test condition: and( ne(variables['_testKind'], 'testIntegration'), ne(variables['System.JobName'], 'transparent_compiler_release') ) - script: eng\CIBuild.cmd -compressallmetadata -configuration $(_configuration) -$(_testKind) env: + DOTNET_DbgEnableMiniDump: 1 + DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp TEST_TRANSPARENT_COMPILER: 1 NativeToolsOnMachine: true displayName: Build / Test Transparent Compiler From f0a86c0faccff6c4e7a77622b4f2f76aff714845 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 5 Aug 2024 21:25:42 +0200 Subject: [PATCH 11/12] Refactored CE checking: use wrapper type for passing environment --- azure-pipelines-PR.yml | 28 +- .../CheckComputationExpressions.fs | 1655 ++++------------- 2 files changed, 387 insertions(+), 1296 deletions(-) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index 89e50496e2f..f182f8b9e10 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -230,7 +230,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -248,7 +248,7 @@ stages: condition: failed() continueOnError: true inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + PathToPublish: '$(Build.SourcesDirectory)\artifacts\log\$(_configuration)' ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' ArtifactType: Container parallel: true @@ -270,7 +270,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -288,7 +288,7 @@ stages: condition: failed() continueOnError: true inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + PathToPublish: '$(Build.SourcesDirectory)\artifacts\log\$(_configuration)' ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' ArtifactType: Container parallel: true @@ -310,7 +310,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -328,7 +328,7 @@ stages: condition: failed() continueOnError: true inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + PathToPublish: '$(Build.SourcesDirectory)\artifacts\log\$(_configuration)' ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' ArtifactType: Container parallel: true @@ -350,7 +350,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -368,7 +368,7 @@ stages: condition: failed() continueOnError: true inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + PathToPublish: '$(Build.SourcesDirectory)\artifacts\log\$(_configuration)' ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' ArtifactType: Container parallel: true @@ -386,7 +386,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build @@ -404,7 +404,7 @@ stages: condition: failed() continueOnError: true inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + PathToPublish: '$(Build.SourcesDirectory)\artifacts\log\$(_configuration)' ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' ArtifactType: Container parallel: true @@ -460,7 +460,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build / Test condition: and( ne(variables['_testKind'], 'testIntegration'), ne(variables['System.JobName'], 'transparent_compiler_release') ) @@ -469,7 +469,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp TEST_TRANSPARENT_COMPILER: 1 NativeToolsOnMachine: true displayName: Build / Test Transparent Compiler @@ -479,7 +479,7 @@ stages: env: DOTNET_DbgEnableMiniDump: 1 DOTNET_DbgMiniDumpType: 3 # Triage dump, 1 for mini, 2 for Heap, 3 for triage, 4 for full. Don't use 4 unless you know what you're doing. - DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp + DOTNET_DbgMiniDumpName: $(Build.SourcesDirectory)\artifacts\log\$(_configuration)\$(Build.BuildId)-%e-%p-%t.dmp NativeToolsOnMachine: true displayName: Build / Integration Test continueOnError: true @@ -507,7 +507,7 @@ stages: condition: failed() continueOnError: true inputs: - PathToPublish: '$(Build.SourcesDirectory)\artifacts\dumps\$(_configuration)' + PathToPublish: '$(Build.SourcesDirectory)\artifacts\log\$(_configuration)' ArtifactName: 'Windows $(_configuration) $(_testKind) process dumps' ArtifactType: Container parallel: true diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 4a272c109ae..62d1129ba05 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -40,16 +40,37 @@ type CustomOperationsMode = | Allowed | Denied +[] +type ComputationExpressionContext<'a> = + { + cenv: TcFileState; + env: TcEnv; + tpenv: UnscopedTyparEnv; + customOperationMethodsIndexedByKeyword: + IDictionary * MethInfo>>; + customOperationMethodsIndexedByMethodName: + IDictionary * MethInfo>>; + sourceMethInfo: 'a list; + builderValName: string; + ad: AccessorDomain; + builderTy: TType; + isQuery: bool; + enableImplicitYield: bool; + origComp: SynExpr; + mWhole: range; + emptyVarSpace: LazyWithContext * TcEnv,range>; + } + let inline TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = AllMethInfosOfTypeInScope collectionSettings cenv.infoReader env.NameEnv (Some nm) ad IgnoreOverrides m ty /// Ignores an attribute let inline IgnoreAttribute _ = None -let arbPat (m: range) = +let inline arbPat (m: range) = mkSynPatVar None (mkSynId (m.MakeSynthetic()) "_missingVar") -let arbKeySelectors m = +let inline arbKeySelectors m = mkSynBifix m "=" (arbExpr ("_keySelectors", m)) (arbExpr ("_keySelector2", m)) // Flag that a debug point should get emitted prior to both the evaluation of 'rhsExpr' and the call to Using @@ -197,22 +218,14 @@ let getCustomOperationMethods (cenv: TcFileState) (env: TcEnv) ad mBuilderVal bu ] /// Decide if the identifier represents a use of a custom query operator -let tryGetDataForCustomOperation - (nm: Ident) - (cenv: TcFileState) - (customOperationMethodsIndexedByKeyword: - IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: - IDictionary * MethInfo>>) - = - +let tryGetDataForCustomOperation (nm: Ident) ceenv = let isOpDataCountAllowed opDatas = match opDatas with | [ _ ] -> true - | _ :: _ -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations + | _ :: _ -> ceenv.cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations | _ -> false - match customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with + match ceenv.customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with | true, opDatas when isOpDataCountAllowed opDatas -> for opData in opDatas do let (opName, @@ -234,8 +247,8 @@ let tryGetDataForCustomOperation then errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) - if not (cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations) then - match customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with + if not (ceenv.cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations) then + match ceenv.customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with | true, [ _ ] -> () | _ -> errorR (Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) @@ -245,8 +258,8 @@ let tryGetDataForCustomOperation Some [ opData ] | _ -> None -let isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm = - tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName +let isCustomOperation ceenv nm = + tryGetDataForCustomOperation nm ceenv |> Option.isSome let customOperationCheckValidity m f opDatas = @@ -270,8 +283,8 @@ let customOperationCheckValidity m f opDatas = v0 // Check for the MaintainsVariableSpace on custom operation -let customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOperationMaintainsVarSpace ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | None -> false | Some opDatas -> opDatas @@ -288,13 +301,8 @@ let customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword _joinConditionWord, _methInfo) -> maintainsVarSpace) -let customOperationMaintainsVarSpaceUsingBind - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - (nm: Ident) - = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOperationMaintainsVarSpaceUsingBind ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | None -> false | Some opDatas -> opDatas @@ -311,8 +319,8 @@ let customOperationMaintainsVarSpaceUsingBind _joinConditionWord, _methInfo) -> maintainsVarSpaceUsingBind) -let customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOperationIsLikeZip ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | None -> false | Some opDatas -> opDatas @@ -329,8 +337,8 @@ let customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customO _joinConditionWord, _methInfo) -> isLikeZip) -let customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOperationIsLikeJoin ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | None -> false | Some opDatas -> opDatas @@ -347,8 +355,8 @@ let customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword custom _joinConditionWord, _methInfo) -> isLikeJoin) -let customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOperationIsLikeGroupJoin ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | None -> false | Some opDatas -> opDatas @@ -365,8 +373,8 @@ let customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword c _joinConditionWord, _methInfo) -> isLikeGroupJoin) -let customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOperationJoinConditionWord ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | Some opDatas -> opDatas |> customOperationCheckValidity @@ -386,8 +394,8 @@ let customOperationJoinConditionWord cenv customOperationMethodsIndexedByKeyword | Some v -> v | _ -> "on" -let customOperationAllowsInto cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOperationAllowsInto ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | None -> false | Some opDatas -> opDatas @@ -404,8 +412,8 @@ let customOperationAllowsInto cenv customOperationMethodsIndexedByKeyword custom _joinConditionWord, _methInfo) -> allowInto) -let customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let customOpUsageText ceenv nm = + match tryGetDataForCustomOperation nm ceenv with | Some((_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, @@ -419,32 +427,16 @@ let customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperatio Some( FSComp.SR.customOperationTextLikeGroupJoin ( nm.idText, - customOperationJoinConditionWord - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm, - customOperationJoinConditionWord - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm + customOperationJoinConditionWord ceenv nm, + customOperationJoinConditionWord ceenv nm ) ) elif isLikeJoin then Some( FSComp.SR.customOperationTextLikeJoin ( nm.idText, - customOperationJoinConditionWord - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm, - customOperationJoinConditionWord - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm + customOperationJoinConditionWord ceenv nm, + customOperationJoinConditionWord ceenv nm ) ) elif isLikeZip then @@ -453,14 +445,8 @@ let customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperatio None | _ -> None -let tryGetArgAttribsForCustomOperator - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - mWhole - (nm: Ident) - = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let tryGetArgAttribsForCustomOperator ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | Some argInfos -> argInfos |> List.map @@ -474,14 +460,14 @@ let tryGetArgAttribsForCustomOperator _isLikeGroupJoin, _joinConditionWord, methInfo) -> - match methInfo.GetParamAttribs(cenv.amap, mWhole) with + match methInfo.GetParamAttribs(ceenv.cenv.amap, ceenv.mWhole) with | [ curriedArgInfo ] -> Some curriedArgInfo // one for the actual argument group | _ -> None) |> Some | _ -> None -let tryGetArgInfosForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm: Ident) = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let tryGetArgInfosForCustomOperator ceenv (nm: Ident) = + match tryGetDataForCustomOperation nm ceenv with | Some argInfos -> argInfos |> List.map @@ -497,23 +483,15 @@ let tryGetArgInfosForCustomOperator cenv customOperationMethodsIndexedByKeyword methInfo) -> match methInfo with | FSMeth(_, _, vref, _) -> - match ArgInfosOfMember cenv.g vref with + match ArgInfosOfMember ceenv.cenv.g vref with | [ curriedArgInfo ] -> Some curriedArgInfo | _ -> None | _ -> None) |> Some | _ -> None -let tryExpectedArgCountForCustomOperator - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - mWhole - (nm: Ident) - = - match - tryGetArgAttribsForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole nm - with +let tryExpectedArgCountForCustomOperator ceenv (nm: Ident) = + match tryGetArgAttribsForCustomOperator ceenv nm with | None -> None | Some argInfosForOverloads -> let nums = @@ -527,7 +505,7 @@ let tryExpectedArgCountForCustomOperator // With 'OverloadsForCustomOperations' we don't compute an exact expected argument count // if any arguments are optional, out or ParamArray. let isSpecial = - if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then + if ceenv.cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then argInfosForOverloads |> List.exists (fun info -> match info with @@ -545,14 +523,8 @@ let tryExpectedArgCountForCustomOperator None // Check for the [] attribute on an argument position -let isCustomOperationProjectionParameter - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - i - (nm: Ident) - = - match tryGetArgInfosForCustomOperator cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm with +let isCustomOperationProjectionParameter ceenv i (nm: Ident) = + match tryGetArgInfosForCustomOperator ceenv nm with | None -> false | Some argInfosForOverloads -> let vs = @@ -562,14 +534,13 @@ let isCustomOperationProjectionParameter | Some argInfos -> i < argInfos.Length && let _, argInfo = List.item i argInfos in - HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) + HasFSharpAttribute ceenv.cenv.g ceenv.cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) if List.allEqual vs then vs[0] else let opDatas = - (tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) - .Value + (tryGetDataForCustomOperation nm ceenv).Value let opName, _, _, _, _, _, _, _j, _ = opDatas[0] errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) @@ -592,44 +563,44 @@ let (|ExprAsPat|_|) (f: SynExpr) = // For join clauses that join on nullable, we syntactically insert the creation of nullable values on the appropriate side of the condition, // then pull the syntax apart again [] -let (|JoinRelation|_|) cenv env (expr: SynExpr) = +let (|JoinRelation|_|) ceenv (expr: SynExpr) = let m = expr.Range - let ad = env.eAccessRights + let ad = ceenv.env.eAccessRights let isOpName opName vref s = (s = opName) && match ResolveExprLongIdent - cenv.tcSink - cenv.nameResolver + ceenv.cenv.tcSink + ceenv.cenv.nameResolver m ad - env.eNameResEnv + ceenv.env.eNameResEnv TypeNameResolutionInfo.Default [ ident (opName, m) ] None with - | Result(_, Item.Value vref2, []) -> valRefEq cenv.g vref vref2 + | Result(_, Item.Value vref2, []) -> valRefEq ceenv.cenv.g vref vref2 | _ -> false match expr with - | BinOpExpr(opId, a, b) when isOpName opNameEquals cenv.g.equals_operator_vref opId.idText -> ValueSome(a, b) + | BinOpExpr(opId, a, b) when isOpName opNameEquals ceenv.cenv.g.equals_operator_vref opId.idText -> ValueSome(a, b) - | BinOpExpr(opId, a, b) when isOpName opNameEqualsNullable cenv.g.equals_nullable_operator_vref opId.idText -> + | BinOpExpr(opId, a, b) when isOpName opNameEqualsNullable ceenv.cenv.g.equals_nullable_operator_vref opId.idText -> let a = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [ MangledGlobalName; "System" ] "Nullable", a, a.Range) ValueSome(a, b) - | BinOpExpr(opId, a, b) when isOpName opNameNullableEquals cenv.g.nullable_equals_operator_vref opId.idText -> + | BinOpExpr(opId, a, b) when isOpName opNameNullableEquals ceenv.cenv.g.nullable_equals_operator_vref opId.idText -> let b = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [ MangledGlobalName; "System" ] "Nullable", b, b.Range) ValueSome(a, b) - | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText -> + | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable ceenv.cenv.g.nullable_equals_nullable_operator_vref opId.idText -> ValueSome(a, b) @@ -659,20 +630,15 @@ let (|InExpr|_|) synExpr = | _ -> None // e1 on e2 (note: 'on' is the 'JoinConditionWord') -let (|OnExpr|_|) (env: TcEnv) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm synExpr = - match tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName with +let (|OnExpr|_|) ceenv nm synExpr = + match tryGetDataForCustomOperation nm ceenv with | None -> None | Some _ -> match synExpr with | SynExpr.App(funcExpr = SynExpr.App(funcExpr = e1; argExpr = SingleIdent opName); argExpr = e2) when - opName.idText = customOperationJoinConditionWord - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm - -> + opName.idText = customOperationJoinConditionWord ceenv nm -> let item = Item.CustomOperation(opName.idText, (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (opName.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) + CallNameResolutionSink ceenv.cenv.tcSink (opName.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.AccessRights) Some(e1, e2) | _ -> None @@ -685,24 +651,24 @@ let (|IntoSuffix|_|) (e: SynExpr) = Some(x, nm2.idRange, intoPat) | _ -> None -let JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName detector synExpr = +let JoinOrGroupJoinOp ceenv detector synExpr = match synExpr with | SynExpr.App(_, _, - CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, + CustomOpId (isCustomOperation ceenv) detector nm, ExprAsPat innerSourcePat, mJoinCore) -> Some(nm, innerSourcePat, mJoinCore, false) // join with bad pattern (gives error on "join" and continues) | SynExpr.App(_, _, - CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm, + CustomOpId (isCustomOperation ceenv) detector nm, _innerSourcePatExpr, mJoinCore) -> errorR ( Error( FSComp.SR.tcBinaryOperatorRequiresVariable ( nm.idText, - Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + Option.get (customOpUsageText ceenv nm) ), nm.idRange ) @@ -710,12 +676,12 @@ let JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperatio Some(nm, arbPat mJoinCore, mJoinCore, true) // join (without anything after - gives error on "join" and continues) - | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) detector nm -> + | CustomOpId (isCustomOperation ceenv) detector nm -> errorR ( Error( FSComp.SR.tcBinaryOperatorRequiresVariable ( nm.idText, - Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + Option.get (customOpUsageText ceenv nm) ), nm.idRange ) @@ -725,27 +691,11 @@ let JoinOrGroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperatio | _ -> None // JoinOrGroupJoinOp customOperationIsLikeJoin -let (|JoinOp|_|) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = - JoinOrGroupJoinOp - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - (customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) - synExpr - -let (|GroupJoinOp|_|) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = - JoinOrGroupJoinOp - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - (customOperationIsLikeGroupJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) - synExpr +let (|JoinOp|_|) ceenv synExpr = JoinOrGroupJoinOp ceenv (customOperationIsLikeJoin ceenv) synExpr +let (|GroupJoinOp|_|) ceenv synExpr = JoinOrGroupJoinOp ceenv (customOperationIsLikeGroupJoin ceenv) synExpr let MatchIntoSuffixOrRecover - cenv - (env: TcEnv) - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv alreadyGivenError (nm: Ident) synExpr @@ -754,7 +704,7 @@ let MatchIntoSuffixOrRecover | IntoSuffix(x, intoWordRange, intoPat) -> // record the "into" as a custom operation for colorization let item = Item.CustomOperation("into", (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + CallNameResolutionSink ceenv.cenv.tcSink (intoWordRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) (x, intoPat, alreadyGivenError) | _ -> if not alreadyGivenError then @@ -763,7 +713,7 @@ let MatchIntoSuffixOrRecover FSComp.SR.tcOperatorIncorrectSyntax ( nm.idText, Option.get ( - customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOpUsageText ceenv nm ) ), nm.idRange @@ -772,26 +722,13 @@ let MatchIntoSuffixOrRecover (synExpr, arbPat synExpr.Range, true) -let MatchOnExprOrRecover - cenv - (env: TcEnv) - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - alreadyGivenError - nm - (onExpr: SynExpr) - = +let MatchOnExprOrRecover ceenv alreadyGivenError nm (onExpr: SynExpr) = match onExpr with - | OnExpr (env: TcEnv) cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm (innerSource, - SynExprParen(keySelectors, - _, - _, - _)) -> + | OnExpr ceenv nm (innerSource, SynExprParen(keySelectors, _, _, _)) -> (innerSource, keySelectors) | _ -> if not alreadyGivenError then - suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv onExpr) + suppressErrorReporting (fun () -> TcExprOfUnknownType ceenv.cenv ceenv.env ceenv.tpenv onExpr) |> ignore errorR ( @@ -799,7 +736,7 @@ let MatchOnExprOrRecover FSComp.SR.tcOperatorIncorrectSyntax ( nm.idText, Option.get ( - customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOpUsageText ceenv nm ) ), nm.idRange @@ -809,37 +746,25 @@ let MatchOnExprOrRecover (arbExpr ("_innerSource", onExpr.Range), mkSynBifix onExpr.Range "=" (arbExpr ("_keySelectors", onExpr.Range)) (arbExpr ("_keySelector2", onExpr.Range))) -let (|JoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = +let (|JoinExpr|_|) (ceenv: ComputationExpressionContext<'a>) synExpr = match synExpr with - | InExpr(JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - innerSourcePat, - _, - alreadyGivenError), - onExpr, - mJoinCore) -> + | InExpr(JoinOp ceenv (nm, innerSourcePat, _, alreadyGivenError), onExpr, mJoinCore) -> let innerSource, keySelectors = MatchOnExprOrRecover - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv alreadyGivenError nm onExpr Some(nm, innerSourcePat, innerSource, keySelectors, mJoinCore) - | JoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - innerSourcePat, - mJoinCore, - alreadyGivenError) -> + | JoinOp ceenv (nm, innerSourcePat, mJoinCore, alreadyGivenError) -> if alreadyGivenError then errorR ( Error( FSComp.SR.tcOperatorRequiresIn ( nm.idText, Option.get ( - customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOpUsageText ceenv nm ) ), nm.idRange @@ -849,47 +774,32 @@ let (|JoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customO Some(nm, innerSourcePat, arbExpr ("_innerSource", synExpr.Range), arbKeySelectors synExpr.Range, mJoinCore) | _ -> None -let (|GroupJoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName synExpr = +let (|GroupJoinExpr|_|) ceenv synExpr = match synExpr with - | InExpr(GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - innerSourcePat, - _, - alreadyGivenError), - intoExpr, - mGroupJoinCore) -> + | InExpr(GroupJoinOp ceenv (nm, innerSourcePat, _, alreadyGivenError), intoExpr, mGroupJoinCore) -> let onExpr, intoPat, alreadyGivenError = MatchIntoSuffixOrRecover - cenv - env - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv alreadyGivenError nm intoExpr let innerSource, keySelectors = MatchOnExprOrRecover - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv alreadyGivenError nm onExpr Some(nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) - | GroupJoinOp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - innerSourcePat, - mGroupJoinCore, - alreadyGivenError) -> + | GroupJoinOp ceenv (nm, innerSourcePat, mGroupJoinCore, alreadyGivenError) -> if alreadyGivenError then errorR ( Error( FSComp.SR.tcOperatorRequiresIn ( nm.idText, Option.get ( - customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOpUsageText ceenv nm ) ), nm.idRange @@ -907,48 +817,30 @@ let (|GroupJoinExpr|_|) cenv env tpenv customOperationMethodsIndexedByKeyword cu | _ -> None let (|JoinOrGroupJoinOrZipClause|_|) - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + (ceenv: ComputationExpressionContext<'a>) synExpr = match synExpr with // join innerSourcePat in innerSource on (keySelector1 = keySelector2) - | JoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - innerSourcePat, - innerSource, - keySelectors, - mJoinCore) -> + | JoinExpr ceenv (nm, innerSourcePat, innerSource, keySelectors, mJoinCore) -> Some(nm, innerSourcePat, innerSource, Some keySelectors, None, mJoinCore) // groupJoin innerSourcePat in innerSource on (keySelector1 = keySelector2) into intoPat - | GroupJoinExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - innerSourcePat, - innerSource, - keySelectors, - intoPat, - mGroupJoinCore) -> + | GroupJoinExpr ceenv (nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) -> Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) // zip intoPat in secondSource - | InExpr(SynExpr.App(_, - _, - CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, - ExprAsPat secondSourcePat, - _), - secondSource, - mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) + | InExpr(SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm, ExprAsPat secondSourcePat, _), secondSource, mZipCore) -> + Some(nm, secondSourcePat, secondSource, None, None, mZipCore) // zip (without secondSource or in - gives error) - | CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm -> + | CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm -> errorR ( Error( FSComp.SR.tcOperatorIncorrectSyntax ( nm.idText, - Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + Option.get (customOpUsageText ceenv nm) ), nm.idRange ) @@ -959,14 +851,14 @@ let (|JoinOrGroupJoinOrZipClause|_|) // zip secondSource (without in - gives error) | SynExpr.App(_, _, - CustomOpId (isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) (customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName) nm, + CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm, ExprAsPat secondSourcePat, mZipCore) -> errorR ( Error( FSComp.SR.tcOperatorIncorrectSyntax ( nm.idText, - Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + Option.get (customOpUsageText ceenv nm) ), mZipCore ) @@ -977,46 +869,26 @@ let (|JoinOrGroupJoinOrZipClause|_|) | _ -> None let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + (ceenv: ComputationExpressionContext<'a>) strict synExpr = match synExpr with - | ForEachThen(isFromSource, - firstSourcePat, - firstSource, - JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - secondSourcePat, - secondSource, - keySelectorsOpt, - pat3opt, - mOpCore), - innerComp) when + | ForEachThen(isFromSource, firstSourcePat, firstSource, JoinOrGroupJoinOrZipClause ceenv (nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore), innerComp) when (let _firstSourceSimplePats, later1 = - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat + use _holder = TemporarilySuspendReportingTypecheckResultsToSink ceenv.cenv.tcSink + SimplePatsOfPat ceenv.cenv.synArgNameGenerator firstSourcePat Option.isNone later1) -> Some(isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp) - | JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - pat2, - expr2, - expr3, - pat3opt, - mOpCore) when - strict - -> + | JoinOrGroupJoinOrZipClause ceenv (nm, pat2, expr2, expr3, pat3opt, mOpCore) when strict -> errorR ( Error( FSComp.SR.tcBinaryOperatorRequiresBody ( nm.idText, - Option.get (customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm) + Option.get (customOpUsageText ceenv nm) ), nm.idRange ) @@ -1054,10 +926,10 @@ let (|OptionalIntoSuffix|) e = | IntoSuffix(body, intoWordRange, intoInfo) -> (body, Some(intoWordRange, intoInfo)) | body -> (body, None) -let (|CustomOperationClause|_|) cenv (env: TcEnv) customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName e = +let (|CustomOperationClause|_|) ceenv e = match e with | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when - isCustomOperation cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + isCustomOperation ceenv nm -> // Now we know we have a custom operation, commit the name resolution let intoInfoOpt = @@ -1065,7 +937,7 @@ let (|CustomOperationClause|_|) cenv (env: TcEnv) customOperationMethodsIndexedB | Some(intoWordRange, intoInfo) -> let item = Item.CustomOperation("into", (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + CallNameResolutionSink ceenv.cenv.tcSink (intoWordRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) Some intoInfo | None -> None @@ -1073,7 +945,7 @@ let (|CustomOperationClause|_|) cenv (env: TcEnv) customOperationMethodsIndexedB Some( nm, Option.get ( - tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName + tryGetDataForCustomOperation nm ceenv ), core, core.Range, @@ -1104,16 +976,13 @@ let rangeForCombine innerComp1 = m.NoteSourceConstruct(NotedSourceConstruct.Combine) // Check for 'where x > y', 'select x, y' and other mis-applications of infix operators, give a good error message, and return a flag -let checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole comp = +let checkForBinaryApp ceenv comp = match comp with | StripApps(SingleIdent nm, [ StripApps(SingleIdent nm2, args); arg2 ]) when IsLogicalInfixOpName nm.idText && (match tryExpectedArgCountForCustomOperator - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - mWhole + ceenv nm2 with | Some n -> n > 0 @@ -1126,14 +995,7 @@ let checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperatio errorR (Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator (), estimatedRangeOfIntendedLeftAndRightArguments)) true | SynExpr.Tuple(false, StripApps(SingleIdent nm2, args) :: _, _, m) when - (match - tryExpectedArgCountForCustomOperator - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - mWhole - nm2 - with + (match tryExpectedArgCountForCustomOperator ceenv nm2 with | Some n -> n > 0 | _ -> false) && not (List.isEmpty args) @@ -1164,19 +1026,7 @@ let inline addVarsToVarSpace (varSpace: LazyWithContext /// /// Try translate the syntax sugar /// -/// File typecheck state -/// Typechecking environment -/// Unscoped type paramenters environment -/// Cache for custom operations, indexed by keyword -/// Cache for custom operations, indexed by method name -/// Source method info -/// Builder name -/// Accessor domain -/// Builder type -/// Indicates if it's query -/// Indicates if implicit yield is enabled -/// Original computation expression -/// Range of the whole expression +/// Computation expression context (carrying caches, environments, ranges, etc) /// Flag if it's inital check /// a flag indicating if custom operators are allowed. They are not allowed inside try/with, try/finally, if/then/else etc. /// a lazy data structure indicating the variables bound so far in the overall computation @@ -1186,21 +1036,7 @@ let inline addVarsToVarSpace (varSpace: LazyWithContext /// /// let rec TryTranslateComputationExpression - (cenv: TcFileState) - env - tpenv - (customOperationMethodsIndexedByKeyword: - IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: - IDictionary * MethInfo>>) - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + (ceenv: ComputationExpressionContext<'a>) (firstTry: CompExprTranslationPass) (q: CustomOperationsMode) (varSpace: LazyWithContext<(Val list * TcEnv), range>) @@ -1208,6 +1044,8 @@ let rec TryTranslateComputationExpression (translatedCtxt: SynExpr -> SynExpr) : SynExpr option = // Guard the stack for deeply nested computation expressions + + let cenv = ceenv.cenv cenv.stackGuard.Guard <| fun () -> @@ -1230,24 +1068,15 @@ let rec TryTranslateComputationExpression // ... // --> // zip expr1 expr2 (fun pat1 pat3 -> ...) - | ForEachThenJoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName true (isFromSource, - firstSourcePat, - firstSource, - nm, - secondSourcePat, - secondSource, - keySelectorsOpt, - secondResultPatOpt, - mOpCore, - innerComp) -> + | ForEachThenJoinOrGroupJoinOrZipClause ceenv true (isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, secondResultPatOpt, mOpCore, innerComp) -> match q with | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), nm.idRange)) | CustomOperationsMode.Allowed -> let firstSource = - mkSourceExprConditional isFromSource firstSource sourceMethInfo builderValName + mkSourceExprConditional isFromSource firstSource ceenv.sourceMethInfo ceenv.builderValName - let secondSource = mkSourceExpr secondSource sourceMethInfo builderValName + let secondSource = mkSourceExpr secondSource ceenv.sourceMethInfo ceenv.builderValName // Add the variables to the variable space, on demand let varSpaceWithFirstVars = @@ -1255,7 +1084,7 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv firstSourcePat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv firstSourcePat None vspecs, envinner) @@ -1264,7 +1093,7 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv secondSourcePat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv secondSourcePat None vspecs, envinner) @@ -1275,7 +1104,7 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat3 None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat3 None vspecs, envinner) | None -> varSpace @@ -1294,7 +1123,7 @@ let rec TryTranslateComputationExpression // check 'join' or 'groupJoin' or 'zip' is permitted for this builder match - tryGetDataForCustomOperation nm cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName + tryGetDataForCustomOperation nm ceenv with | None -> error (Error(FSComp.SR.tcMissingCustomOperation (nm.idText), nm.idRange)) | Some opDatas -> @@ -1305,13 +1134,13 @@ let rec TryTranslateComputationExpression Item.CustomOperation( opName, (fun () -> - customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), + customOpUsageText ceenv nm), Some methInfo ) // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + CallNameResolutionSink cenv.tcSink (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) let mkJoinExpr keySelector1 keySelector2 innerPat e = let mSynthetic = mOpCore.MakeSynthetic() @@ -1375,9 +1204,7 @@ let rec TryTranslateComputationExpression // groupJoin | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv nm -> let secondResultSimplePats, later3 = @@ -1387,7 +1214,7 @@ let rec TryTranslateComputationExpression errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondResultPat.Range)) match relExpr with - | JoinRelation cenv env (keySelector1, keySelector2) -> + | JoinRelation ceenv (keySelector1, keySelector2) -> mkJoinExpr keySelector1 keySelector2 secondResultSimplePats, varSpaceWithGroupJoinVars | BinOpExpr(opId, l, r) -> if isNullableOp opId.idText then @@ -1414,15 +1241,9 @@ let rec TryTranslateComputationExpression mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondResultSimplePats, varSpaceWithGroupJoinVars - | None, Some relExpr when - customOperationIsLikeJoin - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm - -> + | None, Some relExpr when customOperationIsLikeJoin ceenv nm -> match relExpr with - | JoinRelation cenv env (keySelector1, keySelector2) -> + | JoinRelation ceenv (keySelector1, keySelector2) -> mkJoinExpr keySelector1 keySelector2 secondSourceSimplePats, varSpaceWithSecondVars | BinOpExpr(opId, l, r) -> if isNullableOp opId.idText then @@ -1448,13 +1269,7 @@ let rec TryTranslateComputationExpression mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondSourceSimplePats, varSpaceWithGroupJoinVars - | None, None when - customOperationIsLikeZip - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm - -> + | None, None when customOperationIsLikeZip ceenv nm -> mkZipExpr, varSpaceWithSecondVars | _ -> @@ -1466,7 +1281,7 @@ let rec TryTranslateComputationExpression let valsInner, _env = varSpaceInner.Force mOpCore let varSpaceExpr = mkExprForVarSpace mOpCore valsInner let varSpacePat = mkPatForVarSpace mOpCore valsInner - let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr builderValName + let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr ceenv.builderValName let consumingExpr = SynExpr.ForEach( @@ -1480,27 +1295,7 @@ let rec TryTranslateComputationExpression mOpCore ) - Some( - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpaceInner - consumingExpr - translatedCtxt - ) + Some(TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) | SynExpr.ForEach(spFor, spIn, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _mEntireForEach) -> let sourceExpr = @@ -1509,7 +1304,7 @@ let rec TryTranslateComputationExpression | None -> sourceExpr let wrappedSourceExpr = - mkSourceExprConditional isFromSource sourceExpr sourceMethInfo builderValName + mkSourceExprConditional isFromSource sourceExpr ceenv.sourceMethInfo ceenv.builderValName let mFor = match spFor with @@ -1528,7 +1323,7 @@ let rec TryTranslateComputationExpression let mPat = pat.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mFor ceenv.ad "For" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("For"), mFor)) // Add the variables to the query variable space, on demand @@ -1537,29 +1332,12 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None vspecs, envinner) Some( - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - innerComp + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun innerCompR -> let forCall = @@ -1578,7 +1356,7 @@ let rec TryTranslateComputationExpression mFor ) ] - builderValName + ceenv.builderValName let forCall = match spFor with @@ -1602,34 +1380,13 @@ let rec TryTranslateComputationExpression | DebugPointAtFor.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.For) | _ -> m - if isQuery then + if ceenv.isQuery then errorR (Error(FSComp.SR.tcNoIntegerForLoopInQuery (), mFor)) let reduced = elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m) - Some( - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - reduced - translatedCtxt - ) - + Some(TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace reduced translatedCtxt) | SynExpr.While(spWhile, guardExpr, innerComp, _) -> let mGuard = guardExpr.Range @@ -1638,16 +1395,16 @@ let rec TryTranslateComputationExpression | DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) | _ -> mGuard - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcNoWhileInQuery (), mWhile)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "While" builderTy) + 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 env mWhile ad "Delay" builderTy) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mWhile ceenv.ad "Delay" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mWhile)) @@ -1658,24 +1415,7 @@ let rec TryTranslateComputationExpression | DebugPointAtWhile.No -> guardExpr Some( - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - innerComp + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> translatedCtxt ( mkSynCall @@ -1683,9 +1423,9 @@ let rec TryTranslateComputationExpression mWhile [ mkSynDelay2 guardExpr - mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] builderValName + mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] ceenv.builderValName ] - builderValName + ceenv.builderValName )) ) @@ -1773,25 +1513,7 @@ let rec TryTranslateComputationExpression SynExprLetOrUseBangTrivia.Zero ) - TryTranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - rewrittenWhileExpr - translatedCtxt + TryTranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace rewrittenWhileExpr translatedCtxt | SynExpr.TryFinally(innerComp, unwindExpr, _mTryToLast, spTry, spFinally, trivia) -> @@ -1811,32 +1533,20 @@ let rec TryTranslateComputationExpression | DebugPointAtFinally.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFinally, true, unwindExpr) | DebugPointAtFinally.No -> unwindExpr - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcNoTryFinallyInQuery (), mTry)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryFinally" builderTy) + 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 env mTry ad "Delay" builderTy) then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mTry ceenv.ad "Delay" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) let innerExpr = TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv innerComp let innerExpr = @@ -1850,10 +1560,10 @@ let rec TryTranslateComputationExpression "TryFinally" mTry [ - mkSynCall "Delay" mTry [ mkSynDelay innerComp.Range innerExpr ] builderValName + mkSynCall "Delay" mTry [ mkSynDelay innerComp.Range innerExpr ] ceenv.builderValName mkSynDelay2 unwindExpr2 ] - builderValName + ceenv.builderValName ) ) @@ -1866,10 +1576,10 @@ let rec TryTranslateComputationExpression // like our other error messages for missing methods). | SynExpr.ImplicitZero m -> if - (not enableImplicitYield) - && isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy) + (not ceenv.enableImplicitYield) + && isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "Zero" ceenv.builderTy) then - match origComp with + match ceenv.origComp with // builder { } // // The compiler inserts a dummy () in CheckExpressions.fs for @@ -1880,42 +1590,19 @@ let rec TryTranslateComputationExpression cenv.g.langVersion.SupportsFeature LanguageFeature.EmptyBodiedComputationExpressions && Range.equals mUnit range0 -> - error (Error(FSComp.SR.tcEmptyBodyRequiresBuilderZeroMethod (), mWhole)) + error (Error(FSComp.SR.tcEmptyBodyRequiresBuilderZeroMethod (), ceenv.mWhole)) | _ -> error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), m)) - Some(translatedCtxt (mkSynCall "Zero" m [] builderValName)) + Some(translatedCtxt (mkSynCall "Zero" m [] ceenv.builderValName)) - | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (_, - _, - _, - _, - _, - mClause), - _) when firstTry = CompExprTranslationPass.Initial -> + | OptionalSequential(JoinOrGroupJoinOrZipClause ceenv (_, _, _, _, _, mClause), _) when firstTry = CompExprTranslationPass.Initial -> // 'join' clauses preceded by 'let' and other constructs get processed by repackaging with a 'for' loop. let patvs, _env = varSpace.Force comp.Range let varSpaceExpr = mkExprForVarSpace mClause patvs let varSpacePat = mkPatForVarSpace mClause patvs - let dataCompPrior = - translatedCtxt ( - TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause)) - ) + let dataCompPrior = translatedCtxt (TranslateComputationExpressionNoQueryOps ceenv (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause))) // Rebind using for ... let rebind = @@ -1931,32 +1618,9 @@ let rec TryTranslateComputationExpression ) // Retry with the 'for' loop packaging. Set firstTry=false just in case 'join' processing fails - TryTranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Subsequent - q - varSpace - rebind - id + TryTranslateComputationExpression ceenv CompExprTranslationPass.Subsequent q varSpace rebind id - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - _, - opExpr, - mClause, - _), - _) -> + | OptionalSequential(CustomOperationClause ceenv (nm, _, opExpr, mClause, _), _) -> match q with | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), opExpr.Range)) @@ -1965,50 +1629,14 @@ let rec TryTranslateComputationExpression let varSpaceExpr = mkExprForVarSpace mClause patvs let dataCompPriorToOp = - let isYield = - not ( - customOperationMaintainsVarSpaceUsingBind - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm - ) - - translatedCtxt ( - TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause)) - ) + let isYield = not (customOperationMaintainsVarSpaceUsingBind ceenv nm) + translatedCtxt (TranslateComputationExpressionNoQueryOps ceenv (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause)) ) // Now run the consumeCustomOpClauses Some( ConsumeCustomOpClauses - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace dataCompPriorToOp @@ -2021,53 +1649,23 @@ let rec TryTranslateComputationExpression // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 if - isQuery - && checkForBinaryApp cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole innerComp1 + ceenv.isQuery + && checkForBinaryApp ceenv innerComp1 then Some( - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - innerComp2 - translatedCtxt + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt ) else - if isQuery && not (innerComp1.IsArbExprAndThusAlreadyReportedError) then + if ceenv.isQuery && not (innerComp1.IsArbExprAndThusAlreadyReportedError) then match innerComp1 with | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), innerComp1.RangeOfFirstPortion)) match TryTranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial CustomOperationsMode.Denied varSpace @@ -2080,13 +1678,13 @@ let rec TryTranslateComputationExpression if isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Combine" builderTy + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "Combine" ceenv.builderTy ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Combine"), m)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "Delay" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), m)) @@ -2102,25 +1700,11 @@ let rec TryTranslateComputationExpression [ mkSynDelay innerComp2.Range - (TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - innerComp2) + (TranslateComputationExpressionNoQueryOps ceenv innerComp2) ] - builderValName + ceenv.builderValName ] - builderValName + ceenv.builderValName Some(translatedCtxt combineCall) @@ -2137,19 +1721,7 @@ let rec TryTranslateComputationExpression Some( TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial q varSpace @@ -2171,41 +1743,29 @@ let rec TryTranslateComputationExpression | _ -> Some( TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial q varSpace innerComp2 (fun holeFill -> let fillExpr = - if enableImplicitYield then + if ceenv.enableImplicitYield then // When implicit yields are enabled, then if the 'innerComp1' checks as type // 'unit' we interpret the expression as a sequential, and when it doesn't // have type 'unit' we interpret it as a 'Yield + Combine'. let combineExpr = let m1 = rangeForCombine innerComp1 - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] builderValName + let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] ceenv.builderValName mkSynCall "Combine" m1 [ implicitYieldExpr - mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] builderValName + mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] ceenv.builderValName ] - builderValName + ceenv.builderValName SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) else @@ -2217,45 +1777,15 @@ let rec TryTranslateComputationExpression | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> match elseCompOpt with | Some elseComp -> - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcIfThenElseMayNotBeUsedWithinQueries (), trivia.IfToThenRange)) Some( translatedCtxt ( SynExpr.IfThenElse( guardExpr, - TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - thenComp, - Some( - TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - elseComp - ), + TranslateComputationExpressionNoQueryOps ceenv thenComp, + Some(TranslateComputationExpressionNoQueryOps ceenv elseComp), spIfToThen, isRecovery, mIfToEndOfElseBranch, @@ -2270,36 +1800,19 @@ let rec TryTranslateComputationExpression TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv - env + ceenv.env trivia.IfToThenRange - ad + ceenv.ad "Zero" - builderTy + ceenv.builderTy ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), trivia.IfToThenRange)) - mkSynCall "Zero" trivia.IfToThenRange [] builderValName + mkSynCall "Zero" trivia.IfToThenRange [] ceenv.builderValName Some( - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - thenComp + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> translatedCtxt ( SynExpr.IfThenElse( @@ -2318,8 +1831,8 @@ let rec TryTranslateComputationExpression | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> // For 'query' check immediately - if isQuery then - match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with + if ceenv.isQuery then + match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv ceenv.env) binds) with | [ NormalizedBinding(_, SynBindingKind.Normal, false, false, _, _, _, _, _, _, _, _) ] when not isRec -> () | normalizedBindings -> let failAt m = @@ -2339,7 +1852,7 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None vspecs, envinner | _ -> @@ -2347,24 +1860,7 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings (), mQueryOp))) Some( - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - innerComp + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> translatedCtxt (SynExpr.LetOrUse(isRec, false, binds, holeFill, m, trivia))) ) @@ -2378,7 +1874,7 @@ let rec TryTranslateComputationExpression | DebugPointAtBinding.Yes m -> m | _ -> rhsExpr.Range - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcUseMayNotBeUsedInQueries (), mBind)) let innerCompRange = innerComp.Range @@ -2391,21 +1887,7 @@ let rec TryTranslateComputationExpression SynMatchClause( pat, None, - TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - innerComp, + TranslateComputationExpressionNoQueryOps ceenv innerComp, innerCompRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero @@ -2415,11 +1897,11 @@ let rec TryTranslateComputationExpression innerCompRange ) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mBind ceenv.ad "Using" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) Some( - translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ] builderValName) + translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ] ceenv.builderValName) |> addBindDebugPoint spBind ) @@ -2435,7 +1917,7 @@ let rec TryTranslateComputationExpression | DebugPointAtBinding.Yes m -> m | _ -> rhsExpr.Range - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) // Add the variables to the query variable space, on demand @@ -2444,29 +1926,17 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv pat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None vspecs, envinner) let rhsExpr = - mkSourceExprConditional isFromSource rhsExpr sourceMethInfo builderValName + mkSourceExprConditional isFromSource rhsExpr ceenv.sourceMethInfo ceenv.builderValName Some( TranslateComputationExpressionBind - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace mBind @@ -2501,13 +1971,13 @@ let rec TryTranslateComputationExpression | DebugPointAtBinding.Yes m -> m | _ -> rhsExpr.Range - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), mBind)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) then + 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 env mBind ad "Bind" builderTy) then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mBind ceenv.ad "Bind" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), mBind)) let bindExpr = @@ -2519,21 +1989,7 @@ let rec TryTranslateComputationExpression SynMatchClause( pat, None, - TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - innerComp, + TranslateComputationExpressionNoQueryOps ceenv innerComp, innerComp.Range, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero @@ -2544,7 +2000,7 @@ let rec TryTranslateComputationExpression ) let consumeExpr = - mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] builderValName + mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] ceenv.builderValName let consumeExpr = SynExpr.MatchLambda( @@ -2558,9 +2014,9 @@ let rec TryTranslateComputationExpression ) let rhsExpr = - mkSourceExprConditional isFromSource rhsExpr sourceMethInfo builderValName + mkSourceExprConditional isFromSource rhsExpr ceenv.sourceMethInfo ceenv.builderValName - mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] builderValName + mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] ceenv.builderValName |> addBindDebugPoint spBind Some(translatedCtxt bindExpr) @@ -2590,7 +2046,7 @@ let rec TryTranslateComputationExpression if not (cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang) then error (Error(FSComp.SR.tcAndBangNotSupported (), comp.Range)) - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), letBindRange)) let mBind = @@ -2601,7 +2057,7 @@ let rec TryTranslateComputationExpression let sources = (letRhsExpr :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) - |> List.map (fun expr -> mkSourceExprConditional isFromSource expr sourceMethInfo builderValName) + |> List.map (fun expr -> mkSourceExprConditional isFromSource expr ceenv.sourceMethInfo ceenv.builderValName) let pats = letPat :: [ for SynExprAndBang(pat = andPat) in andBangBindings -> andPat ] @@ -2619,11 +2075,11 @@ let rec TryTranslateComputationExpression TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv - env + ceenv.env mBind - ad + ceenv.ad bindReturnNName - builderTy + ceenv.builderTy ) ) @@ -2631,11 +2087,7 @@ let rec TryTranslateComputationExpression hasBindReturnN && Option.isSome ( convertSimpleReturnToExpr - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp varSpace innerComp @@ -2649,26 +2101,14 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv consumePat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None vspecs, envinner) Some( TranslateComputationExpressionBind - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace mBind @@ -2689,11 +2129,11 @@ let rec TryTranslateComputationExpression TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv - env + ceenv.env mBind - ad + ceenv.ad bindNName - builderTy + ceenv.builderTy ) ) @@ -2706,26 +2146,14 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv consumePat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None vspecs, envinner) Some( TranslateComputationExpressionBind - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace mBind @@ -2754,11 +2182,11 @@ let rec TryTranslateComputationExpression TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv - env + ceenv.env mBind - ad + ceenv.ad mergeSourcesName - builderTy + ceenv.builderTy ) then (n - 1) @@ -2787,17 +2215,17 @@ let rec TryTranslateComputationExpression TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv - env + ceenv.env mBind - ad + ceenv.ad mergeSourcesName - builderTy + ceenv.builderTy ) then error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) let source = - mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) builderValName + mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) ceenv.builderValName let pat = SynPat.Tuple(false, List.map snd sourcesAndPats, [], letPat.Range) source, pat @@ -2815,11 +2243,11 @@ let rec TryTranslateComputationExpression TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv - env + ceenv.env mBind - ad + ceenv.ad mergeSourcesName - builderTy + ceenv.builderTy ) then error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) @@ -2827,7 +2255,7 @@ let rec TryTranslateComputationExpression let laterSource, laterPat = mergeSources laterSourcesAndPats let source = - mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [ laterSource ]) builderValName + mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [ laterSource ]) ceenv.builderValName let pat = SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) @@ -2842,27 +2270,15 @@ let rec TryTranslateComputationExpression use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType cenv.g) env tpenv consumePat None + TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None vspecs, envinner) // Build the 'Bind' call Some( TranslateComputationExpressionBind - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace mBind @@ -2875,7 +2291,7 @@ let rec TryTranslateComputationExpression ) | SynExpr.Match(spMatch, expr, clauses, m, trivia) -> - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchKeyword)) let clauses = @@ -2885,19 +2301,7 @@ let rec TryTranslateComputationExpression pat, cond, TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv innerComp, patm, sp, @@ -2909,9 +2313,9 @@ let rec TryTranslateComputationExpression // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) // FUTURE: consider allowing translation to BindReturn | SynExpr.MatchBang(spMatch, expr, clauses, _m, trivia) -> - let inputExpr = mkSourceExpr expr sourceMethInfo builderValName + let inputExpr = mkSourceExpr expr ceenv.sourceMethInfo ceenv.builderValName - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchBangKeyword)) if @@ -2919,11 +2323,11 @@ let rec TryTranslateComputationExpression TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv - env + ceenv.env trivia.MatchBangKeyword - ad + ceenv.ad "Bind" - builderTy + ceenv.builderTy ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), trivia.MatchBangKeyword)) @@ -2935,19 +2339,7 @@ let rec TryTranslateComputationExpression pat, cond, TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv innerComp, patm, sp, @@ -2958,7 +2350,7 @@ let rec TryTranslateComputationExpression SynExpr.MatchLambda(false, trivia.MatchBangKeyword, clauses, DebugPointAtBinding.NoneAtInvisible, trivia.MatchBangKeyword) let callExpr = - mkSynCall "Bind" trivia.MatchBangKeyword [ inputExpr; consumeExpr ] builderValName + mkSynCall "Bind" trivia.MatchBangKeyword [ inputExpr; consumeExpr ] ceenv.builderValName |> addBindDebugPoint spMatch Some(translatedCtxt callExpr) @@ -2974,7 +2366,7 @@ let rec TryTranslateComputationExpression | DebugPointAtWith.Yes _ -> DebugPointAtBinding.Yes trivia.WithKeyword | _ -> DebugPointAtBinding.NoneAtInvisible - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries (), mTry)) let clauses = @@ -2984,19 +2376,7 @@ let rec TryTranslateComputationExpression pat, cond, TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv clauseComp, patm, sp, @@ -3007,28 +2387,16 @@ let rec TryTranslateComputationExpression SynExpr.MatchLambda(true, mTryToLast, clauses, spWith2, mTryToLast) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryWith" builderTy) + 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 env mTry ad "Delay" builderTy) then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mTry ceenv.ad "Delay" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) let innerExpr = TranslateComputationExpressionNoQueryOps - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv innerComp let innerExpr = @@ -3037,17 +2405,17 @@ let rec TryTranslateComputationExpression | _ -> innerExpr let callExpr = - mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ] builderValName; consumeExpr ] builderValName + mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ] ceenv.builderValName; consumeExpr ] ceenv.builderValName Some(translatedCtxt callExpr) | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, m) -> - let yieldFromExpr = mkSourceExpr synYieldExpr sourceMethInfo builderValName + let yieldFromExpr = mkSourceExpr synYieldExpr ceenv.sourceMethInfo ceenv.builderValName - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "YieldFrom" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("YieldFrom"), m)) - let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] builderValName + let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] ceenv.builderValName let yieldFromCall = if IsControlFlowExpression synYieldExpr then @@ -3058,17 +2426,17 @@ let rec TryTranslateComputationExpression Some(translatedCtxt yieldFromCall) | SynExpr.YieldOrReturnFrom((false, _), synReturnExpr, m) -> - let returnFromExpr = mkSourceExpr synReturnExpr sourceMethInfo builderValName + let returnFromExpr = mkSourceExpr synReturnExpr ceenv.sourceMethInfo ceenv.builderValName - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "ReturnFrom" builderTy) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "ReturnFrom" ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("ReturnFrom"), m)) - let returnFromCall = mkSynCall "ReturnFrom" m [ returnFromExpr ] builderValName + let returnFromCall = mkSynCall "ReturnFrom" m [ returnFromExpr ] ceenv.builderValName let returnFromCall = if IsControlFlowExpression synReturnExpr then @@ -3081,13 +2449,13 @@ let rec TryTranslateComputationExpression | SynExpr.YieldOrReturn((isYield, _), synYieldOrReturnExpr, m) -> let methName = (if isYield then "Yield" else "Return") - if isQuery && not isYield then + if ceenv.isQuery && not isYield then error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) then + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad methName ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod (methName), m)) - let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] builderValName + let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] ceenv.builderValName let yieldOrReturnCall = if IsControlFlowExpression synYieldOrReturnExpr then @@ -3100,20 +2468,8 @@ let rec TryTranslateComputationExpression | _ -> None and ConsumeCustomOpClauses - (cenv: TcFileState) - (env: TcEnv) - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + (ceenv: ComputationExpressionContext<'a>) (comp: SynExpr) - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q (varSpace: LazyWithContext<_, _>) dataCompPrior @@ -3131,35 +2487,30 @@ and ConsumeCustomOpClauses match compClausesExpr with // Detect one custom operation... This clause will always match at least once... - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - opDatas, - opExpr, - mClause, - optionalIntoPat), - optionalCont) -> + | OptionalSequential(CustomOperationClause ceenv (nm, opDatas, opExpr, mClause, optionalIntoPat), optionalCont) -> let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] let isLikeZip = - customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOperationIsLikeZip ceenv nm let isLikeJoin = - customOperationIsLikeJoin cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOperationIsLikeJoin ceenv nm let isLikeGroupJoin = - customOperationIsLikeZip cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOperationIsLikeZip ceenv nm // Record the resolution of the custom operation for posterity let item = Item.CustomOperation( opName, - (fun () -> customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm), + (fun () -> customOpUsageText ceenv nm), Some methInfo ) // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + CallNameResolutionSink ceenv.cenv.tcSink (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) if isLikeZip || isLikeJoin || isLikeGroupJoin then errorR ( @@ -3167,7 +2518,7 @@ and ConsumeCustomOpClauses FSComp.SR.tcBinaryOperatorRequiresBody ( nm.idText, Option.get ( - customOpUsageText cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOpUsageText ceenv nm ) ), nm.idRange @@ -3177,24 +2528,12 @@ and ConsumeCustomOpClauses match optionalCont with | None -> // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it - RecordNameAndTypeResolutions cenv env tpenv opExpr + RecordNameAndTypeResolutions ceenv.cenv ceenv.env ceenv.tpenv opExpr dataCompPrior | Some contExpr -> ConsumeCustomOpClauses - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace dataCompPrior @@ -3204,22 +2543,13 @@ and ConsumeCustomOpClauses else let maintainsVarSpace = - customOperationMaintainsVarSpace cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm + customOperationMaintainsVarSpace ceenv nm let maintainsVarSpaceUsingBind = - customOperationMaintainsVarSpaceUsingBind - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - nm + customOperationMaintainsVarSpaceUsingBind ceenv nm let expectedArgCount = - tryExpectedArgCountForCustomOperator - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - mWhole - nm + tryExpectedArgCountForCustomOperator ceenv nm let dataCompAfterOp = match opExpr with @@ -3227,7 +2557,7 @@ and ConsumeCustomOpClauses let argCountsMatch = match expectedArgCount with | Some n -> n = args.Length - | None -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations + | None -> ceenv.cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations if argCountsMatch then // Check for the [] attribute on each argument position @@ -3236,9 +2566,7 @@ and ConsumeCustomOpClauses |> List.mapi (fun i arg -> if isCustomOperationProjectionParameter - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv (i + 1) nm then @@ -3254,7 +2582,7 @@ and ConsumeCustomOpClauses else arg) - mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) builderValName + mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) ceenv.builderValName else let expectedArgCount = defaultArg expectedArgCount 0 @@ -3267,7 +2595,7 @@ and ConsumeCustomOpClauses mClause ([ dataCompPrior ] @ List.init expectedArgCount (fun i -> arbExpr ("_arg" + string i, mClause))) - builderValName + ceenv.builderValName | _ -> failwith "unreachable" match optionalCont with @@ -3289,9 +2617,7 @@ and ConsumeCustomOpClauses if not ( customOperationAllowsInto - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv nm ) then @@ -3323,25 +2649,7 @@ and ConsumeCustomOpClauses intoPat.Range ) - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - (LazyWithContext.NotLazy([], env)) - rebind - id + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q ceenv.emptyVarSpace rebind id // select a.Name; ... // distinct; ... @@ -3350,20 +2658,8 @@ and ConsumeCustomOpClauses | None -> if maintainsVarSpace || maintainsVarSpaceUsingBind then ConsumeCustomOpClauses - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace dataCompAfterOp @@ -3372,22 +2668,10 @@ and ConsumeCustomOpClauses mClause else ConsumeCustomOpClauses - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q - (LazyWithContext.NotLazy([], env)) + ceenv.emptyVarSpace dataCompAfterOp contExpr false @@ -3422,81 +2706,14 @@ and ConsumeCustomOpClauses compClausesExpr.Range ) - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - q - varSpace - rebind - id + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace rebind id -and TranslateComputationExpressionNoQueryOps - (cenv: TcFileState) - (env: TcEnv) - (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: - IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: - IDictionary * MethInfo>>) - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - comp - = - TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole - CompExprTranslationPass.Initial - CustomOperationsMode.Denied - (LazyWithContext.NotLazy([], env)) - comp - id +and TranslateComputationExpressionNoQueryOps ceenv comp = + TranslateComputationExpression ceenv CompExprTranslationPass.Initial CustomOperationsMode.Denied ceenv.emptyVarSpace comp id and TranslateComputationExpressionBind - (cenv: TcFileState) - (env: TcEnv) - (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: - IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: - IDictionary * MethInfo>>) + (ceenv: ComputationExpressionContext<'a>) comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace bindRange @@ -3511,13 +2728,9 @@ and TranslateComputationExpressionBind let innerRange = innerComp.Range let innerCompReturn = - if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then + if ceenv.cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then convertSimpleReturnToExpr - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp varSpace innerComp @@ -3528,7 +2741,7 @@ and TranslateComputationExpressionBind | Some(innerExpr, customOpInfo) when (let bindName = bindName + "Return" - not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy))) + not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env bindRange ceenv.ad bindName ceenv.builderTy))) -> let bindName = bindName + "Return" @@ -3546,27 +2759,15 @@ and TranslateComputationExpressionBind innerRange ) - translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName) + translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) ceenv.builderValName) match customOpInfo with | None -> dataCompPriorToOp | Some(innerComp, mClause) -> // If the `BindReturn` was forced by a custom operation, continue to process the clauses of the CustomOp ConsumeCustomOpClauses - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole q varSpace dataCompPriorToOp @@ -3577,25 +2778,13 @@ and TranslateComputationExpressionBind | _ -> if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy) + isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env bindRange ceenv.ad bindName ceenv.builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod (bindName), bindRange)) // Build the `Bind` call TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial q varSpace @@ -3613,7 +2802,7 @@ and TranslateComputationExpressionBind ) let bindCall = - mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName + mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) ceenv.builderValName translatedCtxt (bindCall |> addBindDebugPoint)) @@ -3621,13 +2810,7 @@ and TranslateComputationExpressionBind /// The outer option indicates if .BindReturn is possible. When it returns None, .BindReturn cannot be used /// The inner option indicates if a custom operation is involved inside and convertSimpleReturnToExpr - (cenv: TcFileState) - (env: TcEnv) - (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: - IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: - IDictionary * MethInfo>>) + (ceenv: ComputationExpressionContext<'a>) comp varSpace innerComp @@ -3643,11 +2826,7 @@ and convertSimpleReturnToExpr |> List.map (fun (SynMatchClause(pat, cond, innerComp2, patm, sp, trivia)) -> match convertSimpleReturnToExpr - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp varSpace innerComp2 @@ -3664,11 +2843,7 @@ and convertSimpleReturnToExpr | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> match convertSimpleReturnToExpr - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp varSpace thenComp @@ -3683,11 +2858,7 @@ and convertSimpleReturnToExpr | Some elseComp -> match convertSimpleReturnToExpr - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp varSpace elseComp @@ -3704,11 +2875,7 @@ and convertSimpleReturnToExpr | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> match convertSimpleReturnToExpr - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp varSpace innerComp @@ -3717,14 +2884,7 @@ and convertSimpleReturnToExpr | Some(_, Some _) -> None | Some(innerExpr, None) -> Some(SynExpr.LetOrUse(isRec, false, binds, innerExpr, m, trivia), None) - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName (nm, - _, - _, - mClause, - _), - _) when - customOperationMaintainsVarSpaceUsingBind cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName nm - -> + | OptionalSequential(CustomOperationClause ceenv (nm, _, _, mClause, _), _) when customOperationMaintainsVarSpaceUsingBind ceenv nm -> let patvs, _env = varSpace.Force comp.Range let varSpaceExpr = mkExprForVarSpace mClause patvs @@ -3734,15 +2894,11 @@ and convertSimpleReturnToExpr | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, trivia) -> // Check the first part isn't a computation expression construct - if (isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1) then + if (isSimpleExpr ceenv innerComp1) then // Check the second part is a simple return match convertSimpleReturnToExpr - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv comp varSpace innerComp2 @@ -3755,63 +2911,40 @@ and convertSimpleReturnToExpr | _ -> None /// Check if an expression has no computation expression constructs -and isSimpleExpr (cenv: TcFileState) env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName comp = +and isSimpleExpr ceenv comp = match comp with - | ForEachThenJoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName false _ -> - false + | ForEachThenJoinOrGroupJoinOrZipClause ceenv false _ -> false | SynExpr.ForEach _ -> false | SynExpr.For _ -> false | SynExpr.While _ -> false | SynExpr.WhileBang _ -> false | SynExpr.TryFinally _ -> false | SynExpr.ImplicitZero _ -> false - | OptionalSequential(JoinOrGroupJoinOrZipClause cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, - _) -> false - | OptionalSequential(CustomOperationClause cenv env customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName _, - _) -> false - | SynExpr.Sequential(expr1 = innerComp1; expr2 = innerComp2) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp1 - && isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp2 + | OptionalSequential(JoinOrGroupJoinOrZipClause ceenv _, _) -> false + | OptionalSequential(CustomOperationClause ceenv _, _) -> false + | SynExpr.Sequential(expr1 = innerComp1; expr2 = innerComp2) -> isSimpleExpr ceenv innerComp1 && isSimpleExpr ceenv innerComp2 | SynExpr.IfThenElse(thenExpr = thenComp; elseExpr = elseCompOpt) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName thenComp + isSimpleExpr ceenv thenComp && (match elseCompOpt with | None -> true - | Some c -> isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName c) + | Some c -> isSimpleExpr ceenv c) | SynExpr.LetOrUse(body = innerComp) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp + isSimpleExpr ceenv innerComp | SynExpr.LetOrUseBang _ -> false | SynExpr.Match(clauses = clauses) -> - clauses - |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp) + clauses |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> isSimpleExpr ceenv innerComp) | SynExpr.MatchBang _ -> false | SynExpr.TryWith(tryExpr = innerComp; withCases = clauses) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName innerComp - && clauses - |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> - isSimpleExpr cenv env tpenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName clauseComp) + isSimpleExpr ceenv innerComp + && clauses |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> isSimpleExpr ceenv clauseComp) | SynExpr.YieldOrReturnFrom _ -> false | SynExpr.YieldOrReturn _ -> false | SynExpr.DoBang _ -> false | _ -> true and TranslateComputationExpression - (cenv: TcFileState) - (env: TcEnv) - (tpenv: UnscopedTyparEnv) - (customOperationMethodsIndexedByKeyword: - IDictionary * MethInfo>>) - (customOperationMethodsIndexedByMethodName: - IDictionary * MethInfo>>) - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + (ceenv: ComputationExpressionContext<'a>) firstTry q varSpace @@ -3819,23 +2952,11 @@ and TranslateComputationExpression translatedCtxt = - cenv.stackGuard.Guard + ceenv.cenv.stackGuard.Guard <| fun () -> match TryTranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv firstTry q varSpace @@ -3849,23 +2970,23 @@ and TranslateComputationExpression // "do! expr;" in final position is treated as { let! () = expr in return () } when Return is provided (and no Zero with Default attribute is available) or as { let! () = expr in zero } otherwise | SynExpr.DoBang(rhsExpr, m) -> let mUnit = rhsExpr.Range - let rhsExpr = mkSourceExpr rhsExpr sourceMethInfo builderValName + let rhsExpr = mkSourceExpr rhsExpr ceenv.sourceMethInfo ceenv.builderValName - if isQuery then + if ceenv.isQuery then error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), m)) let bodyExpr = if isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Return" builderTy + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env m ceenv.ad "Return" ceenv.builderTy ) then SynExpr.ImplicitZero m else match - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy + TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env m ceenv.ad "Zero" ceenv.builderTy with - | minfo :: _ when MethInfoHasAttribute cenv.g m cenv.g.attrib_DefaultValueAttribute minfo -> SynExpr.ImplicitZero m + | minfo :: _ when MethInfoHasAttribute ceenv.cenv.g m ceenv.cenv.g.attrib_DefaultValueAttribute minfo -> SynExpr.ImplicitZero m | _ -> SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) let letBangBind = @@ -3882,19 +3003,7 @@ and TranslateComputationExpression ) TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial q varSpace @@ -3906,56 +3015,32 @@ and TranslateComputationExpression | _ -> // 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 cenv customOperationMethodsIndexedByKeyword customOperationMethodsIndexedByMethodName mWhole comp + ceenv.isQuery + && checkForBinaryApp ceenv comp then TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial q varSpace (SynExpr.ImplicitZero comp.Range) translatedCtxt else - if isQuery && not comp.IsArbExprAndThusAlreadyReportedError then + if ceenv.isQuery && not comp.IsArbExprAndThusAlreadyReportedError then match comp with | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR (Error(FSComp.SR.tcUnrecognizedQueryOperator (), comp.RangeOfFirstPortion)) TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> let fillExpr = - if enableImplicitYield then - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ comp ] builderValName + if ceenv.enableImplicitYield then + let implicitYieldExpr = mkSynCall "Yield" comp.Range [ comp ] ceenv.builderValName SynExpr.SequentialOrImplicitYield( DebugPointAtSequential.SuppressExpr, @@ -4035,6 +3120,36 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv |> Seq.map (fun (nm, group) -> (nm, Seq.toList group)) |> dict + // If there are no 'yield' in the computation expression, and the builder supports 'Yield', + // then allow the type-directed rule interpreting non-unit-typed expressions in statement + // positions as 'yield'. 'yield!' may be present in the computation expression. + let enableImplicitYield = + cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + && (hasMethInfo "Yield" cenv env mBuilderVal ad builderTy + && hasMethInfo "Combine" cenv env mBuilderVal ad builderTy + && hasMethInfo "Delay" cenv env mBuilderVal ad builderTy + && YieldFree cenv comp) + + let origComp = comp + + let ceenv = + { + cenv = cenv + env = env + tpenv = tpenv + customOperationMethodsIndexedByKeyword = customOperationMethodsIndexedByKeyword + customOperationMethodsIndexedByMethodName = customOperationMethodsIndexedByMethodName + sourceMethInfo = sourceMethInfo + builderValName = builderValName + ad = ad + builderTy = builderTy + isQuery = isQuery + enableImplicitYield = enableImplicitYield + origComp = origComp + mWhole = mWhole + emptyVarSpace = LazyWithContext.NotLazy([], env) + } + /// Inside the 'query { ... }' use a modified name environment that contains fake 'CustomOperation' entries /// for all custom operations. This adds them to the completion lists and prevents them being used as values inside /// the query. @@ -4053,9 +3168,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv nm, (fun () -> customOpUsageText - cenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName + ceenv (ident (nm, mBuilderVal))), Some methInfo ))) @@ -4064,33 +3177,11 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv // Environment is needed for completions CallEnvSink cenv.tcSink (comp.Range, env.NameEnv, ad) - // If there are no 'yield' in the computation expression, and the builder supports 'Yield', - // then allow the type-directed rule interpreting non-unit-typed expressions in statement - // positions as 'yield'. 'yield!' may be present in the computation expression. - let enableImplicitYield = - cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield - && (hasMethInfo "Yield" cenv env mBuilderVal ad builderTy - && hasMethInfo "Combine" cenv env mBuilderVal ad builderTy - && hasMethInfo "Delay" cenv env mBuilderVal ad builderTy - && YieldFree cenv comp) - - let origComp = comp + let ceenv = { ceenv with env = env } let basicSynExpr = TranslateComputationExpression - cenv - env - tpenv - customOperationMethodsIndexedByKeyword - customOperationMethodsIndexedByMethodName - sourceMethInfo - builderValName - ad - builderTy - isQuery - enableImplicitYield - origComp - mWhole + ceenv CompExprTranslationPass.Initial hasCustomOperations (LazyWithContext.NotLazy([], env)) From a7b1845c1ed5b8614ed9c12c11464d969c661d01 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 5 Aug 2024 21:09:36 +0000 Subject: [PATCH 12/12] Automated command ran: fantomas Co-authored-by: vzarytovskii <1260985+vzarytovskii@users.noreply.github.com> --- .../CheckComputationExpressions.fs | 1024 ++++++++--------- 1 file changed, 456 insertions(+), 568 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 62d1129ba05..2b66af3eea9 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -43,22 +43,22 @@ type CustomOperationsMode = [] type ComputationExpressionContext<'a> = { - cenv: TcFileState; - env: TcEnv; - tpenv: UnscopedTyparEnv; + cenv: TcFileState + env: TcEnv + tpenv: UnscopedTyparEnv customOperationMethodsIndexedByKeyword: - IDictionary * MethInfo>>; + IDictionary * MethInfo>> customOperationMethodsIndexedByMethodName: - IDictionary * MethInfo>>; - sourceMethInfo: 'a list; - builderValName: string; - ad: AccessorDomain; - builderTy: TType; - isQuery: bool; - enableImplicitYield: bool; - origComp: SynExpr; - mWhole: range; - emptyVarSpace: LazyWithContext * TcEnv,range>; + IDictionary * MethInfo>> + sourceMethInfo: 'a list + builderValName: string + ad: AccessorDomain + builderTy: TType + isQuery: bool + enableImplicitYield: bool + origComp: SynExpr + mWhole: range + emptyVarSpace: LazyWithContext * TcEnv, range> } let inline TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = @@ -259,8 +259,7 @@ let tryGetDataForCustomOperation (nm: Ident) ceenv = | _ -> None let isCustomOperation ceenv nm = - tryGetDataForCustomOperation nm ceenv - |> Option.isSome + tryGetDataForCustomOperation nm ceenv |> Option.isSome let customOperationCheckValidity m f opDatas = let vs = List.map f opDatas @@ -539,8 +538,7 @@ let isCustomOperationProjectionParameter ceenv i (nm: Ident) = if List.allEqual vs then vs[0] else - let opDatas = - (tryGetDataForCustomOperation nm ceenv).Value + let opDatas = (tryGetDataForCustomOperation nm ceenv).Value let opName, _, _, _, _, _, _, _j, _ = opDatas[0] errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) @@ -636,9 +634,14 @@ let (|OnExpr|_|) ceenv nm synExpr = | Some _ -> match synExpr with | SynExpr.App(funcExpr = SynExpr.App(funcExpr = e1; argExpr = SingleIdent opName); argExpr = e2) when - opName.idText = customOperationJoinConditionWord ceenv nm -> + opName.idText = customOperationJoinConditionWord ceenv nm + -> let item = Item.CustomOperation(opName.idText, (fun () -> None), None) - CallNameResolutionSink ceenv.cenv.tcSink (opName.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.AccessRights) + + CallNameResolutionSink + ceenv.cenv.tcSink + (opName.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.AccessRights) + Some(e1, e2) | _ -> None @@ -653,95 +656,53 @@ let (|IntoSuffix|_|) (e: SynExpr) = let JoinOrGroupJoinOp ceenv detector synExpr = match synExpr with - | SynExpr.App(_, - _, - CustomOpId (isCustomOperation ceenv) detector nm, - ExprAsPat innerSourcePat, - mJoinCore) -> Some(nm, innerSourcePat, mJoinCore, false) + | SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) detector nm, ExprAsPat innerSourcePat, mJoinCore) -> + Some(nm, innerSourcePat, mJoinCore, false) // join with bad pattern (gives error on "join" and continues) - | SynExpr.App(_, - _, - CustomOpId (isCustomOperation ceenv) detector nm, - _innerSourcePatExpr, - mJoinCore) -> - errorR ( - Error( - FSComp.SR.tcBinaryOperatorRequiresVariable ( - nm.idText, - Option.get (customOpUsageText ceenv nm) - ), - nm.idRange - ) - ) + | SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) detector nm, _innerSourcePatExpr, mJoinCore) -> + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) Some(nm, arbPat mJoinCore, mJoinCore, true) // join (without anything after - gives error on "join" and continues) | CustomOpId (isCustomOperation ceenv) detector nm -> - errorR ( - Error( - FSComp.SR.tcBinaryOperatorRequiresVariable ( - nm.idText, - Option.get (customOpUsageText ceenv nm) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) Some(nm, arbPat synExpr.Range, synExpr.Range, true) | _ -> None // JoinOrGroupJoinOp customOperationIsLikeJoin -let (|JoinOp|_|) ceenv synExpr = JoinOrGroupJoinOp ceenv (customOperationIsLikeJoin ceenv) synExpr -let (|GroupJoinOp|_|) ceenv synExpr = JoinOrGroupJoinOp ceenv (customOperationIsLikeGroupJoin ceenv) synExpr +let (|JoinOp|_|) ceenv synExpr = + JoinOrGroupJoinOp ceenv (customOperationIsLikeJoin ceenv) synExpr -let MatchIntoSuffixOrRecover - ceenv - alreadyGivenError - (nm: Ident) - synExpr - = +let (|GroupJoinOp|_|) ceenv synExpr = + JoinOrGroupJoinOp ceenv (customOperationIsLikeGroupJoin ceenv) synExpr + +let MatchIntoSuffixOrRecover ceenv alreadyGivenError (nm: Ident) synExpr = match synExpr with | IntoSuffix(x, intoWordRange, intoPat) -> // record the "into" as a custom operation for colorization let item = Item.CustomOperation("into", (fun () -> None), None) - CallNameResolutionSink ceenv.cenv.tcSink (intoWordRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) + + CallNameResolutionSink + ceenv.cenv.tcSink + (intoWordRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) + (x, intoPat, alreadyGivenError) | _ -> if not alreadyGivenError then - errorR ( - Error( - FSComp.SR.tcOperatorIncorrectSyntax ( - nm.idText, - Option.get ( - customOpUsageText ceenv nm - ) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) (synExpr, arbPat synExpr.Range, true) let MatchOnExprOrRecover ceenv alreadyGivenError nm (onExpr: SynExpr) = match onExpr with - | OnExpr ceenv nm (innerSource, SynExprParen(keySelectors, _, _, _)) -> - (innerSource, keySelectors) + | OnExpr ceenv nm (innerSource, SynExprParen(keySelectors, _, _, _)) -> (innerSource, keySelectors) | _ -> if not alreadyGivenError then suppressErrorReporting (fun () -> TcExprOfUnknownType ceenv.cenv ceenv.env ceenv.tpenv onExpr) |> ignore - errorR ( - Error( - FSComp.SR.tcOperatorIncorrectSyntax ( - nm.idText, - Option.get ( - customOpUsageText ceenv nm - ) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) (arbExpr ("_innerSource", onExpr.Range), mkSynBifix onExpr.Range "=" (arbExpr ("_keySelectors", onExpr.Range)) (arbExpr ("_keySelector2", onExpr.Range))) @@ -750,26 +711,12 @@ let (|JoinExpr|_|) (ceenv: ComputationExpressionContext<'a>) synExpr = match synExpr with | InExpr(JoinOp ceenv (nm, innerSourcePat, _, alreadyGivenError), onExpr, mJoinCore) -> let innerSource, keySelectors = - MatchOnExprOrRecover - ceenv - alreadyGivenError - nm - onExpr + MatchOnExprOrRecover ceenv alreadyGivenError nm onExpr Some(nm, innerSourcePat, innerSource, keySelectors, mJoinCore) | JoinOp ceenv (nm, innerSourcePat, mJoinCore, alreadyGivenError) -> if alreadyGivenError then - errorR ( - Error( - FSComp.SR.tcOperatorRequiresIn ( - nm.idText, - Option.get ( - customOpUsageText ceenv nm - ) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) Some(nm, innerSourcePat, arbExpr ("_innerSource", synExpr.Range), arbKeySelectors synExpr.Range, mJoinCore) | _ -> None @@ -778,33 +725,15 @@ let (|GroupJoinExpr|_|) ceenv synExpr = match synExpr with | InExpr(GroupJoinOp ceenv (nm, innerSourcePat, _, alreadyGivenError), intoExpr, mGroupJoinCore) -> let onExpr, intoPat, alreadyGivenError = - MatchIntoSuffixOrRecover - ceenv - alreadyGivenError - nm - intoExpr + MatchIntoSuffixOrRecover ceenv alreadyGivenError nm intoExpr let innerSource, keySelectors = - MatchOnExprOrRecover - ceenv - alreadyGivenError - nm - onExpr + MatchOnExprOrRecover ceenv alreadyGivenError nm onExpr Some(nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) | GroupJoinOp ceenv (nm, innerSourcePat, mGroupJoinCore, alreadyGivenError) -> if alreadyGivenError then - errorR ( - Error( - FSComp.SR.tcOperatorRequiresIn ( - nm.idText, - Option.get ( - customOpUsageText ceenv nm - ) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) Some( nm, @@ -816,10 +745,7 @@ let (|GroupJoinExpr|_|) ceenv synExpr = ) | _ -> None -let (|JoinOrGroupJoinOrZipClause|_|) - (ceenv: ComputationExpressionContext<'a>) - synExpr - = +let (|JoinOrGroupJoinOrZipClause|_|) (ceenv: ComputationExpressionContext<'a>) synExpr = match synExpr with // join innerSourcePat in innerSource on (keySelector1 = keySelector2) @@ -831,50 +757,31 @@ let (|JoinOrGroupJoinOrZipClause|_|) Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) // zip intoPat in secondSource - | InExpr(SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm, ExprAsPat secondSourcePat, _), secondSource, mZipCore) -> - Some(nm, secondSourcePat, secondSource, None, None, mZipCore) + | InExpr(SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm, ExprAsPat secondSourcePat, _), + secondSource, + mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) // zip (without secondSource or in - gives error) | CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm -> - errorR ( - Error( - FSComp.SR.tcOperatorIncorrectSyntax ( - nm.idText, - Option.get (customOpUsageText ceenv nm) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) Some(nm, arbPat synExpr.Range, arbExpr ("_secondSource", synExpr.Range), None, None, synExpr.Range) // zip secondSource (without in - gives error) - | SynExpr.App(_, - _, - CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm, - ExprAsPat secondSourcePat, - mZipCore) -> - errorR ( - Error( - FSComp.SR.tcOperatorIncorrectSyntax ( - nm.idText, - Option.get (customOpUsageText ceenv nm) - ), - mZipCore - ) - ) + | SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm, ExprAsPat secondSourcePat, mZipCore) -> + errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), mZipCore)) Some(nm, secondSourcePat, arbExpr ("_innerSource", synExpr.Range), None, None, mZipCore) | _ -> None -let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) - (ceenv: ComputationExpressionContext<'a>) - strict - synExpr - = +let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) (ceenv: ComputationExpressionContext<'a>) strict synExpr = match synExpr with - | ForEachThen(isFromSource, firstSourcePat, firstSource, JoinOrGroupJoinOrZipClause ceenv (nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore), innerComp) when + | ForEachThen(isFromSource, + firstSourcePat, + firstSource, + JoinOrGroupJoinOrZipClause ceenv (nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore), + innerComp) when (let _firstSourceSimplePats, later1 = use _holder = TemporarilySuspendReportingTypecheckResultsToSink ceenv.cenv.tcSink SimplePatsOfPat ceenv.cenv.synArgNameGenerator firstSourcePat @@ -884,15 +791,7 @@ let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) Some(isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp) | JoinOrGroupJoinOrZipClause ceenv (nm, pat2, expr2, expr3, pat3opt, mOpCore) when strict -> - errorR ( - Error( - FSComp.SR.tcBinaryOperatorRequiresBody ( - nm.idText, - Option.get (customOpUsageText ceenv nm) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) Some( true, @@ -928,29 +827,21 @@ let (|OptionalIntoSuffix|) e = let (|CustomOperationClause|_|) ceenv e = match e with - | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when - isCustomOperation ceenv nm - -> + | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, intoOpt) when isCustomOperation ceenv nm -> // Now we know we have a custom operation, commit the name resolution let intoInfoOpt = match intoOpt with | Some(intoWordRange, intoInfo) -> let item = Item.CustomOperation("into", (fun () -> None), None) - CallNameResolutionSink ceenv.cenv.tcSink (intoWordRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) + CallNameResolutionSink + ceenv.cenv.tcSink + (intoWordRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) Some intoInfo | None -> None - Some( - nm, - Option.get ( - tryGetDataForCustomOperation nm ceenv - ), - core, - core.Range, - intoInfoOpt - ) + Some(nm, Option.get (tryGetDataForCustomOperation nm ceenv), core, core.Range, intoInfoOpt) | _ -> None let (|OptionalSequential|) e = @@ -980,11 +871,7 @@ let checkForBinaryApp ceenv comp = match comp with | StripApps(SingleIdent nm, [ StripApps(SingleIdent nm2, args); arg2 ]) when IsLogicalInfixOpName nm.idText - && (match - tryExpectedArgCountForCustomOperator - ceenv - nm2 - with + && (match tryExpectedArgCountForCustomOperator ceenv nm2 with | Some n -> n > 0 | _ -> false) && not (List.isEmpty args) @@ -1046,6 +933,7 @@ let rec TryTranslateComputationExpression // Guard the stack for deeply nested computation expressions let cenv = ceenv.cenv + cenv.stackGuard.Guard <| fun () -> @@ -1068,7 +956,16 @@ let rec TryTranslateComputationExpression // ... // --> // zip expr1 expr2 (fun pat1 pat3 -> ...) - | ForEachThenJoinOrGroupJoinOrZipClause ceenv true (isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, secondResultPatOpt, mOpCore, innerComp) -> + | ForEachThenJoinOrGroupJoinOrZipClause ceenv true (isFromSource, + firstSourcePat, + firstSource, + nm, + secondSourcePat, + secondSource, + keySelectorsOpt, + secondResultPatOpt, + mOpCore, + innerComp) -> match q with | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), nm.idRange)) | CustomOperationsMode.Allowed -> @@ -1076,7 +973,8 @@ let rec TryTranslateComputationExpression let firstSource = mkSourceExprConditional isFromSource firstSource ceenv.sourceMethInfo ceenv.builderValName - let secondSource = mkSourceExpr secondSource ceenv.sourceMethInfo ceenv.builderValName + let secondSource = + mkSourceExpr secondSource ceenv.sourceMethInfo ceenv.builderValName // Add the variables to the variable space, on demand let varSpaceWithFirstVars = @@ -1122,25 +1020,20 @@ let rec TryTranslateComputationExpression errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondSourcePat.Range)) // check 'join' or 'groupJoin' or 'zip' is permitted for this builder - match - tryGetDataForCustomOperation nm ceenv - with + match tryGetDataForCustomOperation nm ceenv with | None -> error (Error(FSComp.SR.tcMissingCustomOperation (nm.idText), nm.idRange)) | Some opDatas -> let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] // Record the resolution of the custom operation for posterity let item = - Item.CustomOperation( - opName, - (fun () -> - customOpUsageText ceenv nm), - Some methInfo - ) + Item.CustomOperation(opName, (fun () -> customOpUsageText ceenv nm), Some methInfo) // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) + CallNameResolutionSink + cenv.tcSink + (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) let mkJoinExpr keySelector1 keySelector2 innerPat e = let mSynthetic = mOpCore.MakeSynthetic() @@ -1202,11 +1095,7 @@ let rec TryTranslateComputationExpression match secondResultPatOpt, keySelectorsOpt with // groupJoin - | Some secondResultPat, Some relExpr when - customOperationIsLikeGroupJoin - ceenv - nm - -> + | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin ceenv nm -> let secondResultSimplePats, later3 = SimplePatsOfPat cenv.synArgNameGenerator secondResultPat @@ -1269,8 +1158,7 @@ let rec TryTranslateComputationExpression mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondSourceSimplePats, varSpaceWithGroupJoinVars - | None, None when customOperationIsLikeZip ceenv nm -> - mkZipExpr, varSpaceWithSecondVars + | None, None when customOperationIsLikeZip ceenv nm -> mkZipExpr, varSpaceWithSecondVars | _ -> assert false @@ -1323,7 +1211,18 @@ let rec TryTranslateComputationExpression let mPat = pat.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mFor ceenv.ad "For" ceenv.builderTy) then + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mFor + ceenv.ad + "For" + ceenv.builderTy + ) + then error (Error(FSComp.SR.tcRequireBuilderMethod ("For"), mFor)) // Add the variables to the query variable space, on demand @@ -1337,33 +1236,32 @@ let rec TryTranslateComputationExpression vspecs, envinner) Some( - TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp - (fun innerCompR -> - - let forCall = - mkSynCall - "For" - mFor - [ - wrappedSourceExpr - SynExpr.MatchLambda( - false, - mPat, - [ - SynMatchClause(pat, None, innerCompR, mPat, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, - mFor - ) - ] - ceenv.builderValName + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun innerCompR -> - let forCall = - match spFor with - | DebugPointAtFor.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, false, forCall) - | DebugPointAtFor.No -> forCall + let forCall = + mkSynCall + "For" + mFor + [ + wrappedSourceExpr + SynExpr.MatchLambda( + false, + mPat, + [ + SynMatchClause(pat, None, innerCompR, mPat, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + mFor + ) + ] + ceenv.builderValName + + let forCall = + match spFor with + | DebugPointAtFor.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, false, forCall) + | DebugPointAtFor.No -> forCall - translatedCtxt forCall) + translatedCtxt forCall) ) | SynExpr.For( @@ -1399,12 +1297,30 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcNoWhileInQuery (), mWhile)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mWhile ceenv.ad "While" ceenv.builderTy) + 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) + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mWhile + ceenv.ad + "Delay" + ceenv.builderTy + ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mWhile)) @@ -1415,18 +1331,17 @@ let rec TryTranslateComputationExpression | DebugPointAtWhile.No -> guardExpr Some( - TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp - (fun holeFill -> - translatedCtxt ( - mkSynCall - "While" - mWhile - [ - mkSynDelay2 guardExpr - mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] ceenv.builderValName - ] - ceenv.builderValName - )) + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> + translatedCtxt ( + mkSynCall + "While" + mWhile + [ + mkSynDelay2 guardExpr + mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] ceenv.builderValName + ] + ceenv.builderValName + )) ) | SynExpr.WhileBang(spWhile, guardExpr, innerComp, mOrig) -> @@ -1537,17 +1452,34 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcNoTryFinallyInQuery (), mTry)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mTry ceenv.ad "TryFinally" ceenv.builderTy) + 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 + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mTry + ceenv.ad + "Delay" + ceenv.builderTy + ) + then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) - let innerExpr = - TranslateComputationExpressionNoQueryOps - ceenv - innerComp + let innerExpr = TranslateComputationExpressionNoQueryOps ceenv innerComp let innerExpr = match spTry with @@ -1577,7 +1509,16 @@ let rec TryTranslateComputationExpression | SynExpr.ImplicitZero m -> if (not ceenv.enableImplicitYield) - && isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "Zero" ceenv.builderTy) + && isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + m + ceenv.ad + "Zero" + ceenv.builderTy + ) then match ceenv.origComp with // builder { } @@ -1602,7 +1543,10 @@ let rec TryTranslateComputationExpression let varSpaceExpr = mkExprForVarSpace mClause patvs let varSpacePat = mkPatForVarSpace mClause patvs - let dataCompPrior = translatedCtxt (TranslateComputationExpressionNoQueryOps ceenv (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause))) + let dataCompPrior = + translatedCtxt ( + TranslateComputationExpressionNoQueryOps ceenv (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause)) + ) // Rebind using for ... let rebind = @@ -1630,31 +1574,19 @@ let rec TryTranslateComputationExpression let dataCompPriorToOp = let isYield = not (customOperationMaintainsVarSpaceUsingBind ceenv nm) - translatedCtxt (TranslateComputationExpressionNoQueryOps ceenv (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause)) ) + + translatedCtxt ( + TranslateComputationExpressionNoQueryOps ceenv (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause)) + ) // Now run the consumeCustomOpClauses - Some( - ConsumeCustomOpClauses - ceenv - comp - q - varSpace - dataCompPriorToOp - comp - false - mClause - ) + Some(ConsumeCustomOpClauses ceenv comp q varSpace dataCompPriorToOp comp false mClause) | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, _) -> // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 - if - ceenv.isQuery - && checkForBinaryApp ceenv innerComp1 - then - Some( - TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt - ) + if ceenv.isQuery && checkForBinaryApp ceenv innerComp1 then + Some(TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt) else @@ -1678,13 +1610,29 @@ let rec TryTranslateComputationExpression if isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "Combine" ceenv.builderTy + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + m + ceenv.ad + "Combine" + ceenv.builderTy ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Combine"), m)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "Delay" ceenv.builderTy) + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + m + ceenv.ad + "Delay" + ceenv.builderTy + ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), m)) @@ -1698,9 +1646,7 @@ let rec TryTranslateComputationExpression "Delay" m1 [ - mkSynDelay - innerComp2.Range - (TranslateComputationExpressionNoQueryOps ceenv innerComp2) + mkSynDelay innerComp2.Range (TranslateComputationExpressionNoQueryOps ceenv innerComp2) ] ceenv.builderValName ] @@ -1742,36 +1688,32 @@ let rec TryTranslateComputationExpression // "expr; cexpr" is treated as sequential execution | _ -> Some( - TranslateComputationExpression - ceenv - CompExprTranslationPass.Initial - q - varSpace - innerComp2 - (fun holeFill -> - let fillExpr = - if ceenv.enableImplicitYield then - // When implicit yields are enabled, then if the 'innerComp1' checks as type - // 'unit' we interpret the expression as a sequential, and when it doesn't - // have type 'unit' we interpret it as a 'Yield + Combine'. - let combineExpr = - let m1 = rangeForCombine innerComp1 - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] ceenv.builderValName - - mkSynCall - "Combine" - m1 - [ - implicitYieldExpr - mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] ceenv.builderValName - ] - ceenv.builderValName - - SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) - else - SynExpr.Sequential(sp, true, innerComp1, holeFill, m, SynExprSequentialTrivia.Zero) - - translatedCtxt fillExpr) + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp2 (fun holeFill -> + let fillExpr = + if ceenv.enableImplicitYield then + // When implicit yields are enabled, then if the 'innerComp1' checks as type + // 'unit' we interpret the expression as a sequential, and when it doesn't + // have type 'unit' we interpret it as a 'Yield + Combine'. + let combineExpr = + let m1 = rangeForCombine innerComp1 + + let implicitYieldExpr = + mkSynCall "Yield" comp.Range [ innerComp1 ] ceenv.builderValName + + mkSynCall + "Combine" + m1 + [ + implicitYieldExpr + mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] ceenv.builderValName + ] + ceenv.builderValName + + SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) + else + SynExpr.Sequential(sp, true, innerComp1, holeFill, m, SynExprSequentialTrivia.Zero) + + translatedCtxt fillExpr) ) | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> @@ -1812,19 +1754,10 @@ let rec TryTranslateComputationExpression mkSynCall "Zero" trivia.IfToThenRange [] ceenv.builderValName Some( - TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace thenComp - (fun holeFill -> - translatedCtxt ( - SynExpr.IfThenElse( - guardExpr, - holeFill, - Some elseComp, - spIfToThen, - isRecovery, - mIfToEndOfElseBranch, - trivia - ) - )) + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> + translatedCtxt ( + SynExpr.IfThenElse(guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) + )) ) // 'let binds in expr' @@ -1860,8 +1793,8 @@ let rec TryTranslateComputationExpression error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings (), mQueryOp))) Some( - TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp - (fun holeFill -> translatedCtxt (SynExpr.LetOrUse(isRec, false, binds, holeFill, m, trivia))) + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> + translatedCtxt (SynExpr.LetOrUse(isRec, false, binds, holeFill, m, trivia))) ) // 'use x = expr in expr' @@ -1897,7 +1830,18 @@ let rec TryTranslateComputationExpression innerCompRange ) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mBind ceenv.ad "Using" ceenv.builderTy) then + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mBind + ceenv.ad + "Using" + ceenv.builderTy + ) + then error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) Some( @@ -1974,10 +1918,32 @@ let rec TryTranslateComputationExpression 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 + 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 + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mBind + ceenv.ad + "Bind" + ceenv.builderTy + ) + then error (Error(FSComp.SR.tcRequireBuilderMethod ("Bind"), mBind)) let bindExpr = @@ -2085,13 +2051,7 @@ let rec TryTranslateComputationExpression if hasBindReturnN - && Option.isSome ( - convertSimpleReturnToExpr - ceenv - comp - varSpace - innerComp - ) + && Option.isSome (convertSimpleReturnToExpr ceenv comp varSpace innerComp) then let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) @@ -2255,7 +2215,11 @@ let rec TryTranslateComputationExpression let laterSource, laterPat = mergeSources laterSourcesAndPats let source = - mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [ laterSource ]) ceenv.builderValName + mkSynCall + mergeSourcesName + sourcesRange + (List.map fst nowSourcesAndPats @ [ laterSource ]) + ceenv.builderValName let pat = SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) @@ -2297,16 +2261,7 @@ let rec TryTranslateComputationExpression let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> - SynMatchClause( - pat, - cond, - TranslateComputationExpressionNoQueryOps - ceenv - innerComp, - patm, - sp, - trivia - )) + SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps ceenv innerComp, patm, sp, trivia)) Some(translatedCtxt (SynExpr.Match(spMatch, expr, clauses, m, trivia))) @@ -2335,16 +2290,7 @@ let rec TryTranslateComputationExpression let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> - SynMatchClause( - pat, - cond, - TranslateComputationExpressionNoQueryOps - ceenv - innerComp, - patm, - sp, - trivia - )) + SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps ceenv innerComp, patm, sp, trivia)) let consumeExpr = SynExpr.MatchLambda(false, trivia.MatchBangKeyword, clauses, DebugPointAtBinding.NoneAtInvisible, trivia.MatchBangKeyword) @@ -2372,32 +2318,40 @@ let rec TryTranslateComputationExpression let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, clauseComp, patm, sp, trivia)) -> - SynMatchClause( - pat, - cond, - TranslateComputationExpressionNoQueryOps - ceenv - clauseComp, - patm, - sp, - trivia - )) + SynMatchClause(pat, cond, TranslateComputationExpressionNoQueryOps ceenv clauseComp, patm, sp, trivia)) let consumeExpr = SynExpr.MatchLambda(true, mTryToLast, clauses, spWith2, mTryToLast) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env mTry ceenv.ad "TryWith" ceenv.builderTy) + 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 + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + mTry + ceenv.ad + "Delay" + ceenv.builderTy + ) + then error (Error(FSComp.SR.tcRequireBuilderMethod ("Delay"), mTry)) - let innerExpr = - TranslateComputationExpressionNoQueryOps - ceenv - innerComp + let innerExpr = TranslateComputationExpressionNoQueryOps ceenv innerComp let innerExpr = match spTry with @@ -2405,14 +2359,33 @@ let rec TryTranslateComputationExpression | _ -> innerExpr let callExpr = - mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ] ceenv.builderValName; consumeExpr ] ceenv.builderValName + mkSynCall + "TryWith" + mTry + [ + mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ] ceenv.builderValName + consumeExpr + ] + ceenv.builderValName Some(translatedCtxt callExpr) | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, m) -> - let yieldFromExpr = mkSourceExpr synYieldExpr ceenv.sourceMethInfo ceenv.builderValName + let yieldFromExpr = + mkSourceExpr synYieldExpr ceenv.sourceMethInfo ceenv.builderValName - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "YieldFrom" ceenv.builderTy) then + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + m + ceenv.ad + "YieldFrom" + ceenv.builderTy + ) + then error (Error(FSComp.SR.tcRequireBuilderMethod ("YieldFrom"), m)) let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] ceenv.builderValName @@ -2426,17 +2399,28 @@ let rec TryTranslateComputationExpression Some(translatedCtxt yieldFromCall) | SynExpr.YieldOrReturnFrom((false, _), synReturnExpr, m) -> - let returnFromExpr = mkSourceExpr synReturnExpr ceenv.sourceMethInfo ceenv.builderValName + let returnFromExpr = + mkSourceExpr synReturnExpr ceenv.sourceMethInfo ceenv.builderValName if ceenv.isQuery then error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv ceenv.env m ceenv.ad "ReturnFrom" ceenv.builderTy) + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + m + ceenv.ad + "ReturnFrom" + ceenv.builderTy + ) then error (Error(FSComp.SR.tcRequireBuilderMethod ("ReturnFrom"), m)) - let returnFromCall = mkSynCall "ReturnFrom" m [ returnFromExpr ] ceenv.builderValName + let returnFromCall = + mkSynCall "ReturnFrom" m [ returnFromExpr ] ceenv.builderValName let returnFromCall = if IsControlFlowExpression synReturnExpr then @@ -2452,10 +2436,22 @@ 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 + if + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + cenv + ceenv.env + m + ceenv.ad + methName + ceenv.builderTy + ) + then error (Error(FSComp.SR.tcRequireBuilderMethod (methName), m)) - let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] ceenv.builderValName + let yieldOrReturnCall = + mkSynCall methName m [ synYieldOrReturnExpr ] ceenv.builderValName let yieldOrReturnCall = if IsControlFlowExpression synYieldOrReturnExpr then @@ -2491,65 +2487,38 @@ and ConsumeCustomOpClauses let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] - let isLikeZip = - customOperationIsLikeZip ceenv nm + let isLikeZip = customOperationIsLikeZip ceenv nm - let isLikeJoin = - customOperationIsLikeJoin ceenv nm + let isLikeJoin = customOperationIsLikeJoin ceenv nm - let isLikeGroupJoin = - customOperationIsLikeZip ceenv nm + let isLikeGroupJoin = customOperationIsLikeZip ceenv nm // Record the resolution of the custom operation for posterity let item = - Item.CustomOperation( - opName, - (fun () -> customOpUsageText ceenv nm), - Some methInfo - ) + Item.CustomOperation(opName, (fun () -> customOpUsageText ceenv nm), Some methInfo) // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink ceenv.cenv.tcSink (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) + CallNameResolutionSink + ceenv.cenv.tcSink + (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ceenv.env.eAccessRights) if isLikeZip || isLikeJoin || isLikeGroupJoin then - errorR ( - Error( - FSComp.SR.tcBinaryOperatorRequiresBody ( - nm.idText, - Option.get ( - customOpUsageText ceenv nm - ) - ), - nm.idRange - ) - ) + errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)) match optionalCont with | None -> // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it RecordNameAndTypeResolutions ceenv.cenv ceenv.env ceenv.tpenv opExpr dataCompPrior - | Some contExpr -> - ConsumeCustomOpClauses - ceenv - comp - q - varSpace - dataCompPrior - contExpr - lastUsesBind - mClause + | Some contExpr -> ConsumeCustomOpClauses ceenv comp q varSpace dataCompPrior contExpr lastUsesBind mClause else - let maintainsVarSpace = - customOperationMaintainsVarSpace ceenv nm + let maintainsVarSpace = customOperationMaintainsVarSpace ceenv nm - let maintainsVarSpaceUsingBind = - customOperationMaintainsVarSpaceUsingBind ceenv nm + let maintainsVarSpaceUsingBind = customOperationMaintainsVarSpaceUsingBind ceenv nm - let expectedArgCount = - tryExpectedArgCountForCustomOperator ceenv nm + let expectedArgCount = tryExpectedArgCountForCustomOperator ceenv nm let dataCompAfterOp = match opExpr with @@ -2564,12 +2533,7 @@ and ConsumeCustomOpClauses let args = args |> List.mapi (fun i arg -> - if - isCustomOperationProjectionParameter - ceenv - (i + 1) - nm - then + if isCustomOperationProjectionParameter ceenv (i + 1) nm then SynExpr.Lambda( false, false, @@ -2614,13 +2578,7 @@ and ConsumeCustomOpClauses // Rebind the into pattern and process the rest of the clauses match optionalIntoPat with | Some intoPat -> - if - not ( - customOperationAllowsInto - ceenv - nm - ) - then + if not (customOperationAllowsInto ceenv nm) then error (Error(FSComp.SR.tcOperatorDoesntAcceptInto (nm.idText), intoPat.Range)) // Rebind using either for ... or let!.... @@ -2657,25 +2615,9 @@ and ConsumeCustomOpClauses // Process the rest of the clauses | None -> if maintainsVarSpace || maintainsVarSpaceUsingBind then - ConsumeCustomOpClauses - ceenv - comp - q - varSpace - dataCompAfterOp - contExpr - maintainsVarSpaceUsingBind - mClause + ConsumeCustomOpClauses ceenv comp q varSpace dataCompAfterOp contExpr maintainsVarSpaceUsingBind mClause else - ConsumeCustomOpClauses - ceenv - comp - q - ceenv.emptyVarSpace - dataCompAfterOp - contExpr - false - mClause + ConsumeCustomOpClauses ceenv comp q ceenv.emptyVarSpace dataCompAfterOp contExpr false mClause // No more custom operator clauses in compClausesExpr, but there may be clauses like join, yield etc. // Bind/iterate the dataCompPrior and use compClausesExpr as the body. @@ -2729,11 +2671,7 @@ and TranslateComputationExpressionBind let innerCompReturn = if ceenv.cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then - convertSimpleReturnToExpr - ceenv - comp - varSpace - innerComp + convertSimpleReturnToExpr ceenv comp varSpace innerComp else None @@ -2741,7 +2679,18 @@ and TranslateComputationExpressionBind | Some(innerExpr, customOpInfo) when (let bindName = bindName + "Return" - not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env bindRange ceenv.ad bindName ceenv.builderTy))) + not ( + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + ceenv.cenv + ceenv.env + bindRange + ceenv.ad + bindName + ceenv.builderTy + ) + )) -> let bindName = bindName + "Return" @@ -2765,56 +2714,46 @@ and TranslateComputationExpressionBind | None -> dataCompPriorToOp | Some(innerComp, mClause) -> // If the `BindReturn` was forced by a custom operation, continue to process the clauses of the CustomOp - ConsumeCustomOpClauses - ceenv - comp - q - varSpace - dataCompPriorToOp - innerComp - false - mClause + ConsumeCustomOpClauses ceenv comp q varSpace dataCompPriorToOp innerComp false mClause | _ -> if - isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env bindRange ceenv.ad bindName ceenv.builderTy) + isNil ( + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + ceenv.cenv + ceenv.env + bindRange + ceenv.ad + bindName + ceenv.builderTy + ) then error (Error(FSComp.SR.tcRequireBuilderMethod (bindName), bindRange)) // Build the `Bind` call - TranslateComputationExpression - ceenv - CompExprTranslationPass.Initial - q - varSpace - innerComp - (fun holeFill -> - let consumeExpr = - SynExpr.MatchLambda( - false, - consumePat.Range, - [ - SynMatchClause(consumePat, None, holeFill, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) - ], - DebugPointAtBinding.NoneAtInvisible, - innerRange - ) + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> + let consumeExpr = + SynExpr.MatchLambda( + false, + consumePat.Range, + [ + SynMatchClause(consumePat, None, holeFill, innerRange, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) + ], + DebugPointAtBinding.NoneAtInvisible, + innerRange + ) - let bindCall = - mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) ceenv.builderValName + let bindCall = + mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) ceenv.builderValName - translatedCtxt (bindCall |> addBindDebugPoint)) + translatedCtxt (bindCall |> addBindDebugPoint)) /// This function is for desugaring into .Bind{N}Return calls if possible /// The outer option indicates if .BindReturn is possible. When it returns None, .BindReturn cannot be used /// The inner option indicates if a custom operation is involved inside -and convertSimpleReturnToExpr - (ceenv: ComputationExpressionContext<'a>) - comp - varSpace - innerComp - = +and convertSimpleReturnToExpr (ceenv: ComputationExpressionContext<'a>) comp varSpace innerComp = match innerComp with | SynExpr.YieldOrReturn((false, _), returnExpr, m) -> let returnExpr = SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnExpr) @@ -2824,13 +2763,7 @@ and convertSimpleReturnToExpr let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp2, patm, sp, trivia)) -> - match - convertSimpleReturnToExpr - ceenv - comp - varSpace - innerComp2 - with + match convertSimpleReturnToExpr ceenv comp varSpace innerComp2 with | None -> None // failure | Some(_, Some _) -> None // custom op on branch = failure | Some(innerExpr2, None) -> Some(SynMatchClause(pat, cond, innerExpr2, patm, sp, trivia))) @@ -2841,13 +2774,7 @@ and convertSimpleReturnToExpr None | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> - match - convertSimpleReturnToExpr - ceenv - comp - varSpace - thenComp - with + match convertSimpleReturnToExpr ceenv comp varSpace thenComp with | None -> None | Some(_, Some _) -> None | Some(thenExpr, None) -> @@ -2856,13 +2783,7 @@ and convertSimpleReturnToExpr // When we are missing an 'else' part alltogether in case of 'if cond then return exp', we fallback from BindReturn into regular Bind+Return | None -> None | Some elseComp -> - match - convertSimpleReturnToExpr - ceenv - comp - varSpace - elseComp - with + match convertSimpleReturnToExpr ceenv comp varSpace elseComp with | None -> None // failure | Some(_, Some _) -> None // custom op on branch = failure | Some(elseExpr, None) -> Some(Some elseExpr) @@ -2873,13 +2794,7 @@ and convertSimpleReturnToExpr Some(SynExpr.IfThenElse(guardExpr, thenExpr, elseExprOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia), None) | SynExpr.LetOrUse(isRec, false, binds, innerComp, m, trivia) -> - match - convertSimpleReturnToExpr - ceenv - comp - varSpace - innerComp - with + match convertSimpleReturnToExpr ceenv comp varSpace innerComp with | None -> None | Some(_, Some _) -> None | Some(innerExpr, None) -> Some(SynExpr.LetOrUse(isRec, false, binds, innerExpr, m, trivia), None) @@ -2896,13 +2811,7 @@ and convertSimpleReturnToExpr // Check the first part isn't a computation expression construct if (isSimpleExpr ceenv innerComp1) then // Check the second part is a simple return - match - convertSimpleReturnToExpr - ceenv - comp - varSpace - innerComp2 - with + match convertSimpleReturnToExpr ceenv comp varSpace innerComp2 with | None -> None | Some(innerExpr2, optionalCont) -> Some(SynExpr.Sequential(sp, true, innerComp1, innerExpr2, m, trivia), optionalCont) else @@ -2929,40 +2838,26 @@ and isSimpleExpr ceenv comp = && (match elseCompOpt with | None -> true | Some c -> isSimpleExpr ceenv c) - | SynExpr.LetOrUse(body = innerComp) -> - isSimpleExpr ceenv innerComp + | SynExpr.LetOrUse(body = innerComp) -> isSimpleExpr ceenv innerComp | SynExpr.LetOrUseBang _ -> false | SynExpr.Match(clauses = clauses) -> - clauses |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> isSimpleExpr ceenv innerComp) + clauses + |> List.forall (fun (SynMatchClause(resultExpr = innerComp)) -> isSimpleExpr ceenv innerComp) | SynExpr.MatchBang _ -> false | SynExpr.TryWith(tryExpr = innerComp; withCases = clauses) -> isSimpleExpr ceenv innerComp - && clauses |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> isSimpleExpr ceenv clauseComp) + && clauses + |> List.forall (fun (SynMatchClause(resultExpr = clauseComp)) -> isSimpleExpr ceenv clauseComp) | SynExpr.YieldOrReturnFrom _ -> false | SynExpr.YieldOrReturn _ -> false | SynExpr.DoBang _ -> false | _ -> true -and TranslateComputationExpression - (ceenv: ComputationExpressionContext<'a>) - firstTry - q - varSpace - comp - translatedCtxt - = +and TranslateComputationExpression (ceenv: ComputationExpressionContext<'a>) firstTry q varSpace comp translatedCtxt = ceenv.cenv.stackGuard.Guard <| fun () -> - match - TryTranslateComputationExpression - ceenv - firstTry - q - varSpace - comp - translatedCtxt - with + match TryTranslateComputationExpression ceenv firstTry q varSpace comp translatedCtxt with | Some e -> e | None -> // This only occurs in final position in a sequence @@ -2978,15 +2873,30 @@ and TranslateComputationExpression let bodyExpr = if isNil ( - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env m ceenv.ad "Return" ceenv.builderTy + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + ceenv.cenv + ceenv.env + m + ceenv.ad + "Return" + ceenv.builderTy ) then SynExpr.ImplicitZero m else match - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult ceenv.cenv ceenv.env m ceenv.ad "Zero" ceenv.builderTy + TryFindIntrinsicOrExtensionMethInfo + ResultCollectionSettings.AtMostOneResult + ceenv.cenv + ceenv.env + m + ceenv.ad + "Zero" + ceenv.builderTy with - | minfo :: _ when MethInfoHasAttribute ceenv.cenv.g m ceenv.cenv.g.attrib_DefaultValueAttribute minfo -> SynExpr.ImplicitZero m + | minfo :: _ when MethInfoHasAttribute ceenv.cenv.g m ceenv.cenv.g.attrib_DefaultValueAttribute minfo -> + SynExpr.ImplicitZero m | _ -> SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) let letBangBind = @@ -3002,22 +2912,13 @@ and TranslateComputationExpression SynExprLetOrUseBangTrivia.Zero ) - TranslateComputationExpression - ceenv - CompExprTranslationPass.Initial - q - varSpace - letBangBind - translatedCtxt + TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace letBangBind translatedCtxt // "expr;" in final position is treated as { expr; zero } // Suppress the sequence point on the "zero" | _ -> // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore comp - if - ceenv.isQuery - && checkForBinaryApp ceenv comp - then + if ceenv.isQuery && checkForBinaryApp ceenv comp then TranslateComputationExpression ceenv CompExprTranslationPass.Initial @@ -3164,14 +3065,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv AddFakeNameToNameEnv nm nenv - (Item.CustomOperation( - nm, - (fun () -> - customOpUsageText - ceenv - (ident (nm, mBuilderVal))), - Some methInfo - ))) + (Item.CustomOperation(nm, (fun () -> customOpUsageText ceenv (ident (nm, mBuilderVal))), Some methInfo))) } // Environment is needed for completions @@ -3180,13 +3074,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv let ceenv = { ceenv with env = env } let basicSynExpr = - TranslateComputationExpression - ceenv - CompExprTranslationPass.Initial - hasCustomOperations - (LazyWithContext.NotLazy([], env)) - comp - id + TranslateComputationExpression ceenv CompExprTranslationPass.Initial hasCustomOperations (LazyWithContext.NotLazy([], env)) comp id let mDelayOrQuoteOrRun = mBuilderVal