diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index c90e75a3ae6..29d04082093 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -1004,6 +1004,8 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa | Parser.TOKEN_OLET(_) -> getErrorString("Parser.TOKEN.OLET") | Parser.TOKEN_OBINDER | Parser.TOKEN_BINDER -> getErrorString("Parser.TOKEN.BINDER") + | Parser.TOKEN_OAND_BANG + | Parser.TOKEN_AND_BANG -> getErrorString("Parser.TOKEN.AND.BANG") | Parser.TOKEN_ODO -> getErrorString("Parser.TOKEN.ODO") | Parser.TOKEN_OWITH -> getErrorString("Parser.TOKEN.OWITH") | Parser.TOKEN_OFUNCTION -> getErrorString("Parser.TOKEN.OFUNCTION") diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index de26c9b349a..6a4e5da6b1c 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1475,6 +1475,9 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl 3301,chkInvalidFunctionReturnType,"The function or method has an invalid return type '%s'. This is not permitted by the rules of Common IL." 3302,packageManagementRequiresVFive,"The package management feature requires language version 5.0 use /langversion:preview" 3303,fromEndSlicingRequiresVFive,"From the end slicing with requires language version 5.0, use /langversion:preview." +3343,tcRequireMergeSourcesOrBindN,"The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '%s' method or appropriate 'MergeSource' and 'Bind' methods" +3344,tcAndBangNotSupported,"This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature." +3345,tcInvalidUseBangBindingNoAndBangs,"use! may not be combined with and!" useSdkRefs,"Use reference assemblies for .NET framework references when available (Enabled by default)." fSharpBannerVersion,"%s for F# %s" optsLangVersion,"Display the allowed values for language version, specify language version such as 'latest' or 'preview'" diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx index cf3d3c92b29..a56e6f14219 100644 --- a/src/fsharp/FSStrings.resx +++ b/src/fsharp/FSStrings.resx @@ -564,6 +564,9 @@ keyword 'and' + ! + keyword 'and!' + keyword 'as' diff --git a/src/fsharp/LanguageFeatures.fs b/src/fsharp/LanguageFeatures.fs index 2170cee8f75..9d23f9e266e 100644 --- a/src/fsharp/LanguageFeatures.fs +++ b/src/fsharp/LanguageFeatures.fs @@ -28,6 +28,7 @@ type LanguageFeature = | PackageManagement | FromEndSlicing | FixedIndexSlice3d4d + | AndBang /// LanguageVersion management type LanguageVersion (specifiedVersionAsString) = @@ -61,6 +62,7 @@ type LanguageVersion (specifiedVersionAsString) = LanguageFeature.NameOf, previewVersion LanguageFeature.OpenStaticClasses, previewVersion LanguageFeature.PackageManagement, previewVersion + LanguageFeature.AndBang, previewVersion ] let specified = diff --git a/src/fsharp/LanguageFeatures.fsi b/src/fsharp/LanguageFeatures.fsi index 37a58a50b49..5f274351d72 100644 --- a/src/fsharp/LanguageFeatures.fsi +++ b/src/fsharp/LanguageFeatures.fsi @@ -16,7 +16,7 @@ type LanguageFeature = | PackageManagement | FromEndSlicing | FixedIndexSlice3d4d - + | AndBang /// LanguageVersion management type LanguageVersion = diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 470b54709b8..d485399af83 100644 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -1784,6 +1784,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxt tokenTup (CtxtLetDecl(blockLet, tokenStartPos)) returnToken tokenLexbufState (if blockLet then OBINDER b else token) + // and! ... ~~~> CtxtLetDecl + | AND_BANG isUse, (ctxt :: _) -> + let blockLet = match ctxt with CtxtSeqBlock _ -> true | _ -> false + if debug then dprintf "AND!: entering CtxtLetDecl(blockLet=%b), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" blockLet outputPos tokenStartPos + pushCtxt tokenTup (CtxtLetDecl(blockLet,tokenStartPos)) + returnToken tokenLexbufState (if blockLet then OAND_BANG isUse else token) + | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), ctxtStack when thereIsACtxtMemberBodyOnTheStackAndWeShouldPopStackForUpcomingMember ctxtStack -> if debug then dprintf "STATIC/MEMBER/OVERRIDE/DEFAULT: already inside CtxtMemberBody, popping all that context before starting next member...\n" // save this token, we'll consume it again later... diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs old mode 100644 new mode 100755 index c8880576868..ac71f5bb589 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1842,31 +1842,25 @@ let UseCombinedArity g declKind rhsExpr prelimScheme = let UseNoArity prelimScheme = BuildValScheme ExpressionBinding None prelimScheme -let MakeSimpleVals cenv env names = +/// Make and publish the Val nodes for a collection of simple (non-generic) value specifications +let MakeAndPublishSimpleVals cenv env names = let tyschemes = DontGeneralizeVals names let valSchemes = NameMap.map UseNoArity tyschemes let values = MakeAndPublishVals cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valSchemes, [], XmlDoc.Empty, None) let vspecMap = NameMap.map fst values values, vspecMap -let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = - +/// Make and publish the Val nodes for a collection of value specifications at Lambda and Match positions +/// +/// We merge the additions to the name resolution environment into one using a merged range so all values are brought +/// into scope simultaneously. The technique used to do this is a disturbing and unfortunate hack that +/// intercepts `NotifyNameResolution` calls being emitted by `MakeAndPublishSimpleVals` + +let MakeAndPublishSimpleValsForMergedScope cenv env m (names: NameMap<_>) = let values, vspecMap = - if not mergeNamesInOneNameresEnv then MakeSimpleVals cenv env names + if names.Count <= 1 then + MakeAndPublishSimpleVals cenv env names else - // reason: now during typecheck we create new name resolution environment for all components of tupled arguments in lambda. - // When trying to find best environment for the given position first we pick the most deeply nested scope that contains given position - // (and that will be lambda body - correct one), then we look for the better subtree on the left hand side - // (and that will be name resolution environment containing second parameter parameter - without the first one). - // fix: I've tried to make fix as local as possible to reduce overall impact on the source code. - // Idea of the fix: replace existing typecheck results sink and capture all reported name resolutions (this will be all parameters in lambda). - // After that - we restore the sink back, generate new name resolution environment that contains all captured names and report generated environment - // to the old sink. - - - // default behavior - send EnvWithScope notification for every resolved name - // what we do here is override this default behavior and capture only all name resolution notifications - // later we'll process them and create one name resolution env that will contain names from all notifications let nameResolutions = ResizeArray() let values, vspecMap = let sink = @@ -1875,14 +1869,14 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = member this.NotifyNameResolution(pos, item, itemGroup, itemTyparInst, occurence, denv, nenv, ad, m, replacing) = if not m.IsSynthetic then nameResolutions.Add(pos, item, itemGroup, itemTyparInst, occurence, denv, nenv, ad, m, replacing) - member this.NotifyExprHasType(_, _, _, _, _, _) = assert false // no expr typings in MakeSimpleVals + member this.NotifyExprHasType(_, _, _, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals member this.NotifyFormatSpecifierLocation(_, _) = () member this.NotifyOpenDeclaration(_) = () member this.CurrentSourceText = None member this.FormatStringCheckContext = None } use _h = WithNewTypecheckResultsSink(sink, cenv.tcSink) - MakeSimpleVals cenv env names + MakeAndPublishSimpleVals cenv env names if nameResolutions.Count <> 0 then let (_, _, _, _, _, _, _, ad, m1, _replacing) = nameResolutions.[0] @@ -1905,8 +1899,6 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = let envinner = AddLocalValMap cenv.tcSink m vspecMap env envinner, values, vspecMap - - //------------------------------------------------------------------------- // Helpers to freshen existing types and values, i.e. when a reference // to C<_> occurs then generate C for a fresh type inference variable ?ty. @@ -3535,7 +3527,7 @@ let YieldFree cenv expr = | SynExpr.ForEach (_, _, _, _, _, body, _) -> YieldFree body - | SynExpr.LetOrUseBang(_, _, _, _, _, body, _) -> + | SynExpr.LetOrUseBang(_, _, _, _, _, _, body, _) -> YieldFree body | SynExpr.YieldOrReturn((true, _), _, _) -> false @@ -6249,7 +6241,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m)) | SynExpr.DoBang (_, m) - | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> + | SynExpr.LetOrUseBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) | SynExpr.MatchBang (_, _, _, m) -> @@ -6261,7 +6253,7 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = | SynExpr.Lambda (isMember, isSubsequent, spats, bodyExpr, m) when isMember || isFirst || isSubsequent -> let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy let vs, (tpenv, names, takenNames) = TcSimplePats cenv isMember CheckCxs domainTy env (tpenv, Map.empty, takenNames) spats - let envinner, _, vspecMap = MakeAndPublishSimpleVals cenv env m names true + let envinner, _, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names let byrefs = vspecMap |> Map.map (fun _ v -> isByrefTy cenv.g v.Type, v) let envinner = if isMember then envinner else ExitFamilyRegion envinner let bodyExpr, tpenv = TcIteratedLambdas cenv false envinner resultTy takenNames tpenv bodyExpr @@ -7529,6 +7521,9 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | [] -> callExpr | _ -> mkSynCall "Source" callExpr.Range [callExpr] + let mkSourceExprConditional isFromSource callExpr = + if isFromSource then mkSourceExpr callExpr else callExpr + /// Decide if the builder is an auto-quote builder let isAutoQuote = hasMethInfo "Quote" @@ -7979,7 +7974,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(), nm.idRange)) - let firstSource = if isFromSource then mkSourceExpr firstSource else firstSource + let firstSource = mkSourceExprConditional isFromSource firstSource let secondSource = mkSourceExpr secondSource // Add the variables to the variable space, on demand @@ -8123,11 +8118,12 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SynExpr.ForEach (spForLoop, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _) -> - let wrappedSourceExpr = if isFromSource then mkSourceExpr sourceExpr else sourceExpr + let wrappedSourceExpr = mkSourceExprConditional isFromSource sourceExpr let mFor = match spForLoop with SequencePointAtForLoop m -> m | _ -> pat.Range let mPat = pat.Range let spBind = match spForLoop with SequencePointAtForLoop m -> SequencePointAtBinding m | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("For"), mFor)) + 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 let varSpace = @@ -8149,16 +8145,20 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder let mGuard = guardExpr.Range let mWhile = match spWhile with SequencePointAtWhileLoop m -> m | _ -> mGuard if isQuery then error(Error(FSComp.SR.tcNoWhileInQuery(), mWhile)) - if 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) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mWhile)) + if 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) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mWhile)) Some(trans true q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "While" mWhile [mkSynDelay2 guardExpr; mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) ) | SynExpr.TryFinally (innerComp, unwindExpr, mTryToLast, spTry, _spFinally) -> let mTry = match spTry with SequencePointAtTry m -> m | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcNoTryFinallyInQuery(), mTry)) - if 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 error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) + if 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 + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) Some (translatedCtxt (mkSynCall "TryFinally" mTry [mkSynCall "Delay" mTry [mkSynDelay innerComp.Range (transNoQueryOps innerComp)]; mkSynDelay2 unwindExpr])) | SynExpr.Paren (_, _, _, m) -> @@ -8238,7 +8238,10 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | StripApps(SingleIdent nm, args) -> if args.Length = expectedArgCount then // Check for the [] attribute on each argument position - let args = args |> List.mapi (fun i arg -> if isCustomOperationProjectionParameter (i+1) nm then SynExpr.Lambda (false, false, varSpaceSimplePat, arg, arg.Range.MakeSynthetic()) else arg) + let args = args |> List.mapi (fun i arg -> + if isCustomOperationProjectionParameter (i+1) nm then + SynExpr.Lambda (false, false, varSpaceSimplePat, arg, arg.Range.MakeSynthetic()) + else arg) mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) else errorR(Error(FSComp.SR.tcCustomOperationHasIncorrectArgCount(nm.idText, expectedArgCount, args.Length), nm.idRange)) @@ -8266,7 +8269,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // Rebind using either for ... or let!.... let rebind = if maintainsVarSpaceUsingBind then - SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) + SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, intoPat, dataCompAfterOp, [], contExpr, intoPat.Range) else SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) @@ -8288,7 +8291,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // Rebind using either for ... or let!.... let rebind = if lastUsesBind then - SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, varSpacePat, dataCompPrior, compClausesExpr, compClausesExpr.Range) + SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, varSpacePat, dataCompPrior, [], compClausesExpr, compClausesExpr.Range) else SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, varSpacePat, dataCompPrior, compClausesExpr, compClausesExpr.Range) @@ -8316,8 +8319,10 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // 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 m1 = rangeForCombine innerComp1 - if isNil (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) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), m)) + if isNil (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) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), m)) Some (translatedCtxt (mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]])) | None -> // "do! expr; cexpr" is treated as { let! () = expr in cexpr } @@ -8328,7 +8333,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SuppressSequencePointOnStmtOfSequential -> SequencePointAtBinding m | SuppressSequencePointOnExprOfSequential -> NoSequencePointAtDoBinding | SequencePointsAtSeq -> SequencePointAtBinding m - Some(trans true q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, innerComp2, m)) translatedCtxt) + Some(trans true q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, [], innerComp2, m)) translatedCtxt) + // "expr; cexpr" is treated as sequential execution | _ -> Some (trans true q varSpace innerComp2 (fun holeFill -> @@ -8353,7 +8359,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder Some (translatedCtxt (SynExpr.IfThenElse (guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch))) | None -> let elseComp = - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mIfToThen ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), mIfToThen)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mIfToThen ad "Zero" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), mIfToThen)) mkSynCall "Zero" mIfToThen [] Some (trans true q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse (guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch)))) @@ -8385,7 +8392,6 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // error case error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings(), mQueryOp))) - Some (trans true q varSpace innerComp (fun holeFill -> translatedCtxt (SynExpr.LetOrUse (isRec, false, binds, holeFill, m)))) // 'use x = expr in expr' @@ -8394,16 +8400,18 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if isQuery then error(Error(FSComp.SR.tcUseMayNotBeUsedInQueries(), bindRange)) let innerCompRange = innerComp.Range let consumeExpr = SynExpr.MatchLambda(false, innerCompRange, [Clause(pat, None, transNoQueryOps innerComp, innerCompRange, SequencePointAtTarget)], spBind, innerCompRange) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) Some (translatedCtxt (mkSynCall "Using" bindRange [rhsExpr; consumeExpr ])) - // 'let! pat = expr in expr' --> build.Bind(e1, (function _argN -> match _argN with pat -> expr)) - | SynExpr.LetOrUseBang (spBind, false, isFromSource, pat, rhsExpr, innerComp, _) -> + // '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 (spBind, false, isFromSource, pat, rhsExpr, [], innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) - let innerRange = innerComp.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) // Add the variables to the query variable space, on demand let varSpace = @@ -8412,28 +8420,135 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat, None) vspecs, envinner) - let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr - Some (trans true q varSpace innerComp (fun holeFill -> - let consumeExpr = SynExpr.MatchLambda (false, pat.Range, [Clause(pat, None, holeFill, innerRange, SequencePointAtTarget)], spBind, innerRange) - translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr]))) + let rhsExpr = mkSourceExprConditional isFromSource rhsExpr + Some (transBind q varSpace bindRange "Bind" [rhsExpr] pat spBind 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 (spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat), rhsExpr, innerComp, _) - | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.LongIdent (LongIdentWithDots([id], _), _, _, _, _, _) as pat), rhsExpr, innerComp, _) -> + // '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 (spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat) , rhsExpr, [], innerComp, _) + | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.LongIdent (longDotId=LongIdentWithDots([id], _)) as pat), rhsExpr, [], innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Bind" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) + let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, transNoQueryOps innerComp, innerComp.Range, SequencePointAtTarget)], spBind, bindRange) let consumeExpr = mkSynCall "Using" bindRange [SynExpr.Ident(id); consumeExpr ] let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, consumeExpr, id.idRange, SequencePointAtTarget)], spBind, bindRange) - let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr + let rhsExpr = mkSourceExprConditional isFromSource rhsExpr + // TODO: consider allowing translation to BindReturn Some(translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr])) - // 'use! pat = e1 in e2' where 'pat' is not a simple name --> error - | SynExpr.LetOrUseBang (_spBind, true, _isFromSource, pat, _rhsExpr, _innerComp, _) -> - error(Error(FSComp.SR.tcInvalidUseBangBinding(), pat.Range)) + // 'use! pat = e1 ... in e2' where 'pat' is not a simple name --> error + | SynExpr.LetOrUseBang (_spBind, true, _isFromSource, pat, _rhsExpr, andBangs, _innerComp, _) -> + 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(letSpBind, false, isFromSource, letPat, letRhsExpr, andBangBindings, innerComp, letBindRange) -> + if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then + if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), letBindRange)) + let bindRange = match letSpBind with SequencePointAtBinding m -> m | _ -> letRhsExpr.Range + let sources = (letRhsExpr :: [for (_, _, _, _, andExpr, _) in andBangBindings -> andExpr ]) |> List.map (mkSourceExprConditional isFromSource) + let pats = letPat :: [for (_, _, _, andPat, _, _) in andBangBindings -> andPat ] + let sourcesRange = sources |> List.map (fun e -> e.Range) |> List.reduce unionRanges + + let numSources = sources.Length + let bindReturnNName = "Bind"+string numSources+"Return" + let bindNName = "Bind"+string numSources + + // Check if this is a Bind2Return etc. + let hasBindReturnN = not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindReturnNName builderTy)) + if hasBindReturnN && Option.isSome (convertSimpleReturnToExpr varSpace innerComp) then + let consumePat = SynPat.Tuple(false, pats, letPat.Range) + Some (transBind q varSpace bindRange bindNName sources consumePat letSpBind innerComp translatedCtxt) + + else + + // Check if this is a Bind2 etc. + let hasBindN = not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindNName builderTy)) + if hasBindN then + let consumePat = SynPat.Tuple(false, pats, letPat.Range) + + // Add the variables to the query variable space, on demand + let varSpace = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (consumePat, None) + vspecs, envinner) + + Some (transBind q varSpace bindRange bindNName sources consumePat letSpBind innerComp translatedCtxt) + else + + // 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 bindRange ad mergeSourcesName builderTy) then + (n-1) + else + loop (n+1) + loop 2 + + if maxMergeSources = 1 then error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange)) + + let rec mergeSources (sourcesAndPats: (SynExpr * SynPat) list) = + let numSourcesAndPats = sourcesAndPats.Length + assert (numSourcesAndPats <> 0) + if numSourcesAndPats = 1 then + sourcesAndPats.[0] + + elif numSourcesAndPats <= maxMergeSources then + + // Call MergeSources2(e1, e2), MergeSources3(e1, e2, e3) etc + let mergeSourcesName = mkMergeSourcesName numSourcesAndPats + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then + error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange)) + + let source = mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) + let pat = SynPat.Tuple(false, List.map snd sourcesAndPats, letPat.Range) + source, pat + + 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 bindRange ad mergeSourcesName builderTy) then + error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange)) + + let laterSource, laterPat = mergeSources laterSourcesAndPats + let source = mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [laterSource]) + let pat = SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [laterPat], letPat.Range) + source, pat + + let 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 + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (consumePat, None) + vspecs, envinner) + + // Build the 'Bind' call + Some (transBind q varSpace bindRange "Bind" [mergedSources] consumePat letSpBind innerComp translatedCtxt) + else + error(Error(FSComp.SR.tcAndBangNotSupported(), comp.Range)) | SynExpr.Match (spMatch, expr, clauses, m) -> let mMatch = match spMatch with SequencePointAtBinding mMatch -> mMatch | _ -> m @@ -8445,9 +8560,14 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SynExpr.MatchBang (spMatch, expr, clauses, m) -> let mMatch = match spMatch with SequencePointAtBinding mMatch -> mMatch | _ -> m if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mMatch ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), mMatch)) + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mMatch ad "Bind" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), mMatch)) + let clauses = clauses |> List.map (fun (Clause(pat, cond, innerComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps innerComp, patm, sp)) let consumeExpr = SynExpr.MatchLambda (false, mMatch, clauses, spMatch, mMatch) + + // TODO: consider allowing translation to BindReturn Some(translatedCtxt (mkSynCall "Bind" mMatch [expr; consumeExpr])) | SynExpr.TryWith (innerComp, _mTryToWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) -> @@ -8456,14 +8576,19 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(), mTry)) let clauses = clauses |> List.map (fun (Clause(pat, cond, clauseComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps clauseComp, patm, sp)) let consumeExpr = SynExpr.MatchLambda(true, mTryToLast, clauses, NoSequencePointAtStickyBinding, mTryToLast) - if 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 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)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) + Some(translatedCtxt (mkSynCall "TryWith" mTry [mkSynCall "Delay" mTry [mkSynDelay2 (transNoQueryOps innerComp)]; consumeExpr])) | SynExpr.YieldOrReturnFrom ((isYield, _), yieldExpr, m) -> let yieldExpr = mkSourceExpr yieldExpr if isYield then - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"), m)) Some (translatedCtxt (mkSynCall "YieldFrom" m [yieldExpr])) else @@ -8477,7 +8602,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SynExpr.YieldOrReturn ((isYield, _), yieldExpr, m) -> let methName = (if isYield then "Yield" else "Return") if isQuery && not isYield then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(), m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod(methName), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod(methName), m)) Some(translatedCtxt (mkSynCall methName m [yieldExpr])) | _ -> None @@ -8500,8 +8626,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Return" builderTy) then SynExpr.ImplicitZero m else - SynExpr.YieldOrReturn((false, true), SynExpr.Const (SynConst.Unit, m), m) - trans true q varSpace (SynExpr.LetOrUseBang(NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt + SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) + trans true q varSpace (SynExpr.LetOrUseBang (NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, [], bodyExpr, m)) translatedCtxt // "expr;" in final position is treated as { expr; zero } // Suppress the sequence point on the "zero" @@ -8523,6 +8649,104 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder SynExpr.Sequential(SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range) translatedCtxt fillExpr) + and transBind q varSpace bindRange bindName bindArgs (consumePat: SynPat) spBind (innerComp: SynExpr) translatedCtxt = + + let innerRange = innerComp.Range + + let innerCompReturn = + if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then + convertSimpleReturnToExpr varSpace innerComp + else None + + match innerCompReturn with + | Some innerExpr when + (let bindName = bindName + "Return" + not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy))) -> + + let bindName = bindName + "Return" + + // Build the `BindReturn` call + let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [Clause(consumePat, None, innerExpr, innerRange, SequencePointAtTarget)], spBind, innerRange) + translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [consumeExpr])) + + | _ -> + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod(bindName), bindRange)) + + // Build the `Bind` call + trans true q varSpace innerComp (fun holeFill -> + let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [Clause(consumePat, None, holeFill, innerRange, SequencePointAtTarget)], spBind, innerRange) + translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [consumeExpr]))) + + and convertSimpleReturnToExpr varSpace innerComp = + match innerComp with + | SynExpr.YieldOrReturn ((false, _), returnExpr, _) -> Some returnExpr + | SynExpr.Match (spMatch, expr, clauses, m) -> + let clauses = + clauses |> List.map (fun (Clause(pat, cond, innerComp2, patm, sp)) -> + match convertSimpleReturnToExpr varSpace innerComp2 with + | None -> None + | Some innerExpr2 -> Some (Clause(pat, cond, innerExpr2, patm, sp))) + if clauses |> List.forall Option.isSome then + Some (SynExpr.Match (spMatch, expr, (clauses |> List.map Option.get), m)) + else + None + + | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) -> + match convertSimpleReturnToExpr varSpace thenComp with + | None -> None + | Some thenExpr -> + match Option.map (convertSimpleReturnToExpr varSpace) elseCompOpt with + | Some None -> None + | elseExprOpt -> + Some (SynExpr.IfThenElse (guardExpr, thenExpr, Option.bind id elseExprOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) ) + + | SynExpr.LetOrUse (isRec, false, binds, innerComp, m) -> + match convertSimpleReturnToExpr varSpace innerComp with + | None -> None + | Some innerExpr -> Some (SynExpr.LetOrUse (isRec, false, binds, innerExpr, m)) + + | SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) -> + + // Check the first part isn't a computation expression construct + if isSimpleExpr innerComp1 then + // Check the second part is a simple return + match convertSimpleReturnToExpr varSpace innerComp2 with + | None -> None + | Some innerExpr2 -> Some (SynExpr.Sequential (sp, true, innerComp1, innerExpr2, m)) + else + None + + | _ -> None + + /// Check is an expression has no computation expression constructs + and isSimpleExpr comp = + + match comp with + | ForEachThenJoinOrGroupJoinOrZipClause _ -> false + | SynExpr.ForEach _ -> false + | SynExpr.For _ -> false + | SynExpr.While _ -> false + | SynExpr.TryFinally _ -> false + | SynExpr.ImplicitZero _ -> false + | OptionalSequential (JoinOrGroupJoinOrZipClause _, _) -> false + | OptionalSequential (CustomOperationClause _, _) -> false + | SynExpr.Sequential (_, _, innerComp1, innerComp2, _) -> isSimpleExpr innerComp1 && isSimpleExpr innerComp2 + | SynExpr.IfThenElse (_, thenComp, elseCompOpt, _, _, _, _) -> + isSimpleExpr thenComp && (match elseCompOpt with None -> true | Some c -> isSimpleExpr c) + | SynExpr.LetOrUse (_, _, _, innerComp, _) -> isSimpleExpr innerComp + | SynExpr.LetOrUseBang _ -> false + | SynExpr.Match (_, _, clauses, _) -> + clauses |> List.forall (fun (Clause(_, _, innerComp, _, _)) -> isSimpleExpr innerComp) + | SynExpr.MatchBang _ -> false + | SynExpr.TryWith (innerComp, _, clauses, _, _, _, _) -> + isSimpleExpr innerComp && + clauses |> List.forall (fun (Clause(_, _, clauseComp, _, _)) -> isSimpleExpr clauseComp) + | SynExpr.YieldOrReturnFrom _ -> false + | SynExpr.YieldOrReturn _ -> false + | _ -> true + let basicSynExpr = trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill) @@ -8546,7 +8770,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder SynExpr.Lambda (false, false, SynSimplePats.SimplePats ([mkSynSimplePatVar false (mkSynId mBuilderVal builderValName)], mBuilderVal), runExpr, mBuilderVal) let env = - match comp with + match comp with | SynExpr.YieldOrReturn ((true, _), _, _) -> { env with eContextInfo = ContextInfo.YieldInComputationExpression } | SynExpr.YieldOrReturn ((_, true), _, _) -> { env with eContextInfo = ContextInfo.ReturnInComputationExpression } | _ -> env @@ -8693,7 +8917,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = //SEQPOINT NEEDED - we must consume spBind on this path Some(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) - | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> + | SynExpr.LetOrUseBang (range=m) -> error(Error(FSComp.SR.tcUseForInSequenceExpression(), m)) | SynExpr.Match (spMatch, expr, clauses, _) -> @@ -8711,7 +8935,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let matchv, matchExpr = CompilePatternForMatchClauses cenv env inputExprMark inputExprMark true ThrowIncompleteMatchException (Some inputExpr) inputExprTy genOuterTy tclauses Some(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) - | SynExpr.TryWith (_, mTryToWith, _, _, _, _, _) -> + | SynExpr.TryWith (tryRange=mTryToWith) -> error(Error(FSComp.SR.tcTryIllegalInSequenceExpression(), mTryToWith)) | SynExpr.YieldOrReturnFrom ((isYield, _), yieldExpr, m) -> @@ -10587,7 +10811,7 @@ and TcAndPatternCompileMatchClauses mExpr matchm actionOnFailure cenv inputExprO and TcMatchPattern cenv inputTy env tpenv (pat: SynPat, optWhenExpr) = let m = pat.Range let patf', (tpenv, names, _) = TcPat WarnOnUpperCase cenv env None (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, false) (tpenv, Map.empty, Set.empty) inputTy pat - let envinner, values, vspecMap = MakeAndPublishSimpleVals cenv env m names false + let envinner, values, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names let optWhenExpr', tpenv = match optWhenExpr with | Some whenExpr -> @@ -12670,7 +12894,7 @@ module IncrClassChecking = let ctorArgNames, (_, names, _) = TcSimplePatsOfUnknownType cenv true CheckCxs env tpenv (SynSimplePats.SimplePats (spats, m)) // Create the values with the given names - let _, vspecs = MakeSimpleVals cenv env names + let _, vspecs = MakeAndPublishSimpleVals cenv env names if tcref.IsStructOrEnumTycon && isNil spats then errorR (ParameterlessStructCtor(tcref.Range)) diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 524f73965ed..40e90b679a4 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -764,12 +764,13 @@ and /// Computation expressions only | YieldOrReturnFrom of (bool * bool) * expr: SynExpr * range: range - /// SynExpr.LetOrUseBang (spBind, isUse, isFromSource, pat, rhsExpr, bodyExpr, mWholeExpr). + /// SynExpr.LetOrUseAndBang (spBind, isUse, isFromSource, pat, rhsExpr, mLetBangExpr, [(andBangSpBind, andBangIsUse, andBangIsFromSource, andBangPat, andBangRhsExpr, mAndBangExpr)], bodyExpr). /// /// F# syntax: let! pat = expr in expr /// F# syntax: use! pat = expr in expr + /// F# syntax: let! pat = expr and! ... and! ... and! pat = expr in expr /// Computation expressions only - | LetOrUseBang of bindSeqPoint: SequencePointInfoForBinding * isUse: bool * isFromSource: bool * SynPat * SynExpr * SynExpr * range: range + | LetOrUseBang of bindSeqPoint: SequencePointInfoForBinding * isUse: bool * isFromSource: bool * SynPat * rhs: SynExpr * andBangs:(SequencePointInfoForBinding * bool * bool * SynPat * SynExpr * range) list * body:SynExpr * range: range /// F# syntax: match! expr with pat1 -> expr | ... | patN -> exprN | MatchBang of matchSeqPoint: SequencePointInfoForBinding * expr: SynExpr * clauses: SynMatchClause list * range: range (* bool indicates if this is an exception match in a computation expression which throws unmatched exceptions *) @@ -2475,6 +2476,6 @@ let rec synExprContainsError inpExpr = | SynExpr.MatchBang (_, e, cl, _) -> walkExpr e || walkMatchClauses cl - | SynExpr.LetOrUseBang (_, _, _, _, e1, e2, _) -> - walkExpr e1 || walkExpr e2 + | SynExpr.LetOrUseBang (rhs=e1;body=e2;andBangs=es) -> + walkExpr e1 || walkExprs [ for (_,_,_,_,e,_) in es do yield e ] || walkExpr e2 walkExpr inpExpr diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index 901a203b832..5970e1fb8c0 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -233,10 +233,12 @@ rule token args skip = parse { YIELD_BANG(false) } | "match!" { MATCH_BANG } + | "and!" + { AND_BANG(false) } | ident '!' { let tok = Keywords.KeywordOrIdentifierToken args lexbuf (lexemeTrimRight lexbuf 1) match tok with - | LET _ -> BINDER (lexemeTrimRight lexbuf 1) + | LET _ -> BINDER (lexemeTrimRight lexbuf 1) | _ -> fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("!")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) } | ident ('#') { fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("#")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) } diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index e1d888196b5..66ee0bd792e 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -189,7 +189,7 @@ let rangeOfLongIdent(lid:LongIdent) = %token CHAR %token DECIMAL %token <(string * string)> BIGNUM -%token LET YIELD YIELD_BANG +%token LET YIELD YIELD_BANG AND_BANG %token LESS GREATER /* here the bool indicates if the tokens are part of a type application or type parameter declaration, e.g. C, detected by the lex filter */ %token PERCENT_OP BINDER %token LQUOTE RQUOTE RQUOTE_DOT @@ -218,6 +218,7 @@ let rangeOfLongIdent(lid:LongIdent) = /* for offside rule */ %token OLET /* LexFilter #light converts 'LET' tokens to 'OLET' when starting (CtxtLetDecl(blockLet=true)) */ %token OBINDER /* LexFilter #light converts 'BINDER' tokens to 'OBINDER' when starting (CtxtLetDecl(blockLet=true)) */ +%token OAND_BANG /* LexFilter #light converts 'AND_BANG' tokens to 'OAND_BANG' when starting (CtxtLetDecl(blockLet=true)) */ %token ODO /* LexFilter #light converts 'DO' tokens to 'ODO' */ %token ODO_BANG /* LexFilter #light converts 'DO_BANG' tokens to 'ODO_BANG' */ %token OTHEN /* LexFilter #light converts 'THEN' tokens to 'OTHEN' */ @@ -453,7 +454,8 @@ let rangeOfLongIdent(lid:LongIdent) = %nonassoc paren_pat_colon %nonassoc paren_pat_attribs %left OR BAR_BAR JOIN_IN -%left AND /* check */ +%left AND +%left AND_BANG %left AMP AMP_AMP %nonassoc pat_conj %nonassoc expr_not @@ -3060,6 +3062,20 @@ recover: | error { debugPrint("recovering via error"); true } | EOF { debugPrint("recovering via EOF"); false } +morebinders: + | AND_BANG headBindingPattern EQUALS typedSeqExprBlock IN morebinders %prec expr_let + { let spBind = SequencePointAtBinding(rhs2 parseState 1 5) (* TODO Pretty sure this is wrong *) + let m = rhs parseState 1 (* TODO Pretty sure this is wrong *) + (spBind,$1,true,$2,$4,m) :: $6 } + + | OAND_BANG headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP morebinders %prec expr_let + { $5 "and!" (rhs parseState 1) // report unterminated error + let spBind = SequencePointAtBinding(rhs2 parseState 1 5) (* TODO Pretty sure this is wrong *) + let m = rhs parseState 1 (* TODO Pretty sure this is wrong *) + (spBind,$1,true,$2,$4,m) :: $7 } + + | %prec prec_no_more_attr_bindings + { [] } declExpr: | defnBindings IN typedSeqExpr %prec expr_let @@ -3353,27 +3369,35 @@ declExpr: | YIELD_BANG declExpr { SynExpr.YieldOrReturnFrom (($1,not $1), $2, unionRanges (rhs parseState 1) $2.Range) } - | BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let + | YIELD recover + { let mYieldAll = rhs parseState 1 + SynExpr.YieldOrReturn (($1, not $1), arbExpr("yield", mYieldAll), mYieldAll) } + + | YIELD_BANG recover + { let mYieldAll = rhs parseState 1 + SynExpr.YieldOrReturnFrom (($1, not $1), arbExpr("yield!", mYieldAll), mYieldAll) } + + | BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP morebinders typedSeqExprBlock %prec expr_let { let spBind = SequencePointAtBinding(rhs2 parseState 1 5) - let m = unionRanges (rhs parseState 1) $7.Range - SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) } + let m = unionRanges (rhs parseState 1) $8.Range + SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, $7, $8, m) } - | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP typedSeqExprBlock %prec expr_let + | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP morebinders typedSeqExprBlock %prec expr_let { $5 (if $1 = "use" then "use!" else "let!") (rhs parseState 1) // report unterminated error let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) - let m = unionRanges (rhs parseState 1) $7.Range - SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) } + let m = unionRanges (rhs parseState 1) $8.Range + SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, $7, $8, m) } | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP error %prec expr_let { // error recovery that allows intellisense when writing incomplete computation expressions let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) let mAll = unionRanges (rhs parseState 1) (rhs parseState 7) let m = $4.Range.EndRange // zero-width range - SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4, SynExpr.ImplicitZero m, mAll) } + SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, [], SynExpr.ImplicitZero m, mAll) } | DO_BANG typedSeqExpr IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let { let spBind = NoSequencePointAtDoBinding - SynExpr.LetOrUseBang (spBind,false,true,SynPat.Const(SynConst.Unit,$2.Range),$2,$5, unionRanges (rhs parseState 1) $5.Range) } + SynExpr.LetOrUseBang(spBind, false, true, SynPat.Const(SynConst.Unit,$2.Range), $2, [], $5, unionRanges (rhs parseState 1) $5.Range) } | ODO_BANG typedSeqExprBlock hardwhiteDefnBindingsTerminator %prec expr_let { SynExpr.DoBang ($2, unionRanges (rhs parseState 1) $2.Range) } diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index e495fa0428c..b826728b477 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -703,9 +703,13 @@ module ParsedInput = addLongIdentWithDots ident List.iter walkExpr [e1; e2; e3] | SynExpr.JoinIn (e1, _, e2, _) -> List.iter walkExpr [e1; e2] - | SynExpr.LetOrUseBang (_, _, _, pat, e1, e2, _) -> + | SynExpr.LetOrUseBang (_, _, _, pat, e1, es, e2, _) -> walkPat pat - List.iter walkExpr [e1; e2] + walkExpr e1 + for (_,_,_,patAndBang,eAndBang,_) in es do + walkPat patAndBang + walkExpr eAndBang + walkExpr e2 | SynExpr.TraitCall (ts, sign, e, _) -> List.iter walkTypar ts walkMemberSig sign diff --git a/src/fsharp/service/ServiceInterfaceStubGenerator.fs b/src/fsharp/service/ServiceInterfaceStubGenerator.fs index dfaa9a537ae..e5461138bfd 100644 --- a/src/fsharp/service/ServiceInterfaceStubGenerator.fs +++ b/src/fsharp/service/ServiceInterfaceStubGenerator.fs @@ -896,8 +896,14 @@ module InterfaceStubGenerator = | SynExpr.DoBang (synExpr, _range) -> walkExpr synExpr - | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, _synPat, synExpr1, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, _synPat, synExpr1, synExprAndBangs, synExpr2, _range) -> + [ + yield synExpr1 + for (_,_,_,_,eAndBang,_) in synExprAndBangs do + yield eAndBang + yield synExpr2 + ] + |> List.tryPick walkExpr | SynExpr.LibraryOnlyILAssembly _ | SynExpr.LibraryOnlyStaticOptimization _ diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs old mode 100644 new mode 100755 index e0792c9d2a8..a0e2d57893e --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -261,14 +261,14 @@ module internal TokenClassifications = | MEMBER | STATIC | NAMESPACE | OASSERT | OLAZY | ODECLEND | OBLOCKSEP | OEND | OBLOCKBEGIN | ORIGHT_BLOCK_END | OBLOCKEND | OBLOCKEND_COMING_SOON | OBLOCKEND_IS_HERE | OTHEN | OELSE | OLET(_) - | OBINDER _ | BINDER _ | ODO | OWITH | OFUNCTION | OFUN | ORESET | ODUMMY _ | DO_BANG + | OBINDER _ | OAND_BANG _ | BINDER _ | ODO | OWITH | OFUNCTION | OFUN | ORESET | ODUMMY _ | DO_BANG | ODO_BANG | YIELD _ | YIELD_BANG _ | OINTERFACE_MEMBER | ELIF | RARROW | LARROW | SIG | STRUCT | UPCAST | DOWNCAST | NULL | RESERVED | MODULE | AND | AS | ASSERT | ASR | DOWNTO | EXCEPTION | FALSE | FOR | FUN | FUNCTION | FINALLY | LAZY | MATCH | MATCH_BANG | MUTABLE | NEW | OF | OPEN | OR | VOID | EXTERN | INTERFACE | REC | TO | TRUE | TRY | TYPE | VAL | INLINE | WHEN | WHILE | WITH - | IF | THEN | ELSE | DO | DONE | LET(_) | IN (*| NAMESPACE*) | CONST + | IF | THEN | ELSE | DO | DONE | LET _ | AND_BANG _ | IN | CONST | HIGH_PRECEDENCE_PAREN_APP | FIXED | HIGH_PRECEDENCE_BRACK_APP | TYPE_COMING_SOON | TYPE_IS_HERE | MODULE_COMING_SOON | MODULE_IS_HERE -> diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index eeab436524f..a1c42f7fa75 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -473,10 +473,16 @@ module public AstTraversal = | SynExpr.ImplicitZero (_range) -> None | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, synPat, synExpr, synExpr2, _range) -> - [dive synPat synPat.Range traversePat - dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, synPat, synExpr, andBangSynExprs, synExpr2, _range) -> + [ + yield dive synPat synPat.Range traversePat + yield dive synExpr synExpr.Range traverseSynExpr + yield! + [ for (_,_,_,andBangSynPat,andBangSynExpr,_) in andBangSynExprs do + yield (dive andBangSynPat andBangSynPat.Range traversePat) + yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr)] + yield dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr | SynExpr.MatchBang (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> [yield dive synExpr synExpr.Range traverseSynExpr diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 56f2312da46..8df0fedbb89 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -245,14 +245,21 @@ module Structure = | SynExpr.DoBang (e, r) -> rcheck Scope.Do Collapse.Below r <| Range.modStart 3 r parseExpr e - | SynExpr.LetOrUseBang (_, _, _, pat, e1, e2, _) -> - // for `let!` or `use!` the pattern begins at the end of the keyword so that - // this scope can be used without adjustment if there is no `=` on the same line - // if there is an `=` the range will be adjusted during the tooltip creation - let r = Range.endToEnd pat.Range e1.Range - rcheck Scope.LetOrUseBang Collapse.Below r r - parseExpr e1 - parseExpr e2 + | SynExpr.LetOrUseBang (_, _, _, pat, eLet, es, eBody, _) -> + [ + yield eLet + yield! [ for (_,_,_,_,eAndBang,_) in es do yield eAndBang ] + ] + |> List.iter (fun e -> + // for `let!`, `use!` or `and!` the pattern begins at the end of the + // keyword so that this scope can be used without adjustment if there is no `=` + // on the same line. If there is an `=` the range will be adjusted during the + // tooltip creation + let r = Range.endToEnd pat.Range e.Range + rcheck Scope.LetOrUseBang Collapse.Below r r + parseExpr e + ) + parseExpr eBody | SynExpr.For (_, _, _, _, _, e, r) | SynExpr.ForEach (_, _, _, _, _, e, r) -> rcheck Scope.For Collapse.Below r r diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index f1422794746..399b3e87914 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -322,9 +322,12 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op yield! walkExpr false e2 yield! walkExpr false e3 - | SynExpr.LetOrUseBang (spBind, _, _, _, e1, e2, _) -> + | SynExpr.LetOrUseBang (spBind, _, _, _, e1, es, e2, _) -> yield! walkBindSeqPt spBind yield! walkExpr true e1 + for (andBangSpBind,_,_,_,eAndBang,_) in es do + yield! walkBindSeqPt andBangSpBind + yield! walkExpr true eAndBang yield! walkExpr true e2 | SynExpr.MatchBang (spBind, e, cl, _) -> @@ -880,7 +883,14 @@ module UntypedParseImpl = | SynExpr.Match (_, e, synMatchClauseList, _) | SynExpr.MatchBang (_, e, synMatchClauseList, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause synMatchClauseList) - | SynExpr.LetOrUseBang (_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.LetOrUseBang(_, _, _, _, e1, es, e2, _) -> + [ + yield e1 + for (_,_,_,_,eAndBang,_) in es do + yield eAndBang + yield e2 + ] + |> List.tryPick (walkExprWithKind parentKind) | SynExpr.DoBang (e, _) -> walkExprWithKind parentKind e | SynExpr.TraitCall (ts, sign, e, _) -> List.tryPick walkTypar ts diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index a2e4bf20810..3d85d19f7f4 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -57,6 +57,11 @@ Algoritmus {0} není podporovaný. + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Atributy nejde použít pro rozšíření typů. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. Není definovaný obor názvů {0}. diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index baf48ce914b..d3266324ea4 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -57,6 +57,11 @@ Algorithmus "{0}" wird nicht unterstützt + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Attribute können nicht auf Typerweiterungen angewendet werden. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. Der Namespace "{0}" ist nicht definiert. diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 1d82a7a42cf..0fbf10ee041 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -57,6 +57,11 @@ No se admite el algoritmo '{0}' + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Los atributos no se pueden aplicar a las extensiones de tipo. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. El espacio de nombres "{0}" no está definido. diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 54296abddfd..208b5df146f 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -57,6 +57,11 @@ Algorithme '{0}' non pris en charge + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Impossible d'appliquer des attributs aux extensions de type. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. L'espace de noms '{0}' n'est pas défini. diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 850e1233e6a..87607c68dde 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -57,6 +57,11 @@ L'algoritmo '{0}' non è supportato + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Gli attributi non possono essere applicati a estensioni di tipo. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. Lo spazio dei nomi '{0}' non è definito. diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 9267524fe89..fc807fd3da9 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -57,6 +57,11 @@ アルゴリズム '{0}' はサポートされていません + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ 属性を型拡張に適用することはできません。 + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. 名前空間 '{0}' が定義されていません。 diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index 9aab61aa0f9..4354b83a019 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -57,6 +57,11 @@ {0}' 알고리즘은 지원되지 않습니다. + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ 형식 확장에 특성을 적용할 수 없습니다. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. '{0}' 네임스페이스가 정의되지 않았습니다. diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index 07c155e3203..2f9150028e5 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -57,6 +57,11 @@ Algorytm „{0}” nie jest obsługiwany + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Atrybutów nie można stosować do rozszerzeń typu. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. Nie zdefiniowano przestrzeni nazw „{0}”. diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index d6a95f10f37..f09542103c3 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -57,6 +57,11 @@ Algoritmo '{0}' sem suporte + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Os atributos não podem ser aplicados às extensões de tipo. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. O namespace '{0}' não está definido. diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index d364e6e039c..0460038d6f9 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -57,6 +57,11 @@ Алгоритм "{0}" не поддерживается + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Атрибуты не могут быть применены к расширениям типа. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. Пространство имен "{0}" не определено. diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 2f05dd2afee..8df54eda5f9 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -57,6 +57,11 @@ {0}' algoritması desteklenmiyor + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ Öznitelikler tür uzantılarına uygulanamaz. + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. '{0}' ad alanı tanımlı değil. diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index 9ee2a500ffe..daf8925fab2 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -57,6 +57,11 @@ 不支持算法“{0}” + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ 属性不可应用于类型扩展。 + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. 未定义命名空间“{0}”。 diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index ce66cb1b949..3fe7318b45e 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -57,6 +57,11 @@ 不支援演算法 '{0}' + + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature. + + This is the wrong anonymous record. It should have the fields {0}. This is the wrong anonymous record. It should have the fields {0}. @@ -77,6 +82,16 @@ 屬性無法套用到類型延伸模組。 + + use! may not be combined with and! + use! may not be combined with and! + + + + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '{0}' method or appropriate 'MergeSource' and 'Bind' methods + + The namespace '{0}' is not defined. 未定義命名空間 '{0}'。 diff --git a/src/fsharp/xlf/FSStrings.cs.xlf b/src/fsharp/xlf/FSStrings.cs.xlf index b998717df6e..c5ba4efd986 100644 --- a/src/fsharp/xlf/FSStrings.cs.xlf +++ b/src/fsharp/xlf/FSStrings.cs.xlf @@ -1627,6 +1627,11 @@ symbol |} + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.de.xlf b/src/fsharp/xlf/FSStrings.de.xlf index f1ee5ebd68c..c31cfafe2cb 100644 --- a/src/fsharp/xlf/FSStrings.de.xlf +++ b/src/fsharp/xlf/FSStrings.de.xlf @@ -1627,6 +1627,11 @@ Symbol "|}" + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.es.xlf b/src/fsharp/xlf/FSStrings.es.xlf index 00665ca3070..772bda82f20 100644 --- a/src/fsharp/xlf/FSStrings.es.xlf +++ b/src/fsharp/xlf/FSStrings.es.xlf @@ -1627,6 +1627,11 @@ símbolo "|}" + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.fr.xlf b/src/fsharp/xlf/FSStrings.fr.xlf index fc0e0f6e756..e6e3707de7b 100644 --- a/src/fsharp/xlf/FSStrings.fr.xlf +++ b/src/fsharp/xlf/FSStrings.fr.xlf @@ -1627,6 +1627,11 @@ symbole '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.it.xlf b/src/fsharp/xlf/FSStrings.it.xlf index cd9a47d880a..7b0bb4c2867 100644 --- a/src/fsharp/xlf/FSStrings.it.xlf +++ b/src/fsharp/xlf/FSStrings.it.xlf @@ -1627,6 +1627,11 @@ simbolo '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.ja.xlf b/src/fsharp/xlf/FSStrings.ja.xlf index 26a7e52ea19..12b8412734d 100644 --- a/src/fsharp/xlf/FSStrings.ja.xlf +++ b/src/fsharp/xlf/FSStrings.ja.xlf @@ -1627,6 +1627,11 @@ シンボル '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.ko.xlf b/src/fsharp/xlf/FSStrings.ko.xlf index d6921f25eb3..b4b1f75b9be 100644 --- a/src/fsharp/xlf/FSStrings.ko.xlf +++ b/src/fsharp/xlf/FSStrings.ko.xlf @@ -1627,6 +1627,11 @@ 기호 '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.pl.xlf b/src/fsharp/xlf/FSStrings.pl.xlf index 1bb0d77df7b..3f18d2c2364 100644 --- a/src/fsharp/xlf/FSStrings.pl.xlf +++ b/src/fsharp/xlf/FSStrings.pl.xlf @@ -1627,6 +1627,11 @@ symbol „|}” + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.pt-BR.xlf b/src/fsharp/xlf/FSStrings.pt-BR.xlf index 180bd4449df..ee303bbedeb 100644 --- a/src/fsharp/xlf/FSStrings.pt-BR.xlf +++ b/src/fsharp/xlf/FSStrings.pt-BR.xlf @@ -1627,6 +1627,11 @@ símbolo '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.ru.xlf b/src/fsharp/xlf/FSStrings.ru.xlf index 3951b3192b6..dcea3abcf12 100644 --- a/src/fsharp/xlf/FSStrings.ru.xlf +++ b/src/fsharp/xlf/FSStrings.ru.xlf @@ -1627,6 +1627,11 @@ Обозначение '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.tr.xlf b/src/fsharp/xlf/FSStrings.tr.xlf index f2acceada26..8c776350a4b 100644 --- a/src/fsharp/xlf/FSStrings.tr.xlf +++ b/src/fsharp/xlf/FSStrings.tr.xlf @@ -1627,6 +1627,11 @@ sembol '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.zh-Hans.xlf b/src/fsharp/xlf/FSStrings.zh-Hans.xlf index ab04ab42601..14245558ce7 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hans.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hans.xlf @@ -1627,6 +1627,11 @@ 符号 "|}" + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/src/fsharp/xlf/FSStrings.zh-Hant.xlf b/src/fsharp/xlf/FSStrings.zh-Hant.xlf index 3fd801411f3..70e5ec8c063 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hant.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hant.xlf @@ -1627,6 +1627,11 @@ 符號 '|}' + + keyword 'and!' + keyword 'and!' + + \ No newline at end of file diff --git a/tests/fsharp/Compiler/CompilerAssert.fs b/tests/fsharp/Compiler/CompilerAssert.fs index ef0e591a0c1..f38a105287d 100644 --- a/tests/fsharp/Compiler/CompilerAssert.fs +++ b/tests/fsharp/Compiler/CompilerAssert.fs @@ -415,45 +415,58 @@ let main argv = 0""" Assert.IsEmpty(typeCheckResults.Errors, sprintf "Type Check errors: %A" typeCheckResults.Errors) - static member TypeCheckWithErrorsAndOptions options (source: string) expectedTypeErrors = + static member TypeCheckWithErrorsAndOptionsAndAdjust options libAdjust (source: string) expectedTypeErrors = lock gate <| fun () -> - let parseResults, fileAnswer = - checker.ParseAndCheckFileInProject( - "test.fs", - 0, - SourceText.ofString source, - { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}) - |> Async.RunSynchronously - - Assert.IsEmpty(parseResults.Errors, sprintf "Parse errors: %A" parseResults.Errors) + let errors = + let parseResults, fileAnswer = + checker.ParseAndCheckFileInProject( + "test.fs", + 0, + SourceText.ofString source, + { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}) + |> Async.RunSynchronously + + if parseResults.Errors.Length > 0 then + parseResults.Errors + else - match fileAnswer with - | FSharpCheckFileAnswer.Aborted _ -> Assert.Fail("Type Checker Aborted") - | FSharpCheckFileAnswer.Succeeded(typeCheckResults) -> + match fileAnswer with + | FSharpCheckFileAnswer.Aborted _ -> Assert.Fail("Type Checker Aborted"); [| |] + | FSharpCheckFileAnswer.Succeeded(typeCheckResults) -> typeCheckResults.Errors let errors = - typeCheckResults.Errors + errors |> Array.distinctBy (fun e -> e.Severity, e.ErrorNumber, e.StartLineAlternate, e.StartColumn, e.EndLineAlternate, e.EndColumn, e.Message) + |> Array.map (fun info -> + (info.Severity, info.ErrorNumber, (info.StartLineAlternate - libAdjust, info.StartColumn + 1, info.EndLineAlternate - libAdjust, info.EndColumn + 1), info.Message)) - Assert.AreEqual(Array.length expectedTypeErrors, errors.Length, sprintf "Type check errors: %A" errors) + let checkEqual k a b = + if a <> b then + Assert.AreEqual(a, b, sprintf "Mismatch in %s, expected '%A', got '%A'.\nAll errors:\n%A" k a b errors) + + checkEqual "Type Check Errors" (Array.length expectedTypeErrors) errors.Length Array.zip errors expectedTypeErrors - |> Array.iter (fun (info, expectedError) -> - let (expectedServerity: FSharpErrorSeverity, expectedErrorNumber: int, expectedErrorRange: int * int * int * int, expectedErrorMsg: string) = expectedError - Assert.AreEqual(expectedServerity, info.Severity) - Assert.AreEqual(expectedErrorNumber, info.ErrorNumber, "expectedErrorNumber") - Assert.AreEqual(expectedErrorRange, (info.StartLineAlternate, info.StartColumn + 1, info.EndLineAlternate, info.EndColumn + 1), "expectedErrorRange") - Assert.AreEqual(expectedErrorMsg, info.Message, "expectedErrorMsg") + |> Array.iter (fun (actualError, expectedError) -> + let (expectedSeverity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg) = expectedError + let (actualSeverity, actualErrorNumber, actualErrorRange, actualErrorMsg) = actualError + checkEqual "Severity" expectedSeverity actualSeverity + checkEqual "ErrorNumber" expectedErrorNumber actualErrorNumber + checkEqual "ErrorRange" expectedErrorRange actualErrorRange + checkEqual "Message" expectedErrorMsg actualErrorMsg ) + static member TypeCheckWithErrorsAndOptions options (source: string) expectedTypeErrors = + CompilerAssert.TypeCheckWithErrorsAndOptionsAndAdjust options 0 (source: string) expectedTypeErrors + static member TypeCheckWithErrors (source: string) expectedTypeErrors = CompilerAssert.TypeCheckWithErrorsAndOptions [||] source expectedTypeErrors - static member TypeCheckSingleErrorWithOptions options (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = - CompilerAssert.TypeCheckWithErrorsAndOptions options source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] + static member TypeCheckSingleErrorWithOptions options (source: string) (expectedSeverity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = + CompilerAssert.TypeCheckWithErrorsAndOptions options source [| expectedSeverity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] - static member TypeCheckSingleError (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = - CompilerAssert.TypeCheckWithErrors source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] + static member TypeCheckSingleError (source: string) (expectedSeverity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = + CompilerAssert.TypeCheckWithErrors source [| expectedSeverity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] static member CompileExeWithOptions options (source: string) = compile true options source (fun (errors, _) -> @@ -543,8 +556,8 @@ let main argv = 0""" Array.zip errors expectedParseErrors |> Array.iter (fun (info, expectedError) -> - let (expectedServerity: FSharpErrorSeverity, expectedErrorNumber: int, expectedErrorRange: int * int * int * int, expectedErrorMsg: string) = expectedError - Assert.AreEqual(expectedServerity, info.Severity) + let (expectedSeverity: FSharpErrorSeverity, expectedErrorNumber: int, expectedErrorRange: int * int * int * int, expectedErrorMsg: string) = expectedError + Assert.AreEqual(expectedSeverity, info.Severity) Assert.AreEqual(expectedErrorNumber, info.ErrorNumber, "expectedErrorNumber") Assert.AreEqual(expectedErrorRange, (info.StartLineAlternate, info.StartColumn + 1, info.EndLineAlternate, info.EndColumn + 1), "expectedErrorRange") Assert.AreEqual(expectedErrorMsg, info.Message, "expectedErrorMsg") diff --git a/tests/fsharp/Compiler/Conformance/DataExpressions/ComputationExpressions.fs b/tests/fsharp/Compiler/Conformance/DataExpressions/ComputationExpressions.fs new file mode 100644 index 00000000000..5ff853eca0f --- /dev/null +++ b/tests/fsharp/Compiler/Conformance/DataExpressions/ComputationExpressions.fs @@ -0,0 +1,628 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework +open FSharp.Compiler.SourceCodeServices + +[] +module ``ComputationExpressions`` = + let tmp = 1 + + let applicativeLib (opts: {| includeMergeSourcesOverloads: bool |}) = + """ +/// Used for tracking what operations a Trace builder was asked to perform +[] +type TraceOp = + | ApplicativeBind + | ApplicativeBind2 + | ApplicativeBindReturn + | ApplicativeBind2Return + | ApplicativeReturn + | ApplicativeCombine + | ApplicativeYield + | MergeSources + | MergeSources3 + | MergeSources4 + | MonadicBind + | MonadicBind2 + | MonadicReturn + | Run + | Delay + | Log of string + +/// A pseudo identity functor +type Trace<'T>(v: 'T) = + member x.Value = v + override this.ToString () = + sprintf "%+A" v + +/// A builder which records what operations it is asked to perform +type TraceCore() = + + let mutable trace = ResizeArray<_>() + + member _.GetTrace () = trace.ToArray() + + member _.Trace x = trace.Add(x) + +type TraceMergeSourcesCore() = + inherit TraceCore() + + member builder.MergeSources(x1: Trace<'T1>, x2: Trace<'T2>) : Trace<'T1 * 'T2> = + builder.Trace TraceOp.MergeSources + Trace (x1.Value, x2.Value) + """ + (if opts.includeMergeSourcesOverloads then """ + + // Note the struct tuple is acceptable + member builder.MergeSources3(x1: Trace<'T1>, x2: Trace<'T2>, x3: Trace<'T3>) : Trace = + builder.Trace TraceOp.MergeSources3 + Trace (struct (x1.Value, x2.Value, x3.Value)) + + member builder.MergeSources4(x1: Trace<'T1>, x2: Trace<'T2>, x3: Trace<'T3>, x4: Trace<'T4>) : Trace<'T1 * 'T2 * 'T3 * 'T4> = + builder.Trace TraceOp.MergeSources4 + Trace (x1.Value, x2.Value, x3.Value, x4.Value) + """ else "") + """ + +type TraceApplicative() = + inherit TraceMergeSourcesCore() + + member builder.BindReturn(x: Trace<'T1>, f: 'T1 -> 'T2) : Trace<'T2> = + builder.Trace TraceOp.ApplicativeBindReturn + Trace (f x.Value) + + member builder.Bind2Return(x1: Trace<'T1>, x2: Trace<'T2>, f: 'T1 * 'T2 -> 'T3) : Trace<'T3> = + builder.Trace TraceOp.ApplicativeBind2Return + Trace (f (x1.Value, x2.Value)) + +type TraceApplicativeWithDelayAndRun() = + inherit TraceApplicative() + + member builder.Run(x) = + builder.Trace TraceOp.Run + x + + member builder.Delay(thunk) = + builder.Trace TraceOp.Delay + thunk () + +type TraceApplicativeWithDelay() = + inherit TraceApplicative() + + member builder.Delay(thunk) = + builder.Trace TraceOp.Delay + thunk () + +type TraceApplicativeWithRun() = + inherit TraceApplicative() + + member builder.Run(x) = + builder.Trace TraceOp.Run + x + +type TraceMultiBindingMonadic() = + inherit TraceMergeSourcesCore() + + member builder.Bind(x : Trace<'T1>, f : 'T1 -> Trace<'T2>) : Trace<'T2> = + builder.Trace TraceOp.MonadicBind + f x.Value + + member builder.Bind2(x1 : 'T1 Trace, x2 : 'T2 Trace, f : 'T1 * 'T2 -> Trace<'T3>) : Trace<'T3> = + builder.Trace TraceOp.MonadicBind2 + f (x1.Value, x2.Value) + + member builder.Return(x: 'T) : Trace<'T> = + builder.Trace TraceOp.MonadicReturn + Trace x + +type TraceMultiBindingMonoid() = + inherit TraceMergeSourcesCore() + + member builder.Bind(x : Trace<'T1>, f : 'T1 -> Trace<'T2>) : Trace<'T2> = + builder.Trace TraceOp.MonadicBind + f x.Value + + member builder.Bind2(x1 : 'T1 Trace, x2 : 'T2 Trace, f : 'T1 * 'T2 -> Trace<'T3>) : Trace<'T3> = + builder.Trace TraceOp.MonadicBind2 + f (x1.Value, x2.Value) + + member builder.Yield(x: 'T) : Trace<'T list> = + builder.Trace TraceOp.ApplicativeYield + Trace [x] + + member builder.Combine(x1: Trace<'T list>, x2: Trace<'T list>) : Trace<'T list> = + builder.Trace TraceOp.ApplicativeCombine + Trace (x1.Value @ x2.Value) + + member builder.Delay(thunk) = + builder.Trace TraceOp.Delay + thunk () + + member builder.Zero() = + Trace [] + +type TraceApplicativeNoMergeSources() = + inherit TraceCore() + + member builder.BindReturn(x: Trace<'T1>, f: 'T1 -> 'T2) : Trace<'T2> = + builder.Trace TraceOp.ApplicativeBind + Trace (f x.Value) + +type TraceApplicativeNoBindReturn() = + inherit TraceCore() + + member builder.MergeSources(x1: Trace<'T1>, x2: Trace<'T2>) : Trace<'T1 * 'T2> = + builder.Trace TraceOp.MergeSources + Trace (x1.Value, x2.Value) + +type TraceMultiBindingMonadicCustomOp() = + inherit TraceMultiBindingMonadic() + + [] + member builder.Log(boundValues : Trace<'T>, [] messageFunc: 'T -> string) = + builder.Trace (TraceOp.Log (messageFunc boundValues.Value)) + boundValues + +let check msg actual expected = if actual <> expected then failwithf "FAILED %s, expected %A, got %A" msg expected actual + """ + + let includeAll = {| includeMergeSourcesOverloads = true |} + let includeMinimal = {| includeMergeSourcesOverloads = false |} + + let ApplicativeLibTest opts source = + CompilerAssert.CompileExeAndRunWithOptions [| "/langversion:preview" |] (applicativeLib opts + source) + + let ApplicativeLibErrorTest opts source errors = + let lib = applicativeLib opts + // Adjust the expected errors for the number of lines in the library + let libLineAdjust = lib |> Seq.filter (fun c -> c = '\n') |> Seq.length + CompilerAssert.TypeCheckWithErrorsAndOptionsAndAdjust [| "/langversion:preview" |] libLineAdjust (lib + source) errors + + let ApplicativeLibErrorTestFeatureDisabled opts source errors = + let lib = applicativeLib opts + // Adjust the expected errors for the number of lines in the library + let libLineAdjust = lib |> Seq.filter (fun c -> c = '\n') |> Seq.length + CompilerAssert.TypeCheckWithErrorsAndOptionsAndAdjust [| "/langversion:4.7" |] libLineAdjust (lib + source) errors + + [] + let ``AndBang TraceApplicative`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicative() + +let ceResult : Trace = + tracer { + let! x = Trace 3 + and! y = Trace true + return if y then x else -1 + } + +check "fewljvwerjl1" ceResult.Value 3 +check "fewljvwerj12" (tracer.GetTrace ()) [|TraceOp.ApplicativeBind2Return|] + """ + + [] + let ``AndBang TraceApplicative Disable`` () = + ApplicativeLibErrorTestFeatureDisabled includeAll + """ +let tracer = TraceApplicative() + +let ceResult : Trace = + tracer { + let! x = Trace 3 + and! y = Trace true + return if y then x else -1 + } + """ + [| FSharpErrorSeverity.Error, 3344, (6, 9, 8, 35), "This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature." |] + + [] + let ``AndBang TraceMultiBindingMonoid`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceMultiBindingMonoid() + +let ceResult : Trace = + tracer { + let! x = Trace 3 + and! y = Trace true + yield (if y then x else -1) + yield (if y then 5 else -1) + } + +check "fewljvwerjl5" ceResult.Value [3; 5] +check "fewljvwerj16" (tracer.GetTrace ()) [|TraceOp.Delay; TraceOp.MonadicBind2; TraceOp.ApplicativeYield; TraceOp.Delay; TraceOp.ApplicativeYield; TraceOp.ApplicativeCombine|] + """ + + [] + let ``AndBang TraceMultiBindingMonadic`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceMultiBindingMonadic() + +let ceResult : Trace = + tracer { + let fb = Trace "foobar" + match! fb with + | "bar" -> + let! bar = fb + return String.length bar + | _ -> + let! x = Trace 3 + and! y = Trace true + return if y then x else -1 + } + +check "gwrhjkrwpoiwer1" ceResult.Value 3 +check "gwrhjkrwpoiwer2" (tracer.GetTrace ()) [|TraceOp.MonadicBind; TraceOp.MonadicBind2; TraceOp.MonadicReturn|] + """ + + [] + let ``AndBang TraceMultiBindingMonadicCustomOp A`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceMultiBindingMonadicCustomOp() +let ceResult : Trace = + tracer { + let! x = Trace 3 + log (sprintf "%A" x) + return x + } + +check "gwrhjkrwpoiwer1t4" ceResult.Value 3 + """ + + [] + let ``AndBang TraceMultiBindingMonadicCustomOp B`` () = + ApplicativeLibTest includeAll """ +let tracer = TraceMultiBindingMonadicCustomOp() +let ceResult : Trace = + tracer { + let! x = Trace 3 + and! y = Trace true + log (sprintf "%A" (x,y)) + return (ignore y; x) + } + +check "gwrhjkrwpoiwer1t45" ceResult.Value 3 +check "gwrhjkrwpoiwer2t36" (tracer.GetTrace ()) [|TraceOp.MonadicBind2; TraceOp.MonadicReturn; TraceOp.Log "(3, true)"; TraceOp.MonadicBind; TraceOp.MonadicReturn |] + """ + + [] + let ``AndBang TraceMultiBindingMonadic TwoBind`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceMultiBindingMonadic() + +let ceResult : Trace = + tracer { + let fb = Trace "foobar" + match! fb with + | "bar" -> + let! bar = fb + return String.length bar + | _ -> + let! x = Trace 3 + and! y = Trace true + let! x2 = Trace x + and! y2 = Trace y + if y2 then return x2 else return -1 + } + +check "gwrhjkrwpoiwer38" ceResult.Value 3 +check "gwrhjkrwpoiwer39" (tracer.GetTrace ()) [|TraceOp.MonadicBind; TraceOp.MonadicBind2; TraceOp.MonadicBind2; TraceOp.MonadicReturn|] + """ + + [] + let ``AndBang TraceApplicativeWithDelayAndRun`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicativeWithDelayAndRun() + +let ceResult : Trace = + tracer { + let! x = Trace 3 + and! y = Trace true + return if y then x else -1 + } + +check "vlkjrrlwevlk23" ceResult.Value 3 +check "vlkjrrlwevlk24" (tracer.GetTrace ()) [|TraceOp.Delay; TraceOp.ApplicativeBind2Return; TraceOp.Run|] + """ + + [] + let ``AndBang TraceApplicativeWithDelay`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicativeWithDelay() + +let ceResult : int Trace = + tracer { + let! x = Trace 3 + and! y = Trace true + return if y then x else -1 + } + +check "vlkjrrlwevlk23" ceResult.Value 3 +check "vlkjrrlwevlk24" (tracer.GetTrace ()) [|TraceOp.Delay; TraceOp.ApplicativeBind2Return|] + """ + + [] + let ``AndBang TraceApplicativeWithRun`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicativeWithRun() + +let ceResult : int Trace = + tracer { + let! x = Trace 3 + and! y = Trace true + return if y then x else -1 + } + +check "vwerweberlk3" ceResult.Value 3 +check "vwerweberlk4" (tracer.GetTrace ()) [|TraceOp.ApplicativeBind2Return; TraceOp.Run |] + """ + + + [] + let ``AndBang TraceApplicative Size 3`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicative() + +let ceResult = + tracer { + let! x = Trace 3 + and! y = Trace true + and! z = Trace 5 + return if y then x else z + } + +check "fewljvwerjl7" ceResult.Value 3 +check "fewljvwerj18" (tracer.GetTrace ()) [|TraceOp.MergeSources3; TraceOp.ApplicativeBindReturn|] + """ + + [] + let ``AndBang TraceApplicative Size 3 minimal`` () = + ApplicativeLibTest includeMinimal """ + +let tracer = TraceApplicative() + +let ceResult = + tracer { + let! x = Trace 3 + and! y = Trace true + and! z = Trace 5 + return if y then x else z + } + +check "fewljvwerjl7" ceResult.Value 3 +check "fewljvwerj18" (tracer.GetTrace ()) [|TraceOp.MergeSources; TraceOp.MergeSources; TraceOp.ApplicativeBindReturn|] + """ + [] + let ``AndBang TraceApplicative Size 4`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicative() + +let ceResult = + tracer { + let! x1 = Trace 3 + and! x2 = Trace true + and! x3 = Trace 5 + and! x4 = Trace 5 + return if x2 then x1 else x3+x4 + } + +check "fewljvwerjl191" ceResult.Value 3 +check "fewljvwerj1192" (tracer.GetTrace ()) [|TraceOp.MergeSources4; TraceOp.ApplicativeBindReturn|] + """ + + [] + let ``AndBang TraceApplicative Size 5`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicative() + +let ceResult : Trace = + tracer { + let! x1 = Trace 3 + and! x2 = Trace true + and! x3 = Trace 5 + and! x4 = Trace 5 + and! x5 = Trace 8 + return if x2 then x1+x4+x5 else x3 + } + +check "fewljvwerjl193" ceResult.Value 16 +check "fewljvwerj1194" (tracer.GetTrace ()) [|TraceOp.MergeSources; TraceOp.MergeSources4; TraceOp.ApplicativeBindReturn|] + """ + + [] + let ``AndBang TraceApplicative Size 6`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicative() + +let ceResult : Trace = + tracer { + let! x1 = Trace 3 + and! x2 = Trace true + and! x3 = Trace 5 + and! x4 = Trace 5 + and! x5 = Trace 8 + and! x6 = Trace 9 + return if x2 then x1+x4+x5+x6 else x3 + } + +check "fewljvwerjl195" ceResult.Value 25 +check "fewljvwerj1196" (tracer.GetTrace ()) [|TraceOp.MergeSources3; TraceOp.MergeSources4; TraceOp.ApplicativeBindReturn|] + """ + + [] + let ``AndBang TraceApplicative Size 10`` () = + ApplicativeLibTest includeAll """ + +let tracer = TraceApplicative() + +let ceResult : Trace = + tracer { + let! x1 = Trace 3 + and! x2 = Trace true + and! x3 = Trace 5 + and! x4 = Trace 5 + and! x5 = Trace 8 + and! x6 = Trace 9 + and! x7 = Trace 1 + and! x8 = Trace 2 + and! x9 = Trace 3 + and! x10 = Trace 4 + return if x2 then x1+x4+x5+x6+x7+x8+x9+x10 else x3 + } + +check "fewljvwerjl197" ceResult.Value 35 +check "fewljvwerj1198" (tracer.GetTrace ()) [|TraceOp.MergeSources4; TraceOp.MergeSources4; TraceOp.MergeSources4; TraceOp.ApplicativeBindReturn|] + """ + + + [] + let ``AndBang Negative TraceApplicative missing MergeSources`` () = + ApplicativeLibErrorTest includeAll """ +let tracer = TraceApplicativeNoMergeSources() + +let _ = + tracer { + let! x = Trace 1 + and! y = Trace 2 + return x + y + } + """ + [|(FSharpErrorSeverity.Error, 3343, (6, 9, 6, 25), "The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a 'Bind2' method or appropriate 'MergeSource' and 'Bind' methods")|] + + [] + let ``AndBang Negative TraceApplicative missing Bind and BindReturn`` () = + ApplicativeLibErrorTest includeAll """ +let tracer = TraceApplicativeNoBindReturn() + +let _ = + tracer { + let! x = Trace 1 + and! y = Trace 2 + return x + y + } + """ + [|(FSharpErrorSeverity.Error, 708, (6, 9, 6, 25), "This control construct may only be used if the computation expression builder defines a 'Bind' method")|] + + + [] + let ``AndBang Negative TraceApplicative with bad construct`` () = + ApplicativeLibErrorTest includeAll """ + +let tracer = TraceApplicativeNoBindReturn() + +let _ = + tracer { + let! x = Trace 1 // this is a true bind, check the error message here + let! x2 = Trace 1 + return x + y + } + """ + [| FSharpErrorSeverity.Error, 708, (7, 9, 7, 25), "This control construct may only be used if the computation expression builder defines a 'Bind' method" |] + + [] + let ``AndBang TraceApplicative with do-bang`` () = + ApplicativeLibErrorTest includeAll """ +let tracer = TraceApplicative() + +let _ = + tracer { + do! Trace() + and! x = Trace 1 + and! y = Trace 2 + return x + y + } + """ + [|(FSharpErrorSeverity.Error, 10, (7, 9, 7, 13),"Unexpected keyword 'and!' in expression. Expected '}' or other token."); + (FSharpErrorSeverity.Error, 604, (5, 12, 5, 13), "Unmatched '{'"); + (FSharpErrorSeverity.Error, 10, (8, 9, 8, 13), "Unexpected keyword 'and!' in implementation file")|] + + [] + let ``AndBang Negative TraceApplicative let betweeen let! and and!`` () = + ApplicativeLibErrorTest includeAll """ +let tracer = TraceApplicative() + +let _ = + tracer { + let! x = Trace 1 + let _ = 42 + and! y = Trace 2 + return x + y + } + """ + [| (FSharpErrorSeverity.Error, 10, (8, 9, 8, 13), "Unexpected keyword 'and!' in expression") |] + + + [] + let ``AndBang Negative TraceApplicative no return`` () = + ApplicativeLibErrorTest includeAll """ +let tracer = TraceApplicative() + +let _ = + tracer { + let! x = Trace 1 + and! y = Trace 2 + } + """ + [|(FSharpErrorSeverity.Error, 10, (8, 5, 8, 6), "Unexpected symbol '}' in expression")|] + + [] + let ``AndBang TraceApplicative conditional return`` () = + ApplicativeLibTest includeAll """ +let tracer = TraceApplicative() + +let ceResult = + tracer { + let! x = Trace 1 + and! y = Trace 2 + if x = 1 then + return y + else + return 4 + } +check "grwerjkrwejgk" ceResult.Value 2 + """ + + [] + let ``AndBang TraceApplicative match return`` () = + ApplicativeLibTest includeAll """ +let tracer = TraceApplicative() + +let ceResult = + tracer { + let! x = Trace 1 + and! y = Trace 2 + match x with + | 1 -> return y + | _ -> return 4 + } +check "grwerjkrwejgk42" ceResult.Value 2 + """ + + [] + let ``AndBang TraceApplicative incomplete match return`` () = + ApplicativeLibTest includeAll """ +#nowarn "25" + +let tracer = TraceApplicative() + +let ceResult = + tracer { + let! x = Trace 1 + and! y = Trace 2 + match x with + | 1 -> return y + } +check "grwerjkrwejgk42" ceResult.Value 2 + """ + diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 66ae7d66b0b..ef5a0c7b273 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -38,6 +38,7 @@ + diff --git a/tests/fsharp/perf/computation-expressions/dependency_graph.fsx b/tests/fsharp/perf/computation-expressions/dependency_graph.fsx new file mode 100644 index 00000000000..348aab0349b --- /dev/null +++ b/tests/fsharp/perf/computation-expressions/dependency_graph.fsx @@ -0,0 +1,192 @@ + +let mutable nodes = 0 +let mutable recalcs = 0 + +[] +type Node(dirty) = + do nodes <- nodes + 1 + + let dependees = ResizeArray>() + let mutable dirty = dirty + + member _.Dirty with get() = dirty and set v = dirty <- v + + member _.Dependees = + dependees.ToArray() + |> Array.choose (fun c -> match c.TryGetTarget() with true, tg -> Some tg | _ -> None) + + member _.AddDependee(c) = + dependees.Add(System.WeakReference<_>(c)) + + member _.InputChanged() = + for c in dependees do + match c.TryGetTarget() with + | true, tg -> tg.SetDirty() + | _ -> () + + member n.SetDirty() = + if not dirty then + dirty <- true + n.InputChanged() + + +[] +type Node<'T>(dirty) = + inherit Node(dirty) + abstract Value : 'T + +/// A node that recomputes if any if its inputs change +type RecalcNode<'T>(dirty, initial, f: unit -> 'T) = + inherit Node<'T>(dirty) + + let mutable cachedValue = initial + + new (f) = new RecalcNode<'T>(true, Unchecked.defaultof<_>, f) + + new (initial, f) = new RecalcNode<'T>(false, initial, f) + + override n.Value = + if n.Dirty then + recalcs <- recalcs + 1 + cachedValue <- f() + n.Dirty <- false + cachedValue + + override _.ToString() = sprintf "(latest %A)" cachedValue + +/// A node that never recomputes +type ConstantNode<'T>(x: 'T) = + inherit Node<'T>(false) + + override _.Value = x + + override _.ToString() = sprintf "(latest %A)" x + +type InputNode<'T>(v: 'T) = + inherit Node<'T>(false) + let mutable currentValue = v + override _.Value = currentValue + + member node.SetValue v = + currentValue <- v + node.InputChanged() + +type NodeBuilder() = + + member _.Bind(x: Node<'T1>, f: 'T1 -> Node<'T2>) : Node<'T2> = + let rec n = + RecalcNode<'T2>(fun () -> + let n2 = f x.Value + n2.AddDependee(n) + n2.Value) + x.AddDependee(n) + n :> Node<_> + + member _.BindReturn(x: Node<'T1>, f: 'T1 -> 'T2) : Node<'T2> = + let n = RecalcNode<'T2>(fun () -> f x.Value) + x.AddDependee(n) + n :> Node<_> + + member _.Bind2(x1: Node<'T1>, x2: Node<'T2>, f: 'T1 * 'T2 -> Node<'T3>) : Node<'T3> = + let rec n = + RecalcNode<'T3>(fun () -> + let n2 = f (x1.Value, x2.Value) + n2.AddDependee(n) + n2.Value) + x1.AddDependee(n) + x2.AddDependee(n) + n :> Node<_> + + member _.Bind2Return(x1: Node<'T1>, x2: Node<'T2>, f: 'T1 * 'T2 -> 'T3) : Node<'T3> = + let n = RecalcNode<'T3>(fun () -> f (x1.Value, x2.Value)) + x1.AddDependee(n) + x2.AddDependee(n) + n :> Node<_> + + member _.Bind3(x1: Node<'T1>, x2: Node<'T2>, x3: Node<'T3>, f: 'T1 * 'T2 * 'T3 -> Node<'T4>) : Node<'T4> = + let rec n = + RecalcNode<'T4>(fun () -> + let n2 = f (x1.Value, x2.Value, x3.Value) + n2.AddDependee(n) + n2.Value) + x1.AddDependee(n) + x2.AddDependee(n) + x3.AddDependee(n) + n :> Node<_> + + member _.Bind3Return(x1: Node<'T1>, x2: Node<'T2>, x3: Node<'T3>, f: 'T1 * 'T2 * 'T3 -> 'T4) : Node<'T4> = + let n = RecalcNode<'T4>(fun () -> f (x1.Value, x2.Value, x3.Value)) + x1.AddDependee(n) + x2.AddDependee(n) + x3.AddDependee(n) + n :> Node<_> + + member _.MergeSources(x1: Node<'T1>, x2: Node<'T2>) : Node<'T1 * 'T2> = + let n = RecalcNode<_>(fun () -> (x1.Value, x2.Value)) + x1.AddDependee(n) + x2.AddDependee(n) + n :> Node<_> + + member _.Return(x: 'T) : Node<'T> = + ConstantNode<'T>(x) :> Node<_> + +let node = NodeBuilder() +let input v = InputNode(v) + +let inp1 = input 3 +let inp2 = input 7 +let inp3 = input 0 + +let test1() = + node { + let! v1 = inp1 + and! v2 = inp2 + and! v3 = inp3 + return v1 + v2 + v3 + } + //let n1 = node.Bind3Return(inp1.Node, inp2.Node, inp3.Node, (fun (v1, v2, v3) -> v1 + v2 + v3)) + +let test2() = + node { + let! v1 = inp1 + let! v2 = inp2 + let! v3 = inp3 + return v1 + v2 + v3 + } + +let test msg f = + recalcs <- 0 + nodes <- 0 + + let (n: Node) = f() + + let v1 = n.Value // now 10 + + recalcs <- 0 + + for i in 1 .. 1000 do + inp1.SetValue 4 + let v2 = n.Value // now 11 + + inp2.SetValue 10 + let v3 = n.Value // now 14 + () + + printfn "inp1.Dependees.Length = %d" inp1.Dependees.Length + printfn "inp2.Dependees.Length = %d" inp2.Dependees.Length + printfn "total recalcs %s = %d" msg recalcs + printfn "total nodes %s = %d" msg nodes + printfn "----" + +test "using and!" test1 +test "using let!" test2 + +//inp1.Dependees.Length = 1 +//inp2.Dependees.Length = 1 +//total recalcs using and! = 2000 +//total nodes using and! = 1 +//---- +//inp1.Dependees.Length = 1 +//inp2.Dependees.Length = 2000 +//total recalcs using let! = 6000 +//total nodes using let! = 4003 \ No newline at end of file diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/.il.bsl deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.fs b/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.fs index 90ae5e8665c..4b1c9bd1304 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.fs +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.fs @@ -74,7 +74,7 @@ module Eventually = let tryWith e handler = catch e |> bind (function Result v -> Done v | Exception e -> handler e) - + let rec doWhile f e = if f() then e |> bind (fun () -> doWhile f e) else Eventually.Done () diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index a1ea76e7172..0c1a9f7d371 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -3,6 +3,7 @@ namespace Tests.LanguageService.AutoCompletion open System +open Microsoft.VisualStudio.FSharp.LanguageService open Salsa.Salsa open Salsa.VsMocks open Salsa.VsOpsUtils @@ -28,19 +29,20 @@ module StandardSettings = type UsingMSBuild() as this = inherit LanguageServiceBaseTests() - let createFile (code : list) fileKind refs = + let createFile (code : list) fileKind refs otherFlags = let (_, _, file) = match code with | [code] when code.IndexOfAny([|'\r'; '\n'|]) <> -1 -> - this.CreateSingleFileProject(code, fileKind = fileKind, references = refs) - | code -> this.CreateSingleFileProject(code, fileKind = fileKind, references = refs) + this.CreateSingleFileProject(code, fileKind = fileKind, references = refs, ?otherFlags=otherFlags) + | code -> + this.CreateSingleFileProject(code, fileKind = fileKind, references = refs, ?otherFlags=otherFlags) file - let DoWithAutoCompleteUsingExtraRefs refs coffeeBreak fileKind reason (code : list) marker f = + let DoWithAutoCompleteUsingExtraRefs refs otherFlags coffeeBreak fileKind reason (code : list) marker f = // Up to 2 untyped parse operations are OK: we do an initial parse to provide breakpoint valdiation etc. // This might be before the before the background builder is ready to process the foreground typecheck. // In this case the background builder calls us back when its ready, and we then request a foreground typecheck - let file = createFile code fileKind refs + let file = createFile code fileKind refs otherFlags if coffeeBreak then TakeCoffeeBreak(this.VS) @@ -51,33 +53,43 @@ type UsingMSBuild() as this = gpatcc.AssertExactly(0,0) - let DoWithAutoComplete coffeeBreak fileKind reason (code : list) marker f = DoWithAutoCompleteUsingExtraRefs [] coffeeBreak fileKind reason code marker f + let DoWithAutoComplete coffeeBreak fileKind reason otherFlags (code : list) marker f = + DoWithAutoCompleteUsingExtraRefs [] otherFlags coffeeBreak fileKind reason code marker f - let AssertAutoCompleteContains, AssertAutoCompleteContainsNoCoffeeBreak, AutoCompleteInInterfaceFileContains, AssertCtrlSpaceCompleteContains, AssertCtrlSpaceCompleteContainsNoCoffeeBreak = - let AssertAutoCompleteContains coffeeBreak filename reason code marker should shouldnot = - DoWithAutoComplete coffeeBreak filename reason code marker <| - fun completions -> - AssertCompListContainsAll(completions, should) - AssertCompListDoesNotContainAny(completions, shouldnot) + let AssertAutoCompleteContainsAux coffeeBreak filename reason otherFlags code marker should shouldnot = + DoWithAutoComplete coffeeBreak filename reason otherFlags code marker (fun completions -> + AssertCompListContainsAll(completions, should) + AssertCompListDoesNotContainAny(completions, shouldnot)) + + let AssertAutoCompleteContains = + AssertAutoCompleteContainsAux true SourceFileKind.FS BackgroundRequestReason.MemberSelect None + + let AssertAutoCompleteContainsNoCoffeeBreak = + AssertAutoCompleteContainsAux false SourceFileKind.FS BackgroundRequestReason.MemberSelect None + + let AutoCompleteInInterfaceFileContains = + AssertAutoCompleteContainsAux true SourceFileKind.FSI BackgroundRequestReason.MemberSelect None - ((AssertAutoCompleteContains true SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.MemberSelect), - (AssertAutoCompleteContains false SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.MemberSelect), - (AssertAutoCompleteContains true SourceFileKind.FSI Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.MemberSelect), - (AssertAutoCompleteContains true SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.CompleteWord), - (AssertAutoCompleteContains false SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.CompleteWord)) + let AssertCtrlSpaceCompleteContains = + AssertAutoCompleteContainsAux true SourceFileKind.FS BackgroundRequestReason.CompleteWord None + + let AssertCtrlSpaceCompleteContainsWithOtherFlags otherFlags = + AssertAutoCompleteContainsAux true SourceFileKind.FS BackgroundRequestReason.CompleteWord (Some otherFlags) + + let AssertCtrlSpaceCompleteContainsNoCoffeeBreak = + AssertAutoCompleteContainsAux false SourceFileKind.FS BackgroundRequestReason.CompleteWord None let AssertCtrlSpaceCompletionListIsEmpty code marker = - DoWithAutoComplete true SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.CompleteWord code marker AssertCompListIsEmpty + DoWithAutoComplete true SourceFileKind.FS BackgroundRequestReason.CompleteWord None code marker AssertCompListIsEmpty let AssertCtrlSpaceCompletionListIsEmptyNoCoffeeBreak code marker = - DoWithAutoComplete false SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.CompleteWord code marker AssertCompListIsEmpty + DoWithAutoComplete false SourceFileKind.FS BackgroundRequestReason.CompleteWord None code marker AssertCompListIsEmpty let AssertAutoCompleteCompletionListIsEmpty code marker = - DoWithAutoComplete true SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.MemberSelect code marker AssertCompListIsEmpty + DoWithAutoComplete true SourceFileKind.FS BackgroundRequestReason.MemberSelect None code marker AssertCompListIsEmpty let AssertAutoCompleteCompletionListIsEmptyNoCoffeeBreak code marker = - DoWithAutoComplete false SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.MemberSelect code marker AssertCompListIsEmpty - + DoWithAutoComplete false SourceFileKind.FS BackgroundRequestReason.MemberSelect None code marker AssertCompListIsEmpty let testAutoCompleteAdjacentToDot op = let text = sprintf "System.Console%s" op @@ -365,7 +377,7 @@ a. [] member this.``TypeProvider.VisibilityChecksForGeneratedTypes``() = let extraRefs = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")] - let check = DoWithAutoCompleteUsingExtraRefs extraRefs true SourceFileKind.FS Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.MemberSelect + let check = DoWithAutoCompleteUsingExtraRefs extraRefs None true SourceFileKind.FS BackgroundRequestReason.MemberSelect let code = [ @@ -3332,6 +3344,264 @@ let x = query { for bbbb in abbbbc(*D0*) do ["b"] ["i"] + [] + member public this.``CompletionForAndBang_BaseLine0``() = + AssertCtrlSpaceCompleteContains + ["type Builder() =" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "builder {" + " let! xxx3 = 2" + " return x" + "}"] + " return x" + ["xxx3"] + [] + + [] + member public this.``CompletionForAndBang_BaseLine1``() = + AssertCtrlSpaceCompleteContains + ["type Builder() =" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let xxx1 = 1" + "builder {" + " let xxx2 = 1" + " let! xxx3 = 1" + " return (1 + x)" + "}"] + " return (1 + x" + ["xxx1"; "xxx2"; "xxx3"] + [] + + [] + member public this.``CompletionForAndBang_BaseLine2``() = + /// Without closing '}' + AssertCtrlSpaceCompleteContains + ["type Builder() =" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let yyy1 = 1" + "builder {" + " let yyy2 = 1" + " let! yyy3 = 1" + " return (1 + y)"] + " return (1 + y" + ["yyy1"; "yyy2"; "yyy3"] + [] + + [] + member public this.``CompletionForAndBang_BaseLine3``() = + /// Without closing ')' + AssertCtrlSpaceCompleteContains + ["type Builder() =" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let zzz1 = 1" + "builder {" + " let zzz2 = 1" + " let! zzz3 = 1" + " return (1 + z" ] + " return (1 + z" + ["zzz1"; "zzz2"; "zzz3"] + [] + + [] + member public this.``CompletionForAndBang_BaseLine4``() = + AssertCtrlSpaceCompleteContains + ["type Builder() =" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let zzz1 = 1" + "builder {" + " let! zzz3 = 1" + " return (1 + z" ] + " return (1 + z" + ["zzz1"; "zzz3"] + [] + + [] + member public this.``CompletionForAndBang_Test_MergeSources_Bind_Return0``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.MergeSources(a: 'T1, b: 'T2) = (a, b)" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "builder {" + " let! xxx3 = 2" + " and! xxx4 = 2" + " return x" + "}"] + " return x" + ["xxx3"; "xxx4"] + [] + + [] + member public this.``CompletionForAndBang_Test_MergeSources_Bind_Return1``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.MergeSources(a: 'T1, b: 'T2) = (a, b)" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let xxx1 = 1" + "builder {" + " let xxx2 = 1" + " let! xxx3 = 1" + " and! xxx4 = 1" + " return (1 + x)" + "}"] + " return (1 + x" + ["xxx1"; "xxx2"; "xxx3"; "xxx4"] + [] + + [] + member public this.``CompletionForAndBang_Test_MergeSources_Bind_Return2``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.MergeSources(a: 'T1, b: 'T2) = (a, b)" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let yyy1 = 1" + "builder {" + " let yyy2 = 1" + " let! yyy3 = 1" + " and! yyy4 = 1" + " return (1 + y)"] + " return (1 + y" + ["yyy1"; "yyy2"; "yyy3"; "yyy4"] + [] + + [] + member public this.``CompletionForAndBang_Test_MergeSources_Bind_Return3``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.MergeSources(a: 'T1, b: 'T2) = (a, b)" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let zzz1 = 1" + "builder {" + " let zzz2 = 1" + " let! zzz3 = 1" + " and! zzz4 = 1" + " return (1 + z" ] + " return (1 + z" + ["zzz1"; "zzz2"; "zzz3"; "zzz4"] + [] + + [] + member public this.``CompletionForAndBang_Test_MergeSources_Bind_Return4``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.MergeSources(a: 'T1, b: 'T2) = (a, b)" + " member x.Bind(a: 'T1, f: 'T1 -> 'T2) = f a" + " member x.Return(a: 'T) = a" + "let builder = Builder()" + "let zzz1 = 1" + "builder {" + " let! zzz3 = 1" + " and! zzz4 = 1" + " return (1 + z" ] + " return (1 + z" + ["zzz1"; "zzz3"; "zzz4"] + [] + + [] + member public this.``CompletionForAndBang_Test_Bind2Return0``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.Bind2Return(a: 'T1, b: 'T2, f: ('T1 * 'T2) -> 'T3) = f (a, b)" + "let builder = Builder()" + "builder {" + " let! xxx3 = 2" + " and! xxx4 = 2" + " return x" + "}"] + " return x" + ["xxx3"; "xxx4"] + [] + + [] + member public this.``CompletionForAndBang_Test_Bind2Return1``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.Bind2Return(a: 'T1, b: 'T2, f: ('T1 * 'T2) -> 'T3) = f (a, b)" + "let builder = Builder()" + "let xxx1 = 1" + "builder {" + " let xxx2 = 1" + " let! xxx3 = 1" + " and! xxx4 = 1" + " return (1 + x)" + "}"] + " return (1 + x" + ["xxx1"; "xxx2"; "xxx3"; "xxx4"] + [] + + [] + member public this.``CompletionForAndBang_Test_Bind2Return2``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.Bind2Return(a: 'T1, b: 'T2, f: ('T1 * 'T2) -> 'T3) = f (a, b)" + "let builder = Builder()" + "let yyy1 = 1" + "builder {" + " let yyy2 = 1" + " let! yyy3 = 1" + " and! yyy4 = 1" + " return (1 + y)"] + " return (1 + y" + ["yyy1"; "yyy2"; "yyy3"; "yyy4"] + [] + + [] + member public this.``CompletionForAndBang_Test_Bind2Return3``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.Bind2Return(a: 'T1, b: 'T2, f: ('T1 * 'T2) -> 'T3) = f (a, b)" + "let builder = Builder()" + "let zzz1 = 1" + "builder {" + " let zzz2 = 1" + " let! zzz3 = 1" + " and! zzz4 = 1" + " return (1 + z" ] + " return (1 + z" + ["zzz1"; "zzz2"; "zzz3"; "zzz4"] + [] + + [] + member public this.``CompletionForAndBang_Test_Bind2Return4``() = + AssertCtrlSpaceCompleteContainsWithOtherFlags + "/langversion:preview" + ["type Builder() =" + " member x.Bind2Return(a: 'T1, b: 'T2, f: ('T1 * 'T2) -> 'T3) = f (a, b)" + "let builder = Builder()" + "let zzz1 = 1" + "builder {" + " let! zzz3 = 1" + " and! zzz4 = 1" + " return (1 + z" ] + " return (1 + z" + ["zzz1"; "zzz3"; "zzz4"] + [] (**) [] @@ -5202,11 +5472,11 @@ let x = query { for bbbb in abbbbc(*D0*) do (*------------------------------------------IDE Query automation start -------------------------------------------------*) member private this.AssertAutoCompletionInQuery(fileContent : string list, marker:string,contained:string list) = - let file = createFile fileContent SourceFileKind.FS ["System.Xml.Linq"] + let file = createFile fileContent SourceFileKind.FS ["System.Xml.Linq"] None let gpatcc = GlobalParseAndTypeCheckCounter.StartNew(this.VS) MoveCursorToEndOfMarker(file, marker) - let completions = CompleteAtCursorForReason(file,Microsoft.VisualStudio.FSharp.LanguageService.BackgroundRequestReason.CompleteWord) + let completions = CompleteAtCursorForReason(file,BackgroundRequestReason.CompleteWord) AssertCompListContainsAll(completions, contained) gpatcc.AssertExactly(0,0) diff --git a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs index f19ecb1ffc2..fbd950480f9 100644 --- a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs +++ b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs @@ -281,10 +281,11 @@ type LanguageServiceBaseTests() = ?defines : list, ?fileKind : SourceFileKind, ?disabledWarnings : list, - ?fileName : string + ?fileName : string, + ?otherFlags: string ) = let content = content.Split( [|"\r\n"|], StringSplitOptions.None) |> List.ofArray - this.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName) + this.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName, ?otherFlags = otherFlags) member internal this.CreateSingleFileProject ( @@ -293,7 +294,8 @@ type LanguageServiceBaseTests() = ?defines : list, ?fileKind : SourceFileKind, ?disabledWarnings : list, - ?fileName : string + ?fileName : string, + ?otherFlags: string ) = assert (box currentVS = box defaultVS) let mkKeyComponent l = @@ -312,7 +314,7 @@ type LanguageServiceBaseTests() = let refs = mkKeyComponent references let defines = mkKeyComponent defines let warnings = mkKeyComponent disabledWarnings - (refs, defines, disabledWarnings, fileName.ToLower()) + (refs, defines, warnings, otherFlags, fileName.ToLower()) match cache.TryGetValue key with | true, (proj, file) -> @@ -337,6 +339,10 @@ type LanguageServiceBaseTests() = for r in (defaultArg references []) do GlobalFunctions.AddAssemblyReference(proj, r) + match otherFlags with + | None -> () + | Some flags -> GlobalFunctions.SetOtherFlags(proj, flags) + let content = String.concat Environment.NewLine content let _ = AddFileFromTextBlob(proj, fileName, content) let file = OpenFile(proj, fileName) diff --git a/vsintegration/tests/UnitTests/TestLib.Salsa.fs b/vsintegration/tests/UnitTests/TestLib.Salsa.fs index 1c4a65c1ede..e97d403460f 100644 --- a/vsintegration/tests/UnitTests/TestLib.Salsa.fs +++ b/vsintegration/tests/UnitTests/TestLib.Salsa.fs @@ -79,6 +79,7 @@ module internal GlobalFunctions = let CreateSolution(vs) = CreateSolution(vs) let CloseSolution(sol) = CloseSolution(sol) let Cleanup(vs) = Cleanup(vs) + let SetOtherFlags(proj, flags) = SetOtherFlags(proj, flags) let AddAssemblyReference(proj, ref) = AddAssemblyReference(proj, ref) let AddAssemblyReferenceEx(proj, ref, v) = AddAssemblyReferenceEx(proj, ref, v) let SetProjectDefines(proj, d) = SetProjectDefines(proj, d)