WIP: Traits for IL fields

.vscode/launch.json

@@ -5,7 +5,7 @@
         {
             "id": "fscArgsPrompt",
             "description": "Enter arguments for fsc",
-            "default": "",
+            "default": "@/Users/u/code/srtp-fields/srtp.rsp",
             "type": "promptString"
         },
         {
@@ -25,7 +25,7 @@
             // If you have changed target frameworks, make sure to update the program p
             "program": "${workspaceFolder}/artifacts/bin/fsi/Debug/net8.0/fsi.dll",
             "args": [
-                "${input:fsiArgsPrompt}"
+                "${input:fsiArgsPrompt}",
             ],
             "cwd": "${workspaceFolder}",
             "console": "integratedTerminal", // This is the default to be able to run in Codespaces.

Directory.Build.props

@@ -46,6 +46,7 @@
   <PropertyGroup Condition="'$(BUILDING_USING_DOTNET)' == 'true'">
     <DisableAutoSetFscCompilerPath>false</DisableAutoSetFscCompilerPath>
     <FSHARPCORE_USE_PACKAGE Condition="'$(FSHARPCORE_USE_PACKAGE)' == ''">true</FSHARPCORE_USE_PACKAGE>
+    <BUILD_FROM_SOURCE Condition="'$(FSHARPCORE_USE_PACKAGE)' != 'true'">true</BUILD_FROM_SOURCE>
     <DISABLE_ARCADE Condition="'$(DISABLE_ARCADE)' == ''">true</DISABLE_ARCADE>
     <ArtifactsDir>$(MSBuildThisFileDirectory)artifacts/</ArtifactsDir>
     <OutputPath>$(ArtifactsDir)/bin/$(MSBuildProjectName)/$(Configuration)/</OutputPath>

src/Compiler/AbstractIL/ilread.fs

@@ -2857,9 +2857,11 @@ and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx(numTypars, i
     let (ctxt: ILMetadataReader) = getHole ctxtH
     let mdv = ctxt.mdfile.GetView()
     let mrpIdx, nameIdx, typeIdx = seekReadMemberRefRow ctxt mdv idx
+
     let nm = readStringHeap ctxt nameIdx
     let enclTy = seekReadMethodRefParent ctxt mdv numTypars mrpIdx
     let retTy = readBlobHeapAsFieldSig ctxt numTypars typeIdx
+
     mkILFieldSpecInTy (enclTy, nm, retTy)
 
 // One extremely annoying aspect of the MD format is that given a
@@ -2923,7 +2925,7 @@ and seekReadFieldDefAsFieldSpec (ctxt: ILMetadataReader) idx = ctxt.seekReadFiel
 and seekReadFieldDefAsFieldSpecUncached ctxtH idx =
     let (ctxt: ILMetadataReader) = getHole ctxtH
     let mdv = ctxt.mdfile.GetView()
-    let _flags, nameIdx, typeIdx = seekReadFieldRow ctxt mdv idx
+    let _, nameIdx, typeIdx = seekReadFieldRow ctxt mdv idx
     let nm = readStringHeap ctxt nameIdx
     (* Look for the field def parent. *)
     let tidx =

src/Compiler/Checking/CheckExpressions.fs

@@ -8986,6 +8986,7 @@ and TcTraitItemThen (cenv: cenv) overallTy env objOpt traitInfo tpenv mItem dela
             let applicableExpr = MakeApplicableExprNoFlex cenv expr
             applicableExpr, exprTy
         | _ ->
+            // TODO(vlza): process delayed (setters) to support `thing.Property <- value` and `thing.Field <- value` syntaxe
             let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip
             // Account for a unit mismtach in logical v. compiled arguments
             let compiledArgExprs =

src/Compiler/Checking/ConstraintSolver.fs

@@ -68,6 +68,7 @@ open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TypeHierarchy
 open FSharp.Compiler.TypeRelations
+open FSharp.Compiler.AbstractIL.IL
 
 //-------------------------------------------------------------------------
 // Unification of types: solve/record equality constraints
@@ -363,6 +364,7 @@ type TraitConstraintSolution =
     | TTraitSolved of minfo: MethInfo * minst: TypeInst * staticTyOpt: TType option
     | TTraitSolvedRecdProp of fieldInfo: RecdFieldInfo * isSetProp: bool
     | TTraitSolvedAnonRecdProp of anonRecdTypeInfo: AnonRecdTypeInfo * typeInst: TypeInst * index: int
+    | TTraitSolvedField of ty: TType * fieldInfo: ILFieldInfo * isSetField: bool
 
 let BakedInTraitConstraintNames =
     [ "op_Division" ; "op_Multiply"; "op_Addition" 
@@ -1357,8 +1359,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
 
     let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo
 
-    let! res = 
-     trackErrors {
+    let! res = trackErrors {
       match minfos, supportTys, memFlags.IsInstance, nm, argTys with
       | _, _, false, ("op_Division" | "op_Multiply"), [argTy1;argTy2]
           when 
@@ -1398,7 +1399,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
 
                    checkRuleAppliesInPreferenceToMethods argTy1 argTy2 || 
                    checkRuleAppliesInPreferenceToMethods argTy2 argTy1) ->
-                   
+
           match getMeasureOfType g argTy1 with
           | Some (tcref, ms1) -> 
             let ms2 = freshMeasure ()
@@ -1588,7 +1589,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
 
       | [], _, false, "Pow", [argTy1; argTy2] 
           when isFpTy g argTy1 -> 
-          
+
           do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1
           do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1
           do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1
@@ -1644,9 +1645,51 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
               else
                   None
 
+          // TODO(vlza): this probably can be optimized and simplified, to unify search for record fields and regular fields (?)
+          let fieldSearch =
+            // Name (nm) will always start with "get_" or "set_", since it is how it's named in the trait info.
+            // If we want to also support getting and setting for fields, we should add a "trimmed" name + whether it's get or set via flag.
+            // This here is just a hacky way of "transforming" the property into field lookup as well.
+            // However we do the same for the (anon)recd fields already (sort of)
+            let isGet = nm.StartsWithOrdinal("get_")
+            let isSet = nm.StartsWithOrdinal("set_")
+            if not isRigid && ((argTys.IsEmpty && isGet) || isSet) then
+                let nm = nm[4..]
+
+                let fields =
+                    [|
+                        for ty in supportTys do
+                            let item = TryFindIntrinsicNamedItemOfType csenv.InfoReader (nm, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty
+                            match item with
+                            | Some (ILFieldItem [ ilfinfo ]) ->
+                                (* let _calconvMatches = ilfinfo.IsStatic = (not memFlags.IsInstance)
+                                let _canCall = ((ilfinfo.IsInitOnly && isGet) || (not ilfinfo.IsInitOnly && isSet))
+                                let _accessible = IsILFieldInfoAccessible g amap m AccessibleFromEverywhere ilfinfo
+                                let _isNotLiteral = ilfinfo.LiteralValue.IsNone
+                                let _isNotSpecialName = not ilfinfo.IsSpecialName *)
+
+                                if ilfinfo.IsStatic = (not memFlags.IsInstance)
+                                    // If the field is backing init-only property, we don't want solution to be selected as "setter".
+                                    && (isGet || not ilfinfo.IsInitOnly)
+                                    // We only consider public fields
+                                    && IsILFieldInfoAccessible g amap m AccessibleFromEverywhere ilfinfo
+                                    // We don't consider constant fields
+                                    && ilfinfo.LiteralValue.IsNone
+                                    // We don't consider special name fields
+                                    && not ilfinfo.IsSpecialName then
+                                        yield ilfinfo
+                            | _ -> ()
+                    |]
+                if fields.Length = 1 then
+                    Some (fields[0], isSet)
+                else
+                    None
+            else
+                None
+
           // Now check if there are no feasible solutions at all
-          match minfos, recdPropSearch, anonRecdPropSearch with 
-          | [], None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo ->
+          match minfos, recdPropSearch, anonRecdPropSearch, fieldSearch with 
+          | [], None, None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo ->
               if supportTys |> List.exists (isFunTy g) then
                   return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm), m, m2))
               elif supportTys |> List.exists (isAnyTupleTy g) then
@@ -1703,20 +1746,20 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                       (fun (a, _) -> Option.isSome a)
                       (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) CallerArgs.Empty AccessibleFromEverywhere calledMethGroup false (Some (MustEqual retTy)))
 
-              match anonRecdPropSearch, recdPropSearch, methOverloadResult with 
-              | Some (anonInfo, tinst, i), None, None -> 
+              match anonRecdPropSearch, recdPropSearch, methOverloadResult, fieldSearch with 
+              | Some (anonInfo, tinst, i), None, None, None -> 
                   // OK, the constraint is solved by a record property. Assert that the return types match.
                   let rty2 = List.item i tinst
                   do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2
                   return TTraitSolvedAnonRecdProp(anonInfo, tinst, i)
 
-              | None, Some (rfinfo, isSetProp), None -> 
+              | None, Some (rfinfo, isSetProp), None, None -> 
                   // OK, the constraint is solved by a record property. Assert that the return types match.
                   let rty2 = if isSetProp then g.unit_ty else rfinfo.FieldType
                   do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2
                   return TTraitSolvedRecdProp(rfinfo, isSetProp)
 
-              | None, None, Some (calledMeth: CalledMeth<_>) -> 
+              | None, None, Some (calledMeth: CalledMeth<_>), None-> 
                   // OK, the constraint is solved.
                   let minfo = calledMeth.Method
 
@@ -1731,8 +1774,12 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                   else 
                       do! CheckMethInfoAttributes g m None minfo
                       return TTraitSolved (minfo, calledMeth.CalledTyArgs, calledMeth.OptionalStaticType)
-
-              | _ -> 
+              | None, None, None, Some (ilfinfo, isSet) ->
+                  // OK, the constraint is solved by a field. Assert that types match.
+                  let ty2 = ilfinfo.FieldType(amap, m)
+                  do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty2
+                  return TTraitSolvedField(ty2, ilfinfo, isSet)
+              | _ ->
                   do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors
                   return TTraitUnsolved
      }
