Attempt to implement size efficient serializer based on trits

TritsSer.fsx

open System.Collections
open System
open System.Text
open System.Diagnostics

module Trits =

    type Trit = Bit of bool | Split

    let isNullable (x:Type) = x.IsGenericType && x.GetGenericTypeDefinition() = typedefof<Nullable<_>>

    let tritsPrint arr = 
        let sb = StringBuilder()
        Array.iter (fun x -> match x with    
                                | Bit b -> sb.Append(if b then '1' else '0') |> ignore
                                | Split -> sb.Append '|' |> ignore) arr
        printfn "len(%d) %s" <| arr.Length <| sb.ToString()

    let bitsPrint arr = 
        let sb = StringBuilder()
        Array.iter (fun b -> sb.Append(if b then '1' else '0') |> ignore) arr
        printfn "len(%d) %s" <| arr.Length <| sb.ToString()

    let tritConv t = match t with 
                        | 2 -> Split
                        | 0 -> Bit false
                        | 1 -> Bit true
    let bitConv b = if b = 1 
                        then true 
                        else false
    let map = [|
                    ([|0;0|],[|0;0;0|]);
                    ([|0;1|],[|0;0;1|]);
                    ([|0;2|],[|0;1;0|]);
                    ([|1;0|],[|0;1;1|]);
                    ([|1;1|],[|1;0;0|]);
                    ([|1;2|],[|1;0;1|]);
                    ([|2;0|],[|1;1;0|]);
                    ([|2;1|],[|1;1;1|])
                    |] |> Array.map (fun (trits,bits) -> Array.map tritConv trits,  Array.map bitConv bits)
    
    let matchTrits trit1 trit2 = 
        let o = [|trit1;trit2|]
        //printfn "matching %A" o
        let rec matcher pos = 
            if pos = map.Length then failwith "cant match"
            let m = fst map.[pos]
            //printfn "pattern %A" m
            if m = o 
            then snd map.[pos]
            else matcher (pos + 1)
        matcher 0 

    let matchBits bit1 bit2 bit3 = 
        let o = [|bit1;bit2;bit3|]
        let rec matcher pos = 
            if pos = map.Length then failwith "cant match"
            let m = snd map.[pos]
            if m = o 
            then fst map.[pos]
            else matcher (pos + 1)
        matcher 0 
         
    let tritsToBytes (arr:Trit[]) : byte[] = 
        let lInit = arr.Length / 2 * 3
        let l = if lInit % 8 = 0 
                then lInit 
                else let l = (lInit / 8 + 1) * 8
                     if arr.[arr.Length-1] <> Split && (l - lInit) < 3
                     then l + 8
                     else l
        printfn "linit %d l %d" lInit l
        let bits = BitArray(l)
        for i in 0..(arr.Length / 2 - 1) do 
            let m = matchTrits arr.[i*2] arr.[i*2+1]
            for j in 0..(m.Length - 1) do
                bits.[i*3 + j] <- m.[j]

        if l <> lInit && (arr.[arr.Length-1] <> Split)
        then printfn "align bytes"
             let m = matchTrits Split (Bit false)
             for j in 0..2 do
                bits.[lInit + j] <- m.[j]
        
        let bytes = Array.create (bits.Length / 8) 0uy
        bits.CopyTo(bytes,0)
        bytes

    let bytesToTrits (arr:byte[]) : Trit[] = 
        let bits = BitArray(arr)
        let res = ResizeArray()
        let l = bits.Length - bits.Length % 3
        //printfn "bits len %d" l
        for i in 0..3..(l - 1) do 
            //printfn "i %d" i
            let m = matchBits bits.[i] bits.[i+1] bits.[i+2]
            res.AddRange(m)
        res.ToArray()
    

    type TritWriter()=
        let res = ResizeArray<Trit>()

        let bitsToTrits (bits:BitArray) (res : ResizeArray<Trit>) canBeReduced =
            let mutable last = bits.Length-1
            if canBeReduced then
                while not bits.[last] && last <> 0 do
                    last <- last - 1
            for i in 0..last do
                res.Add(Bit bits.[i])

        let bytesToTrits (bytes:byte[]) (res : ResizeArray<Trit>) = bitsToTrits (BitArray(bytes)) res 

        member x.Write(b:bool) = res.Add(Bit b)
        member x.WriteSplit() = res.Add(Split)
        member x.Write(bytes : byte[], canBeReduced) = bytesToTrits bytes res canBeReduced
        member x.ToArray() = 
            if res.Count % 2 = 0
            then res.ToArray()
            else printfn "align trits"
                 let arr = Array.create (res.Count + 1) Split//align to two trits adding single Split
                 res.CopyTo(arr)
                 arr

    let rec serializeInt (o:obj) (t:Type) (res : TritWriter) = 
        printfn "serializing %A %A" t o
        if not t.IsValueType || isNullable t 
        then res.Write (o <> null) //nullable
        match o with 
        | :? string as s -> res.Write (Encoding.UTF8.GetBytes(s), false) 
        | :? bool as c -> res.Write(c) 
        | :? int as i -> res.Write (BitConverter.GetBytes(i), true) 
        | :? uint32 as i -> res.Write (BitConverter.GetBytes(i), true) 
        | :? byte as b -> res.Write ([|b|], true) 
        | :? float as i -> res.Write (BitConverter.GetBytes(i), true) 
        | :? Array as arr -> serializeInt(arr.Length) typeof<int> res 
                             for i in 0..(arr.Length - 1) do
                                res.WriteSplit()
                                serializeInt(arr.GetValue(i)) (t.GetElementType()) res
        | _ ->  let properties = t.GetProperties()
                properties |> Array.iteri (fun i prop ->
                    if prop.CanRead && prop.CanWrite then
                        let value = prop.GetValue(o, null)
                        serializeInt value prop.PropertyType res
                        if i < (properties.Length - 1) then res.WriteSplit()
                )

    let serialize (o:obj) = 
        let res = TritWriter()
        serializeInt o (if o = null then typeof<obj> else o.GetType()) res 
        let res = res.ToArray() 
        tritsPrint(res)
        res |> tritsToBytes

    type TritReader(arr: Trit[])=
        let mutable position = 0
        let rec readToSplit (acc:ResizeArray<bool>) = 
            if position = arr.Length then ()
            else match arr.[position] with
                    | Split -> ()
                               position <- position + 1
                    | Bit b -> acc.Add(b)
                               position <- position + 1
                               readToSplit acc

        member x.ReadNextBytes expectedSize = 
            let bits = BitArray(x.ReadNextBits())
            let bytes = match expectedSize with
                            | Some size -> Array.create size 0uy
                            | None -> Array.create (bits.Length / 8) 0uy
            bits.CopyTo(bytes, 0)
            bytes

        member x.ReadNextBits() : bool[]= 
            let res = ResizeArray()
            readToSplit res
            let f = res.ToArray()
            bitsPrint f
            f
        member x.ReadSkip() : unit = 
            match arr.[position] with
                    | Skip -> position <- position + 1
                    | _ -> failwith "expected skip"
        member x.ReadBit() : bool= 
            match arr.[position] with
                    | Bit b -> position <- position + 1
                               b
                    | _ -> failwith "expected bit"
    let rec deserializeInt (t : Type) (s : TritReader) : obj = 
        printfn "deserializing type %s" t.FullName
        if (not t.IsValueType || isNullable t) && (not <| s.ReadBit())//check null
        then s.ReadSkip()
             null
        else 
            match t with 
            | x when x = typeof<string> -> s.ReadNextBytes None |> Encoding.UTF8.GetString |> box
            | x when x = typeof<bool>  -> s.ReadNextBits().[0] |> box
            | x when x = typeof<int> -> BitConverter.ToInt32(s.ReadNextBytes (Some 4),0) |> box
            | x when x = typeof<uint32> -> BitConverter.ToUInt32(s.ReadNextBytes (Some 4),0) |> box
            | x when x = typeof<float>  -> BitConverter.ToDouble(s.ReadNextBytes(Some 8),0) |> box
            | x when x = typeof<byte>  -> s.ReadNextBytes(Some 1).[0] |> box
            | x when isNullable x->
                    let elType = Nullable.GetUnderlyingType(x)
                    //if isNull 
                    //then Activator.CreateInstance(t, [|null|] )  
                    let v = deserializeInt elType s
                    Activator.CreateInstance(t, [|v|] ) 
            | x when x.IsArray -> 
                    let elType =t.GetElementType() 
                    let len = deserializeInt (typeof<int>) s |> unbox<int>
                    let arrObj = Activator.CreateInstance(t, [|box len|] ) 
                    let arr = unbox<Array> arrObj
                    for i in 0..(len - 1) do
                        arr.SetValue(deserializeInt elType s, i)
                    arrObj
            | _ -> 
                    let o = Activator.CreateInstance(t)
                    let properties = t.GetProperties()
                    properties |> Array.iter (fun prop ->
                        if prop.CanRead && prop.CanWrite then
                            let v = deserializeInt (prop.PropertyType) s
                            printfn "value %A" v
                            prop.SetValue(o, v)
                    )
                    o |> box

    let deserialize<'a> arr = deserializeInt (typeof<'a>) (TritReader(arr |> bytesToTrits)) |> unbox<'a>


