<commit_before>﻿namespace Aardvark.SceneGraph

open System
open System.Threading
open System.Reflection
open System.Collections.Generic
open System.Runtime.InteropServices
open System.Runtime.CompilerServices
open Aardvark.Base
open Aardvark.Base.Rendering
open Aardvark.Base.Incremental
open Aardvark.SceneGraph
open Aardvark.Base.Monads.State
open Microsoft.FSharp.NativeInterop

#nowarn "9"
#nowarn "51"

[<ReferenceEquality; NoComparison>]
type AdaptiveGeometry =
    {
        faceVertexCount  : int
        vertexCount      : int
        indices          : Option<BufferView>
        uniforms         : Map<Symbol,IMod>
        vertexAttributes : Map<Symbol,BufferView>
    }

type GeometrySignature =
    {
        indexType           : Type
        vertexBufferTypes   : Map<Symbol, Type>
        uniformTypes        : Map<Symbol, Type>
    }

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module AdaptiveGeometry =

    let ofIndexedGeometry (uniforms : list<Symbol * IMod>) (ig : IndexedGeometry) =
        let anyAtt = (ig.IndexedAttributes |> Seq.head).Value

        let faceVertexCount, index =
            match ig.IndexArray with
                | null -> anyAtt.Length, None
                | index -> index.Length, Some (BufferView.ofArray index)

        let vertexCount =
            anyAtt.Length
                
    
        {
            faceVertexCount = faceVertexCount
            vertexCount = vertexCount
            indices = index
            uniforms = Map.ofList uniforms
            vertexAttributes = ig.IndexedAttributes |> SymDict.toMap |> Map.map (fun _ -> BufferView.ofArray)
        }



type IManagedBufferWriter =
    inherit IAdaptiveObject
    abstract member Write : IAdaptiveObject -> unit

type IManagedBuffer =
    inherit IDisposable
    inherit IMod<IBuffer>
    abstract member Clear : unit -> unit
    abstract member Capacity : int
    abstract member Set : Range1l * byte[] -> unit
    abstract member Add : Range1l * BufferView -> IDisposable
    abstract member Add : int * IMod -> IDisposable
    abstract member ElementType : Type

type IManagedBuffer<'a when 'a : unmanaged> =
    inherit IManagedBuffer
    abstract member Count : int
    abstract member Item : int -> 'a with get, set
    abstract member Set : Range1l * 'a[] -> unit

[<AutoOpen>]
module private ManagedBufferImplementation =

    type ManagedBuffer<'a when 'a : unmanaged>(runtime : IRuntime) =
        inherit DirtyTrackingAdaptiveObject<ManagedBufferWriter>()
        static let asize = sizeof<'a> |> nativeint
        let store = runtime.CreateMappedBuffer()

        let bufferWriters = Dict<BufferView, ManagedBufferWriter<'a>>()
        let uniformWriters = Dict<IMod, ManagedBufferSingleWriter<'a>>()

        member x.Clear() =
            store.Resize 0n

        member x.Add(range : Range1l, view : BufferView) =
            lock x (fun () ->
                let count = range.Size + 1L

                let writer = 
                    bufferWriters.GetOrCreate(view, fun view ->
                        let remove w =
                            x.Dirty.Remove w |> ignore
                            bufferWriters.Remove view |> ignore

                        let data = BufferView.download 0 (int count) view
                        let real : IMod<'a[]> = data |> PrimitiveValueConverter.convertArray view.ElementType
                        let w = new ManagedBufferWriter<'a>(remove, real, store)
                        x.Dirty.Add w |> ignore
                        w
                    )


                if writer.AddRef range then
                    let min = nativeint(range.Min + count) * asize
                    if store.Capacity < min then
                        store.Resize(Fun.NextPowerOfTwo(int64 min) |> nativeint)

                    lock writer (fun () -> 
                        if writer.OutOfDate then
                            writer.Write(range)
                    )

                { new IDisposable with
                    member x.Dispose() =
                        writer.RemoveRef range |> ignore
                }
            )

        member x.Add(index : int, data : IMod) =
            lock x (fun () ->
                let mutable isNew = false
                let writer =
                    uniformWriters.GetOrCreate(data, fun data ->
                        isNew <- true
                        let remove w =
                            x.Dirty.Remove w |> ignore
                            uniformWriters.Remove data |> ignore

                        let real : IMod<'a> = data |> PrimitiveValueConverter.convertValue
                        let w = new ManagedBufferSingleWriter<'a>(remove, real, store)
                        x.Dirty.Add w |> ignore
                        w
                    )
 
                let range = Range1l(int64 index, int64 index)
                if writer.AddRef range then
                    let min = nativeint (index + 1) * asize
                    if store.Capacity < min then
                        store.Resize(Fun.NextPowerOfTwo(int64 min) |> nativeint)
                            
                    lock writer (fun () -> 
                        if writer.OutOfDate then
                            writer.Write(range)
                    )


                        
                { new IDisposable with
                    member x.Dispose() =
                        writer.RemoveRef range |> ignore
                }
            )

        member x.Set(range : Range1l, value : byte[]) =
            let count = range.Size + 1L
            let e = nativeint(range.Min + count) * asize
            if store.Capacity < e then
                store.Resize(Fun.NextPowerOfTwo(int64 e) |> nativeint)<commit_msg>[GL] fixed broken dirty-tracking in ManagedPool.fs<commit_after>﻿namespace Aardvark.SceneGraph

open System
open System.Threading
open System.Reflection
open System.Collections.Generic
open System.Runtime.InteropServices
open System.Runtime.CompilerServices
open Aardvark.Base
open Aardvark.Base.Rendering
open Aardvark.Base.Incremental
open Aardvark.SceneGraph
open Aardvark.Base.Monads.State
open Microsoft.FSharp.NativeInterop

