Support ValueOption + Struct attribute as optional parameter

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

@@ -29,6 +29,7 @@
 * Adding warning when consuming generic method returning T|null for types not supporting nullness (structs,anons,tuples) ([PR #18057](https://github.com/dotnet/fsharp/pull/18057))
 * Sink: report SynPat.ArrayOrList type ([PR #18127](https://github.com/dotnet/fsharp/pull/18127))
 * Show the default value of compiler options ([PR #18054](https://github.com/dotnet/fsharp/pull/18054))
+* 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
 
@@ -49,3 +50,5 @@
 * Make ILTypeDef base type calculation lazy. ([PR #18005](https://github.com/dotnet/fsharp/pull/18005))
 
 ### Breaking Changes
+
+* Aliasing `StructAttribute` will now produce a warning (part of [Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098))

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
-

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

src/Compiler/Checking/CheckDeclarations.fs

@@ -3222,34 +3222,40 @@ 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.
-                    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 
+
+                    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
                         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

src/Compiler/Checking/CheckPatterns.fs

@@ -58,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) ->
@@ -75,7 +83,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 +93,17 @@ 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 = mkOptionalParamTyBasedOnAttribute g tyarg attribs
+
+                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 +115,23 @@ 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 = mkOptionalParamTyBasedOnAttribute g ctyR attribs
+
+            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 pattribs
 
 // raise an error if any optional args precede any non-optional args
 and ValidateOptArgOrder (synSimplePats: SynSimplePats) =
@@ -166,12 +180,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) =

src/Compiler/Checking/MethodCalls.fs

@@ -328,21 +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 _ -> 
+        | CallerSide _ ->
             if g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop then
-                if isNullableTy g calledArgTy then
-                    mkOptionTy g (destNullableTy g calledArgTy), TypeDirectedConversionUsed.No, None
-                else
-                    mkOptionTy g calledArgTy, TypeDirectedConversionUsed.No, None
+
+                let calledArgTy =
+                    if isNullableTy g calledArgTy then
+                        destNullableTy g calledArgTy
+                    else
+                        calledArgTy
+
+                mkOptionalTy g calledArgTy, TypeDirectedConversionUsed.No, None
             else
                 calledArgTy, TypeDirectedConversionUsed.No, None
 
@@ -392,11 +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
-                else
-                    calledArgTy
+            let calledArgTy2 = tryDestOptionalTy g calledArgTy
             AdjustCalledArgTypeForTypeDirectedConversionsAndAutoQuote infoReader ad callerArgTy calledArgTy2 calledArg m
 
 // F# supports adhoc conversions at some specific points
@@ -1476,11 +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 
-        else
-            calledArgTy // should be unreachable
+    let calledNonOptTy = tryDestOptionalTy g calledArgTy
 
     match calledArg.CallerInfo, eCallerMemberName with
     | CallerLineNumber, _ when typeEquiv g calledNonOptTy g.int_ty ->
@@ -1494,7 +1511,8 @@ let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCalle
         let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy)
         mkSome g calledNonOptTy memberNameExpr mMethExpr
     | _ ->
-        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. 
@@ -1573,20 +1591,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 }
 

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
 
 [<RequireQualifiedAccess>]
 module private ImmutableHashSet =
@@ -15,34 +16,7 @@ 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)
+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 `[<AutoOpen>]` attribute.

src/Compiler/FSComp.txt

@@ -1736,7 +1736,7 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form
 3558,chkExplicitFieldsDeclarationsOnStaticClasses,"If a type uses both [<Sealed>] and [<AbstractClass>] 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 <expr> then <expr>' or 'else if <expr> then <expr>'."
 3563,lexInvalidIdentifier,"This is not a valid identifier"
 3564,parsMissingUnionCaseName,"Missing union case name"
@@ -1790,3 +1790,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"