Support CallerArgumentExpression

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

@@ -30,6 +30,7 @@
 * Type parameter constraint `null` in generic code will now automatically imply `not struct` ([Issue #18320](https://github.com/dotnet/fsharp/issues/18320), [PR #18323](https://github.com/dotnet/fsharp/pull/18323))
 * Add a switch to determine whether to generate a default implementation body for overridden method when completing. [PR #18341](https://github.com/dotnet/fsharp/pull/18341)
 
+* Support `CallerArgumentExpression` ([Language Suggestion #966](https://github.com/fsharp/fslang-suggestions/issues/966), [PR #17519](https://github.com/dotnet/fsharp/pull/17519))
 
 ### Changed
 * FSharpCheckFileResults.ProjectContext.ProjectOptions will not be available when using the experimental Transparent Compiler feature. ([PR #18205](https://github.com/dotnet/fsharp/pull/18205))

docs/release-notes/.Language/preview.md

@@ -5,6 +5,7 @@
 * 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))
 * Warn when `unit` is passed to an `obj`-typed argument  ([PR #18330](https://github.com/dotnet/fsharp/pull/18330))
+* Support `CallerArgumentExpression` ([Language Suggestion #966](https://github.com/fsharp/fslang-suggestions/issues/966), [PR #17519](https://github.com/dotnet/fsharp/pull/17519))
 
 ### Fixed
 

src/Compiler/Checking/MethodCalls.fs

@@ -1437,9 +1437,20 @@ let AdjustCallerArgExpr tcVal (g: TcGlobals) amap infoReader ad isOutArg calledA
 /// matter what order they are applied in as long as they are all composed together.
 let emptyPreBinder (e: Expr) = e
 
+/// Try to pick the code text of an argument with the given parameter name from a list of assigned arguments.
+let tryPickArgumentCodeText assignedArgs paramName =
+    assignedArgs
+    |> List.tryPick (fun { CalledArg=called; CallerArg=caller } -> 
+    match called.NameOpt with
+    | Some x when x.idText = paramName ->
+        let code = FileContent.getCodeText caller.Range
+        if System.String.IsNullOrEmpty code then None
+        else Some code
+    | _ -> None)
+
 /// Get the expression that must be inserted on the caller side for a CallerSide optional arg,
 /// i.e. one where there is no corresponding caller arg.
-let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: CalledArg) currCalledArgTy currDfltVal eCallerMemberName mMethExpr =
+let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: CalledArg) currCalledArgTy currDfltVal eCallerMemberName mMethExpr assignedArgs =
     match currDfltVal with
     | MissingValue -> 
         // Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr. 
@@ -1456,7 +1467,7 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C
             let ctorArgs = [Expr.Const (tcFieldInit mMethExpr fieldInit, mMethExpr, inst)]
             emptyPreBinder, Expr.Op (TOp.ILCall (false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr)
         | ByrefTy g inst ->
-            GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg inst (PassByRef(inst, currDfltVal)) eCallerMemberName mMethExpr
+            GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg inst (PassByRef(inst, currDfltVal)) eCallerMemberName mMethExpr assignedArgs
         | _ ->
             match calledArg.CallerInfo, eCallerMemberName with
             | CallerLineNumber, _ when typeEquiv g currCalledArgTy g.int_ty ->
@@ -1466,6 +1477,14 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C
                 emptyPreBinder, Expr.Const (Const.String fileName, mMethExpr, currCalledArgTy)
             | CallerMemberName, Some callerName when (typeEquiv g currCalledArgTy g.string_ty) ->
                 emptyPreBinder, Expr.Const (Const.String callerName, mMethExpr, currCalledArgTy)
+
+            | CallerArgumentExpression param, _ when g.langVersion.SupportsFeature LanguageFeature.SupportCallerArgumentExpression && typeEquiv g currCalledArgTy g.string_ty ->
+                let stringConst =
+                    match tryPickArgumentCodeText assignedArgs param with
+                    | Some code -> Const.String code
+                    | None -> tcFieldInit mMethExpr fieldInit
+                emptyPreBinder, Expr.Const (stringConst, mMethExpr, currCalledArgTy)
+
             | _ ->
                 emptyPreBinder, Expr.Const (tcFieldInit mMethExpr fieldInit, mMethExpr, currCalledArgTy)
 
@@ -1489,13 +1508,13 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C
 
     | PassByRef (ty, dfltVal2) ->
         let v, _ = mkCompGenLocal mMethExpr "defaultByrefArg" ty
-        let wrapper2, rhs = GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg currCalledArgTy dfltVal2 eCallerMemberName mMethExpr
+        let wrapper2, rhs = GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg currCalledArgTy dfltVal2 eCallerMemberName mMethExpr assignedArgs
         (wrapper2 >> mkCompGenLet mMethExpr v rhs), mkValAddr mMethExpr false (mkLocalValRef v)
 
 /// Get the expression that must be inserted on the caller side for a CalleeSide optional arg where
 /// no caller argument has been provided. Normally this is 'None', however CallerMemberName and friends
 /// can be used with 'CalleeSide' optional arguments
-let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCallerMemberName (mMethExpr: range) =
+let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCallerMemberName (mMethExpr: range) assignedArgs =
     let calledArgTy = calledArg.CalledArgumentType
     let calledNonOptTy = tryDestOptionalTy g calledArgTy
 
@@ -1510,24 +1529,32 @@ let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCalle
     | CallerMemberName, Some(callerName) when typeEquiv g calledNonOptTy g.string_ty ->
         let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy)
         mkSome g calledNonOptTy memberNameExpr mMethExpr
+
+    | CallerArgumentExpression param, _ when g.langVersion.SupportsFeature LanguageFeature.SupportCallerArgumentExpression && typeEquiv g calledNonOptTy g.string_ty ->
+        match tryPickArgumentCodeText assignedArgs param with
+        | Some code -> 
+            let expr = Expr.Const(Const.String code, mMethExpr, calledNonOptTy)
+            mkSome g calledNonOptTy expr mMethExpr
+        | None -> 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. 
-let GetDefaultExpressionForOptionalArg tcFieldInit g (calledArg: CalledArg) eCallerMemberName mItem (mMethExpr: range) =
+let GetDefaultExpressionForOptionalArg tcFieldInit g (calledArg: CalledArg) eCallerMemberName mItem (mMethExpr: range) assignedArgs =
     let calledArgTy = calledArg.CalledArgumentType
     let preBinder, expr = 
         match calledArg.OptArgInfo with 
         | NotOptional -> 
             error(InternalError("Unexpected NotOptional", mItem))
 
         | CallerSide dfltVal ->
-            GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg calledArgTy dfltVal eCallerMemberName mMethExpr
+            GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg calledArgTy dfltVal eCallerMemberName mMethExpr assignedArgs
 
         | CalleeSide ->
-            emptyPreBinder, GetDefaultExpressionForCalleeSideOptionalArg g calledArg eCallerMemberName mMethExpr
+            emptyPreBinder, GetDefaultExpressionForCalleeSideOptionalArg g calledArg eCallerMemberName mMethExpr assignedArgs
 
     // Combine the variable allocators (if any)
     let callerArg = CallerArg(calledArgTy, mMethExpr, false, expr)
@@ -1581,7 +1608,7 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader:
                             mkOptionToNullable g m (destOptionTy g callerArgTy) callerArgExpr
                         else 
                             // CSharpMethod(?x=b) when 'b' has optional type and 'x' has non-nullable type --> CSharpMethod(x=Option.defaultValue DEFAULT v)
-                            let _wrapper, defaultExpr = GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg calledArgTy dfltVal eCallerMemberName m
+                            let _wrapper, defaultExpr = GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g calledArg calledArgTy dfltVal eCallerMemberName m [assignedArg]
                             let ty = destOptionTy g callerArgTy
                             mkOptionDefaultValue g m ty defaultExpr callerArgExpr
                     else
@@ -1645,7 +1672,7 @@ let AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName (infoReader
     // i.e. there is no corresponding caller arg.
     let optArgs, optArgPreBinder = 
         (emptyPreBinder, calledMeth.UnnamedCalledOptArgs) ||> List.mapFold (fun preBinder calledArg -> 
-            let preBinder2, arg = GetDefaultExpressionForOptionalArg tcFieldInit g calledArg eCallerMemberName mItem mMethExpr
+            let preBinder2, arg = GetDefaultExpressionForOptionalArg tcFieldInit g calledArg eCallerMemberName mItem mMethExpr (assignedNamedArgs @ unnamedArgs)
             arg, (preBinder >> preBinder2))
 
     let adjustedNormalUnnamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader ad) unnamedArgs

src/Compiler/Checking/PostInferenceChecks.fs

@@ -2391,8 +2391,10 @@ let CheckEntityDefn cenv env (tycon: Entity) =
             if numCurriedArgSets > 1 && others |> List.exists (fun minfo2 -> not (IsAbstractDefaultPair2 minfo minfo2)) then
                 errorR(Error(FSComp.SR.chkDuplicateMethodCurried(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
 
+            let paramDatas = minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst)
+
             if numCurriedArgSets > 1 &&
-               (minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst)
+               (paramDatas
                 |> List.existsSquared (fun (ParamData(isParamArrayArg, _isInArg, isOutArg, optArgInfo, callerInfo, _, reflArgInfo, ty)) ->
                     isParamArrayArg || isOutArg || reflArgInfo.AutoQuote || optArgInfo.IsOptional || callerInfo <> NoCallerInfo || isByrefLikeTy g m ty)) then
                 errorR(Error(FSComp.SR.chkCurriedMethodsCantHaveOutParams(), m))
@@ -2406,7 +2408,20 @@ let CheckEntityDefn cenv env (tycon: Entity) =
                     if not ((isOptionTy g ty) && (typeEquiv g g.string_ty (destOptionTy g ty))) then
                         errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m))
 
-                minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst)
+                let paramNames = HashSet()
+                paramDatas
+                |> List.iterSquared (fun (ParamData(_, _, _, _, _, nameOpt, _, _)) ->
+                    nameOpt |> Option.iter (fun name -> paramNames.Add name.idText |> ignore))
+
+                let checkArgOfCallerArgumentExpression m arg (nameOpt: Ident option) =
+                    match nameOpt with
+                    | Some ident when arg = ident.idText -> 
+                        warning(Error(FSComp.SR.tcCallerArgumentExpressionSelfReferential(), m))
+                    | _ when not (paramNames.Contains arg) -> 
+                        warning(Error(FSComp.SR.tcCallerArgumentExpressionHasInvalidParameterName(), m))
+                    | _ -> ()
+
+                paramDatas
                 |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, nameOpt, _, ty)) ->
                     ignore isInArg
 
@@ -2426,6 +2441,14 @@ let CheckEntityDefn cenv env (tycon: Entity) =
                             errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "int", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m))
                     | CallerSide _, (CallerFilePath | CallerMemberName) -> errorIfNotStringTy m ty callerInfo
                     | CalleeSide, (CallerFilePath | CallerMemberName) -> errorIfNotStringOptionTy m ty callerInfo
+                    | CallerSide _, CallerArgumentExpression arg ->
+                        checkLanguageFeatureAndRecover g.langVersion LanguageFeature.SupportCallerArgumentExpression m
+                        errorIfNotStringTy m ty callerInfo
+                        checkArgOfCallerArgumentExpression m arg nameOpt
+                    | CalleeSide, CallerArgumentExpression arg ->
+                        checkLanguageFeatureAndRecover g.langVersion LanguageFeature.SupportCallerArgumentExpression m
+                        errorIfNotStringOptionTy m ty callerInfo
+                        checkArgOfCallerArgumentExpression m arg nameOpt
                 )
 
         for pinfo in immediateProps do

src/Compiler/Checking/infos.fs

@@ -240,6 +240,7 @@ type CallerInfo =
     | CallerLineNumber
     | CallerMemberName
     | CallerFilePath
+    | CallerArgumentExpression of paramName: string
 
     override x.ToString() = sprintf "%+A" x
 
@@ -317,20 +318,25 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) =
     let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs
     let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute argInfo.Attribs
     let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs
