Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update for extlib 1.7.8 breaking change #10086

Merged
merged 2 commits into from
Jan 22, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
130 changes: 130 additions & 0 deletions libs/extlib-leftovers/base64.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,130 @@
(*
* Base64 - Base64 codec
* Copyright (C) 2003 Nicolas Cannasse
*
* This library 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; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library 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 library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)

open ExtBytes

exception Invalid_char
exception Invalid_table

external unsafe_char_of_int : int -> char = "%identity"

type encoding_table = char array
type decoding_table = int array

let chars = [|
'A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P';
'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z';'a';'b';'c';'d';'e';'f';
'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v';
'w';'x';'y';'z';'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'+';'/'
|]

let make_decoding_table tbl =
if Array.length tbl <> 64 then raise Invalid_table;
let d = Array.make 256 (-1) in
for i = 0 to 63 do
Array.unsafe_set d (int_of_char (Array.unsafe_get tbl i)) i;
done;
d

let inv_chars = make_decoding_table chars

let encode ?(tbl=chars) ch =
if Array.length tbl <> 64 then raise Invalid_table;
let data = ref 0 in
let count = ref 0 in
let flush() =
if !count > 0 then begin
let d = (!data lsl (6 - !count)) land 63 in
IO.write ch (Array.unsafe_get tbl d);
end;
in
let write c =
let c = int_of_char c in
data := (!data lsl 8) lor c;
count := !count + 8;
while !count >= 6 do
count := !count - 6;
let d = (!data asr !count) land 63 in
IO.write ch (Array.unsafe_get tbl d)
done;
in
let output s p l =
for i = p to p + l - 1 do
write (Bytes.unsafe_get s i)
done;
l
in
IO.create_out ~write ~output
~flush:(fun () -> flush(); IO.flush ch)
~close:(fun() -> flush(); IO.close_out ch)

let decode ?(tbl=inv_chars) ch =
if Array.length tbl <> 256 then raise Invalid_table;
let data = ref 0 in
let count = ref 0 in
let rec fetch() =
if !count >= 8 then begin
count := !count - 8;
let d = (!data asr !count) land 0xFF in
unsafe_char_of_int d
end else
let c = int_of_char (IO.read ch) in
let c = Array.unsafe_get tbl c in
if c = -1 then raise Invalid_char;
data := (!data lsl 6) lor c;
count := !count + 6;
fetch()
in
let read = fetch in
let input s p l =
let i = ref 0 in
try
while !i < l do
Bytes.unsafe_set s (p + !i) (fetch());
incr i;
done;
l
with
IO.No_more_input when !i > 0 ->
!i
in
let close() =
count := 0;
IO.close_in ch
in
IO.create_in ~read ~input ~close

let str_encode ?(tbl=chars) s =
let ch = encode ~tbl (IO.output_bytes()) in
IO.nwrite_string ch s;
IO.close_out ch

let str_decode ?(tbl=inv_chars) s =
let ch = decode ~tbl (IO.input_bytes s) in
IO.nread_string ch ((Bytes.length s * 6) / 8)

let encode_string ?(tbl=chars) s =
let ch = encode ~tbl (IO.output_string ()) in
IO.nwrite_string ch s;
IO.close_out ch

let decode_string ?(tbl=inv_chars) s =
let ch = decode ~tbl (IO.input_string s) in
IO.nread_string ch ((String.length s * 6) / 8)
65 changes: 65 additions & 0 deletions libs/extlib-leftovers/base64.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,65 @@
(*
* Base64 - Base64 codec
* Copyright (C) 2003 Nicolas Cannasse
*
* This library 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; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library 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 library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)

(** Base64 codec.

8-bit characters are encoded into 6-bit ones using ASCII lookup tables.
Default tables maps 0..63 values on characters A-Z, a-z, 0-9, '+' and '/'
(in that order).
*)

open ExtBytes

(** This exception is raised when reading an invalid character
from a base64 input. *)
exception Invalid_char

(** This exception is raised if the encoding or decoding table
size is not correct. *)
exception Invalid_table

(** An encoding table maps integers 0..63 to the corresponding char. *)
type encoding_table = char array

(** A decoding table maps chars 0..255 to the corresponding 0..63 value
or -1 if the char is not accepted. *)
type decoding_table = int array

(** erroneous interface, kept for compatibility use [encode_string] instead *)
val str_encode : ?tbl:encoding_table -> string -> Bytes.t

(** erroneous interface, kept for compatibility use [decode_string] instead *)
val str_decode : ?tbl:decoding_table -> Bytes.t -> string

(** Encode a string into Base64. *)
val encode_string : ?tbl:encoding_table -> string -> string

(** Decode a string encoded into Base64, raise [Invalid_char] if a
character in the input string is not a valid one. *)
val decode_string : ?tbl:decoding_table -> string -> string

(** Generic base64 encoding over an output. *)
val encode : ?tbl:encoding_table -> 'a IO.output -> 'a IO.output

(** Generic base64 decoding over an input. *)
val decode : ?tbl:decoding_table -> IO.input -> IO.input

(** Create a valid decoding table from an encoding one. *)
val make_decoding_table : encoding_table -> decoding_table
1 change: 1 addition & 0 deletions src/codegen/codegen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ open Type
open Common
open Error
open Globals
open Extlib_leftovers

(* -------------------------------------------------------------------------- *)
(* TOOLS *)
Expand Down
2 changes: 1 addition & 1 deletion src/context/common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1102,7 +1102,7 @@ let get_entry_point com =
let c =
match m.m_statics with
| Some c when (PMap.mem "main" c.cl_statics) -> c
| _ -> ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types
| _ -> Option.get (ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types)
in
let e = Option.get com.main in (* must be present at this point *)
(snd path, c, e)
Expand Down
3 changes: 2 additions & 1 deletion src/macro/eval/evalMain.ml
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ open EvalHash
open EvalEncode
open EvalField
open MacroApi
open Extlib_leftovers
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this required?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, for Base64


(* Create *)

Expand Down Expand Up @@ -585,4 +586,4 @@ let get_api_call_pos () =
| None -> env
| Some env -> env
in
{ pfile = rev_hash env.env_info.pfile; pmin = env.env_leave_pmin; pmax = env.env_leave_pmax }
{ pfile = rev_hash env.env_info.pfile; pmin = env.env_leave_pmin; pmax = env.env_leave_pmax }
4 changes: 2 additions & 2 deletions src/optimization/inline.ml
Original file line number Diff line number Diff line change
Expand Up @@ -114,10 +114,10 @@ let api_inline ctx c field params p =
let mk_typeexpr path =
let m = (try Hashtbl.find ctx.g.modules path with Not_found -> die "" __LOC__) in
add_dependency ctx.m.curmod m;
ExtList.List.find_map (function
Option.get (ExtList.List.find_map (function
| TClassDecl cl when cl.cl_path = path -> Some (make_static_this cl p)
| _ -> None
) m.m_types
) m.m_types)
in

let eJsSyntax () = mk_typeexpr (["js"],"Syntax") in
Expand Down