type Car()=
    member val Id = 1 with get,set
    member val Name = "a" with get,set
    member val Latitude = 1.0 with get,set
    member val Longitude = 0.1 with get,set
    
    member val NullCheck =  new System.Nullable<int>(1) with get,set
    member val NullCheck2 =  System.Nullable<int>() with get,set
    member val Uint =  2u with get,set
    member val Bundle = [|0uy|] with get,set

    override x.GetHashCode() =
        hash (x.Id, x.Name, x.Latitude, x.Longitude, x.Bundle, x.NullCheck, x.NullCheck2, x.Uint)
    override x.Equals(b) =
        match b with
        | :? Car as p -> (x.Id, x.Name, x.Latitude, x.Longitude, x.Bundle, x.NullCheck, x.NullCheck2, x.Uint) = (p.Id, p.Name, p.Latitude, p.Longitude, p.Bundle, p.NullCheck, p.NullCheck2, p.Uint)
        | _ -> false
    override x.ToString() =
        sprintf "Car(%A,%A,%A,%A,%A,%A,%A,%A)" x.Id x.Name x.Latitude x.Longitude x.Bundle x.NullCheck x.NullCheck2 x.Uint
        



let car = Car()
car.Latitude <- 100.1
let arr = Trits.serialize car
printfn "Serialized length %d" arr.Length


let car2 = Trits.deserialize<Car> arr
printfn "%s" <| car2.ToString()
sprintf "result %A" (car.Equals car2)