@@ -1779,27 +1826,32 @@ and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignore
 /// each member constraint.
 and RecordMemberConstraintSolution css m trace traitInfo traitConstraintSln =
     match traitConstraintSln with
-    | TTraitUnsolved -> 
+    | TTraitUnsolved ->
         ResultD false
 
     | TTraitSolved (minfo, minst, staticTyOpt) ->
         let sln = MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt
         TransactMemberConstraintSolution traitInfo trace sln
         ResultD true
 
-    | TTraitBuiltIn -> 
+    | TTraitBuiltIn ->
         TransactMemberConstraintSolution traitInfo trace BuiltInSln
         ResultD true
 
-    | TTraitSolvedRecdProp (rfinfo, isSet) -> 
+    | TTraitSolvedRecdProp (rfinfo, isSet) ->
         let sln = FSRecdFieldSln(rfinfo.TypeInst,rfinfo.RecdFieldRef,isSet)
         TransactMemberConstraintSolution traitInfo trace sln
         ResultD true
 
-    | TTraitSolvedAnonRecdProp (anonInfo, tinst, i) -> 
+    | TTraitSolvedAnonRecdProp (anonInfo, tinst, i) ->
         let sln = FSAnonRecdFieldSln(anonInfo, tinst, i)
         TransactMemberConstraintSolution traitInfo trace sln
         ResultD true
