Support CallerArgumentExpression

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

@@ -38,6 +38,7 @@
 * Enable consuming generic arguments defined as `allows ref struct` in C# ([Issue #17597](https://github.com/dotnet/fsharp/issues/17597)
 * Trivia for SynTypeConstraint.WhereTyparNotSupportsNull. ([Issue #17721](https://github.com/dotnet/fsharp/issues/17721), [PR #17745](https://github.com/dotnet/fsharp/pull/17745))
 * Trivia for SynType.WithNull. ([Issue #17720](https://github.com/dotnet/fsharp/issues/17720), [PR #17745](https://github.com/dotnet/fsharp/pull/17745))
+* Support `CallerArgumentExpression` ([Language Suggestion #966](https://github.com/fsharp/fslang-suggestions/issues/966), [PR #17519](https://github.com/dotnet/fsharp/pull/17519))
 
 ### Changed
 

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

@@ -1,6 +1,7 @@
 ### Added
 
 * 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))
+* 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

@@ -1418,7 +1418,7 @@ let emptyPreBinder (e: Expr) = e
 
 /// 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 unnamedArgs =
     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. 
@@ -1435,7 +1435,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 unnamedArgs
         | _ ->
             match calledArg.CallerInfo, eCallerMemberName with
             | CallerLineNumber, _ when typeEquiv g currCalledArgTy g.int_ty ->
@@ -1445,6 +1445,20 @@ 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 str =
+                    unnamedArgs
+                    |> List.tryPick (fun { CalledArg=called; CallerArg=caller } -> 
+                        match called.NameOpt with
+                        | Some x when x.idText = param ->
+                            let code = FileContent.getCodeText caller.Range
+                            if System.String.IsNullOrEmpty code then None
+                            else Some (Const.String code)
+                        | _ -> None)
+                    |> Option.defaultWith (fun _ -> tcFieldInit mMethExpr fieldInit)
+                emptyPreBinder, Expr.Const (str, mMethExpr, currCalledArgTy)
+
             | _ ->
                 emptyPreBinder, Expr.Const (tcFieldInit mMethExpr fieldInit, mMethExpr, currCalledArgTy)
 
@@ -1468,13 +1482,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 unnamedArgs
         (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) unnamedArgs =
     let calledArgTy = calledArg.CalledArgumentType
     let calledNonOptTy = 
         if isOptionTy g calledArgTy then 
@@ -1493,23 +1507,39 @@ 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 ->
+        let exprOpt =
+            unnamedArgs
+            |> List.tryPick (fun { CalledArg=called; CallerArg=caller } -> 
+                match called.NameOpt with
+                | Some x when x.idText = param ->
+                    let code = FileContent.getCodeText caller.Range
+                    if System.String.IsNullOrEmpty code then None
+                    else Some (Expr.Const(Const.String code, mMethExpr, calledNonOptTy))
+                | _ -> None)
+
+        match exprOpt with
+        | Some expr -> mkSome g calledNonOptTy expr mMethExpr
+        | None -> mkNone g calledNonOptTy mMethExpr
+
     | _ ->
         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. 
-let GetDefaultExpressionForOptionalArg tcFieldInit g (calledArg: CalledArg) eCallerMemberName mItem (mMethExpr: range) =
+let GetDefaultExpressionForOptionalArg tcFieldInit g (calledArg: CalledArg) eCallerMemberName mItem (mMethExpr: range) unnamedArgs =
     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 unnamedArgs
 
         | CalleeSide ->
-            emptyPreBinder, GetDefaultExpressionForCalleeSideOptionalArg g calledArg eCallerMemberName mMethExpr
+            emptyPreBinder, GetDefaultExpressionForCalleeSideOptionalArg g calledArg eCallerMemberName mMethExpr unnamedArgs
 
     // Combine the variable allocators (if any)
     let callerArg = CallerArg(calledArgTy, mMethExpr, false, expr)
@@ -1563,7 +1593,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
@@ -1623,7 +1653,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 unnamedArgs
             arg, (preBinder >> preBinder2))
 
     let adjustedNormalUnnamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader ad) unnamedArgs

src/Compiler/Checking/PostInferenceChecks.fs

@@ -2389,15 +2389,30 @@ 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))
 
             if numCurriedArgSets = 1 then
