Support CallerArgumentExpression

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

@@ -38,6 +38,7 @@
 * 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)
 * Use a more accurate range for CE Combine methods. [PR #18394](https://github.com/dotnet/fsharp/pull/18394)
 
+* 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/CheckBasics.fs

@@ -335,6 +335,8 @@ type TcFileState =
 
       // forward call
       TcComputationExpression: TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> range * Expr * TType * SynExpr -> Expr * UnscopedTyparEnv
+
+      SourceText: ISourceText option
     }
 
     /// Create a new compilation environment
@@ -344,7 +346,8 @@ type TcFileState =
           tcSimplePats,
           tcSequenceExpressionEntry,
           tcArrayOrListSequenceExpression,
-          tcComputationExpression) =
+          tcComputationExpression,
+          sourceText: ISourceText option) =
 
         let niceNameGen = NiceNameGenerator()
         let infoReader = InfoReader(g, amap)
@@ -376,6 +379,7 @@ type TcFileState =
           TcSequenceExpressionEntry = tcSequenceExpressionEntry
           TcArrayOrListComputedExpression = tcArrayOrListSequenceExpression
           TcComputationExpression = tcComputationExpression
+          SourceText = sourceText
         }
 
     override _.ToString() = "<cenv>"

src/Compiler/Checking/CheckBasics.fsi

@@ -313,6 +313,9 @@ type TcFileState =
                 -> UnscopedTyparEnv
                 -> range * Expr * TType * SynExpr
                 -> Expr * UnscopedTyparEnv
+
+        /// The impl file content. Used to support `CallerArgumentExpression` feature.
+        SourceText: ISourceText option
     }
 
     static member Create:
@@ -356,5 +359,6 @@ type TcFileState =
                 -> OverallTy
                 -> UnscopedTyparEnv
                 -> range * Expr * TType * SynExpr
-                -> Expr * UnscopedTyparEnv) ->
+                -> Expr * UnscopedTyparEnv) *
+        sourceText: ISourceText option ->
             TcFileState

src/Compiler/Checking/CheckDeclarations.fs

@@ -5751,7 +5751,8 @@ let CheckOneImplFile
         env,
         rootSigOpt: ModuleOrNamespaceType option,
         synImplFile,
-        diagnosticOptions) =
+        diagnosticOptions,
+        sourceText: ISourceText option) =
 
     let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _, _)) = synImplFile
     let infoReader = InfoReader(g, amap)
@@ -5774,7 +5775,8 @@ let CheckOneImplFile
                 tcSimplePats=TcSimplePats,
                 tcSequenceExpressionEntry=TcSequenceExpressionEntry,
                 tcArrayOrListSequenceExpression=TcArrayOrListComputedExpression,
-                tcComputationExpression=TcComputationExpression)    
+                tcComputationExpression=TcComputationExpression,
+                sourceText=sourceText)    
 
         let envinner, moduleTyAcc = MakeInitialEnv env 
 
@@ -5919,7 +5921,8 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin
             tcSimplePats=TcSimplePats,
             tcSequenceExpressionEntry=TcSequenceExpressionEntry,
             tcArrayOrListSequenceExpression=TcArrayOrListComputedExpression,
-            tcComputationExpression=TcComputationExpression)
+            tcComputationExpression=TcComputationExpression,
+            sourceText=None)
 
     let envinner, moduleTyAcc = MakeInitialEnv tcEnv 
     let m = sigFile.QualifiedName.Range

src/Compiler/Checking/CheckDeclarations.fsi

@@ -60,7 +60,8 @@ val CheckOneImplFile:
     TcEnv *
     ModuleOrNamespaceType option *
     ParsedImplFileInput *
-    FSharpDiagnosticOptions ->
+    FSharpDiagnosticOptions *
+    ISourceText option ->
         Cancellable<TopAttribs * CheckedImplFile * TcEnv * bool>
 
 val CheckOneSigFile:

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -10282,7 +10282,7 @@ and TcMethodApplication
 
     let objArgPreBinder, objArgs, allArgsPreBinders, allArgs, allArgsCoerced, optArgPreBinder, paramArrayPreBinders, outArgExprs, outArgTmpBinds =
         let tcVal = LightweightTcValForUsingInBuildMethodCall g
