Implement record serialization with Reflection.Emit

Author: Tarmil

benchmarks/FSharp.SystemTextJson.Benchmarks/Program.fs

@@ -34,7 +34,7 @@ type ArrayTestBase<'t>(instance: 't) =
         options
 
 
-    [<Params(10,100)>]
+    [<Params(10,100,1000)>]
     member val ArrayLength = 0 with get, set
 
     member val InstanceArray = [||] with get, set

src/FSharp.SystemTextJson/FSharp.SystemTextJson.fsproj

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

src/FSharp.SystemTextJson/Record.fs

@@ -1,32 +1,14 @@
 namespace System.Text.Json.Serialization
 
 open System
+open System.Runtime.Serialization
 open System.Text.Json
 open FSharp.Reflection
 
-type internal RecordProperty =
-    {
-        Name: string
-        Type: Type
-        Ignore: bool
-    }
-
 type JsonRecordConverter<'T>() =
     inherit JsonConverter<'T>()
 
-    static let fieldProps =
-        FSharpType.GetRecordFields(typeof<'T>, true)
-        |> Array.map (fun p ->
-            let name =
-                match p.GetCustomAttributes(typeof<JsonPropertyNameAttribute>, true) with
-                | [| :? JsonPropertyNameAttribute as name |] -> name.Name
-                | _ -> p.Name
-            let ignore =
-                p.GetCustomAttributes(typeof<JsonIgnoreAttribute>, true)
-                |> Array.isEmpty
-                |> not
-            { Name = name; Type = p.PropertyType; Ignore = ignore }
-        )
+    static let fieldProps = RecordField<'T>.properties()
 
     static let expectedFieldCount =
         fieldProps
@@ -35,8 +17,6 @@ type JsonRecordConverter<'T>() =
 
     static let ctor = FSharpValue.PreComputeRecordConstructor(typeof<'T>, true)
 
-    static let dector = FSharpValue.PreComputeRecordReader(typeof<'T>, true)
-
     static let fieldIndex (reader: byref<Utf8JsonReader>) =
         let mutable found = ValueNone
         let mutable i = 0
@@ -74,11 +54,11 @@ type JsonRecordConverter<'T>() =
 
     override __.Write(writer, value, options) =
         writer.WriteStartObject()
-        (fieldProps, dector value)
-        ||> Array.iter2 (fun p v ->
+        fieldProps
+        |> Array.iter (fun p ->
             if not p.Ignore then
                 writer.WritePropertyName(p.Name)
-                JsonSerializer.Serialize(writer, v, options))
+                p.Serialize.Invoke(writer, value, options))
         writer.WriteEndObject()
 
 type JsonRecordConverter() =

src/FSharp.SystemTextJson/RecordField.fs

@@ -0,0 +1,67 @@
+namespace System.Text.Json.Serialization
+
+open System
+open System.Reflection
+open FSharp.Reflection
+open System.Reflection.Emit
+open System.Text.Json
+
+type internal Serializer<'Record> = delegate of Utf8JsonWriter * 'Record * JsonSerializerOptions -> unit
+type internal FieldReader<'Record, 'Field> = delegate of 'Record -> 'Field
+
+type internal RecordField<'Record> =
+    {
+        Name: string
+        Type: Type
+        Ignore: bool
+        Serialize: Serializer<'Record>
+    }
+
+    static member name (p: PropertyInfo) =
+        match p.GetCustomAttributes(typeof<JsonPropertyNameAttribute>, true) with
+        | [| :? JsonPropertyNameAttribute as name |] -> name.Name
+        | _ -> p.Name
+
+    static member isIgnore (p: PropertyInfo) =
+        p.GetCustomAttributes(typeof<JsonIgnoreAttribute>, true)
+        |> Array.isEmpty
+        |> not
+
+    static member 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)
+            gen.Emit(OpCodes.Ldfld, f)
+            gen.Emit(OpCodes.Ret)
+            dynMethod.CreateDelegate(typeof<FieldReader<'Record, 'Field>>) :?> FieldReader<'Record, 'Field>
+        Serializer<'Record>(fun writer r options ->
+            let v = getter.Invoke(r)
+            JsonSerializer.Serialize<'Field>(writer, v, options)
+        )
+
+    static member properties () =
+        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 =
+                typeof<RecordField<'Record>>.GetMethod("serializer", BindingFlags.Static ||| BindingFlags.NonPublic)
+                    .MakeGenericMethod(p.PropertyType)
+                    .Invoke(null, [|f|])
+                    :?> Serializer<'Record>
+            {
+                Name = RecordField<'Record>.name p
+                Type = p.PropertyType
+                Ignore = RecordField<'Record>.isIgnore p
+                Serialize = serializer
+            } : RecordField<'Record>
+        )

src/FSharp.SystemTextJson/paket.references

@@ -1,2 +1,4 @@
 FSharp.Core
-System.Text.Json
+System.Text.Json
+System.Reflection.Emit.Lightweight
+System.Reflection.Emit.ILGeneration