diff --git a/src/Aardvark.Rendering.GL/Resources/Program.fs b/src/Aardvark.Rendering.GL/Resources/Program.fs index 5440ca78..865c17b7 100644 --- 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 index c8e9610e..18dd64cb 100644 --- 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) = 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 index bbcb3289..39549662 100644 --- a/src/Aardvark.Rendering/Surfaces/Surface.fs +++ b/src/Aardvark.Rendering/Surfaces/Surface.fs @@ -10,10 +10,10 @@ type IBackendSurface = type DynamicSurface = EffectInputLayout * aval -[] +[] type Surface = | Effect of effect: Effect - | Dynamic of compile: (IFramebufferSignature -> IndexedGeometryMode -> DynamicSurface) + | Dynamic of compile: Func | 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) = 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 index be9c2023..a30e7651 100644 --- 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" \ No newline at end of file