Source file vlq64.ml

(* Js_of_ocaml compiler
 * http://www.ocsigen.org/js_of_ocaml/
 * Copyright (C) 2013 Hugo Heuzard
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)

open! Stdlib

let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

let code_rev =
  let a = Array.make 256 (-1) in
  for i = 0 to String.length alphabet - 1 do
    a.(Char.code alphabet.[i]) <- i
  done;
  a

let in_alphabet x = code_rev.(Char.code x) <> -1

let vlq_base_shift = 5

(* binary: 100000 *)
let vlq_base = 1 lsl vlq_base_shift

(* binary: 011111 *)
let vlq_base_mask = vlq_base - 1

(* binary: 100000 *)
let vlq_continuation_bit = vlq_base

let toVLQSigned v = if v < 0 then (-v lsl 1) + 1 else v lsl 1

(* assert (toVLQSigned 1 = 2); *)
(* assert (toVLQSigned 2 = 4); *)
(* assert (toVLQSigned (-1) = 3); *)
(* assert (toVLQSigned (-2) = 5);; *)

let fromVLQSigned v =
  let is_neg = v land 1 = 1 in
  let shift = v lsr 1 in
  if is_neg then -shift else shift

(* assert (fromVLQSigned 2 = 1); *)
(* assert (fromVLQSigned 4 = 2); *)
(* assert (fromVLQSigned 3 = -1); *)
(* assert (fromVLQSigned 5 = -2);; *)

let add_char buf x = Buffer.add_char buf alphabet.[x]

let rec encode' buf x =
  let digit = x land vlq_base_mask in
  let rest = x lsr vlq_base_shift in
  if rest = 0
  then add_char buf digit
  else (
    add_char buf (digit lor vlq_continuation_bit);
    encode' buf rest)

let encode b x =
  let vql = toVLQSigned x in
  encode' b vql

let encode_l b l = List.iter ~f:(encode b) l

let rec decode' acc s start pos =
  let digit = code_rev.(Char.code s.[pos]) in
  if digit = -1 then invalid_arg "Vql64.decode'";
  let cont = digit land vlq_continuation_bit = vlq_continuation_bit in
  let digit = digit land vlq_base_mask in
  let acc = acc + (digit lsl ((pos - start) * vlq_base_shift)) in
  if cont then decode' acc s start (succ pos) else acc, succ pos

let decode s p =
  let d, i = decode' 0 s p p in
  fromVLQSigned d, i

let decode_l s ~pos ~len =
  let rec aux pos acc len =
    if len = 0
    then List.rev acc
    else if len < 0
    then invalid_arg "Vlq64.decode_l"
    else
      let d, i = decode s pos in
      let len = len - (i - pos) in
      aux i (d :: acc) len
  in
  aux pos [] len

type input =
  { string : string
  ; mutable pos : int
  ; len : int
  }

let rec decode' src s pos len offset i =
  if pos = len then invalid_arg "Vql64.decode'";
  let digit = Array.unsafe_get code_rev (Char.code s.[pos]) in
  if digit = -1 then invalid_arg "Vql64.decode'";
  let i = i + ((digit land vlq_base_mask) lsl offset) in
  if digit >= vlq_continuation_bit
  then decode' src s (pos + 1) len (offset + vlq_base_shift) i
  else (
    src.pos <- pos + 1;
    i)

let decode src = fromVLQSigned (decode' src src.string src.pos src.len 0 0)