From 4407475bb1fc5b77cd245d9d6689dc07a69bae2a Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 16:34:12 +0100 Subject: [PATCH 01/13] Support ValueOption + Struct attribute as optional parameter --- src/Compiler/Checking/CheckPatterns.fs | 53 ++++- src/Compiler/Checking/MethodCalls.fs | 16 +- src/Compiler/FSComp.txt | 1 + src/Compiler/Facilities/LanguageFeatures.fs | 3 + src/Compiler/Facilities/LanguageFeatures.fsi | 1 + src/Compiler/TypedTree/TypedTreeOps.fs | 4 + src/Compiler/TypedTree/TypedTreeOps.fsi | 6 + src/FSharp.Core/prim-types.fs | 2 +- src/FSharp.Core/prim-types.fsi | 2 +- .../OptionalArguments/OptionalArguments.fs | 216 ++++++++++++++++++ tests/FSharp.Test.Utilities/Compiler.fs | 14 +- 11 files changed, 296 insertions(+), 22 deletions(-) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 3f97cf81780..df3e3c04add 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -35,6 +35,23 @@ type cenv = TcFileState // Helpers that should be elsewhere //------------------------------------------------------------------------- +let inline findSynAttribute (attrName: string) (synAttrs: SynAttributes) = + let attributesToSearch = + if attrName.EndsWith("Attribute") then + set [attrName; attrName.AsSpan().Slice(0, attrName.Length - 9).ToString()] + else + set [attrName; attrName + "Attribute"] + + let mutable found = false + + for synAttr in synAttrs do + for attr in synAttr.Attributes do + let typename = attr.TypeName.LongIdent |> List.last + if attributesToSearch.Contains typename.idText then + found <- true + + found + let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref, [ty], [], m) let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref, [ty], [ph;pt], unionRanges ph.Range pt.Range) @@ -75,7 +92,7 @@ let rec TryAdjustHiddenVarNameToCompGenName (cenv: cenv) env (id: Ident) altName | None -> None /// Bind the patterns used in a lambda. Not clear why we don't use TcPat. -and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = +and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p (attribs: SynAttributes) = let g = cenv.g let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv @@ -85,14 +102,22 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = // Check to see if pattern translation decides to use an alternative identifier. match TryAdjustHiddenVarNameToCompGenName cenv env id altNameRefCellOpt with | Some altId -> - TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv (SynSimplePat.Id (altId, None, isCompGen, isMemberThis, isOpt, m) ) + TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv (SynSimplePat.Id (altId, None, isCompGen, isMemberThis, isOpt, m) ) attribs | None -> if isOpt then if not optionalArgsOK then errorR(Error(FSComp.SR.tcOptionalArgsOnlyOnMembers(), m)) let tyarg = NewInferenceType g - UnifyTypes cenv env m ty (mkOptionTy g tyarg) + + let optionalParamTy = + if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) + && findSynAttribute "StructAttribute" attribs + then + mkValueOptionTy g tyarg + else + mkOptionTy g tyarg + UnifyTypes cenv env m ty optionalParamTy let vFlags = TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, isCompGen) let _, names, takenNames = TcPatBindingName cenv env id ty isMemberThis None None vFlags (names, takenNames) @@ -104,20 +129,28 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = match p with // Optional arguments on members - | SynSimplePat.Id(_, _, _, _, true, _) -> UnifyTypes cenv env m ty (mkOptionTy g ctyR) + | SynSimplePat.Id(_, _, _, _, true, _) -> + let optionalParamTy = + if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) + && findSynAttribute "StructAttribute" attribs + then + mkValueOptionTy g ctyR + else + mkOptionTy g ctyR + UnifyTypes cenv env m ty optionalParamTy | _ -> UnifyTypes cenv env m ty ctyR let patEnvR = TcPatLinearEnv(tpenv, names, takenNames) - + // Ensure the untyped typar name sticks match cty, ty with | SynType.Var(typar = SynTypar(ident = untypedIdent)), TType_var(typar = typedTp) -> typedTp.SetIdent(untypedIdent) | _ -> () - TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnvR p + TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnvR p attribs - | SynSimplePat.Attrib (p, _, _) -> - TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv p + | SynSimplePat.Attrib (p, pattribs, _) -> + TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv p (attribs @ pattribs) // raise an error if any optional args precede any non-optional args and ValidateOptArgOrder (synSimplePats: SynSimplePats) = @@ -166,12 +199,12 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS [id.idText], patEnvR | SynSimplePats.SimplePats (pats = [synSimplePat]) -> - let v, patEnv = TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv synSimplePat + let v, patEnv = TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv synSimplePat [] [v], patEnv | SynSimplePats.SimplePats (ps, _, m) -> let ptys = UnifyRefTupleType env.eContextInfo cenv env.DisplayEnv m ty ps - let ps', patEnvR = (patEnv, List.zip ptys ps) ||> List.mapFold (fun patEnv (ty, pat) -> TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv pat) + let ps', patEnvR = (patEnv, List.zip ptys ps) ||> List.mapFold (fun patEnv (ty, pat) -> TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv pat []) ps', patEnvR and TcSimplePatsOfUnknownType (cenv: cenv) optionalArgsOK checkConstraints env tpenv (pat: SynPat) = diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 3343f7dbac3..f36e33a86c9 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -1476,9 +1476,12 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C /// can be used with 'CalleeSide' optional arguments let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCallerMemberName (mMethExpr: range) = let calledArgTy = calledArg.CalledArgumentType - let calledNonOptTy = - if isOptionTy g calledArgTy then - destOptionTy g calledArgTy + let calledNonOptTy = + if isOptionTy g calledArgTy then + destOptionTy g calledArgTy + elif g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) + && isValueOptionTy g calledArgTy then + destValueOptionTy g calledArgTy else calledArgTy // should be unreachable @@ -1494,7 +1497,12 @@ let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCalle let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy) mkSome g calledNonOptTy memberNameExpr mMethExpr | _ -> - mkNone g calledNonOptTy mMethExpr + if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) + && isValueOptionTy g calledArgTy + then + mkValueNone g calledArgTy mMethExpr + else + mkNone g calledNonOptTy mMethExpr /// Get the expression that must be inserted on the caller side for an optional arg where /// no caller argument has been provided. diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index b42500049d2..6ff77f2a10b 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1789,3 +1789,4 @@ featureUseTypeSubsumptionCache,"Use type conversion cache during compilation" featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase identifiers in binding patterns" 3873,chkDeprecatePlacesWhereSeqCanBeOmitted,"This construct is deprecated. Sequence expressions should be of the form 'seq {{ ... }}'" featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted" +featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters" diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 0e2783796af..5401ea26a1b 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -97,6 +97,7 @@ type LanguageFeature = | DontWarnOnUppercaseIdentifiersInBindingPatterns | UseTypeSubsumptionCache | DeprecatePlacesWhereSeqCanBeOmitted + | SupportValueOptionsAsOptionalParameters /// LanguageVersion management type LanguageVersion(versionText) = @@ -225,6 +226,7 @@ type LanguageVersion(versionText) = LanguageFeature.AllowObjectExpressionWithoutOverrides, previewVersion LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns, previewVersion LanguageFeature.DeprecatePlacesWhereSeqCanBeOmitted, previewVersion + LanguageFeature.SupportValueOptionsAsOptionalParameters, previewVersion ] static let defaultLanguageVersion = LanguageVersion("default") @@ -385,6 +387,7 @@ type LanguageVersion(versionText) = FSComp.SR.featureDontWarnOnUppercaseIdentifiersInBindingPatterns () | LanguageFeature.UseTypeSubsumptionCache -> FSComp.SR.featureUseTypeSubsumptionCache () | LanguageFeature.DeprecatePlacesWhereSeqCanBeOmitted -> FSComp.SR.featureDeprecatePlacesWhereSeqCanBeOmitted () + | LanguageFeature.SupportValueOptionsAsOptionalParameters -> FSComp.SR.featureSupportValueOptionsAsOptionalParameters () /// Get a version string associated with the given feature. static member GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index bc361ba1337..90572888001 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -88,6 +88,7 @@ type LanguageFeature = | DontWarnOnUppercaseIdentifiersInBindingPatterns | UseTypeSubsumptionCache | DeprecatePlacesWhereSeqCanBeOmitted + | SupportValueOptionsAsOptionalParameters /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e2c1c0861a9..d6a8e4752db 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3887,10 +3887,14 @@ let mkSome g ty arg m = mkUnionCaseExpr(mkSomeCase g, [ty], [arg], m) let mkNone g ty m = mkUnionCaseExpr(mkNoneCase g, [ty], [], m) +let mkValueNoneCase (g: TcGlobals) = mkUnionCaseRef g.valueoption_tcr_canon "ValueNone" + let mkValueSomeCase (g: TcGlobals) = mkUnionCaseRef g.valueoption_tcr_canon "ValueSome" let mkAnySomeCase g isStruct = (if isStruct then mkValueSomeCase g else mkSomeCase g) +let mkValueNone g ty m = mkUnionCaseExpr(mkValueNoneCase g, [ty], [], m) + type ValRef with member vref.IsDispatchSlot = match vref.MemberInfo with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 4eafbf229dc..a120ef25f06 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1906,12 +1906,18 @@ val mkNoneCase: TcGlobals -> UnionCaseRef /// Create the union case 'Some(expr)' for an option type val mkSomeCase: TcGlobals -> UnionCaseRef +/// Create the struct union case 'ValueNone' for a voption type +val mkValueNoneCase: TcGlobals -> UnionCaseRef + /// Create the struct union case 'ValueSome(expr)' for a voption type val mkValueSomeCase: TcGlobals -> UnionCaseRef /// Create the struct union case 'Some' or 'ValueSome(expr)' for a voption type val mkAnySomeCase: TcGlobals -> isStruct: bool -> UnionCaseRef +/// Create the struct expression 'ValueNone' for an voption type +val mkValueNone: TcGlobals -> TType -> range -> Expr + /// Create the expression '[]' for a list type val mkNil: TcGlobals -> range -> TType -> Expr diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index 7c5f12f764d..7f1b0a122ad 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -183,7 +183,7 @@ namespace Microsoft.FSharp.Core inherit Attribute() member _.CompiledName = compiledName - [] + [] [] type StructAttribute() = inherit Attribute() diff --git a/src/FSharp.Core/prim-types.fsi b/src/FSharp.Core/prim-types.fsi index 15264b3a14e..a992a0204e0 100644 --- a/src/FSharp.Core/prim-types.fsi +++ b/src/FSharp.Core/prim-types.fsi @@ -200,7 +200,7 @@ namespace Microsoft.FSharp.Core /// Adding this attribute to a type causes it to be represented using a CLI struct. /// /// Attributes - [] + [] [] type StructAttribute = inherit Attribute diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs index 48cbd63e1e2..9f883fe1be3 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs @@ -115,4 +115,220 @@ module MemberDefinitions_OptionalArguments = |> verifyCompileAndRun |> shouldSucceed + [] + let ``Optional Arguments can't be a ValueOption+StructAttribute attribute with langversion=9`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M() + 0 + """ + source + |> asLibrary + |> withLangVersion90 + |> withNoWarn 25 + |> compile + |> shouldFail + |> withDiagnostics [ + Error 1, Line 6, Col 11, Line 6, Col 22, "This expression was expected to have type + ''a option' +but here has type + ''b voption' " + Error 1, Line 7, Col 11, Line 7, Col 20, "This expression was expected to have type + ''a option' +but here has type + ''b voption' "] + + [] + let ``Optional Arguments can't be a Option+StructAttribute attribute with langversion=preview`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(Some 1) + X.M(None) + X.M() + 0 + """ + source + |> asLibrary + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldFail + |> withDiagnostics [ + Error 1, Line 11, Col 9, Line 11, Col 15, "This expression was expected to have type + ''a voption' +but here has type + ''b option' " + Error 1, Line 12, Col 9, Line 12, Col 13, "This expression was expected to have type + ''a voption' +but here has type + ''b option' " + ] + + [] + let ``Optional Arguments can be a ValueOption+StructAttribute attribute with langversion=preview`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome 1"; "VNone"; "VNone"] + |> verifyIL [""" +.method public static void M(valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1 x) cil managed +{ + .param [1] + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.OptionalArgumentAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.StructAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 4 + .locals init (!!a V_0, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_1, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4 V_2) + IL_0000: ldarga.s x + IL_0002: call instance int32 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Tag() + IL_0007: ldc.i4.0 + IL_0008: bne.un.s IL_000c + + IL_000a: br.s IL_0032 + + IL_000c: ldarga.s x + IL_000e: call instance !0 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Item() + IL_0013: stloc.0 + IL_0014: ldstr "VSome %A" + IL_0019: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit,!!a>::.ctor(string) + IL_001e: stloc.1 + IL_001f: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0024: ldloc.1 + IL_0025: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter>(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_002a: ldloc.0 + IL_002b: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0030: pop + IL_0031: ret + + IL_0032: ldstr "VNone" + IL_0037: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5::.ctor(string) + IL_003c: stloc.2 + IL_003d: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0042: ldloc.2 + IL_0043: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_0048: pop + IL_0049: ret +} + """] + + + [] + let ``Optional Arguments can be a ValueOption+Struct attribute with langversion=preview`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome 1"; "VNone"; "VNone"] + |> verifyIL [""" +.method public static void M(valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1 x) cil managed +{ + .param [1] + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.OptionalArgumentAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.StructAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 4 + .locals init (!!a V_0, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_1, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4 V_2) + IL_0000: ldarga.s x + IL_0002: call instance int32 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Tag() + IL_0007: ldc.i4.0 + IL_0008: bne.un.s IL_000c + + IL_000a: br.s IL_0032 + + IL_000c: ldarga.s x + IL_000e: call instance !0 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Item() + IL_0013: stloc.0 + IL_0014: ldstr "VSome %A" + IL_0019: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit,!!a>::.ctor(string) + IL_001e: stloc.1 + IL_001f: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0024: ldloc.1 + IL_0025: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter>(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_002a: ldloc.0 + IL_002b: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0030: pop + IL_0031: ret + + IL_0032: ldstr "VNone" + IL_0037: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5::.ctor(string) + IL_003c: stloc.2 + IL_003d: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0042: ldloc.2 + IL_0043: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_0048: pop + IL_0049: ret +} + """] \ No newline at end of file diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 115964702f8..cd409116c3c 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -1515,15 +1515,17 @@ Actual: match result with | CompilationResult.Success _ -> result | CompilationResult.Failure r -> - eprintfn "\nAll errors:" - r.Diagnostics |> Seq.iter (eprintfn "%A") - + let messages = r.Diagnostics |> List.map (fun e -> $"%A{e}") |> String.concat ";\n" + let diagnostics = $"All errors:\n{messages}" + + eprintfn $"\n{diagnostics}" + match r.Output with | Some (EvalOutput { Result = Result.Error ex }) | Some (ExecutionOutput {Outcome = Failure ex }) -> - raise ex - | _ -> - failwithf "Operation failed (expected to succeed)." + failwithf $"Eval or Execution has failed (expected to succeed): %A{ex}\n{diagnostics}" + | _ -> + failwithf $"Operation failed (expected to succeed).\n{diagnostics}" let shouldFail (result: CompilationResult) : CompilationResult = match result with From 10110b313bdedbcc8ea48751493139b08c40122f Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 16:39:13 +0100 Subject: [PATCH 02/13] Release notes --- docs/release-notes/.Language/preview.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/release-notes/.Language/preview.md b/docs/release-notes/.Language/preview.md index 0d882e20bbe..d6ef41c3d57 100644 --- a/docs/release-notes/.Language/preview.md +++ b/docs/release-notes/.Language/preview.md @@ -3,8 +3,10 @@ * Better generic unmanaged structs handling. ([Language suggestion #692](https://github.com/fsharp/fslang-suggestions/issues/692), [PR #12154](https://github.com/dotnet/fsharp/pull/12154)) * Deprecate places where `seq` can be omitted. ([Language suggestion #1033](https://github.com/fsharp/fslang-suggestions/issues/1033), [PR #17772](https://github.com/dotnet/fsharp/pull/17772)) * Added type conversions cache, only enabled for compiler runs ([PR#17668](https://github.com/dotnet/fsharp/pull/17668)) +* Support ValueOption + Struct attribute as optional parameter for methods ([Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098)) ### Fixed + * Warn on uppercase identifiers in patterns. ([PR #15816](https://github.com/dotnet/fsharp/pull/15816)) ### Changed From 7889af35dda8be14c4bcadbcdb7c121ef51d4851 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 16:39:53 +0100 Subject: [PATCH 03/13] Release notes --- docs/release-notes/.FSharp.Compiler.Service/9.0.200.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md index 8c19083bb74..a7d638be28b 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md @@ -21,6 +21,7 @@ * Support literal attribute on decimals ([PR #17769](https://github.com/dotnet/fsharp/pull/17769)) * Added type conversions cache, only enabled for compiler runs, guarded by language version preview ([PR #17668](https://github.com/dotnet/fsharp/pull/17668)) * Added project property ParallelCompilation which turns on graph based type checking, parallel ILXGen and parallel optimization. By default on for users of langversion=preview ([PR #17948](https://github.com/dotnet/fsharp/pull/17948)) +* Support ValueOption + Struct attribute as optional parameter for methods ([Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098)) ### Changed From 7ef486f243425260fc396647c720fd9f39b4e20c Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 16:40:35 +0100 Subject: [PATCH 04/13] Release notes --- docs/release-notes/.FSharp.Core/9.0.200.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Core/9.0.200.md b/docs/release-notes/.FSharp.Core/9.0.200.md index fdcc65f5537..9ee215274b5 100644 --- a/docs/release-notes/.FSharp.Core/9.0.200.md +++ b/docs/release-notes/.FSharp.Core/9.0.200.md @@ -6,8 +6,9 @@ ### Added ### Changed + * String function changed to guarantee a non-null string return type ([PR #17809](https://github.com/dotnet/fsharp/pull/17809)) +* Add Parameters as valid target for the Struct attribute ([Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098)) ### Breaking Changes - From 603a62f63c7d4d7d2a77fb4203aecc9a2501c596 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 16:45:54 +0100 Subject: [PATCH 05/13] Translations --- 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 +++++ 13 files changed, 65 insertions(+) diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index c74702e5ddc..7435554bacf 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -612,6 +612,11 @@ reprezentace struktury aktivních vzorů + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Vlastnosti testu případu sjednocení diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 3e0443ea3ba..10f4690c3e5 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -612,6 +612,11 @@ Strukturdarstellung für aktive Muster + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Eigenschaften von Union-Falltests diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index ecadc24a021..b2a72d8d583 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -612,6 +612,11 @@ representación de struct para modelos activos + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Propiedades de prueba de caso de unión diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 7a9769e0d22..be647343a04 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -612,6 +612,11 @@ représentation de structure pour les modèles actifs + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Propriétés du test de cas d’union diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 1db94e74c44..ddb9ac7819d 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -612,6 +612,11 @@ rappresentazione struct per criteri attivi + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Proprietà test case di unione diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 67b3ad51f9a..5b994a09de7 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -612,6 +612,11 @@ アクティブなパターンの構造体表現 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties ユニオン ケースのテスト プロパティ diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index d33ad95bff5..c814fa0b704 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -612,6 +612,11 @@ 활성 패턴에 대한 구조체 표현 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties 공용 구조체 사례 테스트 속성 diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index a992a59bb23..d963755d2ad 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -612,6 +612,11 @@ reprezentacja struktury aktywnych wzorców + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Właściwości testowe przypadku unii diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index d547f088b3e..fe135542ebc 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -612,6 +612,11 @@ representação estrutural para padrões ativos + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Propriedades de teste de caso de união diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 1da17d068ce..1d131012092 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -612,6 +612,11 @@ представление структуры для активных шаблонов + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Свойства теста союзного случая diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index fe29aebcff7..e5437462e93 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -612,6 +612,11 @@ etkin desenler için yapı gösterimi + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Birleşim durumu test özellikleri diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index c1b2b3d4682..c6bcf20debe 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -612,6 +612,11 @@ 活动模式的结构表示形式 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties 联合用例测试属性 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 7c6c76ff2f7..14c310ae955 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -612,6 +612,11 @@ 現用模式的結構表示法 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties 聯集案例測試屬性 From fa7a4fda6391f7caee87c71dc0a343318bbefeea Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 18:20:17 +0100 Subject: [PATCH 06/13] Don't concat lists of attributes, the one from SynSimplePat.Attrib will contain all --- src/Compiler/Checking/CheckPatterns.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index df3e3c04add..a4ffd259579 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -150,7 +150,7 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p (at TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnvR p attribs | SynSimplePat.Attrib (p, pattribs, _) -> - TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv p (attribs @ pattribs) + TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv p pattribs // raise an error if any optional args precede any non-optional args and ValidateOptArgOrder (synSimplePats: SynSimplePats) = From 3ddea10bc7492fe4760ee7628798441fe54c0714 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 18:38:19 +0100 Subject: [PATCH 07/13] Warn on StructAttribute aliasing --- src/Compiler/Checking/CheckDeclarations.fs | 39 +++++++++++++--------- src/Compiler/Checking/CheckPatterns.fs | 1 + src/Compiler/FSComp.txt | 2 +- src/Compiler/xlf/FSComp.txt.cs.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.de.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.es.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.fr.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.it.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.ja.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.ko.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.pl.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.ru.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.tr.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 6 ++-- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 6 ++-- 16 files changed, 64 insertions(+), 56 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 80c1a656c2d..1580f8d8755 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3222,34 +3222,41 @@ module EstablishTypeDefinitionCores = ignore inSig #endif - // This case deals with ordinary type and measure abbreviations - if not hasMeasureableAttr then + // This case deals with ordinary type and measure abbreviations + if not hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkConstraints ItemOccurrence.UseInType WarnOnIWSAM.No envinner tpenv rhsType - // Give a warning if `AutoOpenAttribute` is being aliased. + + // Give a warning if `AutoOpenAttribute` or `StructAttribute` is being aliased. // If the user were to alias the `Microsoft.FSharp.Core.AutoOpenAttribute` type, it would not be detected by the project graph dependency resolution algorithm. + let attributes = [ g.attrib_AutoOpenAttribute; g.attrib_StructAttribute ] + match stripTyEqns g ty with - | AppTy g (tcref, _) when not tcref.IsErased -> - match tcref.CompiledRepresentation with - | CompiledTypeRepr.ILAsmOpen _ -> () - | CompiledTypeRepr.ILAsmNamed _ -> - if tcref.CompiledRepresentationForNamedType.FullName = g.attrib_AutoOpenAttribute.TypeRef.FullName then - warning(Error(FSComp.SR.chkAutoOpenAttributeInTypeAbbrev(), tycon.Id.idRange)) - | _ -> () - - if not firstPass then - let ftyvs = freeInTypeLeftToRight g false ty + | AppTy g (tcref, _) when tcref.IsErased -> + match tcref.CompiledRepresentation with + | CompiledTypeRepr.ILAsmOpen _ -> () + | CompiledTypeRepr.ILAsmNamed _ -> + let fullname = tcref.CompiledRepresentationForNamedType.FullName + + attributes + |> List.tryFind (fun a -> a.TypeRef.FullName = fullname) + |> Option.iter (fun a -> warning(Error(FSComp.SR.chkAttributeAliased(a.TypeRef.FullName), a.TyconRef.Range))) + + | _ -> () + + if not firstPass then + let ftyvs = freeInTypeLeftToRight g false ty let typars = tycon.Typars m - if ftyvs.Length <> typars.Length then + if ftyvs.Length <> typars.Length then errorR(Deprecated(FSComp.SR.tcTypeAbbreviationHasTypeParametersMissingOnType(), tycon.Range)) if firstPass then tycon.SetTypeAbbrev (Some ty) | _ -> () - - with RecoverableException exn -> + + with RecoverableException exn -> errorRecovery exn m // Third phase: check and publish the super types. Run twice, once before constraints are established diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index a4ffd259579..4360c3db8ca 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -35,6 +35,7 @@ type cenv = TcFileState // Helpers that should be elsewhere //------------------------------------------------------------------------- +// CAUTION: This function operates over the untyped tree, so should be used only when absolutely necessary. It doesn't verify assembly origine nor does it respect type aliases. let inline findSynAttribute (attrName: string) (synAttrs: SynAttributes) = let attributesToSearch = if attrName.EndsWith("Attribute") then diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 6ff77f2a10b..f83e58106b7 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1735,7 +1735,7 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form 3558,chkExplicitFieldsDeclarationsOnStaticClasses,"If a type uses both [] and [] attributes, it means it is static. Explicit field declarations are not allowed." 3559,typrelNeverRefinedAwayFromTop,"A type has been implicitly inferred as 'obj', which may be unintended. Consider adding explicit type annotations. You can disable this warning by using '#nowarn \"3559\"' or '--nowarn:3559'." 3560,tcCopyAndUpdateRecordChangesAllFields,"This copy-and-update record expression changes all fields of record type '%s'. Consider using the record construction syntax instead." -3561,chkAutoOpenAttributeInTypeAbbrev,"FSharp.Core.AutoOpenAttribute should not be aliased." +3561,chkAttributeAliased,"%s should not be aliased." 3562,parsUnexpectedEndOfFileElif,"Unexpected end of input in 'else if' or 'elif' branch of conditional expression. Expected 'elif then ' or 'else if then '." 3563,lexInvalidIdentifier,"This is not a valid identifier" 3564,parsMissingUnionCaseName,"Missing union case name" diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 7435554bacf..63614d57f96 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -37,9 +37,9 @@ Pokud typ používá atribut [<Sealed>] i [<AbstractClass>], znamená to, že je statický. Další konstruktor není povolený. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute by neměl mít alias. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 10f4690c3e5..cdbcefaa23f 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -37,9 +37,9 @@ Wenn ein Typ sowohl das Attribute [<Sealed>] wie auch [<AbstractClass>] verwendet, bedeutet dies, dass er statisch ist. Ein zusätzlicher Konstruktor ist nicht zulässig. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute darf kein Alias sein. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index b2a72d8d583..3c009280e3a 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -37,9 +37,9 @@ Si un tipo usa los atributos [<Sealed>] y [<AbstractClass>], significa que es estático. No se permite un constructor adicional. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute no debe tener alias. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index be647343a04..d67a566fadb 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -37,9 +37,9 @@ Si un type utilise les attributs [<Sealed>] et [<AbstractClass>], cela signifie qu’il est statique. Un constructeur supplémentaire n’est pas autorisé. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute ne doit pas avoir d'alias. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index ddb9ac7819d..99dfdca8485 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -37,9 +37,9 @@ Se un tipo usa entrambi gli attributi [<Sealed>] e [<AbstractClass>], significa che è statico. Non sono ammessi costruttori aggiuntivi. - - FSharp.Core.AutoOpenAttribute should not be aliased. - Non sono consentiti alias per FSharp.Core.AutoOpenAttribute. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 5b994a09de7..856821b36d5 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -37,9 +37,9 @@ 型が [<Sealed>] と [<AbstractClass>] の両方の属性を使用する場合、それは静的であることを意味します。追加のコンストラクターは許可されていません。 - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute にエイリアスを設定することはできません。 + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index c814fa0b704..4d9f7e9aa98 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -37,9 +37,9 @@ 형식이 [<Sealed>] 및 [<AbstractClass>] 특성을 모두 사용하는 경우 정적임을 의미합니다. 추가 생성자는 허용되지 않습니다. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute는 별칭을 지정할 수 없습니다. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index d963755d2ad..c54276d9d6c 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -37,9 +37,9 @@ Jeśli typ używa obu [<Sealed>] i [< AbstractClass>] atrybutów, oznacza to, że jest statyczny. Konstruktor jest również niedozwolony. - - FSharp.Core.AutoOpenAttribute should not be aliased. - Element FSharp.Core.AutoOpenAttribute nie powinien mieć aliasu. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index fe135542ebc..72517388c74 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -37,9 +37,9 @@ Se um tipo usa os atributos [<Sealed>] e [<AbstractClass>], significa que é estático. Construtor adicional não é permitido. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute não deve ter alias. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 1d131012092..e459bb5a5fe 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -37,9 +37,9 @@ Если тип использует атрибуты [<Sealed>] и [<AbstractClass>], это означает, что он статический. Дополнительный конструктор не разрешен. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute не должен быть псевдонимом. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index e5437462e93..c308554e54a 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -37,9 +37,9 @@ Bir tür, hem [<Sealed>] hem de [< AbstractClass>] özniteliklerini kullanıyorsa bu statik olduğu anlamına gelir. Ek oluşturucuya izin verilmez. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute diğer adlı olamaz. + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index c6bcf20debe..49c81e43798 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -37,9 +37,9 @@ 如果类型同时使用 [<Sealed>] 和 [<AbstractClass>] 属性，则表示它是静态的。不允许使用其他构造函数。 - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute 不应为别名。 + + {0} should not be aliased. + {0} should not be aliased. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 14c310ae955..dbe38025843 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -37,9 +37,9 @@ 如果類型同時使用 [<Sealed>] 和 [<AbstractClass>] 屬性，表示其為靜態。不允許其他建構函式。 - - FSharp.Core.AutoOpenAttribute should not be aliased. - 不應別名化 FSharp.Core.AutoOpenAttribute。 + + {0} should not be aliased. + {0} should not be aliased. From 47e748d103aec383748de396929f815a49aeeffd Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 2 Dec 2024 20:01:23 +0100 Subject: [PATCH 08/13] Fix a bunch of corner cases --- src/Compiler/Checking/CheckDeclarations.fs | 29 +++++++++---- src/Compiler/Checking/MethodCalls.fs | 41 ++++++++++++------- src/Compiler/TypedTree/TypedTreeOps.fs | 2 + src/Compiler/TypedTree/TypedTreeOps.fsi | 3 ++ .../OptionalArguments/OptionalArguments.fs | 38 +++++++++++++++-- 5 files changed, 86 insertions(+), 27 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 1580f8d8755..2438b2ab33b 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3232,18 +3232,29 @@ module EstablishTypeDefinitionCores = // If the user were to alias the `Microsoft.FSharp.Core.AutoOpenAttribute` type, it would not be detected by the project graph dependency resolution algorithm. let attributes = [ g.attrib_AutoOpenAttribute; g.attrib_StructAttribute ] + (*match stripTyEqns g ty with + | AppTy g (tcref, _) when not tcref.IsErased -> + match tcref.CompiledRepresentation with + | CompiledTypeRepr.ILAsmOpen _ -> () + | CompiledTypeRepr.ILAsmNamed _ -> + if tcref.CompiledRepresentationForNamedType.FullName = g.attrib_AutoOpenAttribute.TypeRef.FullName then + warning(Error(FSComp.SR.chkAutoOpenAttributeInTypeAbbrev(), tycon.Id.idRange)) + | _ -> ()*) + + + match stripTyEqns g ty with - | AppTy g (tcref, _) when tcref.IsErased -> - match tcref.CompiledRepresentation with - | CompiledTypeRepr.ILAsmOpen _ -> () - | CompiledTypeRepr.ILAsmNamed _ -> - let fullname = tcref.CompiledRepresentationForNamedType.FullName + | AppTy g (tcref, _) when tcref.IsErased -> + match tcref.CompiledRepresentation with + | CompiledTypeRepr.ILAsmOpen _ -> () + | CompiledTypeRepr.ILAsmNamed _ -> + let fullname = tcref.CompiledRepresentationForNamedType.FullName - attributes - |> List.tryFind (fun a -> a.TypeRef.FullName = fullname) - |> Option.iter (fun a -> warning(Error(FSComp.SR.chkAttributeAliased(a.TypeRef.FullName), a.TyconRef.Range))) + attributes + |> List.tryFind (fun a -> a.TypeRef.FullName = fullname) + |> Option.iter (fun a -> warning(Error(FSComp.SR.chkAttributeAliased(a.TypeRef.FullName), tycon.Id.idRange))) - | _ -> () + | _ -> () if not firstPass then let ftyvs = freeInTypeLeftToRight g false ty diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index f36e33a86c9..15d240aeaaa 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -337,12 +337,18 @@ let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableO if callerArg.IsExplicitOptional then match calledArg.OptArgInfo with // CSharpMethod(?x = arg), optional C#-style argument, may have nullable type - | CallerSide _ -> + | CallerSide _ -> if g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop then if isNullableTy g calledArgTy then - mkOptionTy g (destNullableTy g calledArgTy), TypeDirectedConversionUsed.No, None + if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g calledArgTy then + mkValueOptionTy g (destNullableTy g calledArgTy), TypeDirectedConversionUsed.No, None + else + mkOptionTy g (destNullableTy g calledArgTy), TypeDirectedConversionUsed.No, None else - mkOptionTy g calledArgTy, TypeDirectedConversionUsed.No, None + if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g calledArgTy then + mkValueOptionTy g calledArgTy, TypeDirectedConversionUsed.No, None + else + mkOptionTy g calledArgTy, TypeDirectedConversionUsed.No, None else calledArgTy, TypeDirectedConversionUsed.No, None @@ -392,9 +398,11 @@ let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableO // FSharpMethod(x = arg), optional F#-style argument, should have option type | CalleeSide -> - let calledArgTy2 = + let calledArgTy2 = if isOptionTy g calledArgTy then destOptionTy g calledArgTy + elif g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g calledArgTy then + destValueOptionTy g calledArgTy else calledArgTy AdjustCalledArgTypeForTypeDirectedConversionsAndAutoQuote infoReader ad callerArgTy calledArgTy2 calledArg m @@ -1497,8 +1505,7 @@ let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCalle let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy) mkSome g calledNonOptTy memberNameExpr mMethExpr | _ -> - if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) - && isValueOptionTy g calledArgTy + if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) && isValueOptionTy g calledArgTy then mkValueNone g calledArgTy mMethExpr else @@ -1581,20 +1588,24 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: // AdjustCallerArgExpr later on will deal with any nullable conversion callerArgExpr - | CalleeSide -> - if isOptCallerArg then + | CalleeSide -> + if isOptCallerArg then // FSharpMethod(?x=b) --> FSharpMethod(?x=b) - callerArgExpr - else + callerArgExpr + else // FSharpMethod(x=b) when FSharpMethod(A) --> FSharpMethod(?x=Some(b :> A)) - if isOptionTy g calledArgTy then - let calledNonOptTy = destOptionTy g calledArgTy + if isOptionTy g calledArgTy then + let calledNonOptTy = destOptionTy g calledArgTy let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr mkSome g calledNonOptTy callerArgExpr2 m - else + elif g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) && isValueOptionTy g calledArgTy then + let calledNonOptTy = destValueOptionTy g calledArgTy + let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr + mkValueSome g calledNonOptTy callerArgExpr2 m + else assert false - callerArgExpr // defensive code - this case is unreachable - + callerArgExpr // defensive code - this case is unreachable + let callerArg2 = CallerArg(tyOfExpr g callerArgExpr2, m, isOptCallerArg, callerArgExpr2) { assignedArg with CallerArg=callerArg2 } diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d6a8e4752db..f64462f5782 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3893,6 +3893,8 @@ let mkValueSomeCase (g: TcGlobals) = mkUnionCaseRef g.valueoption_tcr_canon "Val let mkAnySomeCase g isStruct = (if isStruct then mkValueSomeCase g else mkSomeCase g) +let mkValueSome g ty arg m = mkUnionCaseExpr(mkValueSomeCase g, [ty], [arg], m) + let mkValueNone g ty m = mkUnionCaseExpr(mkValueNoneCase g, [ty], [], m) type ValRef with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index a120ef25f06..3da91fe71ec 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1915,6 +1915,9 @@ val mkValueSomeCase: TcGlobals -> UnionCaseRef /// Create the struct union case 'Some' or 'ValueSome(expr)' for a voption type val mkAnySomeCase: TcGlobals -> isStruct: bool -> UnionCaseRef +/// Create the expression 'ValueSome(expr)' +val mkValueSome: TcGlobals -> TType -> Expr -> range -> Expr + /// Create the struct expression 'ValueNone' for an voption type val mkValueNone: TcGlobals -> TType -> range -> Expr diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs index 9f883fe1be3..9b2fc465f33 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs @@ -199,6 +199,7 @@ type X() = let main _ = X.M(ValueSome 1) X.M(ValueNone) + X.M(1) X.M() 0 """ @@ -212,7 +213,7 @@ let main _ = |> shouldSucceed |> run |> shouldSucceed - |> withOutputContainsAllInOrder ["VSome 1"; "VNone"; "VNone"] + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] |> verifyIL [""" .method public static void M(valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1 x) cil managed { @@ -274,6 +275,7 @@ type X() = let main _ = X.M(ValueSome 1) X.M(ValueNone) + X.M(1) X.M() 0 """ @@ -287,7 +289,7 @@ let main _ = |> shouldSucceed |> run |> shouldSucceed - |> withOutputContainsAllInOrder ["VSome 1"; "VNone"; "VNone"] + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] |> verifyIL [""" .method public static void M(valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1 x) cil managed { @@ -331,4 +333,34 @@ let main _ = IL_0048: pop IL_0049: ret } - """] \ No newline at end of file + """] + + [] + let ``Optional Arguments in constructor can be a ValueOption+StructAttribute attribute with langversion=preview`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome 1"; "VNone"; "VNone"] \ No newline at end of file From 3c19c496447e6ecb1240b6458694aa3ce121ec3a Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Wed, 4 Dec 2024 18:36:58 +0100 Subject: [PATCH 09/13] Added attribute alias warning, add more tests --- src/Compiler/Checking/CheckDeclarations.fs | 34 +-- .../OptionalArguments/OptionalArguments.fs | 288 ++++++++++++++++-- .../WarnForAttributeAlias.fs | 39 +++ .../WarnForAutoOpenAttributeAlias.fs | 23 -- .../FSharp.Compiler.ComponentTests.fsproj | 2 +- 5 files changed, 318 insertions(+), 68 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAttributeAlias.fs delete mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAutoOpenAttributeAlias.fs diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 2438b2ab33b..bec5c9d9966 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3230,31 +3230,19 @@ module EstablishTypeDefinitionCores = // Give a warning if `AutoOpenAttribute` or `StructAttribute` is being aliased. // If the user were to alias the `Microsoft.FSharp.Core.AutoOpenAttribute` type, it would not be detected by the project graph dependency resolution algorithm. - let attributes = [ g.attrib_AutoOpenAttribute; g.attrib_StructAttribute ] - (*match stripTyEqns g ty with - | AppTy g (tcref, _) when not tcref.IsErased -> - match tcref.CompiledRepresentation with - | CompiledTypeRepr.ILAsmOpen _ -> () - | CompiledTypeRepr.ILAsmNamed _ -> - if tcref.CompiledRepresentationForNamedType.FullName = g.attrib_AutoOpenAttribute.TypeRef.FullName then - warning(Error(FSComp.SR.chkAutoOpenAttributeInTypeAbbrev(), tycon.Id.idRange)) - | _ -> ()*) - - - - match stripTyEqns g ty with - | AppTy g (tcref, _) when tcref.IsErased -> - match tcref.CompiledRepresentation with - | CompiledTypeRepr.ILAsmOpen _ -> () - | CompiledTypeRepr.ILAsmNamed _ -> - let fullname = tcref.CompiledRepresentationForNamedType.FullName - - attributes - |> List.tryFind (fun a -> a.TypeRef.FullName = fullname) - |> Option.iter (fun a -> warning(Error(FSComp.SR.chkAttributeAliased(a.TypeRef.FullName), tycon.Id.idRange))) + let inline checkAttributeAliased ty (tycon: Tycon) (attrib: BuiltinAttribInfo) = + match stripTyEqns g ty with + | AppTy g (tcref, _) when not tcref.IsErased -> + match tcref.CompiledRepresentation with + | CompiledTypeRepr.ILAsmOpen _ -> () + | CompiledTypeRepr.ILAsmNamed _ -> + if tcref.CompiledRepresentationForNamedType.FullName = attrib.TypeRef.FullName then + warning(Error(FSComp.SR.chkAttributeAliased(attrib.TypeRef.FullName), tycon.Id.idRange)) + | _ -> () - | _ -> () + checkAttributeAliased ty tycon g.attrib_AutoOpenAttribute + checkAttributeAliased ty tycon g.attrib_StructAttribute if not firstPass then let ftyvs = freeInTypeLeftToRight g false ty diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs index 9b2fc465f33..c0604630d56 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs @@ -150,12 +150,70 @@ but here has type ''b voption' "] [] - let ``Optional Arguments can't be a Option+StructAttribute attribute with langversion=preview`` () = + let ``Optional Arguments wrap Option`` () = let source = FSharp """ module Program type X() = - static member M([] ?x) = + static member M(?x) = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X.M(Some 1) + X.M(None) + X.M(1) + X.M() + 0 + """ + source + |> asExe + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some Some 1"; "Some None"; "Some 1"; "None"] + + [] + let ``Optional Arguments wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X() = + static member M(?x) = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M(1) + X.M() + 0 + """ + source + |> asExe + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some ValueSome 1"; "Some ValueNone"; "Some 1"; "None"] + + [] + let ``Optional Struct Arguments wrap Option`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = match x with | ValueSome x -> printfn "VSome %A" x | ValueNone -> printfn "VNone" @@ -164,25 +222,49 @@ type X() = let main _ = X.M(Some 1) X.M(None) + X.M(1) X.M() 0 """ source - |> asLibrary + |> asExe |> withLangVersionPreview |> withNoWarn 25 |> compile - |> shouldFail - |> withDiagnostics [ - Error 1, Line 11, Col 9, Line 11, Col 15, "This expression was expected to have type - ''a voption' -but here has type - ''b option' " - Error 1, Line 12, Col 9, Line 12, Col 13, "This expression was expected to have type - ''a voption' -but here has type - ''b option' " - ] + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome Some 1"; "VSome None"; "VSome 1"; "VNone"] + + [] + let ``Optional Struct Arguments wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M(1) + X.M() + 0 + """ + source + |> asExe + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + [] let ``Optional Arguments can be a ValueOption+StructAttribute attribute with langversion=preview`` () = @@ -334,23 +416,148 @@ let main _ = IL_0049: ret } """] - + + [] + let ``Optional Arguments in constructor wrap Option`` () = + let source = + FSharp """ +module Program +type X<'T>(?x: 'T) = + member _.M() = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X(Some 1).M() + X(None).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some Some 1"; "Some None"; "Some 1"; "None"] + + [] + let ``Optional Arguments in constructor wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X<'T>(?x: 'T) = + member _.M() = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some ValueSome 1"; "Some ValueNone"; "Some 1"; "None"] + + [] + let ``Optional Struct Arguments in constructor wrap Option`` () = + let source = + FSharp """ +module Program +type X<'T>([] ?x: 'T) = + member _.M() = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X(Some 1).M() + X(None).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome Some 1"; "VSome None"; "VSome 1"; "VNone"] + + [] + let ``Optional Struct Arguments in constructor wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X<'T>([] ?x: 'T) = + member _.M() = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + [] let ``Optional Arguments in constructor can be a ValueOption+StructAttribute attribute with langversion=preview`` () = let source = FSharp """ module Program -type X() = - static member M([] ?x) = +type X<'T>([] ?x: 'T) = + member _.M() = match x with | ValueSome x -> printfn "VSome %A" x | ValueNone -> printfn "VNone" [] let main _ = - X.M(ValueSome 1) - X.M(ValueNone) - X.M() + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() 0 """ let compilation = @@ -363,4 +570,43 @@ let main _ = |> shouldSucceed |> run |> shouldSucceed - |> withOutputContainsAllInOrder ["VSome 1"; "VNone"; "VNone"] \ No newline at end of file + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + + [] + let ``Optional Arguments in constructor can't be a ValueOption+StructAttribute attribute with langversion=90`` () = + let source = + FSharp """ +module Program +type X<'T>([] ?x: 'T) = + member _.M() = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersion90 + |> withNoWarn 25 + |> asLibrary + |> compile + + compilation + |> shouldFail + |> withDiagnostics [ + Error 1, Line 6, Col 11, Line 6, Col 22, "This expression was expected to have type + ''T option' +but here has type + ''a voption' " + Error 1, Line 7, Col 11, Line 7, Col 20, "This expression was expected to have type + ''T option' +but here has type + ''a voption' " + ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAttributeAlias.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAttributeAlias.fs new file mode 100644 index 00000000000..2edc2107284 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAttributeAlias.fs @@ -0,0 +1,39 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Conformance.BasicGrammarElements + +open Xunit +open FSharp.Test.Compiler + +module WarnForAttributeAlias = + [] + let ``Warn user when aliasing FSharp_Core_AutoOpenAttribute`` () = + Fsx """ +type ByItsOwnNatureUnBottledAttribute = Microsoft.FSharp.Core.AutoOpenAttribute + +[] +module Foo = + let bar = 0 +""" + |> withLangVersion80 + |> compile + |> shouldFail + |> withDiagnostics [ + (Warning 3561, Line 2, Col 6, Line 2, Col 38, "Microsoft.FSharp.Core.AutoOpenAttribute should not be aliased."); + ] + + [] + let ``Warn user when aliasing FSharp_Core_StructAttribute`` () = + Fsx """ +type ByItsOwnNatureUnBottledAttribute = StructAttribute + +[] +module Foo = + let bar = 0 +""" + |> withLangVersion80 + |> compile + |> shouldFail + |> withDiagnostics [ + (Warning 3561, Line 2, Col 6, Line 2, Col 38, "Microsoft.FSharp.Core.StructAttribute should not be aliased."); + ] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAutoOpenAttributeAlias.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAutoOpenAttributeAlias.fs deleted file mode 100644 index b1d60d36842..00000000000 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAutoOpenAttributeAlias.fs +++ /dev/null @@ -1,23 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Conformance.BasicGrammarElements - -open Xunit -open FSharp.Test.Compiler - -module WarnForAutoOpenAttributeAlias = - [] - let ``Warn user when aliasing FSharp_Core_AutoOpenAttribute`` () = - Fsx """ -type ByItsOwnNatureUnBottledAttribute = Microsoft.FSharp.Core.AutoOpenAttribute - -[] -module Foo = - let bar = 0 -""" - |> withLangVersion80 - |> compile - |> shouldFail - |> withDiagnostics [ - (Warning 3561, Line 2, Col 6, Line 2, Col 38, "FSharp.Core.AutoOpenAttribute should not be aliased."); - ] diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index a1a46d7a99e..3626637a3ba 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -73,7 +73,7 @@ - + From 715499db1ef1bf2a5585cb77029d40e6369eaf30 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Wed, 4 Dec 2024 18:38:41 +0100 Subject: [PATCH 10/13] Added attribute alias warning, add more tests --- src/Compiler/Checking/CheckPatterns.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 4360c3db8ca..aaa43bcc64f 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -39,7 +39,7 @@ type cenv = TcFileState let inline findSynAttribute (attrName: string) (synAttrs: SynAttributes) = let attributesToSearch = if attrName.EndsWith("Attribute") then - set [attrName; attrName.AsSpan().Slice(0, attrName.Length - 9).ToString()] + set [attrName; attrName.Substring(0, attrName.Length - 9).ToString()] else set [attrName; attrName + "Attribute"] From 93603e686206283c5525e94f956a26a12384ab6b Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 16 Dec 2024 19:10:52 +0100 Subject: [PATCH 11/13] PR comments --- src/Compiler/Checking/CheckPatterns.fs | 44 +++++---------- src/Compiler/Checking/MethodCalls.fs | 65 ++++++++++++----------- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 11 ++++ src/Compiler/SyntaxTree/SyntaxTreeOps.fsi | 2 + 4 files changed, 59 insertions(+), 63 deletions(-) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index aaa43bcc64f..b3db808c346 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -35,24 +35,6 @@ type cenv = TcFileState // Helpers that should be elsewhere //------------------------------------------------------------------------- -// CAUTION: This function operates over the untyped tree, so should be used only when absolutely necessary. It doesn't verify assembly origine nor does it respect type aliases. -let inline findSynAttribute (attrName: string) (synAttrs: SynAttributes) = - let attributesToSearch = - if attrName.EndsWith("Attribute") then - set [attrName; attrName.Substring(0, attrName.Length - 9).ToString()] - else - set [attrName; attrName + "Attribute"] - - let mutable found = false - - for synAttr in synAttrs do - for attr in synAttr.Attributes do - let typename = attr.TypeName.LongIdent |> List.last - if attributesToSearch.Contains typename.idText then - found <- true - - found - let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref, [ty], [], m) let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref, [ty], [ph;pt], unionRanges ph.Range pt.Range) @@ -76,6 +58,14 @@ let UnifyRefTupleType contextInfo (cenv: cenv) denv m ty ps = AddCxTypeEqualsType contextInfo denv cenv.css m ty (TType_tuple (tupInfoRef, ptys)) ptys +let inline mkOptionalParamTyBasedOnAttribute (g: TcGlobals) tyarg attribs = + if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) + && findSynAttribute "StructAttribute" attribs + then + mkValueOptionTy g tyarg + else + mkOptionTy g tyarg + let rec TryAdjustHiddenVarNameToCompGenName (cenv: cenv) env (id: Ident) altNameRefCellOpt = match altNameRefCellOpt with | Some ({contents = SynSimplePatAlternativeIdInfo.Undecided altId } as altNameRefCell) -> @@ -111,13 +101,8 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p (at let tyarg = NewInferenceType g - let optionalParamTy = - if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) - && findSynAttribute "StructAttribute" attribs - then - mkValueOptionTy g tyarg - else - mkOptionTy g tyarg + let optionalParamTy = mkOptionalParamTyBasedOnAttribute g tyarg attribs + UnifyTypes cenv env m ty optionalParamTy let vFlags = TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, isCompGen) @@ -131,13 +116,8 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p (at match p with // Optional arguments on members | SynSimplePat.Id(_, _, _, _, true, _) -> - let optionalParamTy = - if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) - && findSynAttribute "StructAttribute" attribs - then - mkValueOptionTy g ctyR - else - mkOptionTy g ctyR + let optionalParamTy = mkOptionalParamTyBasedOnAttribute g ctyR attribs + UnifyTypes cenv env m ty optionalParamTy | _ -> UnifyTypes cenv env m ty ctyR diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 15d240aeaaa..4c561dd7fee 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -328,27 +328,46 @@ let AdjustCalledArgTypeForTypeDirectedConversionsAndAutoQuote (infoReader: InfoR else AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy callerArgTy m +let inline tryDestOptionalTy g ty = + if isOptionTy g ty then + destOptionTy g ty + elif g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g ty then + destValueOptionTy g ty + else + ty + +let inline mkOptionalTy (g: TcGlobals) ty = + if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g ty then + mkValueOptionTy g ty + else + mkOptionTy g ty + +let inline mkOptionalNone (g: TcGlobals) ty calledArgTy mMethExpr = + if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g ty then + mkValueNone g calledArgTy mMethExpr + else + mkNone g calledArgTy mMethExpr + + /// Adjust the called argument type to take into account whether the caller's argument is CSharpMethod(?arg=Some(3)) or CSharpMethod(arg=1) let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableOptionalsKnownTypes (calledArg: CalledArg) calledArgTy (callerArg: CallerArg<_>) = let g = infoReader.g let m = callerArg.Range let callerArgTy = callerArg.CallerArgumentType - if callerArg.IsExplicitOptional then - match calledArg.OptArgInfo with + if callerArg.IsExplicitOptional then + match calledArg.OptArgInfo with // CSharpMethod(?x = arg), optional C#-style argument, may have nullable type | CallerSide _ -> if g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop then - if isNullableTy g calledArgTy then - if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g calledArgTy then - mkValueOptionTy g (destNullableTy g calledArgTy), TypeDirectedConversionUsed.No, None - else - mkOptionTy g (destNullableTy g calledArgTy), TypeDirectedConversionUsed.No, None - else - if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g calledArgTy then - mkValueOptionTy g calledArgTy, TypeDirectedConversionUsed.No, None + + let calledArgTy = + if isNullableTy g calledArgTy then + destNullableTy g calledArgTy else - mkOptionTy g calledArgTy, TypeDirectedConversionUsed.No, None + calledArgTy + + mkOptionalTy g calledArgTy, TypeDirectedConversionUsed.No, None else calledArgTy, TypeDirectedConversionUsed.No, None @@ -398,13 +417,7 @@ let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableO // FSharpMethod(x = arg), optional F#-style argument, should have option type | CalleeSide -> - let calledArgTy2 = - if isOptionTy g calledArgTy then - destOptionTy g calledArgTy - elif g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g calledArgTy then - destValueOptionTy g calledArgTy - else - calledArgTy + let calledArgTy2 = tryDestOptionalTy g calledArgTy AdjustCalledArgTypeForTypeDirectedConversionsAndAutoQuote infoReader ad callerArgTy calledArgTy2 calledArg m // F# supports adhoc conversions at some specific points @@ -1484,14 +1497,7 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C /// can be used with 'CalleeSide' optional arguments let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCallerMemberName (mMethExpr: range) = let calledArgTy = calledArg.CalledArgumentType - let calledNonOptTy = - if isOptionTy g calledArgTy then - destOptionTy g calledArgTy - elif g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) - && isValueOptionTy g calledArgTy then - destValueOptionTy g calledArgTy - else - calledArgTy // should be unreachable + let calledNonOptTy = tryDestOptionalTy g calledArgTy match calledArg.CallerInfo, eCallerMemberName with | CallerLineNumber, _ when typeEquiv g calledNonOptTy g.int_ty -> @@ -1505,11 +1511,8 @@ let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCalle let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy) mkSome g calledNonOptTy memberNameExpr mMethExpr | _ -> - if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) && isValueOptionTy g calledArgTy - then - mkValueNone g calledArgTy mMethExpr - else - mkNone g calledNonOptTy mMethExpr + mkOptionalNone g calledArgTy calledNonOptTy mMethExpr + /// Get the expression that must be inserted on the caller side for an optional arg where /// no caller argument has been provided. diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 7b392487adb..73aa1ee529e 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -107,6 +107,17 @@ let rec pushUnaryArg expr arg = errorR (Error(FSComp.SR.tcDotLambdaAtNotSupportedExpression (), expr.Range)) expr +/// CAUTION: This function operates over the untyped tree, so should be used only when absolutely necessary. It doesn't verify assembly origine nor does it respect type aliases. +/// Also, keep in mind that it will only check last part of the assembly (with or without the `Attribute` suffix). +let inline findSynAttribute (attrName: string) (synAttrs: SynAttributes) = + let attributesToSearch = + if attrName.EndsWith("Attribute") then + set [attrName; attrName.Substring(0, attrName.Length - 9)] + else + set [attrName; attrName + "Attribute"] + + synAttrs |> List.exists (fun synAttr -> synAttr.Attributes |> List.exists (fun attr -> attributesToSearch.Contains (attr.TypeName.LongIdent |> List.last |> _.idText))) + [] let (|SynSingleIdent|_|) x = match x with diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index 3ca2b58be43..49190452b4f 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -44,6 +44,8 @@ val mkSynCompGenSimplePatVar: id: Ident -> SynSimplePat val pushUnaryArg: expr: SynExpr -> arg: Ident -> SynExpr +val inline findSynAttribute: attrName: string -> synAttrs: SynAttributes -> bool + /// Match a long identifier, including the case for single identifiers which gets a more optimized node in the syntax tree. [] val (|LongOrSingleIdent|_|): From 5a1e1e97803c8d15b4f86583aa68cda6e8ccea43 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 16 Dec 2024 19:16:00 +0100 Subject: [PATCH 12/13] Fix --- .../Driver/GraphChecking/TrieMapping.fs | 28 ++----------------- 1 file changed, 2 insertions(+), 26 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/TrieMapping.fs b/src/Compiler/Driver/GraphChecking/TrieMapping.fs index 95b22637e9a..60ce5dc2527 100644 --- a/src/Compiler/Driver/GraphChecking/TrieMapping.fs +++ b/src/Compiler/Driver/GraphChecking/TrieMapping.fs @@ -5,6 +5,7 @@ open System.Collections.Immutable open System.Text open FSharp.Compiler.IO open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTreeOps [] module private ImmutableHashSet = @@ -15,34 +16,9 @@ module private ImmutableHashSet = /// Create a new HashSet<'T> with zero elements. let empty () = ImmutableHashSet.Empty -let autoOpenShapes = - set - [| - "FSharp.Core.AutoOpenAttribute" - "Core.AutoOpenAttribute" - "AutoOpenAttribute" - "FSharp.Core.AutoOpen" - "Core.AutoOpen" - "AutoOpen" - |] - -/// This isn't bullet proof, we do prompt a warning when the user is aliasing the AutoOpenAttribute. -let isAutoOpenAttribute (attribute: SynAttribute) = - match attribute.ArgExpr with - | SynExpr.Const(constant = SynConst.Unit) - | SynExpr.Const(constant = SynConst.String _) - | SynExpr.Paren(expr = SynExpr.Const(constant = SynConst.String _)) -> - let attributeName = - attribute.TypeName.LongIdent - |> List.map (fun ident -> ident.idText) - |> String.concat "." - - autoOpenShapes.Contains attributeName - | _ -> false let isAnyAttributeAutoOpen (attributes: SynAttributes) = - attributes - |> List.exists (fun (atl: SynAttributeList) -> List.exists isAutoOpenAttribute atl.Attributes) + findSynAttribute "AutoOpen" attributes /// Checks to see if the top level ModuleOrNamespace exposes content that could be inferred by any of the subsequent files. /// This can happen when a `namespace global` is used, or when a module (with a single ident name) has the `[]` attribute. From 0c7f1f37f8b6ac995940a06a60c479e0ab4a834e Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 18 Dec 2024 17:08:55 +0000 Subject: [PATCH 13/13] Automated command ran: fantomas Co-authored-by: vzarytovskii <1260985+vzarytovskii@users.noreply.github.com> --- src/Compiler/Driver/GraphChecking/TrieMapping.fs | 4 +--- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 9 ++++++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/TrieMapping.fs b/src/Compiler/Driver/GraphChecking/TrieMapping.fs index 60ce5dc2527..215f8a2dae6 100644 --- a/src/Compiler/Driver/GraphChecking/TrieMapping.fs +++ b/src/Compiler/Driver/GraphChecking/TrieMapping.fs @@ -16,9 +16,7 @@ module private ImmutableHashSet = /// Create a new HashSet<'T> with zero elements. let empty () = ImmutableHashSet.Empty - -let isAnyAttributeAutoOpen (attributes: SynAttributes) = - findSynAttribute "AutoOpen" attributes +let isAnyAttributeAutoOpen (attributes: SynAttributes) = findSynAttribute "AutoOpen" attributes /// Checks to see if the top level ModuleOrNamespace exposes content that could be inferred by any of the subsequent files. /// This can happen when a `namespace global` is used, or when a module (with a single ident name) has the `[]` attribute. diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 73aa1ee529e..ffb9bd65647 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -112,11 +112,14 @@ let rec pushUnaryArg expr arg = let inline findSynAttribute (attrName: string) (synAttrs: SynAttributes) = let attributesToSearch = if attrName.EndsWith("Attribute") then - set [attrName; attrName.Substring(0, attrName.Length - 9)] + set [ attrName; attrName.Substring(0, attrName.Length - 9) ] else - set [attrName; attrName + "Attribute"] + set [ attrName; attrName + "Attribute" ] - synAttrs |> List.exists (fun synAttr -> synAttr.Attributes |> List.exists (fun attr -> attributesToSearch.Contains (attr.TypeName.LongIdent |> List.last |> _.idText))) + synAttrs + |> List.exists (fun synAttr -> + synAttr.Attributes + |> List.exists (fun attr -> attributesToSearch.Contains(attr.TypeName.LongIdent |> List.last |> _.idText))) [] let (|SynSingleIdent|_|) x =