-                minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst)
-                |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, _, _, ty)) ->
+                let paramNames =
+                    paramDatas 
+                    |> List.concat
+                    |> List.choose (fun (ParamData(_, _, _, _, _, nameOpt, _, _)) -> nameOpt)
+
+                let checkCallerArgumentExpression name (nameOpt: Ident option) =
+                    match nameOpt with
+                    | Some ident when name = ident.idText -> 
+                        warning(Error(FSComp.SR.tcCallerArgumentExpressionSelfReferential(name), m))
+                    | _ when paramNames |> List.forall (fun i -> name <> i.idText) -> 
+                        warning(Error(FSComp.SR.tcCallerArgumentExpressionHasInvalidParameterName(name), m))
+                    | _ -> ()
+
+                paramDatas
+                |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, nameOpt, _, ty)) ->
                     ignore isInArg
                     match (optArgInfo, callerInfo) with
                     | _, NoCallerInfo -> ()
@@ -2419,7 +2434,20 @@ let CheckEntityDefn cenv env (tycon: Entity) =
                             errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv ty), m))
                     | CalleeSide, CallerMemberName ->
                         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)))
+                            errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m))
+
+                    | CallerSide _, CallerArgumentExpression name ->
+                        if not (typeEquiv g g.string_ty ty) then
+                            errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv ty), m))
+
+                        checkCallerArgumentExpression name nameOpt
+
+                    | CalleeSide, CallerArgumentExpression name ->
+                        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))
+
+                        checkCallerArgumentExpression name nameOpt
+                )
 
         for pinfo in immediateProps do
             let nm = pinfo.PropertyName

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,23 @@ 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
 
     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
@@ -1278,14 +1282,22 @@ 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 = TryFindILAttributeOpt g.attrib_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, false -> NoCallerInfo
+                    | true, false, false, false -> CallerLineNumber
+                    | false, true, false, false -> CallerFilePath
+                    | false, false, true, false -> CallerMemberName            
+                    | false, false, false, true ->
+                        match g.attrib_CallerArgumentExpressionAttribute with
+                        | Some (AttribInfo(tref,_)) ->
+                            match TryDecodeILAttribute tref attrs with
+                            | Some ([ILAttribElem.String (Some name) ], _) -> CallerArgumentExpression(name)
+                            | _ -> NoCallerInfo
+                        | None -> 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/ScriptClosure.fs

@@ -159,7 +159,9 @@ module ScriptPreprocessClosure =
             reduceMemoryUsage
         ) =
 
+        FileContent.readFileContents [ fileName ]
         let projectDir = !! Path.GetDirectoryName(fileName)
+
         let isInteractive = (codeContext = CodeContext.CompilationAndEvaluation)
         let isInvalidationSupported = (codeContext = CodeContext.Editing)
 

src/Compiler/Driver/fsc.fs

@@ -622,6 +622,8 @@ let main1
     // Register framework tcImports to be disposed in future
     disposables.Register frameworkTcImports
 
+    FileContent.readFileContents sourceFiles
+
     // Parse sourceFiles
     ReportTime tcConfig "Parse inputs"
     use unwindParsePhase = UseBuildPhase BuildPhase.Parse

src/Compiler/FSComp.txt

@@ -1783,4 +1783,7 @@ featureEmptyBodiedComputationExpressions,"Support for computation expressions wi
 featureAllowAccessModifiersToAutoPropertiesGettersAndSetters,"Allow access modifiers to auto properties getters and setters"
 3871,tcAccessModifiersNotAllowedInSRTPConstraint,"Access modifiers cannot be applied to an SRTP constraint."
 featureAllowObjectExpressionWithoutOverrides,"Allow object expressions without overrides"
-3872,tcPartialActivePattern,"Multi-case partial active patterns are not supported. Consider using a single-case partial active pattern or a full active pattern."
+3872,tcPartialActivePattern,"Multi-case partial active patterns are not supported. Consider using a single-case partial active pattern or a full active pattern."
+featureSupportCallerArgumentExpression,"Support `CallerArgumentExpression`"
+3873,tcCallerArgumentExpressionSelfReferential,"This CallerArgumentExpression with argument '%s' will have no effect because it's self-referential."
+3873,tcCallerArgumentExpressionHasInvalidParameterName,"This CallerArgumentExpression with argument '%s' will have no effect because it's applied with an invalid parameter name."