diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index dcc6c7e..b0c428a 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -4,10 +4,12 @@ on: pull_request: branches: - master + - next - ci push: branches: - master + - next - ci jobs: @@ -20,13 +22,13 @@ jobs: - macos-latest - windows-latest ocaml-compiler: - - 4.10.0 + - 4.14.2 skip_test: - false include: - os: ubuntu-latest - ocaml-compiler: 4.08.0 + ocaml-compiler: 4.14.2 skip_test: true @@ -34,19 +36,19 @@ jobs: steps: - name: Checkout code - uses: actions/checkout@v2 + uses: actions/checkout@v3 - name: Retrieve opam cache - uses: actions/cache@v2 + uses: actions/cache@v3 id: cache-opam with: path: ~/.opam - key: v2-${{ runner.os }}-bitpack_serialize-${{ matrix.ocaml-compiler }}-${{ hashFiles('opam/*.opam') }} + key: v3-${{ runner.os }}-bitpack_serialize-${{ matrix.ocaml-compiler }}-${{ hashFiles('*.opam') }} # restore-keys: | -# v2-${{ runner.os }}-opam-${{ matrix.ocaml-compiler }}- +# v3-${{ runner.os }}-opam-${{ matrix.ocaml-compiler }}- - name: Use OCaml ${{ matrix.ocaml-compiler }} - uses: avsm/setup-ocaml@v2 + uses: avsm/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-pin: false @@ -64,13 +66,9 @@ jobs: - run: opam --version - run: opam depext -y bitpack_serializer -# if: steps.cache-opam.outputs.cache-hit != 'true' + if: matrix.os != 'windows-latest' - - run: opam install -y opam/*.opam --deps-only --with-test -# if: steps.cache-opam.outputs.cache-hit != 'true' - -# - run: opam upgrade --fixup -# if: steps.cache-opam.outputs.cache-hit == 'true' + - run: opam install -y . --deps-only --with-test - run: make build @@ -82,10 +80,10 @@ jobs: - name: test source is well formatted run: make fmt continue-on-error: true - if: matrix.ocaml-compiler == '4.10.0' && matrix.os == 'ubuntu-latest' + if: matrix.ocaml-compiler == '4.14.2' && matrix.os == 'ubuntu-latest' - name: build-doc - if: matrix.ocaml-compiler == '4.10.0' && matrix.os == 'ubuntu-latest' + if: matrix.ocaml-compiler == '4.14.2' && matrix.os == 'ubuntu-latest' run: | sudo apt install -yqq python3-sphinx python3-sphinx-rtd-theme opam install -y dune odoc diff --git a/opam/bitpack_serializer.opam b/bitpack_serializer.opam similarity index 100% rename from opam/bitpack_serializer.opam rename to bitpack_serializer.opam diff --git a/src/bitpack_serializer.ml b/src/bitpack_serializer.ml index de0615d..d105e84 100644 --- a/src/bitpack_serializer.ml +++ b/src/bitpack_serializer.ml @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 Ocaml Pro *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + module Buffer = Buffer module Lens = Lens diff --git a/src/bitpack_serializer.mli b/src/bitpack_serializer.mli index 274a57a..0f92102 100644 --- a/src/bitpack_serializer.mli +++ b/src/bitpack_serializer.mli @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 OcamlPro *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + module Buffer : module type of Buffer module Lens : module type of Lens diff --git a/src/buffer.ml b/src/buffer.ml index 36e392e..e009467 100644 --- a/src/buffer.ml +++ b/src/buffer.ml @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 OcamlPro *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + open Utils open Collections @@ -28,8 +29,10 @@ type t = } type 'dict dictionary = - | NoDictionary - | Dictionary of 'dict + [ `NoDictionary + | `Dictionary of 'dict] + +type dictionary_config = int option dictionary (** A reading specialized buffer. The dictionary is used to decode strings that have been encoded as integers. *) @@ -48,7 +51,7 @@ type writer = { mutable stats : stats; } -let default_with_dict = Dictionary None +let default_with_dict = `Dictionary None (** Statistic utilities *) let stats_bytes t i = t.stats.bits_bytes <- t.stats.bits_bytes + i @@ -60,7 +63,7 @@ let stats_z t i = t.stats.bits_z <- t.stats.bits_z + i let dictionary_size_to_max_bit_size = function | None -> None - | Some s -> Some (Utils.numbits s - 1) + | Some s -> Some (Utils.numbits (s - 1)) (** Prints an int64 in binary, with at least 8 bits. *) let print_int_bin fmt i = @@ -355,14 +358,14 @@ let write_with_stats stats_add (t : writer) (v : int64) (size : int) = Log.debug "[write] Writing %a on %i bits@." print_int_bin v size; let () = check_size size; - - if v >= (Int64.(shift_left one size)) + let max_possible_value = + if size = 64 + then Int64.max_int + else Int64.(sub (shift_left one size) one) + in + if v > max_possible_value then invalid_argument "Value %Ld does not fit on %i bits" v size; - - if v < Int64.zero - then invalid_argument - "Value %Ld is negative" v in write_byte t.writer @@ -376,8 +379,7 @@ let write = write_with_stats stats_int let read_bool t : bool = (read t 1) = Int64.one let read_uint8 t : int = read t 8 |> Int64.to_int let read_uint16 t : int = read t 16 |> Int64.to_int -let read_uint32 t : int = read t 32 |> Int64.to_int -let read_uint63 t : int64 = read t 63 +let read_uint32 t : int64 = read t 32 let write_stat_int = write_with_stats stats_int @@ -386,8 +388,7 @@ let write_bool t (b : bool) = write_stat_int t Int64.(if b then one else zero) 1 let write_int t (v : int) nbits = write_stat_int t (Int64.of_int v) nbits let write_uint8 t (v : int) = write_int t v 8 let write_uint16 t (v : int) = write_int t v 16 -let write_uint32 t (v : int) = write_int t v 32 -let write_uint63 t (v : int64) = write_stat_int t v 63 +let write_uint32 t (v : int64) = write_stat_int t v 32 let z_length value = (Z.numbits value + 1 + 6) / 7 @@ -589,8 +590,8 @@ let write_string_id (t : writer) (str_id : int) = correspondance between integers and strings. *) let write_str_repr (t : writer) s = match t.dictionary with - | NoDictionary -> write_string t s - | Dictionary dict -> + | `NoDictionary -> write_string t s + | `Dictionary dict -> match StringMap.find_opt s !dict with | None -> let new_id = StringMap.cardinal !dict in @@ -606,8 +607,8 @@ let read_string_id (t : reader) = (** Decodes a string encoded as an integer with the reader dictionary. *) let read_str_repr (t : reader) = match t.dictionary with - | NoDictionary -> read_string t - | Dictionary d -> + | `NoDictionary -> read_string t + | `Dictionary d -> let id = read_string_id t in match IntMap.find_opt id d with None -> @@ -619,9 +620,9 @@ let read_str_repr (t : reader) = let initialize_writer ?(with_dict=default_with_dict) ?(init_size = 4096) () = let dictionary, dictionary_max_bit_size = match with_dict with - | NoDictionary -> NoDictionary, None - | Dictionary size -> - Dictionary (ref StringMap.empty), + | `NoDictionary -> `NoDictionary, None + | `Dictionary size -> + `Dictionary (ref StringMap.empty), dictionary_size_to_max_bit_size size in { writer = @@ -637,8 +638,8 @@ let initialize_writer ?(with_dict=default_with_dict) ?(init_size = 4096) () = (** Encodes and writes the dictionary in a fresh Bytes buffer *) let write_dict d = match d with - | NoDictionary -> Bytes.empty - | Dictionary {contents = d} -> + | `NoDictionary -> Bytes.empty + | `Dictionary {contents = d} -> let t = initialize_writer () in let size = StringMap.cardinal d in write_signed_int t size; @@ -667,17 +668,17 @@ let initialize_reader ?(with_dict=default_with_dict) buffer = buffer; offset = 0; }; - dictionary = NoDictionary; (* updated later *) + dictionary = `NoDictionary; (* updated later *) dictionary_max_bit_size = None; (* updated later *) } in let () = match with_dict with - | NoDictionary -> () - | Dictionary size -> begin + | `NoDictionary -> () + | `Dictionary size -> begin let dictionary = let cardinal = read_signed_int t in - Log.debug "[initialize_reader] Dictionary size = %i@." cardinal; + Log.debug "[initialize_reader] `Dictionary size = %i@." cardinal; let rec build_dic dict id = if id = cardinal then ( @@ -695,7 +696,7 @@ let initialize_reader ?(with_dict=default_with_dict) buffer = in build_dic IntMap.empty 0 in - t.dictionary <- Dictionary dictionary; + t.dictionary <- `Dictionary dictionary; t.dictionary_max_bit_size <- dictionary_size_to_max_bit_size size; end in @@ -703,8 +704,8 @@ let initialize_reader ?(with_dict=default_with_dict) buffer = t let print_dict fmt = function - | NoDictionary -> Format.fprintf fmt "(none)@." - | Dictionary {contents = d} -> + | `NoDictionary -> Format.fprintf fmt "(none)@." + | `Dictionary {contents = d} -> StringMap.iter (fun key elt -> Format.fprintf fmt "%i: %s@." elt key) d diff --git a/src/buffer.mli b/src/buffer.mli index 7444dbe..bba9eab 100644 --- a/src/buffer.mli +++ b/src/buffer.mli @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 OCamlPro *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + (** The Buffer defines the methods for serializers & deserializers in a buffer. The compression algorithm used by the library works by writing @@ -17,9 +18,9 @@ (** A dictionary type. It is used as an argument for initialzing writers and readers. *) -type 'dict dictionary = - | NoDictionary - | Dictionary of 'dict +type dictionary_config = + [ `NoDictionary + | `Dictionary of int option] (** {1 Writer} *) @@ -45,7 +46,7 @@ type writer (by default: 4096) *) val initialize_writer : - ?with_dict:int option dictionary -> + ?with_dict:dictionary_config -> ?init_size:int -> unit -> writer @@ -74,10 +75,7 @@ val write_uint8 : writer -> int -> unit val write_uint16 : writer -> int -> unit (** Equivalent to [write w v 32] *) -val write_uint32 : writer -> int -> unit - -(** Equivalent to [write w v 63] *) -val write_uint63 : writer -> int64 -> unit +val write_uint32 : writer -> int64 -> unit (** Writes an unbounded integer.*) val write_z : writer -> Z.t -> unit @@ -107,7 +105,7 @@ type reader initializing the writer. *) val initialize_reader : - ?with_dict:int option dictionary -> + ?with_dict:dictionary_config -> Bytes.t -> reader (** read buff n reads n bits on the buffer as an unsigned value *) @@ -125,10 +123,7 @@ val read_uint8 : reader -> int val read_uint16 : reader -> int (** Reads 32 bits *) -val read_uint32 : reader -> int - -(** Reads 63 bits *) -val read_uint63 : reader -> int64 +val read_uint32 : reader -> int64 (** Reads an unsigned int prefixed by its size. *) val read_signed_int : reader -> int diff --git a/src/index.mld b/src/index.mld index d97b6e4..63d7794 100644 --- a/src/index.mld +++ b/src/index.mld @@ -1,3 +1,15 @@ +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + {1 Library Bitpack_serializer} The library_binary encoding provides two main modules. diff --git a/src/lens.ml b/src/lens.ml index 1794185..eafbd6b 100644 --- a/src/lens.ml +++ b/src/lens.ml @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 OcamlPro *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + open Utils @@ -21,13 +22,18 @@ type 'a t = | Mu } type _ input = - | UInt : int -> int64 input (* Size *) - | SInt : int input + | Bool : bool input + | FixedSizeInt64 : int -> int64 input + | Int64 : int64 input + | Int : int input | ZInt : Z.t input | String : string input | Bytes : bytes input | FixedSizeBytes : int -> bytes input +let make ~writer ~reader = + Lens {writer; reader} + let write (lens : 'a t) (w_buffer : Buffer.writer) (elt : 'a) : unit = match lens with | Mu -> raise MuReached @@ -40,8 +46,10 @@ let read lens r_buffer = let create (type a) (mode : a input) : a t = let (writer : Buffer.writer -> a -> unit) = match mode with - | UInt size -> fun w v -> Buffer.write w v size - | SInt -> fun w v -> Buffer.write_z w (Z.of_int v) + | Bool -> fun w b -> Buffer.write_bool w b + | FixedSizeInt64 size -> fun w v -> Buffer.write w v size + | Int64 -> fun w v -> Buffer.write_z w (Z.of_int64 v) + | Int -> fun w v -> Buffer.write_z w (Z.of_int v) | ZInt -> Buffer.write_z | String -> Buffer.write_str_repr | Bytes -> Buffer.write_bytes @@ -49,8 +57,10 @@ let create (type a) (mode : a input) : a t = in let (reader : Buffer.reader -> a) = match mode with - | UInt size -> fun r -> Buffer.read r size - | SInt -> fun r -> Buffer.read_z r |> Z.to_int + | Bool -> fun r -> Buffer.read_bool r + | FixedSizeInt64 size -> fun r -> Buffer.read r size + | Int64 -> fun r -> Buffer.read_z r |> Z.to_int64 + | Int -> fun r -> Buffer.read_z r |> Z.to_int | ZInt -> Buffer.read_z | String -> Buffer.read_str_repr | Bytes -> Buffer.read_bytes @@ -58,8 +68,10 @@ let create (type a) (mode : a input) : a t = in Lens {writer; reader} -let uint ~size = create (UInt size) -let sint = create SInt +let bool = create Bool +let fixed_size_int ~size = create (FixedSizeInt64 size) +let int64 = create Int64 +let int = create Int let zint = create ZInt let string = create String let bytes = create Bytes @@ -70,6 +82,23 @@ let conj l1 l2 = Lens { reader = (fun r -> let e1 = read l1 r in let e2 = read l2 r in e1, e2) } +let list l = + let rec writer w = function + | [] -> Buffer.write_bool w false + | elt :: tl -> + Buffer.write_bool w true; + write l w elt; + writer w tl + in + let rec reader acc r = + if Buffer.read_bool r then + let new_elt = read l r in + reader (new_elt :: acc) r + else + List.rev acc + in + Lens {writer; reader = reader []} + type 'a case = | A : { destruct : 'a -> 'b option; @@ -84,7 +113,7 @@ let disj (cases : 'a case array) : 'a t = let len = Array.length cases in Utils.numbits len in - let uint_lens = uint ~size in + let uint_lens = fixed_size_int ~size in let writer w e = let exception Stop in try @@ -122,3 +151,8 @@ let mu (lens : 'a t -> 'a t) : 'a t = in let init_lens = lens Mu in Lens {writer = writer init_lens; reader = reader init_lens} + +let trans atob btoa alens = + let writer w b = write alens w (btoa b) in + let reader r = atob (read alens r) in + Lens {writer; reader} diff --git a/src/lens.mli b/src/lens.mli index 3ef5965..034a6a5 100644 --- a/src/lens.mli +++ b/src/lens.mli @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 OcamlPro *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + (** Lenses are useful tools defining data-types encodings. Lenses provides in a single OCaml value equivalent serializes and deserializers. *) @@ -25,15 +26,32 @@ val write : 'a t -> Buffer.writer -> 'a -> unit (** Reads from a buffer. *) val read : 'a t -> Buffer.reader -> 'a +(** Builds a custom lens.*) +val make : + writer:(Buffer.writer -> 'a -> unit) + -> reader:(Buffer.reader -> 'a) + -> 'a t + (** Basic lenses *) -(** A lens for unsigned int of fixed size. *) -val uint : size:int -> int64 t +(** A lens for booleans. *) +val bool : bool t + +(** A lens for unsigned int64 of fixed size. *) +val fixed_size_int : size:int -> int64 t -(** A lens for signed integers. *) -val sint : int t +(** A lens for int64 of any size. + Encodes the size of the integer before the said integer, which is + efficient only if the integer is lower than about 2^50. *) +val int64 : int64 t -(** A lens for Zarith integers *) +(** A lens for signed integers. + Encodes the size of the integer before the said integer, which is + efficient only if the integer is lower than about 2^20. *) +val int : int t + +(** A lens for Zarith integers. + Encodes the size of the integer before the said integer. *) val zint : Z.t t (** A lens for strings. *) @@ -48,6 +66,9 @@ val fixed_size_bytes : num_bytes:int -> bytes t (** Given two lenses for two types, creates a lens for a pair of these types. *) val conj : 'a t -> 'b t -> ('a * 'b) t +(** Builds a lens for a list of elements given the lens of the said element. *) +val list : 'a t -> 'a list t + (** For creating a lens for disjunctions, we define the ['a case] type for the {!Lens.disj} function to build new lenses. *) type 'a case @@ -65,3 +86,10 @@ val disj : 'a case array -> 'a t (** Builds a self dependent lens. *) val mu : ('a t -> 'a t) -> 'a t + +(** Creates a lens from a bijection between two types. *) +val trans : + ('a -> 'b) -> + ('b -> 'a) -> + 'a t -> + 'b t diff --git a/src/utils.ml b/src/utils.ml index 05c7193..a4aa92e 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 Origin Labs *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + module Collections = struct module StringMap = Map.Make(String) diff --git a/src/utils.mli b/src/utils.mli index 7e2bfd0..096d294 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -1,14 +1,15 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2019-2022 Origin Labs *) -(* *) -(* All rights reserved. *) -(* This file is distributed under the terms of the GNU Lesser General *) -(* Public License version 2.1, with the special exception on linking *) -(* described in the LICENSE.md file in the root directory. *) -(* *) -(* *) -(**************************************************************************) +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + module Collections : sig module StringMap : Map.S with type key = string diff --git a/src/version.mlt b/src/version.mlt index 901bb4b..1cad99f 100644 --- a/src/version.mlt +++ b/src/version.mlt @@ -1,3 +1,15 @@ +(******************************************************************************) +(* *) +(* Copyright (c) 2019-2026 OCamlPro *) +(* *) +(* All rights reserved. *) +(* *) +(* This file is distributed under the terms of the GNU Lesser General Public *) +(* License version 2.1, with the special exception on linking described in *) +(* the LICENSE.md file in the root directory. *) +(* *) +(******************************************************************************) + let query cmd = let chan = Unix.open_process_in cmd in try diff --git a/test/dune b/test/dune index fc31b16..c5fe603 100644 --- a/test/dune +++ b/test/dune @@ -4,6 +4,7 @@ (name lib_expect_tests) (preprocess (pps ppx_expect)) + (modules_without_implementation sig) (inline_tests (modes best)) ; add js for testing with nodejs (libraries bitpack_serializer) ; add your project libraries here diff --git a/test/lib.ml b/test/lib.ml new file mode 100644 index 0000000..c6da84f --- /dev/null +++ b/test/lib.ml @@ -0,0 +1,43 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2023 OCamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +module Buffer = Bitpack_serializer.Buffer +module Lens = Bitpack_serializer.Lens + +type 'a config = { + lens: 'a Lens.t; + dictionary: Buffer.dictionary_config +} + +let write_read + (config : 'a config) + (elt : 'a) : 'a * int = + (* Creates a writer. *) + let writer = + Buffer.initialize_writer + ~with_dict:config.dictionary + () + in + (* Writes on the buffer. *) + let () = Lens.write config.lens writer elt in + (* Concludes the writing. *) + let buff = Buffer.finalize writer in + (* Creates a reader. *) + let reader = + Buffer.initialize_reader + ~with_dict:config.dictionary + buff + in + (* Reads the buffer. *) + let elt' = Lens.read config.lens reader in + let size = Bytes.length buff in + elt', size diff --git a/test/lib.mli b/test/lib.mli new file mode 100644 index 0000000..88a765b --- /dev/null +++ b/test/lib.mli @@ -0,0 +1,25 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2019-2022 OCamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +type 'a config = { + lens: 'a Bitpack_serializer.Lens.t; + dictionary: Bitpack_serializer.Buffer.dictionary_config +} + +(** [write_read ?eq config elt] + Serializes [elt] with the configuration parameters set in [config] + and deserializes the result. + Returns the result as well as the size of the serialization buffer. *) +val write_read : + 'a config -> + 'a -> + 'a * int diff --git a/test/sig.mli b/test/sig.mli new file mode 100644 index 0000000..1e08483 --- /dev/null +++ b/test/sig.mli @@ -0,0 +1,23 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2019-2022 OcamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +module type S = sig + val id : string + + type t + + val to_test: (t * t Lib.config) list + + val pp : Format.formatter -> t -> unit + + val eq : t -> t -> bool +end diff --git a/test/test.ml b/test/test.ml index 33dc89c..bb3570e 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1,69 +1,72 @@ -open Bitpack_serializer -open Buffer +(**************************************************************************) +(* *) +(* Copyright (c) 2019-2023 OcamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) -let write_read with_dict w r elt = - let writer = initialize_writer ~with_dict () in - let () = w writer elt in - let buff = finalize writer in - (* print_stats Format.std_formatter writer; *) - let reader = initialize_reader ~with_dict buff in - r reader, Bytes.length buff +module Buffer = Bitpack_serializer.Buffer +module Lens = Bitpack_serializer.Lens -let%expect_test "int_encoding" = - let to_encode = 3L in - let w writer elt = write writer elt 2 in - let r reader = read reader 2 in - let res, _size = write_read NoDictionary w r to_encode in +let%expect_test "maxint_encoding" = + let to_encode = max_int in + let config = Lib.{lens = Lens.int; dictionary = `NoDictionary} in + let res, _size = Lib.write_read config to_encode in Format.printf "%b" (res = to_encode); [%expect {| true |}] +let%expect_test "minint_encoding" = + let to_encode = min_int in + let config = Lib.{lens = Lens.int; dictionary = `NoDictionary} in + let res, _size = Lib.write_read config to_encode in + Format.printf "%b" (res = to_encode); + [%expect {| true |}] -type operation = - | Var of string - | Const of int - | Add of operation * operation - | Mul of operation * operation - | Sub of operation * operation +let%expect_test "uint_encoding" = + let to_encode = Int64.max_int in + let config = Lib.{lens = Lens.fixed_size_int ~size:64; dictionary = `NoDictionary} in + let res, _size = Lib.write_read config to_encode in + Format.printf "%b" (res = to_encode); + [%expect {| true |}] -let%expect_test "operation_lens" = - let open Lens in - let operation_lens = mu @@ fun self -> - disj [| - case - ~destruct:(function Var v -> Some v | _ -> None) - ~construct:(fun v -> Var v) - string; - case - ~destruct:(function Const i -> Some i | _ -> None) - ~construct:(fun i -> Const i) - sint; - case - ~destruct:(function Add (o1, o2) -> Some (o1, o2) | _ -> None) - ~construct:(fun (o1, o2) -> Add (o1, o2)) - (conj self self); - case - ~destruct:(function Mul (o1, o2) -> Some (o1, o2) | _ -> None) - ~construct:(fun (o1, o2) -> Mul (o1, o2)) - (conj self self); - case - ~destruct:(function Sub (o1, o2) -> Some (o1, o2) | _ -> None) - ~construct:(fun (o1, o2) -> Sub (o1, o2)) - (conj self self); - |] in - let v = - Add( - Add (Var "toto", Const 4), - Mul ( - Sub (Var "toto", Var "toto"), - Const 0 - ) - ) in - let res, _size = - write_read (Dictionary (Some 3)) - (Lens.write operation_lens) - (Lens.read operation_lens) - v - in - Format.printf "%b" (res = v); +let%expect_test "min_int64_encoding" = + let to_encode = Int64.min_int in + let config = Lib.{lens = Lens.fixed_size_int ~size:64; dictionary = `NoDictionary} in + let res, _size = Lib.write_read config to_encode in + Format.printf "%b" (res = to_encode); [%expect {| true |}] +let%expect_test "max_int64_encoding" = + let to_encode = Int64.max_int in + let config = Lib.{lens = Lens.fixed_size_int ~size:64; dictionary = `NoDictionary} in + let res, _size = Lib.write_read config to_encode in + Format.printf "%b" (res = to_encode); + [%expect {| true |}] + +let modules_to_test = [ + (module Test_operation : Sig.S); + (module Test_records : Sig.S); + (module Test_lists : Sig.S); +] + +let%expect_test _ = + List.iter + (fun (module To_test : Sig.S) -> + List.iter + (fun (elt, config) -> + let res, _ = Lib.write_read config elt in + if not (To_test.eq elt res) then begin + Format.printf "Error while testing %s:\n%a\n is not equal to\n%a@." + To_test.id + To_test.pp elt + To_test.pp res + end + ) + To_test.to_test + ) + modules_to_test diff --git a/test/test_lists.ml b/test/test_lists.ml new file mode 100644 index 0000000..4fed677 --- /dev/null +++ b/test/test_lists.ml @@ -0,0 +1,70 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2023 - 2026 OcamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +open Bitpack_serializer +open Buffer + +let id = "test-string-list" + +type t = string list + +let list = [ + "Alice"; + "Bob"; + "Charlie"; + "Alice"; + "David"; + "Bob"; + "Eve"; + "Alice"; + "Frank"; + "Charlie"; + "Bob"; + "Grace"; + "Heidi"; + "Eve"; + "Alice"; + "Ivan"; + "Bob"; + "Judy"; + "Charlie"; + "Alice"; +] + +let lens = + Lens.mu (fun self -> + let writer b = function + | [] -> write_bool b false + | hd :: tl -> + write_bool b true; + write_str_repr b hd; + Lens.write self b tl + and reader b = + match read_bool b with + | false -> [] + | true -> + let v = read_str_repr b in + v :: Lens.read self b + in + Lens.make ~writer ~reader) + +let to_test = + [ + list, Lib.{lens; dictionary = `NoDictionary}; + list, Lib.{lens; dictionary = `Dictionary None}; + list, Lib.{lens; dictionary = `Dictionary (Some 15)}; + ] + +let pp fmt = Format.fprintf fmt "[%a]" (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ";") Format.pp_print_string) + +let eq = List.equal String.equal + diff --git a/test/test_operation.ml b/test/test_operation.ml new file mode 100644 index 0000000..462c060 --- /dev/null +++ b/test/test_operation.ml @@ -0,0 +1,80 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2023 OcamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +let id = "test-operation" + +module Lens = Bitpack_serializer.Lens + +type t = + | Var of string + | Const of int + | Add of t * t + | Mul of t * t + | Sub of t * t + +let rec pp fmt = function + | Var v -> Format.pp_print_string fmt v + | Const i -> Format.pp_print_int fmt i + | Add (i, j) -> Format.fprintf fmt "(%a + %a)" pp i pp j + | Mul (i, j) -> Format.fprintf fmt "(%a * %a)" pp i pp j + | Sub (i, j) -> Format.fprintf fmt "(%a - %a)" pp i pp j + +let lens = Lens.( + mu @@ fun self -> + disj [| + case + ~destruct:(function Var v -> Some v | _ -> None) + ~construct:(fun v -> Var v) + string; + case + ~destruct:(function Const i -> Some i | _ -> None) + ~construct:(fun i -> Const i) + int; + case + ~destruct:(function Add (o1, o2) -> Some (o1, o2) | _ -> None) + ~construct:(fun (o1, o2) -> Add (o1, o2)) + (conj self self); + case + ~destruct:(function Mul (o1, o2) -> Some (o1, o2) | _ -> None) + ~construct:(fun (o1, o2) -> Mul (o1, o2)) + (conj self self); + case + ~destruct:(function Sub (o1, o2) -> Some (o1, o2) | _ -> None) + ~construct:(fun (o1, o2) -> Sub (o1, o2)) + (conj self self); + |] + ) + +let to_test = [ + Var "toto", + Lib.{lens; dictionary = `NoDictionary }; + + Const 2, + Lib.{lens; dictionary = `NoDictionary }; + + Add ((Var "toto"), (Const 2)), + Lib.{lens; dictionary = `NoDictionary }; + + Mul ((Var "toto"), (Add ((Const 2), (Var "foo")))), + Lib.{lens; dictionary = `NoDictionary }; + + Add( + Add (Var "foo", Const 4), + Mul ( + Sub (Var "foo", Var "foo"), + Const 0 + ) + ), + Lib.{lens; dictionary = `Dictionary (Some 1) }; +] + +let eq = (=) diff --git a/test/test_operation.mli b/test/test_operation.mli new file mode 100644 index 0000000..da47297 --- /dev/null +++ b/test/test_operation.mli @@ -0,0 +1,13 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2019-2023 OcamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +include Sig.S diff --git a/test/test_records.ml b/test/test_records.ml new file mode 100644 index 0000000..e412787 --- /dev/null +++ b/test/test_records.ml @@ -0,0 +1,67 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2023 OcamlPro *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +let id = "test-operation" + +module Lens = Bitpack_serializer.Lens + +(* Simulates a simple HTML component. *) +type t = { + name: string; + id: string; + cls: string list; + children: t list; +} + +let rec pp fmt {name; id; cls; children} = + Format.fprintf fmt + "<%s id='%s' class='%a'>%a" + name + id + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt ",") + Format.pp_print_string) + cls + (Format.pp_print_list pp) + children + name + +let eq = (=) + +let make name ~cls ~id children = {name; cls; id; children} +let div = make "div" +let p = make "p" +let span = make "span" + +let to_tup t = (t.name, t.id), (t.cls, t.children) +let of_tup ((name, id), (cls, children)) = make name ~cls ~id children + +let lens = Lens.( + mu (fun self -> + trans + of_tup + to_tup + (conj + (conj string string) + (conj (list string) (list self)) + ) + )) + +let to_test = [ + div ~cls:["main-class"; "bordered"] ~id:"main-div" [ + p ~cls:["editable"] ~id:"p1" []; + span ~cls:["red-text"; "foo"; "bordered"] ~id:"s1" []; + p ~cls:["non-editable"; "bordered"; "foo"; "main-class"] ~id:"p2" []; + ] + , + Lib.{lens; dictionary = `NoDictionary}; +]