+    let callerArgumentExpressionArg = 
+        TryFindFSharpAttributeOpt g g.attrib_CallerArgumentExpressionAttribute argInfo.Attribs
+        |> Option.orElseWith (fun () -> TryFindFSharpAttributeByName "System.Runtime.CompilerServices.CallerArgumentExpressionAttribute" argInfo.Attribs)
 
     let callerInfo =
-        match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with
-        | false, false, false -> NoCallerInfo
-        | true, false, false -> CallerLineNumber
-        | false, true, false -> CallerFilePath
-        | false, false, true -> CallerMemberName
-        | false, true, true -> 
+        match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg, callerArgumentExpressionArg with
+        | false, false, false, None -> NoCallerInfo
+        | true, false, false, None -> CallerLineNumber
+        | false, true, false, None -> CallerFilePath
+        | false, false, true, None -> CallerMemberName
+        | false, false, false, Some(Attrib(_, _, (AttribStringArg x :: _), _, _, _, _)) ->
+            CallerArgumentExpression(x)
+        | false, true, true, _ -> 
             match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with
             | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) ->
                 warning(Error(FSComp.SR.CallerMemberNameIsOverridden(argInfo.Name.Value.idText), callerMemberNameAttributeRange))
                 CallerFilePath
             | _ -> failwith "Impossible"