#nowarn "9"
#nowarn "51"

[<ReferenceEquality; NoComparison>]
type AdaptiveGeometry =
    {
        faceVertexCount  : int
        vertexCount      : int
        indices          : Option<BufferView>
        uniforms         : Map<Symbol,IMod>
        vertexAttributes : Map<Symbol,BufferView>
    }

type GeometrySignature =
    {
        indexType           : Type
        vertexBufferTypes   : Map<Symbol, Type>
        uniformTypes        : Map<Symbol, Type>
    }

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module AdaptiveGeometry =

    let ofIndexedGeometry (uniforms : list<Symbol * IMod>) (ig : IndexedGeometry) =
        let anyAtt = (ig.IndexedAttributes |> Seq.head).Value

        let faceVertexCount, index =
            match ig.IndexArray with
                | null -> anyAtt.Length, None
                | index -> index.Length, Some (BufferView.ofArray index)

        let vertexCount =
            anyAtt.Length
                
    
        {
            faceVertexCount = faceVertexCount
            vertexCount = vertexCount
            indices = index
            uniforms = Map.ofList uniforms
            vertexAttributes = ig.IndexedAttributes |> SymDict.toMap |> Map.map (fun _ -> BufferView.ofArray)
        }



type IManagedBufferWriter =
    inherit IAdaptiveObject
    abstract member Write : IAdaptiveObject -> unit

type IManagedBuffer =
    inherit IDisposable
    inherit IMod<IBuffer>
    abstract member Clear : unit -> unit
    abstract member Capacity : int
    abstract member Set : Range1l * byte[] -> unit
    abstract member Add : Range1l * BufferView -> IDisposable
    abstract member Add : int * IMod -> IDisposable
    abstract member ElementType : Type

type IManagedBuffer<'a when 'a : unmanaged> =
    inherit IManagedBuffer
    abstract member Count : int
    abstract member Item : int -> 'a with get, set
    abstract member Set : Range1l * 'a[] -> unit

[<AutoOpen>]
module private ManagedBufferImplementation =

    type ManagedBuffer<'a when 'a : unmanaged>(runtime : IRuntime) =
        inherit DirtyTrackingAdaptiveObject<ManagedBufferWriter>()
        static let asize = sizeof<'a> |> nativeint
        let store = runtime.CreateMappedBuffer()

        let bufferWriters = Dict<BufferView, ManagedBufferWriter<'a>>()
        let uniformWriters = Dict<IMod, ManagedBufferSingleWriter<'a>>()

        member x.Clear() =
            store.Resize 0n

        member x.Add(range : Range1l, view : BufferView) =
            let mutable isNew = false
            let res = lock x (fun () ->
                let count = range.Size + 1L

                let writer = 
                    bufferWriters.GetOrCreate(view, fun view ->
                        isNew <- true
                        let remove w =
                            x.Dirty.Remove w |> ignore
                            bufferWriters.Remove view |> ignore

                        let data = BufferView.download 0 (int count) view
                        let real : IMod<'a[]> = data |> PrimitiveValueConverter.convertArray view.ElementType
                        let w = new ManagedBufferWriter<'a>(remove, real, store)
                        x.Dirty.Add w |> ignore
                        w
                    )


                if writer.AddRef range then
                    let min = nativeint(range.Min + count) * asize
                    if store.Capacity < min then
                        store.Resize(Fun.NextPowerOfTwo(int64 min) |> nativeint)
       
                    lock writer (fun () -> 
                        if not writer.OutOfDate then
                            writer.Write(range)
                    )

                { new IDisposable with
                    member x.Dispose() =
                        writer.RemoveRef range |> ignore
                }
            )
            if isNew then transact (fun () -> x.MarkOutdated ())
            res

        member x.Add(index : int, data : IMod) =
            let mutable isNew = false
            let res = lock x (fun () ->
                let writer =
                    uniformWriters.GetOrCreate(data, fun data ->
                        isNew <- true
                        let remove w =
                            x.Dirty.Remove w |> ignore
                            uniformWriters.Remove data |> ignore

                        let real : IMod<'a> = data |> PrimitiveValueConverter.convertValue
                        let w = new ManagedBufferSingleWriter<'a>(remove, real, store)
                        x.Dirty.Add w |> ignore
                        w
                    )
 
                let range = Range1l(int64 index, int64 index)
                if writer.AddRef range then
                    let min = nativeint (index + 1) * asize
                    if store.Capacity < min then
                        store.Resize(Fun.NextPowerOfTwo(int64 min) |> nativeint)
                            
                    lock writer (fun () -> 
                        if not writer.OutOfDate then
                            writer.Write(range)
                    )



                        
                { new IDisposable with
                    member x.Dispose() =
                        writer.RemoveRef range |> ignore
                }
            )
            if isNew then
                transact (fun () -> x.MarkOutdated ())
            res

        member x.Set(range : Range1l, value : byte[]) =
            let count = range.Size + 1L
            let e = nativeint(range.Min + count) * asize
            if store.Capacity < e then
                store.Resize(Fun.NextPowerOfTwo(int64 e) |> nativeint)
{'fraction_non_alphanumeric': 0.07527062180078879, 'fraction_numerical': 0.004027859360577327, 'mean_word_length': 1.4875808808182007, 'pattern_counts': {'":': 0, '<': 56, '<?xml version=': 0, '>': 115, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4808859', 'n_tokens_mistral': 3114, 'n_tokens_neox': 2944, 'n_words': 800}