Add support for C# Experimental attribute

docs/release-notes/.FSharp.Compiler.Service/9.0.300.md

@@ -5,6 +5,7 @@
 
 ### Added
 * Added missing type constraints in FCS. ([PR #18241](https://github.com/dotnet/fsharp/pull/18241))
+* Add support for C# `Experimental` attribute. ([PR #18253](https://github.com/dotnet/fsharp/pull/18253))
 
 ### Changed
 

src/Compiler/Checking/AttributeChecking.fs

@@ -24,13 +24,6 @@ open FSharp.Compiler.TypeProviders
 open FSharp.Core.CompilerServices
 #endif
 
-exception ObsoleteDiagnostic of
-    isError: bool *
-    diagnosticId: string *
-    message: string *
-    urlFormat: string *
-    range: range
-
 let fail() = failwith "This custom attribute has an argument that cannot yet be converted using this API"
 
 let rec private evalILAttribElem elem = 
@@ -248,34 +241,59 @@ let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m =
         CompleteD
     | _ ->
         ErrorD (ObsoleteDiagnostic(true, "", msg, "", m))
+
+let private extractILAttribValueFrom name namedArgs   =
+    match namedArgs with 
+    | ExtractILAttributeNamedArg name (AttribElemStringArg v) -> v 
+    | _ -> ""
 
-let private extractILObsoleteAttributeInfo namedArgs =
-    let extractILAttribValueFrom name namedArgs   =
-        match namedArgs with 
-        | ExtractILAttributeNamedArg name (AttribElemStringArg v) -> v 
-        | _ -> ""
+let private extractILAttributeInfo namedArgs =
     let diagnosticId = extractILAttribValueFrom "DiagnosticId" namedArgs
     let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs
     (diagnosticId, urlFormat)
 
+let private CheckILExperimentalAttributes (g: TcGlobals) cattrs m =
+    let (AttribInfo(tref,_)) = g.attrib_IlExperimentalAttribute
+    match TryDecodeILAttribute tref cattrs with
+    // [Experimental("DiagnosticId")]
+    // [Experimental(diagnosticId: "DiagnosticId")]
+    // [Experimental("DiagnosticId", UrlFormat = "UrlFormat")]
+    // [Experimental(diagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")]
+    // Constructors deciding on DiagnosticId and UrlFormat properties.
+    | Some ([ attribElement ], namedArgs) ->
+        let diagnosticId = 
+            match attribElement with 
+            | ILAttribElem.String (Some msg) -> msg
+            | ILAttribElem.String None
+            | _ -> ""
+
+        let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs
+
+        WarnD(Experimental(FSComp.SR.experimentalConstruct (), diagnosticId, urlFormat, m))
+    // Empty constructor or only UrlFormat property are not allowed.
+    // [Experimental]
+    // [Experimental(UrlFormat = "UrlFormat")]
+    | Some _
+    | None -> CompleteD
+
 let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m =
     if isByrefLikeTyconRef then
         CompleteD
     else
         let (AttribInfo(tref,_)) = g.attrib_SystemObsolete
         match TryDecodeILAttribute tref cattrs with
-        // [<Obsolete>]
-        // [<Obsolete("Message")>]
-        // [<Obsolete("Message", true)>]
-        // [<Obsolete("Message", DiagnosticId = "DiagnosticId")>]
-        // [<Obsolete("Message", DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
-        // [<Obsolete(DiagnosticId = "DiagnosticId")>]
-        // [<Obsolete(DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
-        // [<Obsolete("Message", true, DiagnosticId = "DiagnosticId")>]
-        // [<Obsolete("Message", true, DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
+        // [Obsolete>]
+        // [Obsolete("Message")]
+        // [Obsolete("Message", true)]
+        // [Obsolete("Message", DiagnosticId = "DiagnosticId")]
+        // [Obsolete("Message", DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")]
+        // [Obsolete(DiagnosticId = "DiagnosticId")]
+        // [Obsolete(DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")]
+        // [Obsolete("Message", true, DiagnosticId = "DiagnosticId")]
+        // [Obsolete("Message", true, DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")]
         // Constructors deciding on IsError and Message properties.
         | Some ([ attribElement ], namedArgs) ->
-            let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs
+            let diagnosticId, urlFormat = extractILAttributeInfo namedArgs
             let msg = 
                 match attribElement with 
                 | ILAttribElem.String (Some msg) -> msg
@@ -284,7 +302,7 @@ let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs
 
             WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m))
         | Some ([ILAttribElem.String (Some msg); ILAttribElem.Bool isError ], namedArgs) ->
-            let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs
+            let diagnosticId, urlFormat = extractILAttributeInfo namedArgs
             if isError then
                 if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then
                     CheckCompilerFeatureRequiredAttribute g cattrs msg m
