Implement record deserialization with Reflection.Emit

Author: Tarmil

src/FSharp.SystemTextJson/FSharp.SystemTextJson.fsproj

@@ -5,7 +5,7 @@
   </PropertyGroup>
   <ItemGroup>
     <Compile Include="TypeCache.fs" />
-    <Compile Include="RecordField.fs" />
+    <Compile Include="Record.Reflection.fs" />
     <Compile Include="Record.fs" />
     <Compile Include="Union.fs" />
     <Compile Include="All.fs" />

src/FSharp.SystemTextJson/Record.Reflection.fs

@@ -0,0 +1,102 @@
+namespace System.Text.Json.Serialization
+
+open System
+open System.Reflection
+open FSharp.Reflection
+open System.Reflection.Emit
+open System.Text.Json
+
+type internal Serializer = delegate of Utf8JsonWriter * obj * JsonSerializerOptions -> unit
+type internal Deserializer = delegate of byref<Utf8JsonReader> * obj * JsonSerializerOptions -> unit
+
+type internal RecordField<'Record> =
+    {
+        Name: string
+        Type: Type
+        Ignore: bool
+        Serialize: Serializer
+        Deserialize: Deserializer
+    }
+
+module internal RecordReflection =
+
+    let private name (p: PropertyInfo) =
+        match p.GetCustomAttributes(typeof<JsonPropertyNameAttribute>, true) with
+        | [| :? JsonPropertyNameAttribute as name |] -> name.Name
+        | _ -> p.Name
+
+    let private isIgnore (p: PropertyInfo) =
+        p.GetCustomAttributes(typeof<JsonIgnoreAttribute>, true)
+        |> Array.isEmpty
+        |> not
+
+    let private deserializer<'Field> (f: FieldInfo) =
+        let setter =
+            let dynMethod =
+                new DynamicMethod(
+                    f.Name,
+                    typeof<Void>,
+                    [| typeof<obj>; f.FieldType |],
+                    typedefof<RecordField<_>>.Module,
+                    skipVisibility = true
+                )
+            let gen = dynMethod.GetILGenerator()
+            gen.Emit(OpCodes.Ldarg_0)
+            if f.DeclaringType.IsValueType then
+                gen.Emit(OpCodes.Unbox, f.DeclaringType)
+            gen.Emit(OpCodes.Ldarg_1)
+            gen.Emit(OpCodes.Stfld, f)
+            gen.Emit(OpCodes.Ret)
+            dynMethod.CreateDelegate(typeof<Action<obj, 'Field>>) :?> Action<obj, 'Field>
+        Deserializer(fun reader record options ->
+            let value = JsonSerializer.Deserialize<'Field>(&reader, options)
+            setter.Invoke(record, value))
+
+    let private serializer<'Field> (f: FieldInfo) =
+        let getter =
+            let dynMethod =
+                new DynamicMethod(
+                    f.Name,
+                    f.FieldType,
+                    [| typeof<obj> |],
+                    typedefof<RecordField<_>>.Module,
+                    skipVisibility = true
+                )
+            let gen = dynMethod.GetILGenerator()
+            gen.Emit(OpCodes.Ldarg_0)
+            if f.DeclaringType.IsValueType then
+                gen.Emit(OpCodes.Unbox, f.DeclaringType)
+            gen.Emit(OpCodes.Ldfld, f)
+            gen.Emit(OpCodes.Ret)
+            dynMethod.CreateDelegate(typeof<Func<obj, 'Field>>) :?> Func<obj, 'Field>
+        Serializer(fun writer record options ->
+            let v = getter.Invoke(record)
+            JsonSerializer.Serialize<'Field>(writer, v, options)
+        )
+
+    let private thisModule = typedefof<RecordField<_>>.Assembly.GetType("System.Text.Json.Serialization.RecordReflection")
+
+    let fields<'Record> () =
+        let recordTy = typeof<'Record>
+        let fields = recordTy.GetFields(BindingFlags.Instance ||| BindingFlags.NonPublic)
+        let props = FSharpType.GetRecordFields(recordTy, true)
+        (fields, props)
+        ||> Array.map2 (fun f p ->
+            let serializer =
+                thisModule.GetMethod("serializer", BindingFlags.Static ||| BindingFlags.NonPublic)
+                    .MakeGenericMethod(p.PropertyType)
+                    .Invoke(null, [|f|])
+                    :?> Serializer
+            let deserializer =
+                thisModule.GetMethod("deserializer", BindingFlags.Static ||| BindingFlags.NonPublic)
+                    .MakeGenericMethod(p.PropertyType)
+                    .Invoke(null, [|f|])
+                    :?> Deserializer
+            {
+                Name = name p
+                Type = p.PropertyType
+                Ignore = isIgnore p
+                Serialize = serializer
+                Deserialize = deserializer
+            } : RecordField<'Record>
+        )

src/FSharp.SystemTextJson/Record.fs

@@ -8,22 +8,25 @@ open FSharp.Reflection
 type JsonRecordConverter<'T>() =
     inherit JsonConverter<'T>()
 
-    static let fieldProps = RecordField<'T>.fields()
+    static let ty = typeof<'T>
+
+    static let fields = RecordReflection.fields<'T>()
 
     static let expectedFieldCount =
-        fieldProps
+        fields
         |> Seq.filter (fun p -> not p.Ignore)
         |> Seq.length
 
-    static let ctor = FSharpValue.PreComputeRecordConstructor(typeof<'T>, true)
+    static let ctor() =
+        FormatterServices.GetUninitializedObject(ty)
 
     static let fieldIndex (reader: byref<Utf8JsonReader>) =
         let mutable found = ValueNone
         let mutable i = 0
-        while found.IsNone && i < fieldProps.Length do
-            let p = fieldProps.[i]
+        while found.IsNone && i < fields.Length do
+            let p = fields.[i]
             if reader.ValueTextEquals(p.Name.AsSpan()) then
-                found <- ValueSome (struct (i, p))
+                found <- ValueSome p
             else
                 i <- i + 1
         found
@@ -32,7 +35,7 @@ type JsonRecordConverter<'T>() =
         if reader.TokenType <> JsonTokenType.StartObject then
             raise (JsonException("Failed to parse record type " + typeToConvert.FullName + ", expected JSON object, found " + string reader.TokenType))
 
-        let fields = Array.zeroCreate fieldProps.Length
+        let res = ctor()
         let mutable cont = true
         let mutable fieldsFound = 0
         while cont && reader.Read() do
@@ -41,20 +44,20 @@ type JsonRecordConverter<'T>() =
                 cont <- false
             | JsonTokenType.PropertyName ->
                 match fieldIndex &reader with
-                | ValueSome (i, p) when not p.Ignore ->
+                | ValueSome p when not p.Ignore ->
                     fieldsFound <- fieldsFound + 1
-                    fields.[i] <- JsonSerializer.Deserialize(&reader, p.Type, options)
+                    p.Deserialize.Invoke(&reader, res, options)
                 | _ ->
                     reader.Skip()
             | _ -> ()
 
         if fieldsFound < expectedFieldCount then
             raise (JsonException("Missing field for record type " + typeToConvert.FullName))
-        ctor fields :?> 'T
+        res :?> 'T
 
     override __.Write(writer, value, options) =
         writer.WriteStartObject()
-        for p in fieldProps do
+        for p in fields do
             if not p.Ignore then
                 writer.WritePropertyName(p.Name)
                 p.Serialize.Invoke(writer, value, options)

src/FSharp.SystemTextJson/RecordField.fs

@@ -25,7 +25,7 @@ module NonStruct =
 
     type B =
         {
-            bx: int
+            bx: uint32
             by: string
         }
 
@@ -35,11 +35,11 @@ module NonStruct =
     [<Fact>]
     let ``deserialize via options`` () =
         let actual = JsonSerializer.Deserialize("""{"bx":1,"by":"b"}""", options)
-        Assert.Equal({bx=1;by="b"}, actual)
+        Assert.Equal({bx=1u;by="b"}, actual)
 
     [<Fact>]
     let ``serialize via options`` () =
-        let actual = JsonSerializer.Serialize({bx=1;by="b"}, options)
+        let actual = JsonSerializer.Serialize({bx=1u;by="b"}, options)
         Assert.Equal("""{"bx":1,"by":"b"}""", actual)
 
     type C =
@@ -50,7 +50,7 @@ module NonStruct =
     [<Fact>]
     let ``deserialize nested`` () =
         let actual = JsonSerializer.Deserialize("""{"cx":{"bx":1,"by":"b"}}""", options)
-        Assert.Equal({cx={bx=1;by="b"}}, actual)
+        Assert.Equal({cx={bx=1u;by="b"}}, actual)
 
     [<Fact>]
     let ``deserialize anonymous`` () =