Faster OCaml I/O

Version:1.5.0

Version:1.5.0
This commit is contained in:
Anthony Scemama 2019-08-21 17:50:17 +02:00
parent 0f4a79c240
commit baa47ab0a9
3 changed files with 104 additions and 153 deletions

View File

@ -56,6 +56,12 @@ def main():
elif command.startswith('set'): elif command.startswith('set'):
text = sys.stdin.read() text = sys.stdin.read()
true = True
false = False
TRUE = True
FALSE = False
T = True
F = False
try: try:
data = eval(text) data = eval(text)
except NameError: except NameError:

View File

@ -31,14 +31,14 @@ Exceptions
========== ==========
*) *)
exception Read_only of string;; exception Read_only of string
(* (*
State variables State variables
=============== ===============
*) *)
let read_only = ref false;; let read_only = ref false
let ezfio_filename = ref "EZFIO_File";; let ezfio_filename = ref "EZFIO_File"
(* (*
Helper functions Helper functions
@ -47,23 +47,23 @@ Helper functions
let check_readonly = let check_readonly =
if !read_only then if !read_only then
raise (Read_only "Read only attribute is set"); raise (Read_only "Read only attribute is set")
;;
let exists path = let exists path =
let filename = path^"/.version" in let filename = Filename.concat path ".version" in
Sys.file_exists filename Sys.file_exists filename
;;
let has group name = let has group name =
let dirname = !ezfio_filename ^ "/" ^ group in let dirname = Filename.concat !ezfio_filename group in
if (exists dirname) then if (exists dirname) then
(Sys.file_exists (dirname ^ "/" ^ name) ) Sys.file_exists @@ Filename.concat dirname name
else else
false false
;;
let has_array group name = has group (name^".gz");;
let has_array group name = has group (name^".gz")
let mkdir path = let mkdir path =
check_readonly; check_readonly;
@ -72,75 +72,35 @@ let mkdir path =
Unix.mkdir path 0o777; Unix.mkdir path 0o777;
let out_channel = open_out (path^"/.version") in let out_channel = open_out (path^"/.version") in
Printf.fprintf out_channel "%s\n" version ; Printf.fprintf out_channel "%s\n" version ;
close_out out_channel; close_out out_channel
;;
let create_group group = let create_group group =
let dirname = !ezfio_filename ^ "/" ^ group in let dirname = Filename.concat !ezfio_filename group in
if not (exists dirname) then if not (exists dirname) then
mkdir dirname; mkdir dirname
;;
let split line s =
let rec do_work lst word = function
| 0 -> word::lst
| i ->
begin
match line.[i-1] with
| a when a == s ->
if word <> "" then
do_work (word::lst) "" (i-1)
else
do_work lst "" (i-1)
| a -> do_work lst ( (Char.escaped a)^word) (i-1)
end
in do_work [] "" (String.length line)
;;
let ltrim s =
let rec do_work s l =
match s.[0] with
| '\n'
| ' ' -> do_work (String.sub s 1 (l-1)) (l-1)
| _ -> s
in
let l = String.length s in
if (l > 0) then do_work s l
else s
;;
let rtrim s =
let rec do_work s l =
let newl = l-1 in
match s.[newl] with
| '\n'
| ' ' -> do_work (String.sub s 0 (newl)) (newl)
| _ -> s
in
let l = String.length s in
if (l > 0) then do_work s l
else s
;;
let trim s = ltrim (rtrim s) ;;
let maxval l = let maxval l =
match l with match l with
| [] -> None | [] -> None
| [a] -> Some a | [a] -> Some a
| hd::tail -> Some (List.fold_left max hd tail) | hd::tail -> Some (List.fold_left max hd tail)
;;
let minval l = let minval l =
match l with match l with
| [] -> None | [] -> None
| [a] -> Some a | [a] -> Some a
| hd::tail -> Some (List.fold_left min hd tail) | hd::tail -> Some (List.fold_left min hd tail)
;;
let at arr idx = arr.(idx);;
let size (_) = 0;; let at arr idx = arr.(idx)
(*
let size (_) = 0
*)
let n_count_ch (str,_,v) = let n_count_ch (str,_,v) =
let rec do_work accu = function let rec do_work accu = function
@ -151,7 +111,7 @@ let n_count_ch (str,_,v) =
else accu else accu
in do_work newaccu (i-1) in do_work newaccu (i-1)
in do_work 0 (String.length str) in do_work 0 (String.length str)
;;
let n_count (l,_,v) = let n_count (l,_,v) =
let rec do_work accu = function let rec do_work accu = function
@ -162,7 +122,7 @@ let n_count (l,_,v) =
else accu else accu
in do_work newaccu tail in do_work newaccu tail
in do_work 0 l in do_work 0 l
;;
(* (*
Scalars Scalars
@ -175,32 +135,32 @@ Read
*) *)
let read_scalar type_conversion group name = let read_scalar type_conversion group name =
let in_filename = !ezfio_filename ^ "/" ^ group ^ "/" ^ name in let in_filename = Filename.concat !ezfio_filename @@ Filename.concat group name in
let in_channel = open_in in_filename in let in_channel = open_in in_filename in
let trimmed_line = trim (input_line in_channel) in let trimmed_line = String.trim (input_line in_channel) in
let result = type_conversion trimmed_line in let result = type_conversion trimmed_line in
begin begin
close_in in_channel ; close_in in_channel ;
result result
end end
;;
let fortran_bool_of_string = function let fortran_bool_of_string = function
| "T" | "t" -> true | "T" | "t" -> true
| "F" | "f" -> false | "F" | "f" -> false
| x -> raise (Failure ("fortran_bool_of_string should be T or F: "^x)) | x -> raise (Failure ("fortran_bool_of_string should be T or F: "^x))
;;
let fortran_string_of_bool = function let fortran_string_of_bool = function
| true -> "T\n" | true -> "T\n"
| false-> "F\n" | false-> "F\n"
;;
let read_int = read_scalar int_of_string ;;
let read_int64 = read_scalar Int64.of_string ;; let read_int = read_scalar int_of_string
let read_float = read_scalar float_of_string ;; let read_int64 = read_scalar Int64.of_string
let read_string= read_scalar (fun (x:string) -> x);; let read_float = read_scalar float_of_string
let read_bool = read_scalar fortran_bool_of_string;; let read_string= read_scalar (fun (x:string) -> x)
let read_bool = read_scalar fortran_bool_of_string
(* (*
Write Write
@ -208,28 +168,28 @@ Write
*) *)
let print_int out_channel i = Printf.fprintf out_channel "%20d\n" i let print_int out_channel i = Printf.fprintf out_channel "%20d\n" i
and print_int64 out_channel i = Printf.fprintf out_channel "%20Ld\n" i let print_int64 out_channel i = Printf.fprintf out_channel "%20Ld\n" i
and print_float out_channel f = Printf.fprintf out_channel "%24.15e\n" f let print_float out_channel f = Printf.fprintf out_channel "%24.15e\n" f
and print_string out_channel s = Printf.fprintf out_channel "%s\n" s let print_string out_channel s = Printf.fprintf out_channel "%s\n" s
and print_bool out_channel b = Printf.fprintf out_channel "%s\n" (fortran_string_of_bool b);; let print_bool out_channel b = Printf.fprintf out_channel "%s\n" (fortran_string_of_bool b)
let write_scalar print_fun group name s = let write_scalar print_fun group name s =
check_readonly; check_readonly;
create_group group; create_group group;
let out_filename = !ezfio_filename ^ "/" ^ group ^ "/" ^ name in let out_filename = Filename.concat !ezfio_filename @@ Filename.concat group name in
let out_channel = open_out out_filename in let out_channel = open_out out_filename in
begin begin
print_fun out_channel s; print_fun out_channel s;
close_out out_channel; close_out out_channel
end end
;;
let write_int = write_scalar print_int let write_int = write_scalar print_int
and write_int64 = write_scalar print_int64 let write_int64 = write_scalar print_int64
and write_float = write_scalar print_float let write_float = write_scalar print_float
and write_bool = write_scalar print_bool let write_bool = write_scalar print_bool
and write_string = write_scalar print_string let write_string = write_scalar print_string
;;
@ -241,7 +201,7 @@ Arrays
type 'a ezfio_data = type 'a ezfio_data =
| Ezfio_item of 'a array | Ezfio_item of 'a array
| Ezfio_data of ('a ezfio_data) array | Ezfio_data of ('a ezfio_data) array
;;
type 'a ezfio_array = type 'a ezfio_array =
@ -249,7 +209,7 @@ type 'a ezfio_array =
dim : int array; dim : int array;
data : 'a ezfio_data ; data : 'a ezfio_data ;
} }
;;
let ezfio_array_of_list ~rank ~dim ~data = let ezfio_array_of_list ~rank ~dim ~data =
assert (rank > 0); assert (rank > 0);
@ -284,7 +244,7 @@ let ezfio_array_of_list ~rank ~dim ~data =
dim= dim; dim= dim;
data=result; data=result;
} }
;;
let ezfio_get_element { rank=r ; dim=d ; data=data } coord = let ezfio_get_element { rank=r ; dim=d ; data=data } coord =
@ -303,7 +263,7 @@ let ezfio_get_element { rank=r ; dim=d ; data=data } coord =
| [] -> raise (Failure "Error in ezfio_get_element") | [] -> raise (Failure "Error in ezfio_get_element")
in in
do_work data coord do_work data coord
;;
let flattened_ezfio { rank ; dim ; data } = let flattened_ezfio { rank ; dim ; data } =
@ -327,9 +287,9 @@ let flattened_ezfio { rank ; dim ; data } =
in in
match data with match data with
| Ezfio_item d -> d | Ezfio_item d -> d
| Ezfio_data d -> flatten_n rank d | Ezfio_data d -> flatten_n rank d
;;
(* (*
@ -337,48 +297,36 @@ Read
---- ----
*) *)
let unzipped_filename filename =
if not (Sys.file_exists filename) then
raise (Failure ("file "^filename^" doesn't exist"));
let uz_filename = Filename.temp_file "" ".tmp" ~temp_dir:(Sys.getcwd ()) in
let command = "zcat "^filename^" > "^uz_filename
in
if (Sys.command command) == 0 then
uz_filename
else
begin
Sys.remove uz_filename ;
raise (Failure ("Unable to execute :\n"^command))
end
;;
let read_rank in_channel = let read_rank in_channel =
let trimmed_line = trim (input_line in_channel) in let trimmed_line = String.trim (input_line in_channel) in
int_of_string trimmed_line int_of_string trimmed_line
;;
let read_dimensions in_channel = let read_dimensions in_channel =
let trimmed_line = trim (input_line in_channel) in let line = input_line in_channel in
let list_of_str = split trimmed_line ' ' in let arr_of_str =
Array.of_list (List.map int_of_string list_of_str) String.split_on_char ' ' line
;; |> List.filter (fun x -> x <> "")
|> Array.of_list
in
Array.map int_of_string arr_of_str
let read_array type_conversion group name : 'a ezfio_array = let read_array type_conversion group name : 'a ezfio_array =
let in_filename = !ezfio_filename ^ "/" ^ group ^ "/" ^ name ^ ".gz" in let in_filename = (Filename.concat !ezfio_filename @@ Filename.concat group name) ^ ".gz" in
let uz_filename = unzipped_filename in_filename in let in_channel = Unix.open_process_in ("zcat "^in_filename) in
let in_channel = open_in uz_filename in
(* Read rank *) (* Read rank *)
let rank = read_rank in_channel let rank = read_rank in_channel
(* Read dimensions *) (* Read dimensions *)
and dimensions = read_dimensions in_channel and dimensions = read_dimensions in_channel
in in
begin begin
assert (rank == Array.length dimensions) ; assert (rank == Array.length dimensions) ;
(* Read one-dimensional arrays *) (* Read one-dimensional arrays *)
let read_1d nmax = let read_1d nmax =
Ezfio_item (Array.init nmax (fun i-> Ezfio_item (Array.init nmax (fun i->
let buffer = trim (input_line in_channel) in let buffer = String.trim (input_line in_channel) in
try type_conversion buffer with try type_conversion buffer with
| Failure s -> failwith (s^": "^buffer))) | Failure s -> failwith (s^": "^buffer)))
in in
@ -389,30 +337,30 @@ let read_array type_conversion group name : 'a ezfio_array =
| m -> | m ->
let rec do_work accu = function let rec do_work accu = function
| 0 -> Array.of_list (List.rev accu) | 0 -> Array.of_list (List.rev accu)
| n -> | n ->
let newlist = read_nd (m-1) in let newlist = read_nd (m-1) in
do_work (newlist::accu) (n-1) do_work (newlist::accu) (n-1)
in in
Ezfio_data (do_work [] dimensions.(m-1)) Ezfio_data (do_work [] dimensions.(m-1))
in in
let result = { let result = {
rank = rank ; rank = rank ;
dim = dimensions ; dim = dimensions ;
data = read_nd rank ; data = read_nd rank ;
} }
in in
close_in in_channel ; match Unix.close_process_in in_channel with
Sys.remove uz_filename ; | Unix.WEXITED _ -> result
result; | _ -> failwith ("Failed in reading compressed file "^in_filename)
end end
;;
let read_int_array = read_array int_of_string let read_int_array = read_array int_of_string
and read_int64_array = read_array Int64.of_string let read_int64_array = read_array Int64.of_string
and read_float_array = read_array float_of_string let read_float_array = read_array float_of_string
and read_bool_array = read_array fortran_bool_of_string let read_bool_array = read_array fortran_bool_of_string
and read_string_array = read_array (fun (x:string) -> x) let read_string_array = read_array (fun (x:string) -> x)
;;
(* (*
Write Write
@ -422,32 +370,29 @@ Write
let write_array print_fun group name a = let write_array print_fun group name a =
check_readonly; check_readonly;
create_group group; create_group group;
let out_filename = !ezfio_filename ^ "/" ^ group ^ "/" ^ name ^".gz" in let out_filename = (Filename.concat !ezfio_filename @@ Filename.concat group name)^".gz" in
let uz_filename = Filename.temp_file "" ".tmp" ~temp_dir:(Sys.getcwd ()) in let command = "gzip > "^out_filename in
let out_channel = open_out uz_filename in let out_channel = Unix.open_process_out command in
let { rank=rank ; dim=dimensions ; data=data } = a in let { rank=rank ; dim=dimensions ; data=data } = a in
let data = flattened_ezfio a let data = flattened_ezfio a in
in begin
begin
(* Write rank *) (* Write rank *)
Printf.fprintf out_channel "%3d\n" rank; Printf.fprintf out_channel "%3d\n" rank;
(* Write dimensions *) (* Write dimensions *)
Array.iter (Printf.fprintf out_channel "%20d ") dimensions; Array.iter (Printf.fprintf out_channel "%20d ") dimensions;
Printf.fprintf out_channel "\n"; Printf.fprintf out_channel "\n%!";
Array.iter (print_fun out_channel) data; Array.iter (print_fun out_channel) data;
close_out out_channel ; match Unix.close_process_out out_channel with
let command = "gzip -c < "^uz_filename^" > "^out_filename | Unix.WEXITED _ -> ()
in | _ -> failwith ("Failed writing compressed file "^out_filename)
if (Sys.command command == 0) then (Sys.remove uz_filename )
else raise (Failure ("command failed:\n"^command))
end end
;;
let write_int_array = write_array print_int let write_int_array = write_array print_int
and write_int64_array = write_array print_int64 let write_int64_array = write_array print_int64
and write_float_array = write_array print_float let write_float_array = write_array print_float
and write_string_array = write_array print_string let write_string_array = write_array print_string
and write_bool_array = write_array print_bool;; let write_bool_array = write_array print_bool
(* (*
Library routines Library routines
@ -457,7 +402,7 @@ let set_file filename =
if not (exists filename) then if not (exists filename) then
begin begin
mkdir filename; mkdir filename;
mkdir (filename^"/ezfio"); mkdir (Filename.concat filename "ezfio");
let command = Printf.sprintf " let command = Printf.sprintf "
LANG= date > %s/ezfio/creation LANG= date > %s/ezfio/creation
echo $USER > %s/ezfio/user echo $USER > %s/ezfio/user
@ -467,7 +412,7 @@ let set_file filename =
raise (Failure ("Unable to create new ezfio file:\n"^filename)) raise (Failure ("Unable to create new ezfio file:\n"^filename))
end ; end ;
ezfio_filename := filename ezfio_filename := filename
;;
(*$TAIL*) (*$TAIL*)

View File

@ -1 +1 @@
VERSION=1.4.1 VERSION=1.5.0