-        | _, _, _ ->
+        | _, _, _, _ ->
             // if multiple caller info attributes are specified, pick the "wrong" one here
             // so that we get an error later
             match tryDestOptionTy g ty with
@@ -1280,14 +1286,20 @@ type MethInfo =
                  let isCallerLineNumberArg = TryFindILAttribute g.attrib_CallerLineNumberAttribute attrs
                  let isCallerFilePathArg = TryFindILAttribute g.attrib_CallerFilePathAttribute attrs
                  let isCallerMemberNameArg = TryFindILAttribute g.attrib_CallerMemberNameAttribute attrs
+                 let isCallerArgumentExpressionArg =
+                     g.attrib_CallerArgumentExpressionAttribute
+                     |> Option.bind (fun (AttribInfo(tref, _)) -> TryDecodeILAttribute tref attrs)
+                     |> Option.orElseWith (fun () -> TryDecodeILAttributeByName "System.Runtime.CompilerServices.CallerArgumentExpressionAttribute" attrs)
 
                  let callerInfo =
-                    match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with
-                    | false, false, false -> NoCallerInfo
-                    | true, false, false -> CallerLineNumber
-                    | false, true, false -> CallerFilePath
-                    | false, false, true -> CallerMemberName
-                    | _, _, _ ->
+                    match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg, isCallerArgumentExpressionArg with
+                    | false, false, false, None -> NoCallerInfo
+                    | true, false, false, None -> CallerLineNumber
+                    | false, true, false, None -> CallerFilePath
+                    | false, false, true, None -> CallerMemberName            
+                    | false, false, false, Some ([ILAttribElem.String (Some name) ], _) -> CallerArgumentExpression(name)
+                    | false, false, false, _ -> NoCallerInfo
+                    | _, _, _, _ ->
                         // if multiple caller info attributes are specified, pick the "wrong" one here
                         // so that we get an error later
                         if p.Type.TypeRef.FullName = "System.Int32" then CallerFilePath

