4 people like it.

CompressedArray

Store rarely accessed efficiently compressed (only for unmanaged types). Efficient decompression with no temporary arrays by utilizing NativePtr with UnmanagedMemoryStream. Uncompressed resultant array stored with WeakReference to save multiple uncompression steps.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 

open System
open System.IO
open System.IO.Compression
open Microsoft.FSharp.NativeInterop

#nowarn "9"

type CompressedArray<'a when 'a : unmanaged> (data:array<'a>, compressionLevel) =
    static let compress (uncompressedData:array<'a>) (compressionLevel:CompressionLevel) : (array<byte>*int64) =
        use ptrToBufferOfA = fixed (&uncompressedData.[0])
        let ptrToBuffer = NativePtr.toNativeInt ptrToBufferOfA
        let ptrToBufferOfByte = NativePtr.ofNativeInt<byte> ptrToBuffer

        let length = (int64 uncompressedData.Length) * (int64 sizeof<'a>)
        use uncompressedStream = new UnmanagedMemoryStream (ptrToBufferOfByte, length)
        use compressedStream = new MemoryStream ()
        let deflatingStream = new DeflateStream (compressedStream, compressionLevel)
        using deflatingStream (fun deflating -> uncompressedStream.CopyTo deflating)

        (compressedStream.ToArray (), length)

    static let decompress (compressedBytes:array<byte>, decompressedSize:int64) : array<'a> =
        let elements = int (decompressedSize / (int64 sizeof<'a>))
        if (int64 elements) * (int64 sizeof<'a>) <> decompressedSize then
            failwith "logic error: decompressedSize is not multiple of sizeof<'a>"

        let buffer = Array.zeroCreate<'a> elements
        use ptrToBufferofA = fixed (&buffer.[0])
        let ptrToBuffer = NativePtr.toNativeInt ptrToBufferofA
        let ptrToBufferOfByte = NativePtr.ofNativeInt<byte> ptrToBuffer

        let uncompressedStreamOnBuffer = new UnmanagedMemoryStream (ptrToBufferOfByte, decompressedSize, decompressedSize, FileAccess.Write)
        using uncompressedStreamOnBuffer (fun uncompressed ->
            use compressedStream = new MemoryStream (compressedBytes, false)
            use inflatingStream = new DeflateStream (compressedStream, CompressionMode.Decompress)
            inflatingStream.CopyTo uncompressed)

        buffer

    let uncompressed = WeakReference<array<'a>> Unchecked.defaultof<_>
    let compressed = compress data compressionLevel

    new (data:array<'a>) = CompressedArray<'a> (data, CompressionLevel.Fastest)

    member __.Ratio =
        (float ((fst compressed).Length)) / (float (snd compressed))

    member __.ToUncompressed () =
        match uncompressed.TryGetTarget () with
        | true, result -> result
        | false, _ ->
            let result = decompress compressed
            uncompressed.SetTarget result
            result
namespace System
namespace System.IO
namespace System.IO.Compression
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.NativeInterop
Multiple items
type CompressedArray<'a (requires unmanaged)> =
  new : data:'a array -> CompressedArray<'a>
  new : data:'a array * compressionLevel:CompressionMode -> CompressedArray<'a>
  member ToUncompressed : unit -> 'a array
  member Ratio : float

Full name: Script.CompressedArray<_>

--------------------
new : data:'a array -> CompressedArray<'a>
new : data:'a array * compressionLevel:CompressionMode -> CompressedArray<'a>
val data : 'a array (requires unmanaged)
type 'T array = 'T []

Full name: Microsoft.FSharp.Core.array<_>
val compressionLevel : CompressionMode
val compress : ('a array -> CompressionMode -> byte array * int64) (requires unmanaged)
val uncompressedData : 'a array (requires unmanaged)
Multiple items
val byte : value:'T -> byte (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.byte

--------------------
type byte = Byte

Full name: Microsoft.FSharp.Core.byte
Multiple items
val int64 : value:'T -> int64 (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int64

--------------------
type int64 = Int64

Full name: Microsoft.FSharp.Core.int64

--------------------
type int64<'Measure> = int64

Full name: Microsoft.FSharp.Core.int64<_>
val ptrToBufferOfA : nativeptr<'a> (requires unmanaged)
val ptrToBuffer : nativeint
module NativePtr

from Microsoft.FSharp.NativeInterop
val toNativeInt : address:nativeptr<'T> -> nativeint (requires unmanaged)

Full name: Microsoft.FSharp.NativeInterop.NativePtr.toNativeInt
val ptrToBufferOfByte : nativeptr<byte>
val ofNativeInt : address:nativeint -> nativeptr<'T> (requires unmanaged)

Full name: Microsoft.FSharp.NativeInterop.NativePtr.ofNativeInt
val length : int64
property Array.Length: int
val sizeof<'T> : int

Full name: Microsoft.FSharp.Core.Operators.sizeof
val uncompressedStream : UnmanagedMemoryStream
Multiple items
type UnmanagedMemoryStream =
  inherit Stream
  new : pointer:byte * length:int64 -> UnmanagedMemoryStream + 3 overloads
  member CanRead : bool
  member CanSeek : bool
  member CanWrite : bool
  member Capacity : int64
  member Flush : unit -> unit
  member Length : int64
  member Position : int64 with get, set
  member PositionPointer : byte with get, set
  member Read : buffer:byte[] * offset:int * count:int -> int
  ...

Full name: System.IO.UnmanagedMemoryStream

--------------------
UnmanagedMemoryStream(pointer: nativeptr<byte>, length: int64) : unit
UnmanagedMemoryStream(buffer: Runtime.InteropServices.SafeBuffer, offset: int64, length: int64) : unit
UnmanagedMemoryStream(buffer: Runtime.InteropServices.SafeBuffer, offset: int64, length: int64, access: FileAccess) : unit
UnmanagedMemoryStream(pointer: nativeptr<byte>, length: int64, capacity: int64, access: FileAccess) : unit
val compressedStream : MemoryStream
Multiple items
type MemoryStream =
  inherit Stream
  new : unit -> MemoryStream + 6 overloads
  member CanRead : bool
  member CanSeek : bool
  member CanWrite : bool
  member Capacity : int with get, set
  member Flush : unit -> unit
  member GetBuffer : unit -> byte[]
  member Length : int64
  member Position : int64 with get, set
  member Read : buffer:byte[] * offset:int * count:int -> int
  ...

Full name: System.IO.MemoryStream

--------------------
MemoryStream() : unit
MemoryStream(capacity: int) : unit
MemoryStream(buffer: byte []) : unit
MemoryStream(buffer: byte [], writable: bool) : unit
MemoryStream(buffer: byte [], index: int, count: int) : unit
MemoryStream(buffer: byte [], index: int, count: int, writable: bool) : unit
MemoryStream(buffer: byte [], index: int, count: int, writable: bool, publiclyVisible: bool) : unit
val deflatingStream : DeflateStream
Multiple items
type DeflateStream =
  inherit Stream
  new : stream:Stream * mode:CompressionMode -> DeflateStream + 1 overload
  member BaseStream : Stream
  member BeginRead : array:byte[] * offset:int * count:int * asyncCallback:AsyncCallback * asyncState:obj -> IAsyncResult
  member BeginWrite : array:byte[] * offset:int * count:int * asyncCallback:AsyncCallback * asyncState:obj -> IAsyncResult
  member CanRead : bool
  member CanSeek : bool
  member CanWrite : bool
  member EndRead : asyncResult:IAsyncResult -> int
  member EndWrite : asyncResult:IAsyncResult -> unit
  member Flush : unit -> unit
  ...

Full name: System.IO.Compression.DeflateStream

--------------------
DeflateStream(stream: Stream, mode: CompressionMode) : unit
DeflateStream(stream: Stream, mode: CompressionMode, leaveOpen: bool) : unit
val using : resource:'T -> action:('T -> 'U) -> 'U (requires 'T :> IDisposable)

Full name: Microsoft.FSharp.Core.Operators.using
val deflating : DeflateStream
Stream.CopyTo(destination: Stream) : unit
Stream.CopyTo(destination: Stream, bufferSize: int) : unit
MemoryStream.ToArray() : byte []
val decompress : (byte array * int64 -> 'a array) (requires unmanaged)
val compressedBytes : byte array
val decompressedSize : int64
val elements : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val buffer : 'a [] (requires unmanaged)
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val zeroCreate : count:int -> 'T []

Full name: Microsoft.FSharp.Collections.Array.zeroCreate
val ptrToBufferofA : nativeptr<'a> (requires unmanaged)
val uncompressedStreamOnBuffer : UnmanagedMemoryStream
type FileAccess =
  | Read = 1
  | Write = 2
  | ReadWrite = 3

Full name: System.IO.FileAccess
field FileAccess.Write = 2
val uncompressed : UnmanagedMemoryStream
val inflatingStream : DeflateStream
type CompressionMode =
  | Decompress = 0
  | Compress = 1

Full name: System.IO.Compression.CompressionMode
field CompressionMode.Decompress = 0
val uncompressed : obj
Multiple items
type WeakReference =
  new : target:obj -> WeakReference + 1 overload
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member IsAlive : bool
  member Target : obj with get, set
  member TrackResurrection : bool

Full name: System.WeakReference

--------------------
WeakReference(target: obj) : unit
WeakReference(target: obj, trackResurrection: bool) : unit
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
val compressed : byte array * int64
member CompressedArray.Ratio : float

Full name: Script.CompressedArray`1.Ratio
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val __ : CompressedArray<'a> (requires unmanaged)
member CompressedArray.ToUncompressed : unit -> 'a array

Full name: Script.CompressedArray`1.ToUncompressed
val result : 'a array (requires unmanaged)
Raw view Test code New version

More information

Link:http://fssnip.net/7UE
Posted:6 years ago
Author:manofstick
Tags: array , nativeptr

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.