+    | TTraitSolvedField (ty, ilfinfo, isSet) ->
+        let isStruct = match ilfinfo.ILFieldRef.Type.Boxity with | AsValue -> true | _ -> false
+        let sln = ILFieldSln(ty, ilfinfo.TypeInst, ilfinfo.ILFieldRef, isStruct, ilfinfo.IsStatic, isSet)
+        TransactMemberConstraintSolution traitInfo trace sln
+        ResultD true
 
 /// Convert a MethInfo into the data we save in the TAST
 and MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt =

src/Compiler/Checking/MethodCalls.fs

@@ -2097,7 +2097,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs =
 
     let sln = 
         match traitInfo.Solution with 
-        | None -> Choice5Of5()
+        | None -> Choice6Of6()
         | Some sln ->
 
             // Given the solution information, reconstruct the MethInfo for the solution
@@ -2110,27 +2110,30 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs =
                     match extOpt with 
                     | None -> MethInfo.CreateILMeth(amap, m, origTy, mdef)
                     | Some ilActualTypeRef -> 
-                        let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef 
+                        let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef
                         MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef)
-                Choice1Of5 (ilMethInfo, minst, staticTyOpt)
+                Choice1Of6 (ilMethInfo, minst, staticTyOpt)
 
             | FSMethSln(ty, vref, minst, staticTyOpt) ->
