Fix equality for Surface

Store Func instead of F# function so structural equality can be used.
aardvark-platform · Jun 12, 2024 · 4a70621 · 4a70621
1 parent f5b109b
commit 4a70621
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 16 deletions.
diff --git a/src/Aardvark.Rendering.GL/Resources/Program.fs b/src/Aardvark.Rendering.GL/Resources/Program.fs
@@ -943,10 +943,8 @@ module ProgramExtensions =
                 | Error err -> Error err
 
             | Surface.Dynamic compile ->
-                // Use surface reference as key rather than create, since equality is undefined behavior for F# functions
-                // See F# specification: 6.9.24 Values with Underspecified Object Identity and Type Identity
-                x.ShaderCache.GetOrAdd(surface, signature, fun _ ->
-                    let (inputLayout, module_) = compile signature topology
+                x.ShaderCache.GetOrAdd(compile, signature, fun _ ->
+                    let (inputLayout, module_) = compile.Invoke(signature, topology)
 
                     let initial = AVal.force module_
                     let layoutHash = inputLayout.ComputeHash()

diff --git a/src/Aardvark.Rendering.Vulkan/Management/ResourceManager.fs b/src/Aardvark.Rendering.Vulkan/Management/ResourceManager.fs
@@ -1913,12 +1913,12 @@ type ResourceManager(device : Device) =
 
         program.PipelineLayout, resource
 
-    member private x.CreateDynamicShaderProgram(key : obj, pass : RenderPass, top : IndexedGeometryMode,
-                                                compile : IFramebufferSignature -> IndexedGeometryMode -> DynamicSurface) =
+    member private x.CreateDynamicShaderProgram(pass : RenderPass, top : IndexedGeometryMode,
+                                                compile : Func<IFramebufferSignature, IndexedGeometryMode, DynamicSurface>) =
         dynamicProgramCache.GetOrCreate(
-            [key; top :> obj; pass.Layout :> obj],
+            [compile :> obj; top :> obj; pass.Layout :> obj],
             fun cache key ->
-                let _, module_ = compile pass top
+                let _, module_ = compile.Invoke(pass, top)
                 use initialProgram = device.CreateShaderProgram(AVal.force module_)
 
                 let program = new DynamicShaderProgramResource(cache, key, device, initialProgram.PipelineLayout, module_)
@@ -1933,9 +1933,7 @@ type ResourceManager(device : Device) =
             x.CreateShaderProgram(pass, effect, top)
 
         | Surface.Dynamic compile ->
-            // Use surface itself as key rather than compile function, since equality is undefined behavior for F# functions.
-            // See F# specification: 6.9.24 Values with Underspecified Object Identity and Type Identity
-            let program = x.CreateDynamicShaderProgram(data, pass, top, compile)
+            let program = x.CreateDynamicShaderProgram(pass, top, compile)
             program.Layout, program
 
         | Surface.Backend (:? ShaderProgram as program) ->

diff --git a/src/Aardvark.Rendering/Surfaces/Surface.fs b/src/Aardvark.Rendering/Surfaces/Surface.fs
@@ -10,10 +10,10 @@ type IBackendSurface =
 
 type DynamicSurface = EffectInputLayout * aval<Imperative.Module>
 
-[<RequireQualifiedAccess; ReferenceEquality>]
+[<RequireQualifiedAccess>]
 type Surface =
     | Effect of effect: Effect
-    | Dynamic of compile: (IFramebufferSignature -> IndexedGeometryMode -> DynamicSurface)
+    | Dynamic of compile: Func<IFramebufferSignature, IndexedGeometryMode, DynamicSurface>
     | Backend of surface: IBackendSurface
     | None
 
@@ -31,8 +31,8 @@ module Surface =
         static member inline ToSurface(surface: Surface)         = surface
         static member inline ToSurface(effect: Effect)           = Surface.Effect effect
         static member inline ToSurface(effects: #seq<Effect>)    = Surface.Effect <| FShade.Effect.compose effects
-        static member inline ToSurface(compile)                  = Surface.Dynamic compile
-        static member inline ToSurface(compile: Func<_, _, _>)   = Surface.Dynamic (fun s t -> compile.Invoke(s, t))
+        static member inline ToSurface(compile: _ -> _ -> _)     = Surface.Dynamic compile
+        static member inline ToSurface(compile: Func<_, _, _>)   = Surface.Dynamic compile
         static member inline ToSurface(surface: IBackendSurface) = Surface.Backend surface
 
     let inline private toSurface (_ : ^Z) (data: ^T) =

diff --git a/src/Tests/Aardvark.Rendering.Tests/Tests/Rendering/Surfaces.fs b/src/Tests/Aardvark.Rendering.Tests/Tests/Rendering/Surfaces.fs
@@ -50,8 +50,33 @@ module Surfaces =
             | :? Vulkan.Runtime as r, (:? Vulkan.RenderPass as p) -> vkDynamicShaderCaching p surface r
             | _ -> failwith "Unknown backend"
 
+        let equality (_: IRuntime) =
+            let getEffect() =
+                Effect.compose [
+                    toEffect DefaultSurfaces.trafo
+                    toEffect DefaultSurfaces.vertexColor
+                ]
+
+            let s1 = Surface.Effect <| getEffect()
+            let s2 = Surface.Effect <| getEffect()
+            Expect.equal s1 s2 "Surface.Effect not equal"
+
+            let effect = getEffect()
+
+            let compile =
+                System.Func<_, _, _>(
+                    fun (signature: IFramebufferSignature) (topology: IndexedGeometryMode) ->
+                        let module_ = Effect.link signature topology false effect
+                        EffectInputLayout.ofModule module_, AVal.constant module_
+                )
+
+            let s1 = Surface.Dynamic compile
+            let s2 = Surface.Dynamic compile
+            Expect.equal s1 s2 "Surface.Dynamic not equal"
+
     let tests (backend : Backend) =
         [
-            "Dynamic shader caching", Cases.dynamicShaderCaching
+            "Dynamic shader caching",   Cases.dynamicShaderCaching
+            "Equality",                 Cases.equality
         ]
         |> prepareCases backend "Surfaces"