-        AdjustCallerArgs tcVal TcFieldInit env.eCallerMemberName cenv.infoReader ad finalCalledMeth objArgs lambdaVars mItem mMethExpr
+        AdjustCallerArgs tcVal TcFieldInit env.eCallerMemberName cenv.SourceText cenv.infoReader ad finalCalledMeth objArgs lambdaVars mItem mMethExpr
 
     // Record the resolution of the named argument for the Language Service
     allArgs |> List.iter (fun assignedArg ->

src/Compiler/Checking/MethodCalls.fs

@@ -1443,9 +1443,22 @@ 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 (sourceText: ISourceText option) assignedArgs paramName =
+    assignedArgs
+    |> List.tryPick (fun { CalledArg=called; CallerArg=caller } -> 
+    match called.NameOpt with
+    | Some x when x.idText = paramName ->
+        sourceText
+        |> Option.bind (fun sourceText ->
+        let code = sourceText.GetSubTextFromRange 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 sourceText 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. 
@@ -1462,7 +1475,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 sourceText mMethExpr assignedArgs
         | _ ->
             match calledArg.CallerInfo, eCallerMemberName with
             | CallerLineNumber, _ when typeEquiv g currCalledArgTy g.int_ty ->
@@ -1472,6 +1485,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 sourceText 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)
 
@@ -1495,13 +1516,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 sourceText 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 sourceText (mMethExpr: range) assignedArgs =
     let calledArgTy = calledArg.CalledArgumentType
     let calledNonOptTy = tryDestOptionalTy g calledArgTy
 
@@ -1516,31 +1537,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)
         mkOptionalSome g calledArgTy calledNonOptTy memberNameExpr mMethExpr
+
+    | CallerArgumentExpression param, _ when g.langVersion.SupportsFeature LanguageFeature.SupportCallerArgumentExpression && typeEquiv g calledNonOptTy g.string_ty ->
+        match tryPickArgumentCodeText sourceText assignedArgs param with
+        | Some code -> 
+            let expr = Expr.Const(Const.String code, mMethExpr, calledNonOptTy)
+            mkOptionalSome g calledArgTy calledNonOptTy expr mMethExpr
+        | None -> mkOptionalNone g calledArgTy 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 sourceText 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 sourceText mMethExpr assignedArgs
 
         | CalleeSide ->
-            emptyPreBinder, GetDefaultExpressionForCalleeSideOptionalArg g calledArg eCallerMemberName mMethExpr
+            emptyPreBinder, GetDefaultExpressionForCalleeSideOptionalArg g calledArg eCallerMemberName sourceText mMethExpr assignedArgs
 
     // Combine the variable allocators (if any)
     let callerArg = CallerArg(calledArgTy, mMethExpr, false, expr)
     preBinder, { NamedArgIdOpt = None; CalledArg = calledArg; CallerArg = callerArg }
 
 // Adjust all the optional arguments, filling in values for defaults, 
-let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) =
+let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName sourceText (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) =
     let g = infoReader.g
     let amap = infoReader.amap
     let callerArg = assignedArg.CallerArg
@@ -1587,7 +1616,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 sourceText m [assignedArg]
                             let ty = destOptionTy g callerArgTy
                             mkOptionDefaultValue g m ty defaultExpr callerArgExpr
                     else
@@ -1637,7 +1666,7 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader:
 //    - VB also allows you to pass intrinsic values as optional values to parameters 
 //        typed as Object. What we do in this case is we box the intrinsic value."
 //
-let AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (calledMeth: CalledMeth<_>) mItem mMethExpr =
+let AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (calledMeth: CalledMeth<_>) mItem mMethExpr sourceText =
     let g = infoReader.g
 
     let assignedNamedArgs = calledMeth.ArgSets |> List.collect (fun argSet -> argSet.AssignedNamedArgs)
@@ -1651,11 +1680,11 @@ 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 sourceText mItem mMethExpr (assignedNamedArgs @ unnamedArgs)
             arg, (preBinder >> preBinder2))
 
-    let adjustedNormalUnnamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader ad) unnamedArgs
-    let adjustedAssignedNamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader ad) assignedNamedArgs
+    let adjustedNormalUnnamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName sourceText infoReader ad) unnamedArgs
+    let adjustedAssignedNamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName sourceText infoReader ad) assignedNamedArgs
 
     optArgs, optArgPreBinder, adjustedNormalUnnamedArgs, adjustedAssignedNamedArgs
 
@@ -1703,7 +1732,7 @@ let AdjustParamArrayCallerArgs tcVal g amap infoReader ad (calledMeth: CalledMet
 /// Build the argument list for a method call. Adjust for param array, optional arguments, byref arguments and coercions.
 /// For example, if you pass an F# reference cell to a byref then we must get the address of the 
 /// contents of the ref. Likewise lots of adjustments are made for optional arguments etc.
-let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (calledMeth: CalledMeth<_>) objArgs lambdaVars mItem mMethExpr =
+let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName sourceText (infoReader: InfoReader) ad (calledMeth: CalledMeth<_>) objArgs lambdaVars mItem mMethExpr =
     let g = infoReader.g
     let amap = infoReader.amap
     let calledMethInfo = calledMeth.Method
@@ -1725,7 +1754,7 @@ let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader
         AdjustParamArrayCallerArgs tcVal g amap infoReader ad calledMeth mMethExpr
 
     let optArgs, optArgPreBinder, adjustedNormalUnnamedArgs, adjustedFinalAssignedNamedArgs = 
-        AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName infoReader ad calledMeth mItem mMethExpr
+        AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName infoReader ad calledMeth mItem mMethExpr sourceText
 
     let outArgs, outArgExprs, outArgTmpBinds =
         AdjustOutCallerArgs g calledMeth mMethExpr

src/Compiler/Checking/MethodCalls.fsi

@@ -434,6 +434,7 @@ val AdjustCallerArgs:
     tcVal: (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) ->
     tcFieldInit: (range -> AbstractIL.IL.ILFieldInit -> Const) ->
     eCallerMemberName: string option ->
+    sourceText: ISourceText option ->
     infoReader: InfoReader ->
     ad: AccessorDomain ->
     calledMeth: CalledMeth<Expr> ->