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'):
text = sys.stdin.read()
true = True
false = False
TRUE = True
FALSE = False
T = True
F = False
try:
data = eval(text)
except NameError:

View File

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

View File

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