@@ -294,15 +312,16 @@ let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs
                 WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m))
         // Only DiagnosticId, UrlFormat
         | Some (_, namedArgs) ->
-            let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs
+            let diagnosticId, urlFormat = extractILAttributeInfo namedArgs
             WarnD(ObsoleteDiagnostic(false, diagnosticId, "", urlFormat, m))
         // No arguments
         | None -> CompleteD
 
-/// Check IL attributes for 'ObsoleteAttribute', returning errors and warnings as data
+/// Check IL attributes for Experimental, warnings as data
 let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m =
     trackErrors {
         do! CheckILObsoleteAttributes g isByrefLikeTyconRef cattrs m
+        do! CheckILExperimentalAttributes g cattrs m
     }
 
 let langVersionPrefix = "--langversion:preview"
@@ -366,7 +385,7 @@ let private CheckCompilerMessageAttribute g attribs m =
             ()
     }
 
-let private CheckExperimentalAttribute g attribs m =
+let private CheckFSharpExperimentalAttribute g attribs m =
     trackErrors {
         match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with
         | Some(Attrib(unnamedArgs= [ AttribStringArg(s) ])) ->
@@ -376,11 +395,10 @@ let private CheckExperimentalAttribute g attribs m =
                 else
                     g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0)
             if not (isExperimentalAttributeDisabled s) then
-                do! WarnD(Experimental(s, m))
-        | Some _ ->
-            do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m))
-        | _ ->
-            ()
+                do! WarnD(Experimental(s, "", "", m))
+        // Empty constructor is not allowed.
+        | Some _
+        | _ -> ()
     }
 
 let private CheckUnverifiableAttribute g attribs m  =
@@ -399,7 +417,7 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m =
         trackErrors {
             do! CheckObsoleteAttributes g attribs m
             do! CheckCompilerMessageAttribute g attribs m
-            do! CheckExperimentalAttribute g attribs m
+            do! CheckFSharpExperimentalAttribute g attribs m
             do! CheckUnverifiableAttribute g attribs m
         }
 

src/Compiler/Checking/AttributeChecking.fsi

@@ -13,13 +13,6 @@ open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.Text
 open FSharp.Compiler.TypedTree
 
-exception ObsoleteDiagnostic of
-    isError: bool *
-    diagnosticId: string *
-    message: string *
-    urlFormat: string *
-    range: range
-
 type AttribInfo =
     | FSAttribInfo of TcGlobals * Attrib
     | ILAttribInfo of TcGlobals * Import.ImportMap * ILScopeRef * ILAttribute * range

src/Compiler/Checking/PostInferenceChecks.fs

@@ -551,7 +551,7 @@ let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty =
                 if isLessAccessible tyconAcc valAcc then
                     let errorText = FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, (objName())) |> snd
                     let warningText = errorText + Environment.NewLine + FSComp.SR.tcTypeAbbreviationsCheckedAtCompileTime()
-                    warning(AttributeChecking.ObsoleteDiagnostic(false, "", warningText, "", m))
+                    warning(ObsoleteDiagnostic(false, "", warningText, "", m))
 
         CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty
 

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -14,7 +14,6 @@ open Internal.Utilities.Library
 open Internal.Utilities.Text
 
 open FSharp.Compiler
-open FSharp.Compiler.AttributeChecking
 open FSharp.Compiler.CheckExpressions
 open FSharp.Compiler.CheckDeclarations
 open FSharp.Compiler.CheckIncrementalClasses
@@ -149,7 +148,7 @@ type Exception with
         | ValueRestriction(_, _, _, _, m)
         | LetRecUnsound(_, _, m)
         | ObsoleteDiagnostic(_, _, _, _, m)
-        | Experimental(_, m)
+        | Experimental(range = m)
         | PossibleUnverifiableCode m
         | UserCompilerMessage(_, _, m)
         | Deprecated(_, m)
@@ -1795,7 +1794,7 @@ type Exception with
             if s <> "" then
                 os.AppendString(Obsolete2E().Format s)
 
-        | Experimental(s, _) -> os.AppendString(ExperimentalE().Format s)
+        | Experimental(message = s) -> os.AppendString(ExperimentalE().Format s)
 
         | PossibleUnverifiableCode _ -> os.AppendString(PossibleUnverifiableCodeE().Format)
 

src/Compiler/Facilities/DiagnosticsLogger.fs

@@ -108,7 +108,7 @@ exception LibraryUseOnly of range: range
 
 exception Deprecated of message: string * range: range
 
-exception Experimental of message: string * range: range
+exception Experimental of message: string * diagnosticId: string * urlFormat: string * range: range
 
 exception PossibleUnverifiableCode of range: range
 
@@ -133,6 +133,8 @@ exception DiagnosticWithSuggestions of number: int * message: string * range: ra
 /// A diagnostic that is raised when enabled manually, or by default with a language feature
 exception DiagnosticEnabledWithLanguageFeature of number: int * message: string * range: range * enabledByLangFeature: bool
 
