From 548ac5c24755446accd272a46e82fd252b8e108b Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 4 Nov 2022 19:45:52 +0100 Subject: [PATCH 01/15] Add while! --- .../Checking/CheckComputationExpressions.fs | 49 ++++++++++++++++++- src/Compiler/Checking/CheckExpressions.fs | 4 ++ src/Compiler/Driver/CompilerDiagnostics.fs | 1 + src/Compiler/FSComp.txt | 1 + src/Compiler/FSStrings.resx | 7 ++- .../Service/FSharpParseFileResults.fs | 5 ++ src/Compiler/Service/ServiceLexing.fs | 3 ++ src/Compiler/Service/ServiceLexing.fsi | 1 + src/Compiler/Service/ServiceParseTreeWalk.fs | 7 +++ src/Compiler/Service/ServiceStructure.fs | 3 +- src/Compiler/SyntaxTree/LexFilter.fs | 4 +- src/Compiler/SyntaxTree/PrettyNaming.fs | 1 + src/Compiler/SyntaxTree/SyntaxTree.fs | 3 ++ src/Compiler/SyntaxTree/SyntaxTree.fsi | 3 ++ src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 2 + src/Compiler/lex.fsl | 3 ++ src/Compiler/pars.fsy | 43 +++++++++++++++- src/Compiler/xlf/FSComp.txt.cs.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.de.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.es.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.fr.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.it.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.ja.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.ko.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.pl.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.ru.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.tr.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 ++ src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 ++ src/Compiler/xlf/FSStrings.cs.xlf | 5 ++ src/Compiler/xlf/FSStrings.de.xlf | 5 ++ src/Compiler/xlf/FSStrings.es.xlf | 5 ++ src/Compiler/xlf/FSStrings.fr.xlf | 5 ++ src/Compiler/xlf/FSStrings.it.xlf | 5 ++ src/Compiler/xlf/FSStrings.ja.xlf | 5 ++ src/Compiler/xlf/FSStrings.ko.xlf | 5 ++ src/Compiler/xlf/FSStrings.pl.xlf | 5 ++ src/Compiler/xlf/FSStrings.pt-BR.xlf | 5 ++ src/Compiler/xlf/FSStrings.ru.xlf | 5 ++ src/Compiler/xlf/FSStrings.tr.xlf | 5 ++ src/Compiler/xlf/FSStrings.zh-Hans.xlf | 5 ++ src/Compiler/xlf/FSStrings.zh-Hant.xlf | 5 ++ 43 files changed, 262 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index db8d307381f..16ed1ae7bfd 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -111,6 +111,7 @@ let YieldFree (cenv: cenv) expr = | SynExpr.TryFinally (tryExpr=body) | SynExpr.LetOrUse (body=body) | SynExpr.While (doExpr=body) + | SynExpr.WhileBang (doExpr=body) | SynExpr.ForEach (bodyExpr=body) -> YieldFree body @@ -142,6 +143,7 @@ let YieldFree (cenv: cenv) expr = | SynExpr.TryFinally (tryExpr=body) | SynExpr.LetOrUse (body=body) | SynExpr.While (doExpr=body) + | SynExpr.WhileBang (doExpr=body) | SynExpr.ForEach (bodyExpr=body) -> YieldFree body @@ -177,7 +179,8 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = | SynExpr.Do _ | SynExpr.MatchBang _ | SynExpr.LetOrUseBang _ - | SynExpr.While _ -> false + | SynExpr.While _ + | SynExpr.WhileBang _ -> false | _ -> true let rec TryGetSimpleSemicolonSequenceOfComprehension expr acc = @@ -1399,6 +1402,47 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol Some(translatedCtxt callExpr) + | SynExpr.WhileBang (spWhile, guardExpr, innerComp, _) -> + let mGuard = guardExpr.Range + let mWhile = match spWhile with DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) | _ -> 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 "Bind" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), mWhile)) + + // 'while' is hit just before each time the guard is called + let guardExpr = + match spWhile with + | DebugPointAtWhile.Yes _ -> + SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) + | DebugPointAtWhile.No -> guardExpr + + // todo desugar directly instead of rewriting first + let body = + let id = mkSynId range.Zero "$cond" + let pat = mkSynPatVar None id + + let body = + let id2 = mkSynId range.Zero "$condM" + let pat2 = mkSynPatVar None id2 + let b = mkSynBinding (Xml.PreXmlDoc.Empty, pat2) (None, false, true, range.Zero, DebugPointAtBinding.NoneAtInvisible, None, SynExpr.Ident id, range.Zero, [], [], None, SynBindingTrivia.Zero) + let set = SynExpr.LongIdentSet (SynLongIdent.SynLongIdent ([ id2 ], [], []), SynExpr.Ident id, range.Zero) + let bang = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], set, range.Zero, SynExprLetOrUseBangTrivia.Zero) + + let body = SynExpr.While (spWhile, SynExpr.Ident id2, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bang, range.Zero), range.Zero) + SynExpr.LetOrUse (false, false, [ b ], body, range.Zero, { InKeyword = None }) + + SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], body, range.Zero, SynExprLetOrUseBangTrivia.Zero) + + tryTrans CompExprTranslationPass.Initial q varSpace body translatedCtxt + | SynExpr.TryWith (innerComp, clauses, mTryToLast, spTry, spWith, trivia) -> let mTry = match spTry with DebugPointAtTry.Yes _ -> trivia.TryKeyword.NoteSourceConstruct(NotedSourceConstruct.Try) | _ -> trivia.TryKeyword let spWith2 = match spWith with DebugPointAtWith.Yes _ -> DebugPointAtBinding.Yes trivia.WithKeyword | _ -> DebugPointAtBinding.NoneAtInvisible @@ -1733,7 +1777,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | _ -> None - /// Check is an expression has no computation expression constructs + /// Check if an expression has no computation expression constructs and isSimpleExpr comp = match comp with @@ -1741,6 +1785,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | SynExpr.ForEach _ -> false | SynExpr.For _ -> false | SynExpr.While _ -> false + | SynExpr.WhileBang _ -> false | SynExpr.TryFinally _ -> false | SynExpr.ImplicitZero _ -> false | OptionalSequential (JoinOrGroupJoinOrZipClause _, _) -> false diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 60a7d9b364e..fff9439aaa3 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5700,6 +5700,9 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE | SynExpr.MatchBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) + | SynExpr.WhileBang (range=m) -> + error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) + // Part of 'T.Ident | SynExpr.Typar (typar, m) -> TcTyparExprThen cenv overallTy env tpenv typar m [] @@ -8678,6 +8681,7 @@ and TcImplicitOpItemThen (cenv: cenv) overallTy env id sln tpenv mItem delayed = | SynExpr.MatchBang _ | SynExpr.LetOrUseBang _ | SynExpr.DoBang _ + | SynExpr.WhileBang _ | SynExpr.TraitCall _ | SynExpr.IndexFromEnd _ | SynExpr.IndexRange _ diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 4b78aa9b9f9..4e69a9239eb 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -1180,6 +1180,7 @@ type Exception with | Parser.TOKEN_INLINE -> SR.GetString("Parser.TOKEN.INLINE") | Parser.TOKEN_WHEN -> SR.GetString("Parser.TOKEN.WHEN") | Parser.TOKEN_WHILE -> SR.GetString("Parser.TOKEN.WHILE") + | Parser.TOKEN_WHILE_BANG -> SR.GetString("Parser.TOKEN.WHILE.BANG") | Parser.TOKEN_WITH -> SR.GetString("Parser.TOKEN.WITH") | Parser.TOKEN_IF -> SR.GetString("Parser.TOKEN.IF") | Parser.TOKEN_DO -> SR.GetString("Parser.TOKEN.DO") diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 9c9da192081..5a562764f21 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1463,6 +1463,7 @@ keywordDescriptionVal,"Used in a signature to indicate a value, or in a type to keywordDescriptionVoid,"Indicates the .NET void type. Used when interoperating with other .NET languages." keywordDescriptionWhen,"Used for Boolean conditions (when guards) on pattern matches and to introduce a constraint clause for a generic type parameter." keywordDescriptionWhile,"Introduces a looping construct." +keywordDescriptionWhileBang,"Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression." keywordDescriptionWith,"Used together with the match keyword in pattern matching expressions. Also used in object expressions, record copying expressions, and type extensions to introduce member definitions, and to introduce exception handlers." keywordDescriptionYield,"Used in a sequence expression to produce a value for a sequence." keywordDescriptionYieldBang,"Used in a computation expression to append the result of a given computation expression to a collection of results for the containing computation expression." diff --git a/src/Compiler/FSStrings.resx b/src/Compiler/FSStrings.resx index 92013c7bba2..da3829dbc5c 100644 --- a/src/Compiler/FSStrings.resx +++ b/src/Compiler/FSStrings.resx @@ -112,10 +112,10 @@ 2.0 - System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 . See also {0}. @@ -1113,4 +1113,7 @@ Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + keyword 'while!' + \ No newline at end of file diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 929d38b957c..61a5da8638e 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -856,6 +856,11 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, for SynMatchClause (whenExpr = whenExpr; resultExpr = resExpr) in clauses do yield! walkExprOpt true whenExpr yield! walkExpr true resExpr + + | SynExpr.WhileBang (spWhile, e1, e2, _) -> + yield! walkWhileSeqPt spWhile + yield! walkExpr false e1 + yield! walkExpr true e2 ] // Process a class declaration or F# type declaration diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index a772cd707aa..fcbd4c9442b 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -383,6 +383,7 @@ module internal TokenClassifications = | INLINE | WHEN | WHILE + | WHILE_BANG | WITH | IF | THEN @@ -1310,6 +1311,7 @@ type FSharpTokenKind = | ColonEquals | When | While + | WhileBang | With | Hash | Ampersand @@ -1520,6 +1522,7 @@ type FSharpToken = | SEMICOLON -> FSharpTokenKind.SemicolonSemicolon | WHEN -> FSharpTokenKind.When | WHILE -> FSharpTokenKind.While + | WHILE_BANG -> FSharpTokenKind.WhileBang | WITH -> FSharpTokenKind.With | HASH -> FSharpTokenKind.Hash | AMP -> FSharpTokenKind.Ampersand diff --git a/src/Compiler/Service/ServiceLexing.fsi b/src/Compiler/Service/ServiceLexing.fsi index 39b2febf315..9bac004d500 100755 --- a/src/Compiler/Service/ServiceLexing.fsi +++ b/src/Compiler/Service/ServiceLexing.fsi @@ -438,6 +438,7 @@ type public FSharpTokenKind = | ColonEquals | When | While + | WhileBang | With | Hash | Ampersand diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 9298fc11b27..576da295a48 100644 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -766,6 +766,13 @@ module SyntaxTraversal = | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.WhileBang (_spWhile, synExpr, synExpr2, _range) -> + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] + |> pick expr + | SynExpr.LibraryOnlyILAssembly _ -> None | SynExpr.LibraryOnlyStaticOptimization _ -> None diff --git a/src/Compiler/Service/ServiceStructure.fs b/src/Compiler/Service/ServiceStructure.fs index 5e381130ed8..c526ffc503c 100644 --- a/src/Compiler/Service/ServiceStructure.fs +++ b/src/Compiler/Service/ServiceStructure.fs @@ -442,7 +442,8 @@ module Structure = parseExpr elseExpr | None -> () - | SynExpr.While (_, _, e, r) -> + | SynExpr.While (_, _, e, r) + | SynExpr.WhileBang (_, _, e, r) -> rcheck Scope.While Collapse.Below r r parseExpr e diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index 88a743a6bf2..303ac0b9c2f 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -1247,7 +1247,7 @@ type LexFilterImpl ( | EOF _ -> false | _ -> not (isSameLine()) || - (match peekNextToken() with TRY | MATCH | MATCH_BANG | IF | LET _ | FOR | WHILE -> true | _ -> false) + (match peekNextToken() with TRY | MATCH | MATCH_BANG | IF | LET _ | FOR | WHILE | WHILE_BANG -> true | _ -> false) // Look for '=' or '.Id.id.id = ' after an identifier let rec isLongIdentEquals token = @@ -2325,7 +2325,7 @@ type LexFilterImpl ( pushCtxt tokenTup (CtxtFor tokenStartPos) returnToken tokenLexbufState token - | WHILE, _ -> + | (WHILE | WHILE_BANG), _ -> if debug then dprintf "WHILE, pushing CtxtWhile(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtWhile tokenStartPos) returnToken tokenLexbufState token diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fs b/src/Compiler/SyntaxTree/PrettyNaming.fs index 4ab6f181358..0e4ed6f32a0 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -238,6 +238,7 @@ let keywordsWithDescription: (string * string) list = "void", FSComp.SR.keywordDescriptionVoid () "when", FSComp.SR.keywordDescriptionWhen () "while", FSComp.SR.keywordDescriptionWhile () + "while!", FSComp.SR.keywordDescriptionWhileBang () "with", FSComp.SR.keywordDescriptionWith () "yield", FSComp.SR.keywordDescriptionYield () "yield!", FSComp.SR.keywordDescriptionYieldBang () diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 66951e620a8..0174c2d07a4 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -679,6 +679,8 @@ type SynExpr = | DoBang of expr: SynExpr * range: range + | WhileBang of whileDebugPoint: DebugPointAtWhile * whileExpr: SynExpr * doExpr: SynExpr * range: range + | LibraryOnlyILAssembly of ilCode: obj * // this type is ILInstr[] but is hidden to avoid the representation of AbstractIL being public typeArgs: SynType list * @@ -777,6 +779,7 @@ type SynExpr = | SynExpr.LetOrUseBang (range = m) | SynExpr.MatchBang (range = m) | SynExpr.DoBang (range = m) + | SynExpr.WhileBang (range = m) | SynExpr.Fixed (range = m) | SynExpr.InterpolatedString (range = m) | SynExpr.Dynamic (range = m) -> m diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 9d12ce00e81..d1eb5d554ef 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -871,6 +871,9 @@ type SynExpr = /// Computation expressions only | DoBang of expr: SynExpr * range: range + /// F# syntax: 'while! ... do ...' + | WhileBang of whileDebugPoint: DebugPointAtWhile * whileExpr: SynExpr * doExpr: SynExpr * range: range + /// Only used in FSharp.Core | LibraryOnlyILAssembly of ilCode: obj * // this type is ILInstr[] but is hidden to avoid the representation of AbstractIL being public diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 72cfa230342..f40ff64a6a7 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -915,6 +915,8 @@ let rec synExprContainsError inpExpr = ] || walkExpr e2 + | SynExpr.WhileBang (_, e1, e2, _) -> walkExpr e1 || walkExpr e2 + | SynExpr.InterpolatedString (parts, _, _m) -> parts |> List.choose (function diff --git a/src/Compiler/lex.fsl b/src/Compiler/lex.fsl index 45057efa104..956094dc705 100644 --- a/src/Compiler/lex.fsl +++ b/src/Compiler/lex.fsl @@ -360,6 +360,9 @@ rule token args skip = parse | "and!" { AND_BANG(false) } + + | "while!" + { WHILE_BANG } | ident '!' { let tok = Keywords.KeywordOrIdentifierToken args lexbuf (lexemeTrimRight lexbuf 1) diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 65714a0fc3e..2f5b78ac14a 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -83,7 +83,7 @@ let parse_error_rich = Some (fun (ctxt: ParseErrorContext<_>) -> %token EXCEPTION FALSE FOR FUN FUNCTION IF IN JOIN_IN FINALLY DO_BANG %token LAZY OLAZY MATCH MATCH_BANG MUTABLE NEW OF %token OPEN OR REC THEN TO TRUE TRY TYPE VAL INLINE INTERFACE INSTANCE CONST -%token WHEN WHILE WITH HASH AMP AMP_AMP QUOTE LPAREN RPAREN RPAREN_COMING_SOON RPAREN_IS_HERE STAR COMMA RARROW GREATER_BAR_RBRACK LPAREN_STAR_RPAREN +%token WHEN WHILE WHILE_BANG WITH HASH AMP AMP_AMP QUOTE LPAREN RPAREN RPAREN_COMING_SOON RPAREN_IS_HERE STAR COMMA RARROW GREATER_BAR_RBRACK LPAREN_STAR_RPAREN %token QMARK QMARK_QMARK DOT COLON COLON_COLON COLON_GREATER COLON_QMARK_GREATER COLON_QMARK COLON_EQUALS SEMICOLON %token SEMICOLON_SEMICOLON LARROW EQUALS LBRACK LBRACK_BAR LBRACE_BAR LBRACK_LESS %token BAR_RBRACK BAR_RBRACE UNDERSCORE @@ -3641,6 +3641,47 @@ declExpr: let mWhileAll = unionRanges (rhs parseState 1) (rhs parseState 3) exprFromParseError (SynExpr.While (spWhile, arbExpr("whileGuard1", mWhileHeader), arbExpr("whileBody3", mWhileBodyArb), mWhileAll)) } + | WHILE_BANG declExpr doToken typedSequentialExprBlock doneDeclEnd + { let mWhileHeader = unionRanges (rhs parseState 1) $2.Range + let spWhile = DebugPointAtWhile.Yes mWhileHeader + let mWhileAll = unionRanges (rhs parseState 1) $4.Range + SynExpr.WhileBang (spWhile, $2, $4, mWhileAll) } + + | WHILE_BANG declExpr doToken typedSequentialExprBlock recover + { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()) + let mWhileHeader = unionRanges (rhs parseState 1) $2.Range + let spWhile = DebugPointAtWhile.Yes mWhileHeader + let mWhileAll = unionRanges (rhs parseState 1) $4.Range + exprFromParseError (SynExpr.WhileBang (spWhile, $2, $4, mWhileAll)) } + + | WHILE_BANG declExpr doToken error doneDeclEnd + { // silent recovery + let mWhileHeader = unionRanges (rhs parseState 1) $2.Range + let spWhile = DebugPointAtWhile.Yes mWhileHeader + let mWhileBodyArb = unionRanges (rhs parseState 4) (rhs parseState 5) + let mWhileAll = unionRanges (rhs parseState 1) (rhs parseState 5) + SynExpr.WhileBang (spWhile, $2, arbExpr("whileBody1", mWhileBodyArb), mWhileAll) } + + | WHILE_BANG declExpr recover + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsWhileDoExpected()) + let mWhileHeader = unionRanges (rhs parseState 1) $2.Range + let spWhile = DebugPointAtWhile.Yes mWhileHeader + let mWhileBodyArb = rhs parseState 3 + let mWhileAll = unionRanges (rhs parseState 1) (rhs parseState 3) + exprFromParseError (SynExpr.WhileBang (spWhile, $2, arbExpr("whileBody2", mWhileBodyArb), mWhileAll)) } + + | WHILE_BANG recover + { if not $2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()) + arbExpr("whileLoop1", rhs parseState 1) } + + | WHILE_BANG error doneDeclEnd + { //silent recovery + let mWhileHeader = rhs parseState 1 + let spWhile = DebugPointAtWhile.Yes mWhileHeader + let mWhileBodyArb = rhs parseState 3 + let mWhileAll = unionRanges (rhs parseState 1) (rhs parseState 3) + exprFromParseError (SynExpr.WhileBang (spWhile, arbExpr("whileGuard1", mWhileHeader), arbExpr("whileBody3", mWhileBodyArb), mWhileAll)) } + | FOR forLoopBinder doToken typedSequentialExprBlock doneDeclEnd { let mFor = rhs parseState 1 let mDo = rhs parseState 3 diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 8c4a1300a7f..7ed070f46bc 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated Bajtový řetězec se nedá interpolovat. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 688592092e3..1e9e4e7d5ce 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated Eine Bytezeichenfolge darf nicht interpoliert werden. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index a06daa1f7f1..1a2ee6b7024 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated no se puede interpolar una cadena de bytes diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index f8a89904bfa..9d251b91bb4 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated une chaîne d'octets ne peut pas être interpolée diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 37d11b74636..c1b5315e412 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated non è possibile interpolare una stringa di byte diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index c42700c1d18..03c26585437 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated バイト文字列は補間されていない可能性があります diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 39e9a33001e..6821658ff33 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated 바이트 문자열을 보간하지 못할 수 있습니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index e3a61d7dd58..77e850cef2b 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated ciąg bajtowy nie może być interpolowany diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 78742938012..153df58e87b 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated uma cadeia de caracteres de byte não pode ser interpolada diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 837271832bf..02d25f959e0 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated невозможно выполнить интерполяцию для строки байтов diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 59d04a3fe94..780c1997ee8 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated bir bayt dizesi, düz metin arasına kod eklenerek kullanılamaz diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index ebcafbf1852..59eefa494c5 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated 不能内插字节字符串 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 0606b9b48c4..b46593e7ef3 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -417,6 +417,11 @@ Used to check if an object is of the given type in a pattern or binding. + + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression. + + a byte string may not be interpolated 位元組字串不能是插補字串 diff --git a/src/Compiler/xlf/FSStrings.cs.xlf b/src/Compiler/xlf/FSStrings.cs.xlf index cfa554f8d23..dedd2d1dde0 100644 --- a/src/Compiler/xlf/FSStrings.cs.xlf +++ b/src/Compiler/xlf/FSStrings.cs.xlf @@ -42,6 +42,11 @@ interpolovaný řetězec (část) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Viz taky {0}. diff --git a/src/Compiler/xlf/FSStrings.de.xlf b/src/Compiler/xlf/FSStrings.de.xlf index 777bac9468b..0f4c16dfb00 100644 --- a/src/Compiler/xlf/FSStrings.de.xlf +++ b/src/Compiler/xlf/FSStrings.de.xlf @@ -42,6 +42,11 @@ Interpolierte Zeichenfolge (Teil) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Siehe auch "{0}". diff --git a/src/Compiler/xlf/FSStrings.es.xlf b/src/Compiler/xlf/FSStrings.es.xlf index 443fc6459d2..ad5e91053bc 100644 --- a/src/Compiler/xlf/FSStrings.es.xlf +++ b/src/Compiler/xlf/FSStrings.es.xlf @@ -42,6 +42,11 @@ cadena interpolada (parte) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Vea también {0}. diff --git a/src/Compiler/xlf/FSStrings.fr.xlf b/src/Compiler/xlf/FSStrings.fr.xlf index f6050605937..fbb7b73b9fa 100644 --- a/src/Compiler/xlf/FSStrings.fr.xlf +++ b/src/Compiler/xlf/FSStrings.fr.xlf @@ -42,6 +42,11 @@ chaîne interpolée (partie) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Voir aussi {0}. diff --git a/src/Compiler/xlf/FSStrings.it.xlf b/src/Compiler/xlf/FSStrings.it.xlf index 30b69ecd61a..831d2e5ba72 100644 --- a/src/Compiler/xlf/FSStrings.it.xlf +++ b/src/Compiler/xlf/FSStrings.it.xlf @@ -42,6 +42,11 @@ stringa interpolata (parte) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Vedere anche {0}. diff --git a/src/Compiler/xlf/FSStrings.ja.xlf b/src/Compiler/xlf/FSStrings.ja.xlf index dc93c489205..4ecf1faee37 100644 --- a/src/Compiler/xlf/FSStrings.ja.xlf +++ b/src/Compiler/xlf/FSStrings.ja.xlf @@ -42,6 +42,11 @@ 補間された文字列 (部分) + + keyword 'while!' + keyword 'while!' + + . See also {0}. 。{0} も参照してください。 diff --git a/src/Compiler/xlf/FSStrings.ko.xlf b/src/Compiler/xlf/FSStrings.ko.xlf index bafe727c644..605ff52819d 100644 --- a/src/Compiler/xlf/FSStrings.ko.xlf +++ b/src/Compiler/xlf/FSStrings.ko.xlf @@ -42,6 +42,11 @@ 보간 문자열(부분) + + keyword 'while!' + keyword 'while!' + + . See also {0}. {0}도 참조하세요. diff --git a/src/Compiler/xlf/FSStrings.pl.xlf b/src/Compiler/xlf/FSStrings.pl.xlf index 3040e343b9d..a984c6b13c6 100644 --- a/src/Compiler/xlf/FSStrings.pl.xlf +++ b/src/Compiler/xlf/FSStrings.pl.xlf @@ -42,6 +42,11 @@ ciąg interpolowany (część) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Zobacz też {0}. diff --git a/src/Compiler/xlf/FSStrings.pt-BR.xlf b/src/Compiler/xlf/FSStrings.pt-BR.xlf index d17084376b1..f85e98c4bd9 100644 --- a/src/Compiler/xlf/FSStrings.pt-BR.xlf +++ b/src/Compiler/xlf/FSStrings.pt-BR.xlf @@ -42,6 +42,11 @@ cadeia de caracteres interpolada (parte) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Consulte também {0}. diff --git a/src/Compiler/xlf/FSStrings.ru.xlf b/src/Compiler/xlf/FSStrings.ru.xlf index 3ff9aaf3df5..1bfb3ce7984 100644 --- a/src/Compiler/xlf/FSStrings.ru.xlf +++ b/src/Compiler/xlf/FSStrings.ru.xlf @@ -42,6 +42,11 @@ интерполированная строка (часть) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . См. также {0}. diff --git a/src/Compiler/xlf/FSStrings.tr.xlf b/src/Compiler/xlf/FSStrings.tr.xlf index 4037386bdb6..1061918ab31 100644 --- a/src/Compiler/xlf/FSStrings.tr.xlf +++ b/src/Compiler/xlf/FSStrings.tr.xlf @@ -42,6 +42,11 @@ düz metin arasına kod eklenmiş dize (parça) + + keyword 'while!' + keyword 'while!' + + . See also {0}. . Ayrıca bkz. {0}. diff --git a/src/Compiler/xlf/FSStrings.zh-Hans.xlf b/src/Compiler/xlf/FSStrings.zh-Hans.xlf index 9cd326e3dd7..ce4ce1a7e0a 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hans.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hans.xlf @@ -42,6 +42,11 @@ 内插字符串(部分) + + keyword 'while!' + keyword 'while!' + + . See also {0}. 。请参见 {0}。 diff --git a/src/Compiler/xlf/FSStrings.zh-Hant.xlf b/src/Compiler/xlf/FSStrings.zh-Hant.xlf index 30cdcc66af5..b9b1dfe04eb 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hant.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hant.xlf @@ -42,6 +42,11 @@ 插補字串 (部分) + + keyword 'while!' + keyword 'while!' + + . See also {0}. 。請參閱 {0}。 From b8a9aaef82c60986a09465f84893dcbcd2eee139 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 5 Nov 2022 09:56:00 +0100 Subject: [PATCH 02/15] Refactor, surface area, negative typecheck baseline --- .../Checking/CheckComputationExpressions.fs | 16 +++++------ .../Service/FSharpParseFileResults.fs | 19 +++---------- src/Compiler/Service/ServiceParseTreeWalk.fs | 28 +++++-------------- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 12 ++++---- ...erService.SurfaceArea.netstandard.expected | 18 ++++++++++++ tests/fsharp/tests.fs | 3 ++ tests/fsharp/typecheck/sigs/neg134.bsl | 17 +++++++++++ tests/fsharp/typecheck/sigs/neg134.fs | 19 +++++++++++++ 8 files changed, 82 insertions(+), 50 deletions(-) create mode 100644 tests/fsharp/typecheck/sigs/neg134.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg134.fs diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 16ed1ae7bfd..6a9260a5448 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -1426,20 +1426,20 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // todo desugar directly instead of rewriting first let body = - let id = mkSynId range.Zero "$cond" + let id = mkSynId mGuard "$cond" let pat = mkSynPatVar None id let body = - let id2 = mkSynId range.Zero "$condM" + let id2 = mkSynId mGuard "$condM" let pat2 = mkSynPatVar None id2 - let b = mkSynBinding (Xml.PreXmlDoc.Empty, pat2) (None, false, true, range.Zero, DebugPointAtBinding.NoneAtInvisible, None, SynExpr.Ident id, range.Zero, [], [], None, SynBindingTrivia.Zero) - let set = SynExpr.LongIdentSet (SynLongIdent.SynLongIdent ([ id2 ], [], []), SynExpr.Ident id, range.Zero) - let bang = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], set, range.Zero, SynExprLetOrUseBangTrivia.Zero) + let b = mkSynBinding (Xml.PreXmlDoc.Empty, pat2) (None, false, true, mGuard, DebugPointAtBinding.NoneAtInvisible, None, SynExpr.Ident id, mGuard, [], [], None, SynBindingTrivia.Zero) + let set = SynExpr.LongIdentSet (SynLongIdent.SynLongIdent ([ id2 ], [], []), SynExpr.Ident id, mGuard) + let bang = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], set, mGuard, SynExprLetOrUseBangTrivia.Zero) - let body = SynExpr.While (spWhile, SynExpr.Ident id2, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bang, range.Zero), range.Zero) - SynExpr.LetOrUse (false, false, [ b ], body, range.Zero, { InKeyword = None }) + let body = SynExpr.While (spWhile, SynExpr.Ident id2, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bang, mWhile), mWhile) + SynExpr.LetOrUse (false, false, [ b ], body, mGuard, { InKeyword = None }) - SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], body, range.Zero, SynExprLetOrUseBangTrivia.Zero) + SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], body, mGuard, SynExprLetOrUseBangTrivia.Zero) tryTrans CompExprTranslationPass.Initial q varSpace body translatedCtxt diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 61a5da8638e..372f9fdb5b3 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -734,7 +734,8 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, for SynInterfaceImpl (bindings = bs) in is do yield! walkBinds bs - | SynExpr.While (spWhile, e1, e2, _) -> + | SynExpr.While (spWhile, e1, e2, _) + | SynExpr.WhileBang (spWhile, e1, e2, _) -> yield! walkWhileSeqPt spWhile yield! walkExpr false e1 yield! walkExpr true e2 @@ -766,7 +767,8 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynExpr.Lambda (body = bodyExpr) -> yield! walkExpr true bodyExpr - | SynExpr.Match (matchDebugPoint = spBind; expr = inpExpr; clauses = cl) -> + | SynExpr.Match (matchDebugPoint = spBind; expr = inpExpr; clauses = cl) + | SynExpr.MatchBang (matchDebugPoint = spBind; expr = inpExpr; clauses = cl) -> yield! walkBindSeqPt spBind yield! walkExpr false inpExpr @@ -848,19 +850,6 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, yield! walkExpr true eAndBang yield! walkExpr true bodyExpr - - | SynExpr.MatchBang (matchDebugPoint = spBind; expr = inpExpr; clauses = clauses) -> - yield! walkBindSeqPt spBind - yield! walkExpr false inpExpr - - for SynMatchClause (whenExpr = whenExpr; resultExpr = resExpr) in clauses do - yield! walkExprOpt true whenExpr - yield! walkExpr true resExpr - - | SynExpr.WhileBang (spWhile, e1, e2, _) -> - yield! walkWhileSeqPt spWhile - yield! walkExpr false e1 - yield! walkExpr true e2 ] // Process a class declaration or F# type declaration diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 576da295a48..1522d579e62 100644 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -505,7 +505,8 @@ module SyntaxTraversal = ] |> pick expr - | SynExpr.While (_spWhile, synExpr, synExpr2, _range) -> + | SynExpr.While (_spWhile, synExpr, synExpr2, _range) + | SynExpr.WhileBang (_spWhile, synExpr, synExpr2, _range) -> [ dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr @@ -561,7 +562,8 @@ module SyntaxTraversal = |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) |> pick expr - | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) -> + | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) + | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) -> [ yield dive synExpr synExpr.Range traverseSynExpr yield! @@ -570,7 +572,9 @@ module SyntaxTraversal = ] |> pick expr - | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.Do (synExpr, _) + | SynExpr.DoBang (synExpr, _) -> + traverseSynExpr synExpr | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr @@ -755,24 +759,6 @@ module SyntaxTraversal = ] |> pick expr - | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) -> - [ - yield dive synExpr synExpr.Range traverseSynExpr - yield! - synMatchClauseList - |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) - ] - |> pick expr - - | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr - - | SynExpr.WhileBang (_spWhile, synExpr, synExpr2, _range) -> - [ - dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr - ] - |> pick expr - | SynExpr.LibraryOnlyILAssembly _ -> None | SynExpr.LibraryOnlyStaticOptimization _ -> None diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index f40ff64a6a7..09d73080abc 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -866,7 +866,9 @@ let rec synExprContainsError inpExpr = walkBinds bs || walkBinds binds | SynExpr.ForEach (_, _, _, _, _, e1, e2, _) - | SynExpr.While (_, e1, e2, _) -> walkExpr e1 || walkExpr e2 + | SynExpr.While (_, e1, e2, _) + | SynExpr.WhileBang (_, e1, e2, _) -> + walkExpr e1 || walkExpr e2 | SynExpr.For (identBody = e1; toBody = e2; doBody = e3) -> walkExpr e1 || walkExpr e2 || walkExpr e3 @@ -874,7 +876,9 @@ let rec synExprContainsError inpExpr = | SynExpr.Lambda (body = e) -> walkExpr e - | SynExpr.Match (expr = e; clauses = cl) -> walkExpr e || walkMatchClauses cl + | SynExpr.Match (expr = e; clauses = cl) + | SynExpr.MatchBang (expr = e; clauses = cl) -> + walkExpr e || walkMatchClauses cl | SynExpr.LetOrUse (bindings = bs; body = e) -> walkBinds bs || walkExpr e @@ -904,8 +908,6 @@ let rec synExprContainsError inpExpr = | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> walkExpr e1 || walkExpr e2 || walkExpr e3 - | SynExpr.MatchBang (expr = e; clauses = cl) -> walkExpr e || walkMatchClauses cl - | SynExpr.LetOrUseBang (rhs = e1; body = e2; andBangs = es) -> walkExpr e1 || walkExprs @@ -915,8 +917,6 @@ let rec synExprContainsError inpExpr = ] || walkExpr e2 - | SynExpr.WhileBang (_, e1, e2, _) -> walkExpr e1 || walkExpr e2 - | SynExpr.InterpolatedString (parts, _, _m) -> parts |> List.choose (function diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 1ece3f1a780..14c8fef999f 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -6740,6 +6740,7 @@ FSharp.Compiler.Syntax.SynExpr+Tags: Int32 TypeTest FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Typed FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Upcast FSharp.Compiler.Syntax.SynExpr+Tags: Int32 While +FSharp.Compiler.Syntax.SynExpr+Tags: Int32 WhileBang FSharp.Compiler.Syntax.SynExpr+Tags: Int32 YieldOrReturn FSharp.Compiler.Syntax.SynExpr+Tags: Int32 YieldOrReturnFrom FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Syntax.SynExpr argExpr @@ -6826,6 +6827,14 @@ FSharp.Compiler.Syntax.SynExpr+While: FSharp.Compiler.Syntax.SynExpr get_whileEx FSharp.Compiler.Syntax.SynExpr+While: FSharp.Compiler.Syntax.SynExpr whileExpr FSharp.Compiler.Syntax.SynExpr+While: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+While: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Syntax.DebugPointAtWhile get_whileDebugPoint() +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Syntax.DebugPointAtWhile whileDebugPoint +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Syntax.SynExpr doExpr +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Syntax.SynExpr get_doExpr() +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Syntax.SynExpr get_whileExpr() +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Syntax.SynExpr whileExpr +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynExpr+WhileBang: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynExpr+YieldOrReturn: FSharp.Compiler.Syntax.SynExpr expr FSharp.Compiler.Syntax.SynExpr+YieldOrReturn: FSharp.Compiler.Syntax.SynExpr get_expr() FSharp.Compiler.Syntax.SynExpr+YieldOrReturn: FSharp.Compiler.Text.Range get_range() @@ -6905,6 +6914,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean IsTypeTest FSharp.Compiler.Syntax.SynExpr: Boolean IsTyped FSharp.Compiler.Syntax.SynExpr: Boolean IsUpcast FSharp.Compiler.Syntax.SynExpr: Boolean IsWhile +FSharp.Compiler.Syntax.SynExpr: Boolean IsWhileBang FSharp.Compiler.Syntax.SynExpr: Boolean IsYieldOrReturn FSharp.Compiler.Syntax.SynExpr: Boolean IsYieldOrReturnFrom FSharp.Compiler.Syntax.SynExpr: Boolean get_IsAddressOf() @@ -6974,6 +6984,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTypeTest() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTyped() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsUpcast() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhile() +FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhileBang() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) @@ -7042,6 +7053,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTypeTest(FShar FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTyped(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewUpcast(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewWhile(FSharp.Compiler.Syntax.DebugPointAtWhile, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewWhileBang(FSharp.Compiler.Syntax.DebugPointAtWhile, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewYieldOrReturn(System.Tuple`2[System.Boolean,System.Boolean], FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewYieldOrReturnFrom(System.Tuple`2[System.Boolean,System.Boolean], FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+AddressOf @@ -7111,6 +7123,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TypeTest FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Typed FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Upcast FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+While +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+WhileBang FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+YieldOrReturn FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+YieldOrReturnFrom FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Text.Range Range @@ -10473,6 +10486,7 @@ FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 Val FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 Void FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 When FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 While +FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 WhileBang FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 WhitespaceTrivia FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 With FSharp.Compiler.Tokenization.FSharpTokenKind+Tags: Int32 Yield @@ -10666,6 +10680,7 @@ FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsVal FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsVoid FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsWhen FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsWhile +FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsWhileBang FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsWhitespaceTrivia FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsWith FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean IsYield @@ -10856,6 +10871,7 @@ FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsVal() FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsVoid() FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsWhen() FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsWhile() +FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsWhileBang() FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsWhitespaceTrivia() FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsWith() FSharp.Compiler.Tokenization.FSharpTokenKind: Boolean get_IsYield() @@ -11046,6 +11062,7 @@ FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FShar FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind Void FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind When FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind While +FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind WhileBang FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind WhitespaceTrivia FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind With FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind Yield @@ -11236,6 +11253,7 @@ FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FShar FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind get_Void() FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind get_When() FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind get_While() +FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind get_WhileBang() FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind get_WhitespaceTrivia() FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind get_With() FSharp.Compiler.Tokenization.FSharpTokenKind: FSharp.Compiler.Tokenization.FSharpTokenKind get_Yield() diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index e1ec4ad346d..435b0ec600d 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -3170,6 +3170,9 @@ module TypecheckTests = [] let ``type check neg133`` () = singleNegTest (testConfig "typecheck/sigs") "neg133" + + [] + let ``type check neg134`` () = singleNegTest (testConfig "typecheck/sigs") "neg134" [] let ``type check neg_anon_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_anon_1" diff --git a/tests/fsharp/typecheck/sigs/neg134.bsl b/tests/fsharp/typecheck/sigs/neg134.bsl new file mode 100644 index 00000000000..31e6fa43adb --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg134.bsl @@ -0,0 +1,17 @@ + +neg134.fs(5,12,5,29): typecheck error FS0001: This expression was expected to have type + 'bool' +but here has type + 'int' + + +neg134.fs(10,12,10,16): typecheck error FS0001: This expression was expected to have type + 'Async<'a>' +but here has type + 'bool' + + +neg134.fs(15,9,15,10): typecheck error FS0001: This expression was expected to have type + 'Async<'a>' +but here has type + 'int' \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/neg134.fs b/tests/fsharp/typecheck/sigs/neg134.fs new file mode 100644 index 00000000000..2302b9c60db --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg134.fs @@ -0,0 +1,19 @@ +module Neg134 +open System.Threading.Tasks + +let a () = task { + while! Task.FromResult 1 do + () +} + +let b () = async { + while! true do + () +} + +let c () = async { + do! 1 + + while! async { return true } do + () +} \ No newline at end of file From 8a99feb9bb9efa0300658c3a0b4c5e7fa8454535 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 5 Nov 2022 12:26:38 +0100 Subject: [PATCH 03/15] Refactor --- .../Checking/CheckComputationExpressions.fs | 71 ++++++++----------- src/Compiler/Service/ServiceParseTreeWalk.fs | 3 +- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 6 +- src/Compiler/SyntaxTree/SyntaxTrivia.fs | 7 +- src/Compiler/SyntaxTree/SyntaxTrivia.fsi | 2 + ...erService.SurfaceArea.netstandard.expected | 2 + tests/fsharp/tests.fs | 6 ++ tests/fsharp/typecheck/sigs/neg134.bsl | 23 +++--- tests/fsharp/typecheck/sigs/neg134.fs | 5 ++ tests/fsharp/typecheck/sigs/pos41.fs | 32 +++++++++ 10 files changed, 101 insertions(+), 56 deletions(-) create mode 100644 tests/fsharp/typecheck/sigs/pos41.fs diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 6a9260a5448..024c97c5b86 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -1030,6 +1030,36 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol [ mkSynDelay2 guardExpr; mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) ) + | SynExpr.WhileBang (spWhile, guardExpr, innerComp, _) -> + let mGuard = guardExpr.Range + let mWhile = match spWhile with DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) | _ -> mGuard + + // 'while!' is hit just before each time the guard is called + let guardExpr = + match spWhile with + | DebugPointAtWhile.Yes _ -> + SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) + | DebugPointAtWhile.No -> guardExpr + + // todo desugar directly instead of rewriting first + let body = + let id = mkSynId mGuard "$cond" + let pat = mkSynPatVar None id + + let body = + let id2 = mkSynId mGuard "$condM" + let pat2 = mkSynPatVar None id2 + let b = mkSynBinding (Xml.PreXmlDoc.Empty, pat2) (None, false, true, mGuard, DebugPointAtBinding.NoneAtSticky, None, SynExpr.Ident id, mGuard, [], [], None, SynBindingTrivia.Zero) + let set = SynExpr.LongIdentSet (SynLongIdent ([ id2 ], [], []), SynExpr.Ident id, mGuard) + let bang = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, false, pat, guardExpr, [], set, mGuard, SynExprLetOrUseBangTrivia.Zero) + + let body = SynExpr.While (DebugPointAtWhile.No, SynExpr.Ident id2, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bang, mWhile), mWhile) + SynExpr.LetOrUse (false, false, [ b ], body, mGuard, SynExprLetOrUseTrivia.Zero) + + SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, false, pat, guardExpr, [], body, mGuard, SynExprLetOrUseBangTrivia.Zero) + + tryTrans CompExprTranslationPass.Initial q varSpace body translatedCtxt + | SynExpr.TryFinally (innerComp, unwindExpr, _mTryToLast, spTry, spFinally, trivia) -> let mTry = match spTry with DebugPointAtTry.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Try) | _ -> trivia.TryKeyword @@ -1402,47 +1432,6 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol Some(translatedCtxt callExpr) - | SynExpr.WhileBang (spWhile, guardExpr, innerComp, _) -> - let mGuard = guardExpr.Range - let mWhile = match spWhile with DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) | _ -> 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 "Bind" builderTy) then - error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), mWhile)) - - // 'while' is hit just before each time the guard is called - let guardExpr = - match spWhile with - | DebugPointAtWhile.Yes _ -> - SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) - | DebugPointAtWhile.No -> guardExpr - - // todo desugar directly instead of rewriting first - let body = - let id = mkSynId mGuard "$cond" - let pat = mkSynPatVar None id - - let body = - let id2 = mkSynId mGuard "$condM" - let pat2 = mkSynPatVar None id2 - let b = mkSynBinding (Xml.PreXmlDoc.Empty, pat2) (None, false, true, mGuard, DebugPointAtBinding.NoneAtInvisible, None, SynExpr.Ident id, mGuard, [], [], None, SynBindingTrivia.Zero) - let set = SynExpr.LongIdentSet (SynLongIdent.SynLongIdent ([ id2 ], [], []), SynExpr.Ident id, mGuard) - let bang = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], set, mGuard, SynExprLetOrUseBangTrivia.Zero) - - let body = SynExpr.While (spWhile, SynExpr.Ident id2, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bang, mWhile), mWhile) - SynExpr.LetOrUse (false, false, [ b ], body, mGuard, { InKeyword = None }) - - SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtInvisible, false, false, pat, guardExpr, [], body, mGuard, SynExprLetOrUseBangTrivia.Zero) - - tryTrans CompExprTranslationPass.Initial q varSpace body translatedCtxt - | SynExpr.TryWith (innerComp, clauses, mTryToLast, spTry, spWith, trivia) -> let mTry = match spTry with DebugPointAtTry.Yes _ -> trivia.TryKeyword.NoteSourceConstruct(NotedSourceConstruct.Try) | _ -> trivia.TryKeyword let spWith2 = match spWith with DebugPointAtWith.Yes _ -> DebugPointAtBinding.Yes trivia.WithKeyword | _ -> DebugPointAtBinding.NoneAtInvisible diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 1522d579e62..1f6815d99d4 100644 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -573,8 +573,7 @@ module SyntaxTraversal = |> pick expr | SynExpr.Do (synExpr, _) - | SynExpr.DoBang (synExpr, _) -> - traverseSynExpr synExpr + | SynExpr.DoBang (synExpr, _) -> traverseSynExpr synExpr | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 09d73080abc..da6edd1b4ab 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -867,8 +867,7 @@ let rec synExprContainsError inpExpr = | SynExpr.ForEach (_, _, _, _, _, e1, e2, _) | SynExpr.While (_, e1, e2, _) - | SynExpr.WhileBang (_, e1, e2, _) -> - walkExpr e1 || walkExpr e2 + | SynExpr.WhileBang (_, e1, e2, _) -> walkExpr e1 || walkExpr e2 | SynExpr.For (identBody = e1; toBody = e2; doBody = e3) -> walkExpr e1 || walkExpr e2 || walkExpr e3 @@ -877,8 +876,7 @@ let rec synExprContainsError inpExpr = | SynExpr.Lambda (body = e) -> walkExpr e | SynExpr.Match (expr = e; clauses = cl) - | SynExpr.MatchBang (expr = e; clauses = cl) -> - walkExpr e || walkMatchClauses cl + | SynExpr.MatchBang (expr = e; clauses = cl) -> walkExpr e || walkMatchClauses cl | SynExpr.LetOrUse (bindings = bs; body = e) -> walkBinds bs || walkExpr e diff --git a/src/Compiler/SyntaxTree/SyntaxTrivia.fs b/src/Compiler/SyntaxTree/SyntaxTrivia.fs index 10b052a5a00..9aa15824896 100644 --- a/src/Compiler/SyntaxTree/SyntaxTrivia.fs +++ b/src/Compiler/SyntaxTree/SyntaxTrivia.fs @@ -76,7 +76,12 @@ type SynExprLambdaTrivia = static member Zero: SynExprLambdaTrivia = { ArrowRange = None } [] -type SynExprLetOrUseTrivia = { InKeyword: range option } +type SynExprLetOrUseTrivia = + { + InKeyword: range option + } + + static member Zero: SynExprLetOrUseTrivia = { InKeyword = None } [] type SynExprLetOrUseBangTrivia = diff --git a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi index 08d847fc5ea..ddfd39216fb 100644 --- a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi @@ -127,6 +127,8 @@ type SynExprLetOrUseTrivia = InKeyword: range option } + static member Zero: SynExprLetOrUseTrivia + /// Represents additional information for SynExpr.LetOrUseBang [] type SynExprLetOrUseBangTrivia = diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 14c8fef999f..9232d9dca0c 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -9470,6 +9470,8 @@ FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseBangTrivia: Microsoft.FSharp.Core.FS FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseBangTrivia: System.String ToString() FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseBangTrivia: Void .ctor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range]) FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia +FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia: FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia Zero +FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia: FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia get_Zero() FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] InKeyword FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_InKeyword() FSharp.Compiler.SyntaxTrivia.SynExprLetOrUseTrivia: System.String ToString() diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 435b0ec600d..f2f0989b451 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -2588,6 +2588,12 @@ module TypecheckTests = fsc cfg "%s --langversion:6.0 --target:exe -o:pos40.exe" cfg.fsc_flags ["pos40.fs"] peverify cfg "pos40.exe" exec cfg ("." ++ "pos40.exe") "" + + [] + let ``sigs pos41`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:pos41.dll --warnaserror" cfg.fsc_flags ["pos41.fs"] + peverify cfg "pos41.dll" [] let ``sigs pos1281`` () = diff --git a/tests/fsharp/typecheck/sigs/neg134.bsl b/tests/fsharp/typecheck/sigs/neg134.bsl index 31e6fa43adb..5f1d0f3e4c6 100644 --- a/tests/fsharp/typecheck/sigs/neg134.bsl +++ b/tests/fsharp/typecheck/sigs/neg134.bsl @@ -1,17 +1,24 @@ neg134.fs(5,12,5,29): typecheck error FS0001: This expression was expected to have type - 'bool' + 'bool' but here has type - 'int' - - + 'int' + neg134.fs(10,12,10,16): typecheck error FS0001: This expression was expected to have type - 'Async<'a>' + 'Async<'a>' but here has type - 'bool' + 'bool' +neg134.fs(10,12,10,16): typecheck error FS0001: This expression was expected to have type + 'Async<'a>' +but here has type + 'bool' neg134.fs(15,9,15,10): typecheck error FS0001: This expression was expected to have type - 'Async<'a>' + 'Async<'a>' but here has type - 'int' \ No newline at end of file + 'int' + +neg134.fs(24,1,24,2): parse error FS0010: Unexpected symbol '}' in expression + +neg134.fs(22,5,22,10): parse error FS3122: Missing 'do' in 'while!' expression. Expected 'while! do '. diff --git a/tests/fsharp/typecheck/sigs/neg134.fs b/tests/fsharp/typecheck/sigs/neg134.fs index 2302b9c60db..b6727900bf9 100644 --- a/tests/fsharp/typecheck/sigs/neg134.fs +++ b/tests/fsharp/typecheck/sigs/neg134.fs @@ -16,4 +16,9 @@ let c () = async { while! async { return true } do () +} + +let d () = async { + while! async { return true } + () } \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/pos41.fs b/tests/fsharp/typecheck/sigs/pos41.fs new file mode 100644 index 00000000000..718b606d3c7 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/pos41.fs @@ -0,0 +1,32 @@ +module Pos41 + +open System +open System.Threading.Tasks + +let a () = async { + while! async { return true } do + () +} + +let b () = task { + while! task { return true } do + () +} + +let c () = task { + while! Task.FromResult true do + () +} + +let d' (t: DateTime) = Task.FromResult (t.Second = 1) + +let d () = task { + do! Async.Sleep 1000 + + while! d' DateTime.Now do + try + while true do + printfn "yup" + with _ -> + do! Async.Sleep 1000 +} \ No newline at end of file From e8c07ccd6a22a4d4bec1a94615ebff850d1c8c58 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 5 Nov 2022 15:11:24 +0100 Subject: [PATCH 04/15] Add runtime test --- .../Microsoft.FSharp.Control/AsyncType.fs | 20 +++++++++++++++++++ tests/fsharp/typecheck/sigs/neg134.bsl | 7 ++++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 29d086d0f20..34a3ec56cf0 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -538,3 +538,23 @@ type AsyncType() = with Failure "finish" -> hasThrown <- true Assert.True hasThrown + + [] + member _.WhileBang () = + let mutable count = 0 + + let asyncCondition = async { + return count < 10 + } + + async { + count <- 1 + + while! asyncCondition do + count <- count + 2 + + count <- count + 1 + } + |> Async.RunSynchronously + + Assert.Equal (12, count) diff --git a/tests/fsharp/typecheck/sigs/neg134.bsl b/tests/fsharp/typecheck/sigs/neg134.bsl index 5f1d0f3e4c6..1647de61214 100644 --- a/tests/fsharp/typecheck/sigs/neg134.bsl +++ b/tests/fsharp/typecheck/sigs/neg134.bsl @@ -1,4 +1,8 @@ +neg134.fs(24,1,24,2): parse error FS0010: Unexpected symbol '}' in expression + +neg134.fs(22,5,22,11): parse error FS3122: Missing 'do' in 'while' expression. Expected 'while do '. + neg134.fs(5,12,5,29): typecheck error FS0001: This expression was expected to have type 'bool' but here has type @@ -19,6 +23,3 @@ neg134.fs(15,9,15,10): typecheck error FS0001: This expression was expected to h but here has type 'int' -neg134.fs(24,1,24,2): parse error FS0010: Unexpected symbol '}' in expression - -neg134.fs(22,5,22,10): parse error FS3122: Missing 'do' in 'while!' expression. Expected 'while! do '. From 12ace42248608e28a888c2fee433d73b46799b28 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 5 Nov 2022 19:13:11 +0100 Subject: [PATCH 05/15] Split tests, use synthetic ranges --- .../Checking/CheckComputationExpressions.fs | 27 ++++++++++--------- tests/fsharp/tests.fs | 3 +++ tests/fsharp/typecheck/sigs/neg134.bsl | 4 --- tests/fsharp/typecheck/sigs/neg134.fs | 5 ---- tests/fsharp/typecheck/sigs/neg135.bsl | 4 +++ tests/fsharp/typecheck/sigs/neg135.fs | 6 +++++ 6 files changed, 27 insertions(+), 22 deletions(-) create mode 100644 tests/fsharp/typecheck/sigs/neg135.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg135.fs diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 024c97c5b86..c44ec288c66 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -1030,9 +1030,10 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol [ mkSynDelay2 guardExpr; mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) ) - | SynExpr.WhileBang (spWhile, guardExpr, innerComp, _) -> + | SynExpr.WhileBang (spWhile, guardExpr, innerComp, mOrig) -> let mGuard = guardExpr.Range let mWhile = match spWhile with DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) | _ -> mGuard + let mGuard = mGuard.MakeSynthetic() // 'while!' is hit just before each time the guard is called let guardExpr = @@ -1042,23 +1043,23 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | DebugPointAtWhile.No -> guardExpr // todo desugar directly instead of rewriting first - let body = - let id = mkSynId mGuard "$cond" - let pat = mkSynPatVar None id + let rewrittenWhileExpr = + let idFirst = mkSynId mGuard "__first" + let patFirst = mkSynPatVar None idFirst let body = - let id2 = mkSynId mGuard "$condM" - let pat2 = mkSynPatVar None id2 - let b = mkSynBinding (Xml.PreXmlDoc.Empty, pat2) (None, false, true, mGuard, DebugPointAtBinding.NoneAtSticky, None, SynExpr.Ident id, mGuard, [], [], None, SynBindingTrivia.Zero) - let set = SynExpr.LongIdentSet (SynLongIdent ([ id2 ], [], []), SynExpr.Ident id, mGuard) - let bang = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, false, pat, guardExpr, [], set, mGuard, SynExprLetOrUseBangTrivia.Zero) + let idCond = mkSynId mGuard "__cond" + let patCond = mkSynPatVar None idCond + let condBinding = mkSynBinding (Xml.PreXmlDoc.Empty, patCond) (None, false, true, mGuard, DebugPointAtBinding.NoneAtSticky, None, SynExpr.Ident idFirst, mGuard, [], [], None, SynBindingTrivia.Zero) + let setCondExpr = SynExpr.Set (SynExpr.Ident idCond, SynExpr.Ident idFirst, mGuard) + let bindCondExpr = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, true, patFirst, guardExpr, [], setCondExpr, mGuard, SynExprLetOrUseBangTrivia.Zero) - let body = SynExpr.While (DebugPointAtWhile.No, SynExpr.Ident id2, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bang, mWhile), mWhile) - SynExpr.LetOrUse (false, false, [ b ], body, mGuard, SynExprLetOrUseTrivia.Zero) + let whileExpr = SynExpr.While (DebugPointAtWhile.No, SynExpr.Ident idCond, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bindCondExpr, mWhile), mOrig) + SynExpr.LetOrUse (false, false, [ condBinding ], whileExpr, mGuard, SynExprLetOrUseTrivia.Zero) - SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, false, pat, guardExpr, [], body, mGuard, SynExprLetOrUseBangTrivia.Zero) + SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, true, patFirst, guardExpr, [], body, mGuard, SynExprLetOrUseBangTrivia.Zero) - tryTrans CompExprTranslationPass.Initial q varSpace body translatedCtxt + tryTrans CompExprTranslationPass.Initial q varSpace rewrittenWhileExpr translatedCtxt | SynExpr.TryFinally (innerComp, unwindExpr, _mTryToLast, spTry, spFinally, trivia) -> diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index f2f0989b451..f35a39778d8 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -3180,6 +3180,9 @@ module TypecheckTests = [] let ``type check neg134`` () = singleNegTest (testConfig "typecheck/sigs") "neg134" + [] + let ``type check neg135`` () = singleNegTest (testConfig "typecheck/sigs") "neg135" + [] let ``type check neg_anon_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_anon_1" diff --git a/tests/fsharp/typecheck/sigs/neg134.bsl b/tests/fsharp/typecheck/sigs/neg134.bsl index 1647de61214..7611095a363 100644 --- a/tests/fsharp/typecheck/sigs/neg134.bsl +++ b/tests/fsharp/typecheck/sigs/neg134.bsl @@ -1,8 +1,4 @@ -neg134.fs(24,1,24,2): parse error FS0010: Unexpected symbol '}' in expression - -neg134.fs(22,5,22,11): parse error FS3122: Missing 'do' in 'while' expression. Expected 'while do '. - neg134.fs(5,12,5,29): typecheck error FS0001: This expression was expected to have type 'bool' but here has type diff --git a/tests/fsharp/typecheck/sigs/neg134.fs b/tests/fsharp/typecheck/sigs/neg134.fs index b6727900bf9..2302b9c60db 100644 --- a/tests/fsharp/typecheck/sigs/neg134.fs +++ b/tests/fsharp/typecheck/sigs/neg134.fs @@ -16,9 +16,4 @@ let c () = async { while! async { return true } do () -} - -let d () = async { - while! async { return true } - () } \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/neg135.bsl b/tests/fsharp/typecheck/sigs/neg135.bsl new file mode 100644 index 00000000000..4fa9303c7d7 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg135.bsl @@ -0,0 +1,4 @@ + +neg135.fs(6,1,6,2): parse error FS0010: Unexpected symbol '}' in expression + +neg135.fs(4,5,4,11): parse error FS3122: Missing 'do' in 'while' expression. Expected 'while do '. diff --git a/tests/fsharp/typecheck/sigs/neg135.fs b/tests/fsharp/typecheck/sigs/neg135.fs new file mode 100644 index 00000000000..113e5d0e719 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg135.fs @@ -0,0 +1,6 @@ +module Neg135 + +let a () = async { + while! async { return true } + () +} \ No newline at end of file From da04c61a7826c59e9b728d6c684b06db54cf5671 Mon Sep 17 00:00:00 2001 From: kerams Date: Mon, 7 Nov 2022 21:02:05 +0100 Subject: [PATCH 06/15] Stuff --- src/Compiler/Checking/CheckExpressions.fs | 10 +++------- tests/fsharp/typecheck/sigs/neg134.bsl | 1 - 2 files changed, 3 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index ae13ad91a6f..943594c1e8f 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5699,13 +5699,9 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m)) | SynExpr.DoBang (_, m) - | SynExpr.LetOrUseBang (range=m) -> - error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) - - | SynExpr.MatchBang (range=m) -> - error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) - - | SynExpr.WhileBang (range=m) -> + | SynExpr.MatchBang (range = m) + | SynExpr.WhileBang (range = m) + | SynExpr.LetOrUseBang (range = m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) // Part of 'T.Ident diff --git a/tests/fsharp/typecheck/sigs/neg134.bsl b/tests/fsharp/typecheck/sigs/neg134.bsl index 7611095a363..504d050d169 100644 --- a/tests/fsharp/typecheck/sigs/neg134.bsl +++ b/tests/fsharp/typecheck/sigs/neg134.bsl @@ -18,4 +18,3 @@ neg134.fs(15,9,15,10): typecheck error FS0001: This expression was expected to h 'Async<'a>' but here has type 'int' - From 7060c27cb1814f3bb4a1a3e1c98e5150a0270627 Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 10 Nov 2022 14:35:03 +0100 Subject: [PATCH 07/15] Move test --- .../FSharp.Compiler.ComponentTests.fsproj | 1 + .../Language/WhileBangTests.fs | 32 +++++++++++++++++++ .../Microsoft.FSharp.Control/AsyncType.fs | 22 +------------ 3 files changed, 34 insertions(+), 21 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 240cf851b92..34b8f8958c7 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -176,6 +176,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs new file mode 100644 index 00000000000..d631c36bf85 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs @@ -0,0 +1,32 @@ +namespace FSharp.Compiler.ComponentTests.Language + +open FSharp.Test +open Xunit +open FSharp.Test.Compiler + +module WhileBangTests = + + [] + let ``while! works as expected`` () = + FSharp """ + let mutable count = 0 + + let asyncCondition = async { + return count < 10 + } + + async { + count <- 1 + + while! asyncCondition do + count <- count + 2 + + count <- count + 1 + return count + } + |> Async.RunSynchronously + |> printfn "%d" + """ + |> compileExeAndRun + |> shouldSucceed + |> withStdOutContains "12" \ No newline at end of file diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 34a3ec56cf0..51d0233cd40 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -537,24 +537,4 @@ type AsyncType() = hasThrown <- false with Failure "finish" -> hasThrown <- true - Assert.True hasThrown - - [] - member _.WhileBang () = - let mutable count = 0 - - let asyncCondition = async { - return count < 10 - } - - async { - count <- 1 - - while! asyncCondition do - count <- count + 2 - - count <- count + 1 - } - |> Async.RunSynchronously - - Assert.Equal (12, count) + Assert.True hasThrown \ No newline at end of file From 732b61e91800b5d1cbea42cb0dbb12fc8b985462 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 26 Nov 2022 08:57:21 +0100 Subject: [PATCH 08/15] Make use of CompilerGeneratedName --- src/Compiler/Checking/CheckComputationExpressions.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index c44ec288c66..215190c9bf9 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -1044,11 +1044,11 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // todo desugar directly instead of rewriting first let rewrittenWhileExpr = - let idFirst = mkSynId mGuard "__first" + let idFirst = mkSynId mGuard (CompilerGeneratedName "first") let patFirst = mkSynPatVar None idFirst let body = - let idCond = mkSynId mGuard "__cond" + let idCond = mkSynId mGuard (CompilerGeneratedName "cond") let patCond = mkSynPatVar None idCond let condBinding = mkSynBinding (Xml.PreXmlDoc.Empty, patCond) (None, false, true, mGuard, DebugPointAtBinding.NoneAtSticky, None, SynExpr.Ident idFirst, mGuard, [], [], None, SynBindingTrivia.Zero) let setCondExpr = SynExpr.Set (SynExpr.Ident idCond, SynExpr.Ident idFirst, mGuard) From 79a1d34a5212f258f3feb8dd6525c9fcd905de34 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 26 Nov 2022 10:07:31 +0100 Subject: [PATCH 09/15] Add more tests --- .../Checking/CheckComputationExpressions.fs | 1 - .../Language/WhileBangTests.fs | 67 ++++++++++++++++++- .../Microsoft.FSharp.Control/AsyncType.fs | 2 +- 3 files changed, 67 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 215190c9bf9..ab565c9b356 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -1042,7 +1042,6 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) | DebugPointAtWhile.No -> guardExpr - // todo desugar directly instead of rewriting first let rewrittenWhileExpr = let idFirst = mkSynId mGuard (CompilerGeneratedName "first") let patFirst = mkSynPatVar None idFirst diff --git a/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs index d631c36bf85..929b7866021 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs @@ -29,4 +29,69 @@ module WhileBangTests = """ |> compileExeAndRun |> shouldSucceed - |> withStdOutContains "12" \ No newline at end of file + |> withStdOutContains "12" + + [] + let ``Nested while! works as expected`` () = + FSharp """ + let mutable total = 0 + let mutable outerCount = 0 + + let outerCondition = async { + outerCount <- outerCount + 1 + return outerCount <= 10 + } + + async { + while! outerCondition do + let mutable innerCount = 0 + + let innerCondition = async { + innerCount <- innerCount + 1 + return innerCount <= 3 + } + + while! innerCondition do + total <- total + 1 + + return total + } + |> Async.RunSynchronously + |> printfn "%d" + """ + |> compileExeAndRun + |> shouldSucceed + |> withStdOutContains "30" + + [] + let ``Nested while! works as expected2`` () = + FSharp """ + let mutable total = 0 + let mutable outerCount = 0 + + let outerCondition = async { + outerCount <- outerCount + 1 + return outerCount <= 10 + } + + let mutable innerOnce = true + + let innerCondition = async { + let c = innerOnce + innerOnce <- false + return c + } + + async { + while! outerCondition do + while! innerCondition do + total <- total + 1 + + return total + } + |> Async.RunSynchronously + |> printfn "%d" + """ + |> compileExeAndRun + |> shouldSucceed + |> withStdOutContains "1" \ No newline at end of file diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 51d0233cd40..29d086d0f20 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -537,4 +537,4 @@ type AsyncType() = hasThrown <- false with Failure "finish" -> hasThrown <- true - Assert.True hasThrown \ No newline at end of file + Assert.True hasThrown From bf5c16c9097b0d5ae20175ecff7cd917c23d5057 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 26 Nov 2022 21:28:18 +0100 Subject: [PATCH 10/15] Add task test --- .../Language/WhileBangTests.fs | 34 ++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs index 929b7866021..064ea901ef4 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs @@ -94,4 +94,36 @@ module WhileBangTests = """ |> compileExeAndRun |> shouldSucceed - |> withStdOutContains "1" \ No newline at end of file + |> withStdOutContains "1" + + [] + let ``Nested while! in task works as expected`` () = + FSharp """ + let mutable total = 0 + let mutable outerCount = 0 + + let outerCondition () = task { + outerCount <- outerCount + 1 + return outerCount <= 10 + } + + (task { + while! outerCondition () do + let mutable innerCount = 0 + + let innerCondition () = task { + innerCount <- innerCount + 1 + return innerCount <= 3 + } + + while! innerCondition () do + total <- total + 1 + + return total + }).Result + |> printfn "%d" + """ + |> ignoreWarnings + |> compileExeAndRun + |> shouldSucceed + |> withStdOutContains "30" \ No newline at end of file From 30d146dbf14c5305fabe86930ae352989c793039 Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 25 Jul 2023 09:46:37 +0200 Subject: [PATCH 11/15] Fix tests --- .../FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs index 064ea901ef4..724bebf887f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/WhileBangTests.fs @@ -27,6 +27,7 @@ module WhileBangTests = |> Async.RunSynchronously |> printfn "%d" """ + |> withLangVersionPreview |> compileExeAndRun |> shouldSucceed |> withStdOutContains "12" @@ -59,6 +60,7 @@ module WhileBangTests = |> Async.RunSynchronously |> printfn "%d" """ + |> withLangVersionPreview |> compileExeAndRun |> shouldSucceed |> withStdOutContains "30" @@ -92,6 +94,7 @@ module WhileBangTests = |> Async.RunSynchronously |> printfn "%d" """ + |> withLangVersionPreview |> compileExeAndRun |> shouldSucceed |> withStdOutContains "1" @@ -124,6 +127,7 @@ module WhileBangTests = |> printfn "%d" """ |> ignoreWarnings + |> withLangVersionPreview |> compileExeAndRun |> shouldSucceed |> withStdOutContains "30" \ No newline at end of file From 0ac9bc75125423daf79eb9345b554c500cbba094 Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 25 Jul 2023 11:26:03 +0200 Subject: [PATCH 12/15] Fix tests --- src/Compiler/pars.fsy | 63 ++++++++++--------- .../SyntaxTree/Expression/WhileBang 02.fs.bsl | 2 +- .../SyntaxTree/Expression/WhileBang 03.fs.bsl | 10 +-- .../SyntaxTree/Expression/WhileBang 04.fs.bsl | 12 ++-- 4 files changed, 46 insertions(+), 41 deletions(-) diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index d4b99284582..346aa6375fd 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -4073,7 +4073,7 @@ declExpr: parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.WhileBang mKeyword $2 (mKeyword, true) } - | FOR forLoopBinder doToken typedSequentialExprBlock doneDeclEnd + | FOR forLoopBinder doToken typedSequentialExprBlock doneDeclEnd { let mFor = rhs parseState 1 let mDo = rhs parseState 3 let spFor = DebugPointAtFor.Yes mFor @@ -4472,7 +4472,7 @@ whileExprCore: { fun (mKeyword, isBang) -> let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader - let mWhileAll = unionRanges mKeyword $3.Range + let mWhileAll = unionRanges mKeyword $4 if isBang then SynExpr.WhileBang (spWhile, $1, $3, mWhileAll) @@ -4481,24 +4481,24 @@ whileExprCore: | declExpr doToken typedSequentialExprBlock recover { fun (mKeyword, isBang) -> - if not $4 then reportParseErrorAt mKeyword (FSComp.SR.parsUnexpectedEndOfFileWhile()) + if not $4 then reportParseErrorAt mKeyword (FSComp.SR.parsUnexpectedEndOfFileWhile ()) let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader let mWhileAll = unionRanges mKeyword $3.Range if isBang then - exprFromParseError (SynExpr.WhileBang (spWhile, $1, $3, mWhileAll)) + SynExpr.WhileBang (spWhile, $1, $3, mWhileAll) else - exprFromParseError (SynExpr.While (spWhile, $1, $3, mWhileAll)) } + SynExpr.While (spWhile, $1, $3, mWhileAll) } - // silent recovery | declExpr doToken error doneDeclEnd - { fun (mKeyword, isBang) -> + { let mWhileBodyArb = rhs parseState 3 + + fun (mKeyword, isBang) -> let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader - let mWhileBodyArb = unionRanges (rhs parseState 3) (rhs parseState 4) - let mWhileAll = unionRanges mKeyword (rhs parseState 4) - let bodyArb = arbExpr("whileBody1", mWhileBodyArb) + let mWhileAll = unionRanges mKeyword $4 + let bodyArb = arbExpr ("whileBody1", mWhileBodyArb) if isBang then SynExpr.WhileBang (spWhile, $1, bodyArb, mWhileAll) @@ -4510,34 +4510,39 @@ whileExprCore: reportParseErrorAt mKeyword (FSComp.SR.parsWhileDoExpected()) let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader - let mWhileBodyArb = rhs parseState 2 - let mWhileAll = unionRanges mKeyword mWhileBodyArb - let bodyArb = arbExpr("whileBody2", mWhileBodyArb) + let mWhileAll = mWhileHeader + let bodyArb = arbExpr ("whileBody2", $1.Range.EndRange) if isBang then - exprFromParseError (SynExpr.WhileBang (spWhile, $1, bodyArb, mWhileAll)) + SynExpr.WhileBang (spWhile, $1, bodyArb, mWhileAll) else - exprFromParseError (SynExpr.While (spWhile, $1, bodyArb, mWhileAll)) } + SynExpr.While (spWhile, $1, bodyArb, mWhileAll) } | recover - { fun (mKeyword, _isBang) -> - if not $1 then reportParseErrorAt mKeyword (FSComp.SR.parsUnexpectedEndOfFileWhile()) - arbExpr("whileLoop1", mKeyword) } - - //silent recovery - | error doneDeclEnd { fun (mKeyword, isBang) -> - let mWhileHeader = mKeyword - let spWhile = DebugPointAtWhile.Yes mWhileHeader - let mWhileBodyArb = rhs parseState 2 - let mWhileAll = unionRanges mKeyword mWhileBodyArb - let guardArb = arbExpr("whileGuard1", mWhileHeader) - let bodyArb = arbExpr("whileBody3", mWhileBodyArb) + if not $1 then reportParseErrorAt mKeyword (FSComp.SR.parsUnexpectedEndOfFileWhile ()) + let spWhile = DebugPointAtWhile.Yes mKeyword + let expr1 = arbExpr ("whileLoop1", mKeyword.EndRange) + let expr2 = arbExpr ("whileLoop2", mKeyword.EndRange) + + if isBang then + SynExpr.WhileBang (spWhile, expr1, expr2, mKeyword) + else + SynExpr.While (spWhile, expr1, expr2, mKeyword) } + | error doneDeclEnd + { let mWhileBodyArb = rhs parseState 1 + + fun (mKeyword, isBang) -> + let spWhile = DebugPointAtWhile.Yes mKeyword + let expr1 = arbExpr ("whileGuard1", mKeyword.EndRange) + let expr2 = arbExpr ("whileBody3", mWhileBodyArb.EndRange) + let mWhileAll = unionRanges mKeyword $2 + if isBang then - exprFromParseError (SynExpr.WhileBang (spWhile, guardArb, bodyArb, mWhileAll)) + SynExpr.WhileBang (spWhile, expr1, expr2, mWhileAll) else - exprFromParseError (SynExpr.While (spWhile, guardArb, bodyArb, mWhileAll)) } + SynExpr.While (spWhile, expr1, expr2, mWhileAll) } dynamicArg: | IDENT diff --git a/tests/service/data/SyntaxTree/Expression/WhileBang 02.fs.bsl b/tests/service/data/SyntaxTree/Expression/WhileBang 02.fs.bsl index d7e2df7cf7f..b12f9b0df18 100644 --- a/tests/service/data/SyntaxTree/Expression/WhileBang 02.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/WhileBang 02.fs.bsl @@ -14,7 +14,7 @@ ImplFile YieldOrReturn ((false, true), Const (Bool true, (3,22--3,26)), (3,15--3,26)), (3,13--3,28)), (3,7--3,28)), - Const (Int32 2, (4,4--4,5)), (3,0--4,5)), (3,0--4,5)); + Const (Int32 2, (4,4--4,5)), (3,0--5,4)), (3,0--5,4)); Expr (Const (Int32 3, (7,0--7,1)), (7,0--7,1))], PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None, (1,0--7,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true), diff --git a/tests/service/data/SyntaxTree/Expression/WhileBang 03.fs.bsl b/tests/service/data/SyntaxTree/Expression/WhileBang 03.fs.bsl index e668ca2cf3c..c379d3e36d0 100644 --- a/tests/service/data/SyntaxTree/Expression/WhileBang 03.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/WhileBang 03.fs.bsl @@ -21,11 +21,11 @@ ImplFile YieldOrReturn ((false, true), Const (Bool true, (4,26--4,30)), (4,19--4,30)), (4,17--4,32)), (4,11--4,32)), - ArbitraryAfterError ("whileBody1", (6,0--6,1)), (4,4--6,1)), - (3,4--3,5), Yes (3,0--6,1), { LeadingKeyword = Let (3,0--3,3) - InlineKeyword = None - EqualsRange = Some (3,6--3,7) })], - (3,0--6,1)); Expr (Const (Int32 2, (6,0--6,1)), (6,0--6,1))], + ArbitraryAfterError ("whileBody1", (6,0--6,1)), (4,4--4,35)), + (3,4--3,5), Yes (3,0--4,35), { LeadingKeyword = Let (3,0--3,3) + InlineKeyword = None + EqualsRange = Some (3,6--3,7) })], + (3,0--4,35)); Expr (Const (Int32 2, (6,0--6,1)), (6,0--6,1))], PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None, (1,0--6,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true), { ConditionalDirectives = [] diff --git a/tests/service/data/SyntaxTree/Expression/WhileBang 04.fs.bsl b/tests/service/data/SyntaxTree/Expression/WhileBang 04.fs.bsl index 1e8ef4d19bb..f3911de760b 100644 --- a/tests/service/data/SyntaxTree/Expression/WhileBang 04.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/WhileBang 04.fs.bsl @@ -21,13 +21,13 @@ ImplFile YieldOrReturn ((false, true), Const (Bool true, (4,26--4,30)), (4,19--4,30)), (4,17--4,32)), (4,11--4,32)), - ArbitraryAfterError ("whileBody1", (5,0--5,0)), (4,4--5,0)), - (3,4--3,5), Yes (3,0--5,0), { LeadingKeyword = Let (3,0--3,3) - InlineKeyword = None - EqualsRange = Some (3,6--3,7) })], - (3,0--5,0))], + ArbitraryAfterError ("whileBody1", (5,0--5,0)), (4,4--4,35)), + (3,4--3,5), Yes (3,0--4,35), { LeadingKeyword = Let (3,0--3,3) + InlineKeyword = None + EqualsRange = Some (3,6--3,7) })], + (3,0--4,35))], PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None, - (1,0--5,0), { LeadingKeyword = Module (1,0--1,6) })], (true, true), + (1,0--4,35), { LeadingKeyword = Module (1,0--1,6) })], (true, true), { ConditionalDirectives = [] CodeComments = [] }, set [])) From 24bff71315d0dbe9f22fbe18e829a7c5b0da81af Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 25 Jul 2023 11:54:00 +0200 Subject: [PATCH 13/15] Refactor --- src/Compiler/pars.fsy | 46 +++++++++++++------------------------------ 1 file changed, 14 insertions(+), 32 deletions(-) diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 346aa6375fd..f633a853247 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -4066,12 +4066,12 @@ declExpr: { raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsAssertIsNotFirstClassValue()) } | WHILE whileExprCore - { $2 (rhs parseState 1, false) } + { SynExpr.While ($2 (rhs parseState 1)) } | WHILE_BANG whileExprCore { let mKeyword = rhs parseState 1 parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.WhileBang mKeyword - $2 (mKeyword, true) } + SynExpr.WhileBang ($2 mKeyword) } | FOR forLoopBinder doToken typedSequentialExprBlock doneDeclEnd { let mFor = rhs parseState 1 @@ -4469,80 +4469,62 @@ declExpr: whileExprCore: | declExpr doToken typedSequentialExprBlock doneDeclEnd - { fun (mKeyword, isBang) -> + { fun mKeyword -> let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader let mWhileAll = unionRanges mKeyword $4 - if isBang then - SynExpr.WhileBang (spWhile, $1, $3, mWhileAll) - else - SynExpr.While (spWhile, $1, $3, mWhileAll) } + spWhile, $1, $3, mWhileAll } | declExpr doToken typedSequentialExprBlock recover - { fun (mKeyword, isBang) -> + { fun mKeyword -> if not $4 then reportParseErrorAt mKeyword (FSComp.SR.parsUnexpectedEndOfFileWhile ()) let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader let mWhileAll = unionRanges mKeyword $3.Range - if isBang then - SynExpr.WhileBang (spWhile, $1, $3, mWhileAll) - else - SynExpr.While (spWhile, $1, $3, mWhileAll) } + spWhile, $1, $3, mWhileAll } | declExpr doToken error doneDeclEnd { let mWhileBodyArb = rhs parseState 3 - fun (mKeyword, isBang) -> + fun mKeyword -> let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader let mWhileAll = unionRanges mKeyword $4 let bodyArb = arbExpr ("whileBody1", mWhileBodyArb) - if isBang then - SynExpr.WhileBang (spWhile, $1, bodyArb, mWhileAll) - else - SynExpr.While (spWhile, $1, bodyArb, mWhileAll) } + spWhile, $1, bodyArb, mWhileAll } | declExpr recover - { fun (mKeyword, isBang) -> + { fun mKeyword -> reportParseErrorAt mKeyword (FSComp.SR.parsWhileDoExpected()) let mWhileHeader = unionRanges mKeyword $1.Range let spWhile = DebugPointAtWhile.Yes mWhileHeader let mWhileAll = mWhileHeader let bodyArb = arbExpr ("whileBody2", $1.Range.EndRange) - if isBang then - SynExpr.WhileBang (spWhile, $1, bodyArb, mWhileAll) - else - SynExpr.While (spWhile, $1, bodyArb, mWhileAll) } + spWhile, $1, bodyArb, mWhileAll } | recover - { fun (mKeyword, isBang) -> + { fun mKeyword -> if not $1 then reportParseErrorAt mKeyword (FSComp.SR.parsUnexpectedEndOfFileWhile ()) let spWhile = DebugPointAtWhile.Yes mKeyword let expr1 = arbExpr ("whileLoop1", mKeyword.EndRange) let expr2 = arbExpr ("whileLoop2", mKeyword.EndRange) - if isBang then - SynExpr.WhileBang (spWhile, expr1, expr2, mKeyword) - else - SynExpr.While (spWhile, expr1, expr2, mKeyword) } + spWhile, expr1, expr2, mKeyword } | error doneDeclEnd { let mWhileBodyArb = rhs parseState 1 - fun (mKeyword, isBang) -> + fun mKeyword -> let spWhile = DebugPointAtWhile.Yes mKeyword let expr1 = arbExpr ("whileGuard1", mKeyword.EndRange) let expr2 = arbExpr ("whileBody3", mWhileBodyArb.EndRange) let mWhileAll = unionRanges mKeyword $2 - if isBang then - SynExpr.WhileBang (spWhile, expr1, expr2, mWhileAll) - else - SynExpr.While (spWhile, expr1, expr2, mWhileAll) } + spWhile, expr1, expr2, mWhileAll } dynamicArg: | IDENT From 864f9130c41a67f2c8bb20faee3a012a1a88190e Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 25 Jul 2023 13:02:55 +0200 Subject: [PATCH 14/15] FIX TESTS --- tests/fsharp/tests.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 9e97721fd31..f2aaad809cc 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -2171,7 +2171,7 @@ module TypecheckTests = [] let ``sigs pos41`` () = let cfg = testConfig "typecheck/sigs" - fsc cfg "%s --target:library -o:pos41.dll --warnaserror" cfg.fsc_flags ["pos41.fs"] + fsc cfg "%s --target:library -o:pos41.dll --warnaserror --langversion:preview" cfg.fsc_flags ["pos41.fs"] peverify cfg "pos41.dll" [] @@ -2452,10 +2452,10 @@ module TypecheckTests = let ``type check neg133`` () = singleNegTest (testConfig "typecheck/sigs") "neg133" [] - let ``type check neg134`` () = singleNegTest (testConfig "typecheck/sigs") "neg134" + let ``type check neg134`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg134" [] - let ``type check neg135`` () = singleNegTest (testConfig "typecheck/sigs") "neg135" + let ``type check neg135`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg135" [] let ``type check neg_anon_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_anon_1" From a881a62a6d56ff90e70f91a1227a568f2f09d015 Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 25 Jul 2023 14:20:05 +0200 Subject: [PATCH 15/15] Fix weird test --- tests/fsharp/typecheck/sigs/neg119a.bsl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharp/typecheck/sigs/neg119a.bsl b/tests/fsharp/typecheck/sigs/neg119a.bsl index 7d9659a091d..056420911b0 100644 --- a/tests/fsharp/typecheck/sigs/neg119a.bsl +++ b/tests/fsharp/typecheck/sigs/neg119a.bsl @@ -6,7 +6,7 @@ Known return type: ((int -> int -> int) -> obj) Known type parameters: < obj , Applicatives.Ap > Available overloads: + - static member Applicatives.Ap.Return: 'a seq * Ap: Applicatives.Ap -> ('a -> 'a seq) // Argument at index 1 doesn't match - static member Applicatives.Ap.Return: ('r -> 'a) * Ap: Applicatives.Ap -> (('a -> 'r -> 'a2) -> 'a3 -> 'a -> 'r -> 'a2) // Argument at index 1 doesn't match - static member Applicatives.Ap.Return: System.Tuple<'a> * Ap: Applicatives.Ap -> ('a -> System.Tuple<'a>) // Argument at index 1 doesn't match - - static member Applicatives.Ap.Return: 'a seq * Ap: Applicatives.Ap -> ('a -> 'a seq) // Argument at index 1 doesn't match - static member Applicatives.Ap.Return: r: ^R * obj -> ('a1 -> ^R) when ^R: (static member Return: 'a1 -> ^R) // Argument 'r' doesn't match Consider adding further type constraints