-                Choice1Of5  (FSMeth(g, ty, vref, None), minst, staticTyOpt)
+                Choice1Of6  (FSMeth(g, ty, vref, None), minst, staticTyOpt)
 
             | FSRecdFieldSln(tinst, rfref, isSetProp) ->
-                Choice2Of5  (tinst, rfref, isSetProp)
+                Choice2Of6  (tinst, rfref, isSetProp)
 
-            | FSAnonRecdFieldSln(anonInfo, tinst, i) -> 
-                Choice3Of5  (anonInfo, tinst, i)
+            | FSAnonRecdFieldSln(anonInfo, tinst, i) ->
+                Choice3Of6  (anonInfo, tinst, i)
 
-            | ClosedExprSln expr -> 
-                Choice4Of5 expr
+            | ClosedExprSln expr ->
+                Choice4Of6 expr
+
+            | ILFieldSln (ty, tinst, ilfref, isStruct, isStatic, isSet) ->
+                Choice5Of6 (ty, tinst, ilfref, isStruct, isStatic, isSet)
+            | BuiltInSln ->
+                Choice6Of6 ()
 
-            | BuiltInSln -> 
-                Choice5Of5 ()
 
     match sln with
-    | Choice1Of5(minfo, methArgTys, staticTyOpt) -> 
+    | Choice1Of6(minfo, methArgTys, staticTyOpt) -> 
         let argExprs = 
             // FIX for #421894 - typechecker assumes that coercion can be applied for the trait
             // calls arguments but codegen doesn't emit coercion operations
@@ -2174,7 +2177,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs =
         else        
             Some (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt)
 
-    | Choice2Of5 (tinst, rfref, isSet) -> 
+    | Choice2Of6 (tinst, rfref, isSet) -> // Recd field
         match isSet, rfref.RecdField.IsStatic, argExprs.Length with 
         // static setter
         | true, true, 1 -> 
@@ -2204,28 +2207,47 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs =
 
         | _ -> None 
 
-    | Choice3Of5 (anonInfo, tinst, i) -> 
+    | Choice3Of6 (anonInfo, tinst, i) -> // Anon recd field
         let tupInfo = anonInfo.TupInfo
         if evalTupInfoIsStruct tupInfo && isByrefTy g (tyOfExpr g argExprs[0]) then 
             Some (mkAnonRecdFieldGetViaExprAddr (anonInfo, argExprs[0], tinst, i, m))
-        else 
+        else
             Some (mkAnonRecdFieldGet g (anonInfo, argExprs[0], tinst, i, m))
 
-    | Choice4Of5 expr -> 
+    | Choice4Of6 expr -> // Closed expression solution
         Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m))
 