+exception ObsoleteDiagnostic of isError: bool * diagnosticId: string * message: string * urlFormat: string * range: range
+
 /// The F# compiler code currently uses 'Error(...)' in many places to create
 /// an DiagnosticWithText as an exception even if it's a warning.
 ///

src/Compiler/Facilities/DiagnosticsLogger.fsi

@@ -68,7 +68,7 @@ exception LibraryUseOnly of range: range
 
 exception Deprecated of message: string * range: range
 
-exception Experimental of message: string * range: range
+exception Experimental of message: string * diagnosticId: string * urlFormat: string * range: range
 
 exception PossibleUnverifiableCode of range: range
 
@@ -87,6 +87,13 @@ exception DiagnosticWithSuggestions of
     identifier: string *
     suggestions: Suggestions
 
+exception ObsoleteDiagnostic of
+    isError: bool *
+    diagnosticId: string *
+    message: string *
+    urlFormat: string *
+    range: range
+
 /// Creates a DiagnosticWithSuggestions whose text comes via SR.*
 val ErrorWithSuggestions: (int * string) * range * string * Suggestions -> exn
 

src/Compiler/Symbols/FSharpDiagnostic.fs

@@ -78,6 +78,17 @@ module ExtendedData =
         /// Represents the URL format of the diagnostic
         member this.UrlFormat: string = urlFormat
 
+    /// Additional data for diagnostics about experimental attributes.
+    [<Class; Experimental("This FCS API is experimental and subject to change.")>]
+    type ExperimentalExtendedData
+        internal (diagnosticId: string, urlFormat: string) =
+        interface IFSharpDiagnosticExtendedData
+        /// Represents the DiagnosticId of the diagnostic
+        member this.DiagnosticId: string = diagnosticId
+
+        /// Represents the URL format of the diagnostic
+        member this.UrlFormat: string = urlFormat
+
     [<Experimental("This FCS API is experimental and subject to change.")>]
     type TypeMismatchDiagnosticExtendedData
         internal (symbolEnv: SymbolEnv, dispEnv: DisplayEnv, expectedType: TType, actualType: TType, context: DiagnosticContextInfo) =
@@ -214,6 +225,9 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str
 
             | ObsoleteDiagnostic(diagnosticId= diagnosticId; urlFormat= urlFormat) ->
                 Some(ObsoleteDiagnosticExtendedData(diagnosticId, urlFormat))
+
+            | Experimental(diagnosticId= diagnosticId; urlFormat= urlFormat) ->
+                Some(ExperimentalExtendedData(diagnosticId, urlFormat))
             | _ -> None
 
         let msg =

src/Compiler/Symbols/FSharpDiagnostic.fsi

@@ -61,6 +61,17 @@ module public ExtendedData =
         /// Represents the URL format of the diagnostic
         member UrlFormat: string
 
+    /// Additional data for diagnostics about experimental attributes.
+    [<Class; Experimental("This FCS API is experimental and subject to change.")>]
+    type public ExperimentalExtendedData =
+        interface IFSharpDiagnosticExtendedData
+
+        /// Represents the DiagnosticId of the diagnostic
+        member DiagnosticId: string
+
+        /// Represents the URL format of the diagnostic
+        member UrlFormat: string
+
     /// Additional data for type-mismatch-like (usually with ErrorNumber = 1) diagnostics
     [<Class; Experimental("This FCS API is experimental and subject to change.")>]
     type public TypeMismatchDiagnosticExtendedData =

src/Compiler/TypedTree/TcGlobals.fs

@@ -1561,6 +1561,7 @@ type TcGlobals(
   member val attrib_CompilerFeatureRequiredAttribute       = findSysAttrib "System.Runtime.CompilerServices.CompilerFeatureRequiredAttribute"
   member val attrib_SetsRequiredMembersAttribute           = findSysAttrib "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute"
   member val attrib_RequiredMemberAttribute                = findSysAttrib "System.Runtime.CompilerServices.RequiredMemberAttribute"
+  member val attrib_IlExperimentalAttribute                   = findSysAttrib "System.Diagnostics.CodeAnalysis.ExperimentalAttribute"
 
   member g.improveType tcref tinst = improveTy tcref tinst
 

src/Compiler/TypedTree/TcGlobals.fsi

@@ -506,6 +506,8 @@ type internal TcGlobals =
 
     member attrib_WarnOnWithoutNullArgumentAttribute: BuiltinAttribInfo
 
+    member attrib_IlExperimentalAttribute: BuiltinAttribInfo
+
     member attribs_Unsupported: FSharp.Compiler.TypedTree.TyconRef list
 
     member bitwise_and_info: IntrinsicValRef