Pickling Sample
Last changed: -213.199.128.153

.

Check out the formatting tips on the right for help formatting and making links.

Use the template below:

Summary

Some peliminaries

 module Pickle


 open System
 open System.IO;;

Some standard byte hacking

 let b0 n = (n &&& 0xFF)
 let b1 n = ((n >>> 8) &&& 0xFF)
 let b2 n = ((n >>> 16) &&& 0xFF)
 let b3 n = ((n >>> 24) &&& 0xFF)

Input/output state. Often picklers must give work with additional state beyond a stream of bytes. Further state can be added directly to these records if a custom pickler target is needed. There are also other ways of making the state extensible (e.g. by making these F# class types and using inheritance).

 type outstate = 
  { os: BinaryWriter;  }


 type instate = 
  { is: BinaryReader;  }

Basic pickle/unpickle operations

 type 'a pickler = 'a -> outstate -> unit
 type 'a unpickler = instate -> 'a


 /// Pickle int32 as a byte
 let pbyte (b:int) st = st.os.Write(Byte.of_int b)
 let ubyte st = Byte.to_int (st.is.ReadByte())


 /// Pickle booleans as bytes.  Pickling as bits will take more work!
 let pbool b st = pbyte (if b then 1 else 0) st
 let ubool st = let b = ubyte st in (b = 1) 


 /// Pickle emptiness
 let pvoid (os: outstate) = ()
 let uvoid (is: instate) = ()


 let punit () (os: outstate) = ()
 let uunit (is: instate) = ()


 /// Pickle an integer byte by byte - in truth you
 /// can actually do this using st.os.Write(i)
 /// but this shows how to get exact control
 let pint32 i st = 
   pbyte (b0 i) st;
   pbyte (b1 i) st;
   pbyte (b2 i) st;
   pbyte (b3 i) st


 let uint32 st = 
   let b0 =  (ubyte st) in
   let b1 =  (ubyte st) in
   let b2 =  (ubyte st) in
   let b3 =  (ubyte st) in
   b0 ||| (b1 <<< 8) ||| (b2 <<< 16) ||| (b3 <<< 24);;

Sequence pickler combinators. "ptup2 pMyInt32 pMyInt32" creates a pickler to pickle two integers sequentially

 let ptup2 p1 p2 (a,b) (st:outstate) = (p1 a st : unit); (p2 b st : unit)
 let ptup3 p1 p2 p3 (a,b,c) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit)
 let ptup4 p1 p2 p3 p4 (a,b,c,d) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit)
 let ptup5 p1 p2 p3 p4 p5 (a,b,c,d,e) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit)
 let ptup6 p1 p2 p3 p4 p5 p6 (a,b,c,d,e,f) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit); (p6 f st : unit)


 let utup2 p1 p2 st = let a = p1 st in let b = p2 st in (a,b)
 let utup3 p1 p2 p3 st =
   let a = p1 st in let b = p2 st in let c = p3 st in (a,b,c)
 let utup4 p1 p2 p3 p4 st =
   let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in (a,b,c,d)
 let utup5 p1 p2 p3 p4 p5 st =
   let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in
   let e = p5 st in (a,b,c,d,e)
 let utup6 p1 p2 p3 p4 p5 p6 st =
   let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in
   let e = p5 st in let f = p6 st in (a,b,c,d,e,f)

Picle byte arays:

 let pbytes (s: byte[]) st = 
  let len = s.Length in
  pint32 (Int32.of_int len) st;
  st.os.Write(s)


 let ubytes st = 
  let n = (uint32 st) in 
  let bytes : byte[] = Array.zero_create n in 
  st.is.Read( bytes,0,n)

Pickle/unpickle arrays by first encoding the integer length and then the sequencing of items in the array (which are encoded/unencoded using the 'p' pickler). use as in "parray pint64", to create a pickler for an array of int64 values formatted using "pint64". If further control is needed over the formatting of the integer then an extra function paramater could be passed.

 let parray p (arr: 'a[]) st = 
   let len = arr.Length in
   pint32 (Int32.of_int len) st;
   Array.iter (fun x -> p x st) arr


 let uarray u st : 'a[] = 
   let n = (uint32 st) in 
   Array.init n (fun _ -> u st) 

Test it

 let outputState = { os = new BinaryWriter(new FileStream(@"c:\baz.bin",FileMode.CreateNew)) };;
 pint32 7216 outputState;;
 pint32 7217 outputState;;
 ptup2 pint32 pint32 (101,202) outputState;;
 outputState.os.Close();;


 let inputState = { is = new BinaryReader(new FileStream(@"c:\baz.bin",FileMode.Open)) };;
 uint32 inputState;;
 uint32 inputState;;
 utup2 uint32 uint32 inputState;;
 inputState.is.Close();;

Further examples and useful combinators

 /// Example: compress integers according to the same scheme used by CLR metadata 
 /// This halves the size of pickled data 
 let pMyInt32 n st = 
   if n >= 0 &  n <= 0x7F then 
     pbyte (b0 n) st
   else if n >= 0x80 & n <= 0x3FFF then  begin
     pbyte ((0x80 ||| (n >>> 8))) st; 
     pbyte ((n &&& 0xFF)) st 
   end else begin
     pbyte 0xFF st;
     pint32 n st
   end 


 let uMyInt32 st = 
   let b0 = ubyte st in 
   if b0 <= 0x7F then b0 
   else if b0 <= 0xbf then 
     let b0 = b0 &&& 0x7f in 
     let b1 = (ubyte st) in 
     (b0 <<< 8) ||| b1
   else  begin
     if b0 <> 0xFF then printf "uMyInt32: invalid encoding\n";
     uint32 st
   end 


 /// Definitions of these left as an exercise...
 // let pint8 i st = ... 
 // let uint8 st = ... 


 //let puint8 i st = ...
 //let uuint8 st =  


 /// Pickle 64-bit integers in custom format
 let pint64 i st = 
   pMyInt32 (Int64.to_int32 (i &&& 0xFFFFFFFFL)) st;
   pMyInt32 (Int64.to_int32 (i >>> 32)) st  


 let uint64 st = 
   let b1 = Int64.of_int32 (uMyInt32 st) in
   let b2 = Int64.of_int32 (uMyInt32 st) in
   b1 ||| (b2 <<< 32) 


 /// Combinators for projecting/injecting data 
 let pwrap (f: 'a -> 'b) (p : 'b pickler) : 'a pickler = (fun x st -> p (f x) st)
 let uwrap (f: 'b -> 'a) (u : 'b unpickler) : 'a unpickler = (fun st -> f (u st))


 /// This is a combinator pair for pickling byte-tag-discriminated unions
 let punion dest x st =
   let (tag,(datap: outstate -> unit)) = dest x in 
   pbyte tag st; datap st 


 let uunion mk st =
   let tag = ubyte st in 
   mk tag st 


 /// Pickle an F# Some/None option as an example of how to use
 /// the byte-tag combinator punion
 let rec poption f  = 
   punion (function 
     | None -> 0,pvoid
     | Some h -> 1,f h) 


 let uoption f = 
   uunion (function 
     | 0 -> uvoid >> (fun () -> None) 
     | 1 -> f >> (fun a -> Some a)
     | n -> failwith ("uoption: found number " ^ string_of_int n)
   )