-    | Choice5Of5 () -> 
+    | Choice5Of6 (ty, tinst, ilfref, isStruct, isStatic, isSet) -> // IL Field
+        let boxity = if isStruct then AsValue else AsObject
+        let ilTy = mkILNamedTy boxity ilfref.DeclaringTypeRef []
+        let fSpec = mkILFieldSpec (ilfref, ilTy)
+
+        match isStatic, isSet with
+        | false, false -> // Instance getter
+            Some(Expr.Op(TOp.ILAsm ([mkNormalLdfld fSpec], [ty]), tinst, argExprs, m))
+        | false, true -> // Instance setter
+            //Some(Expr.Op(TOp.ILAsm ([mkNormalStfld fieldSpec], [ty]), tinst, argExprs, m))
+            //TODO(vlza): do the address trick
+            // let wrap, objExpr, _, _ = mkExprAddrOfExpr g isStruct false NeverMutates argExprs[0] None m
+
+            failwith "5of6 - instance setter"
+        | true, false -> // Static getter
+            //Some(Expr.Op(TOp.ILAsm ([mkNormalLdsfld fieldSpec], [ty]), tinst, argExprs, m))
+            failwith "5of6 - static getter"
+        | true, true -> // Static setter
+            failwith "5of6 - static setter"
+    | Choice6Of6 () -> // Default branch, sort of
         match traitInfo.Solution with 
         | None -> None // the trait has been generalized
         | Some _-> 
-        // For these operators, the witness is just a call to the coresponding FSharp.Core operator
-        match g.TryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy traitInfo argExprs with
-        | Some (info, tyargs, actualArgExprs) -> 
-            tryMkCallCoreFunctionAsBuiltInWitness g info tyargs actualArgExprs m
-        | None -> 
-            // For all other built-in operators, the witness is a call to the coresponding BuiltInWitnesses operator
-            // These are called as F# methods not F# functions
-            tryMkCallBuiltInWitness g traitInfo argExprs m
+            // For these operators, the witness is just a call to the coresponding FSharp.Core operator
+            match g.TryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy traitInfo argExprs with
+            | Some (info, tyargs, actualArgExprs) -> 
+                tryMkCallCoreFunctionAsBuiltInWitness g info tyargs actualArgExprs m
+            | None -> 
+                // For all other built-in operators, the witness is a call to the coresponding BuiltInWitnesses operator
+                // These are called as F# methods not F# functions
+                tryMkCallBuiltInWitness g traitInfo argExprs m
 
 /// Generate a lambda expression for the given solved trait.
 let GenWitnessExprLambda amap g m (traitInfo: TraitConstraintInfo) =

src/Compiler/Checking/infos.fs

@@ -1487,8 +1487,9 @@ type ILFieldInfo =
         | ProvidedField(_, fi1, _), ProvidedField(_, fi2, _)-> ProvidedFieldInfo.TaintedEquals (fi1, fi2)
         | _ -> false
 #endif
-     /// Get an (uninstantiated) reference to the field as an Abstract IL ILFieldRef
-    member x.ILFieldRef = rescopeILFieldRef x.ScopeRef (mkILFieldRef(x.ILTypeRef, x.FieldName, x.ILFieldType))
+    /// Get an (uninstantiated) reference to the field as an Abstract IL ILFieldRef
+    member x.ILFieldRef =
+        rescopeILFieldRef x.ScopeRef (mkILFieldRef(x.ILTypeRef, x.FieldName, x.ILFieldType))
 
     /// Calculates a hash code of field info. Must be compatible with ItemsAreEffectivelyEqual relation.
     member x.ComputeHashCode() = hash x.FieldName

src/Compiler/Symbols/SymbolHelpers.fs

@@ -600,6 +600,7 @@ module internal SymbolHelpers =
             | Some (TraitConstraintSln.FSRecdFieldSln _)
             | Some (TraitConstraintSln.FSAnonRecdFieldSln _)
             | Some (TraitConstraintSln.ClosedExprSln _)
+            | Some (TraitConstraintSln.ILFieldSln _)
             | Some TraitConstraintSln.BuiltInSln
             | None ->
                 GetXmlCommentForItemAux None infoReader m item