src/Compiler/Checking/infos.fsi

@@ -101,6 +101,7 @@ type CallerInfo =
     | CallerLineNumber
     | CallerMemberName
     | CallerFilePath
+    | CallerArgumentExpression of paramName: string
 
 [<RequireQualifiedAccess>]
 type ReflectedArgInfo =

src/Compiler/Driver/CompilerConfig.fs

@@ -1539,3 +1539,14 @@ type TcConfigProvider =
         TcConfigProvider(fun _ctok -> TcConfig.Create(tcConfigB, validate = false))
 
 let GetFSharpCoreLibraryName () = getFSharpCoreLibraryName
+
+/// Read and store the source file content for the `CallerArgumentExpression` feature.
+/// This should only be called in `fsc` or `fsi` processing.
+let readAndStoreFileContents (tcConfig: TcConfig) (sourceFiles: #seq<string>) =
+    if
+        tcConfig.langVersion.SupportsFeature LanguageFeature.SupportCallerArgumentExpression
+        && (tcConfig.compilationMode.IsOneOff || tcConfig.isInteractive)
+    then
+        for fileName in sourceFiles do
+            if FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) then
+                FileContent.update fileName (FileContent.FileCacheType.NotYetRead tcConfig.inputCodePage)

src/Compiler/Driver/CompilerConfig.fsi

@@ -961,3 +961,7 @@ val FSharpMLCompatFileSuffixes: string list
 
 /// Indicates whether experimental features should be enabled automatically
 val FSharpExperimentalFeaturesEnabledAutomatically: bool
+
+/// Read and store the source file content for the `CallerArgumentExpression` feature.
+/// This should only be called in `fsc` or `fsi` processing.
+val readAndStoreFileContents: tcConfig: TcConfig -> sourceFiles: #seq<string> -> unit

src/Compiler/Driver/fsc.fs

@@ -671,6 +671,9 @@ let main1
     // Build the initial type checking environment
     ReportTime tcConfig "Typecheck"
 
+    // Read the source file content for the `CallerArgumentExpression` feature
+    readAndStoreFileContents tcConfig sourceFiles
+
     use unwindParsePhase = UseBuildPhase BuildPhase.TypeCheck
 
     let tcEnv0, openDecls0 =

src/Compiler/FSComp.txt

@@ -1798,3 +1798,6 @@ featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase
 featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted"
 featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters"
 featureSupportWarnWhenUnitPassedToObjArg,"Warn when unit is passed to a member accepting `obj` argument, e.g. `Method(o:obj)` will warn if called via `Method()`."
+featureSupportCallerArgumentExpression,"Support `CallerArgumentExpression`"
+3875,tcCallerArgumentExpressionSelfReferential,"The CallerArgumentExpression on this parameter will have no effect because it's self-referential."
+3875,tcCallerArgumentExpressionHasInvalidParameterName,"The CallerArgumentExpression on this parameter will have no effect because it's applied with an invalid parameter name."