Permalink
Browse files

Merge pull request #613 from samoht/varint

Irmin.Type: add support for integers with variable length
  • Loading branch information...
samoht committed Jan 30, 2019
2 parents 0fe14f1 + 9a067ca commit 36b19d36df1aa2b47d666d6519faa270bd24e4a4
Showing with 93 additions and 24 deletions.
  1. +3 −3 src/irmin/irmin.mli
  2. +48 −19 src/irmin/type.ml
  3. +1 −1 src/irmin/type.mli
  4. +41 −1 test/irmin/test.ml
@@ -61,7 +61,7 @@ module Type: sig
type 'a t
(** The type for runtime representation of values of type ['a]. *)

type len = [ `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int]
type len = [ `Int | `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int]
(** The type of integer used to store buffers, list or array
lengths. *)

@@ -77,8 +77,8 @@ module Type: sig
(** [char] is a representation of the character type. *)

val int: int t
(** [int] is a representation of integers. They will always be
serialised to 64 bits. *)
(** [int] is a representation of integers. Binary serialization used
a varying-width representation. *)

val int32: int32 t
(** [int32] is a representation of the 32-bit integers type. *)
@@ -66,7 +66,7 @@ module Json = struct

end

type len = [`Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int ]
type len = [ `Int | `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int ]

type 'a pp = 'a Fmt.t
type 'a of_string = string -> ('a, [`Msg of string]) result
@@ -234,13 +234,13 @@ let int = Prim Int
let int32 = Prim Int32
let int64 = Prim Int64
let float = Prim Float
let string = Prim (String `Int64)
let bytes = Prim (Bytes `Int64)
let string = Prim (String `Int)
let bytes = Prim (Bytes `Int)
let string_of n = Prim (String n)
let bytes_of n = Prim (Bytes n)

let list ?(len=`Int64) v = List { v; len }
let array ?(len=`Int64) v = Array { v; len }
let list ?(len=`Int) v = List { v; len }
let array ?(len=`Int) v = Array { v; len }
let pair a b = Tuple (Pair (a, b))
let triple a b c = Tuple (Triple (a, b, c))
let option a = Option a
@@ -646,7 +646,7 @@ module Encode_json = struct
match encode_json with
| Some f -> f e u
| None ->
let string = Prim (String `Int64) in
let string = Prim (String `Int) in
match x, pp with
| Prim _, Some pp -> t string e (Fmt.to_to_string pp u)
| _ -> t x e (g u)
@@ -836,7 +836,7 @@ module Decode_json = struct
match decode_json with
| Some d -> d e
| None ->
let string = Prim (String `Int64) in
let string = Prim (String `Int) in
match x, of_string with
| Prim _, Some x -> t string e >|= x |> join
| _ -> t x e >|= f
@@ -924,32 +924,41 @@ let of_json_string x s = Decode_json.(t x @@ Json.decoder (`String s))

module Size_of = struct

let len = function
let int n =
let rec aux len n =
if n >= 0 && n < 128 then len
else aux (len+1) (n lsr 7)
in
`Size (aux 1 n)

let size = function
| `Size s -> s
| `Buffer b -> String.length b

let len n = function
| `Int -> size (int n)
| `Int8 -> 1
| `Int16 -> 2
| `Int32 -> 4
| `Int64 -> 8
| `Fixed _ -> 0

let size = function
| `Size s -> s
| `Buffer b -> String.length b

let unit () = `Size 0
let char (_:char) = `Size 1
let int32 (_:int32) = `Size 4
let int64 (_:int64) = `Size 8
let int (_:int) = `Size 8 (* always use 64 bits for storing ints *)
let bool (_:bool) = `Size 1
let float (_:float) = `Size 8 (* NOTE: we consider 'double' here *)
let string n s = `Size (len n + String.length s)
let bytes n s = `Size (len n + Bytes.length s)
let string n s = let s = String.length s in `Size (len s n + s)
let bytes n s = let s = Bytes.length s in `Size (len s n + s)

let list l n x =
`Size (List.fold_left (fun acc x -> acc + size (l x)) (len n) x)
let init = len (List.length x) n in
`Size (List.fold_left (fun acc x -> acc + size (l x)) init x)

let array l n x =
`Size (Array.fold_left (fun acc x -> acc + size (l x)) (len n) x)
let init = len (Array.length x) n in
`Size (Array.fold_left (fun acc x -> acc + size (l x)) init x)

let pair a b (x, y) = `Size (size (a x) + size (b y))
let triple a b c (x, y, z) = `Size (size (a x) + size (b y) + size (c z))
@@ -1064,10 +1073,21 @@ module Encode_bin = struct
let int32 buf ofs i = B.set_uint32 buf ofs i ; ofs + 4
let int64 buf ofs i = B.set_uint64 buf ofs i ; ofs + 8
let float buf ofs f = int64 buf ofs (Int64.bits_of_float f)
let int buf ofs i = int64 buf ofs (Int64.of_int i)
let bool buf ofs b = char buf ofs (if b then '\255' else '\000')

let int buf ofs i =
let rec aux n ofs =
if n >= 0 && n < 128 then
int8 buf ofs n
else
let out = 128 + (n land 127) in
let ofs = int8 buf ofs out in
aux (n lsr 7) ofs
in
aux i ofs

let len n buf ofs i = match n with
| `Int -> int buf ofs i
| `Int8 -> int8 buf ofs i
| `Int16 -> int16 buf ofs i
| `Int32 -> int32 buf ofs (Int32.of_int i)
@@ -1212,10 +1232,19 @@ module Decode_bin = struct
let int32 buf ofs = ok (ofs+4) (B.get_uint32 buf ofs)
let int64 buf ofs = ok (ofs+8) (B.get_uint64 buf ofs)
let bool buf ofs = char buf ofs >|= function '\000' -> false | _ -> true
let int buf ofs = int64 buf ofs >|= Int64.to_int
let float buf ofs = int64 buf ofs >|= Int64.float_of_bits

let int buf ofs =
let rec aux n p ofs =
int8 buf ofs >>= fun (ofs, i) ->
let n = n + ((i land 127) lsl (p*7)) in
if i >= 0 && i < 128 then (ofs, n)
else aux n (p+1) ofs
in
aux 0 0 ofs

let len buf ofs = function
| `Int -> int buf ofs
| `Int8 -> int8 buf ofs
| `Int16 -> int16 buf ofs
| `Int32 -> int32 buf ofs >|= Int32.to_int
@@ -14,7 +14,7 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

type len = [ `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int ]
type len = [ `Int | `Int8 | `Int16 | `Int32 | `Int64 | `Fixed of int ]

type 'a t
val unit: unit t
@@ -21,7 +21,7 @@ let test_base () =
Alcotest.(check string) "JSON int" "42" s;

let s = T.encode_bin T.int 42 in
Alcotest.(check string) "binery int" "\000\000\000\000\000\000\000*" s;
Alcotest.(check string) "binary int" "*" s;

let s = T.to_string T.int 42 in
Alcotest.(check string) "CLI string" "42" s
@@ -118,13 +118,53 @@ let test_equal () =
let b = `O ["a", `Bool true; "b", `Float 2.; "c", `A [`String "test"]] in
Alcotest.(check bool) "json eq" (T.equal Irmin.Contents.Json_value.t a b) true

let test_int () =
let test dx x =
let tt = Alcotest.testable (T.pp dx) (T.equal dx) in
match T.decode_bin dx (T.encode_bin dx x) with
| Error (`Msg e) -> Alcotest.fail e
| Ok y -> Alcotest.(check tt) "eq" x y
in
let size x s =
match T.size_of T.int x with
| `Size ss -> Alcotest.(check int) (Fmt.strf "size:%d" x) s ss
| _ -> Alcotest.fail "size"
in
let p7 = 128 in
let p14 = 16384 in
let p21 = 2097152 in
let p28 = 268435456 in
let p35 = 34359738368 in
let p42 = 4398046511104 in
let p49 = 562949953421312 in
let p56 = 72057594037927936 in
(* let p63 = max_int in *)
let ps = [p7; p14; p21; p28; p35; p42; p49; p56; (* p63 *) ] in
List.iter (fun p ->
test T.int (p - 1);
test T.int p;
test T.int (p + 1)
) (0 :: ps);
test T.(list int) [];
test T.string "";
test T.string (String.make p14 'x');
List.iter (fun p ->
if p > 0 && p < p28 then test T.(array int) (Array.make p 42)
) ps;
size 0 1;
List.iteri (fun i p ->
size (p - 1) (i + 1);
size p (i + 2)
) ps

let suite = [
"type", [
"base" , `Quick, test_base;
"json" , `Quick, test_json;
"bin" , `Quick, test_bin;
"compare", `Quick, test_compare;
"equal" , `Quick, test_equal;
"ints" , `Quick, test_int;
]
]

0 comments on commit 36b19d3

Please sign in to comment.