10
1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-06-13 16:55:17 +02:00

Implemented to_bytes in OCaml

This commit is contained in:
Anthony Scemama 2022-01-06 17:43:31 +01:00
parent 6fe10712d0
commit 5b1379fd9c
6 changed files with 138 additions and 69 deletions

View File

@ -1,6 +1,6 @@
open Qptypes
type t =
type t =
{ property : Property.t ;
value : Sample.t ;
weight : Weight.t ;
@ -12,7 +12,7 @@ type t =
let re =
Str.regexp "[ |#|\n]+"
let of_string s =
let of_string s =
try
let lst =
@ -23,24 +23,24 @@ let of_string s =
| b :: pid :: c:: p :: w :: v :: [] -> Some
{ property = Property.of_string p ;
value = Sample.of_float (float_of_string v) ;
weight = Weight.of_float (float_of_string w) ;
weight = Weight.of_float (float_of_string w) ;
compute_node = Compute_node.of_string c;
pid = int_of_string pid;
block_id = Block_id.of_int (int_of_string b) ;
}
| b :: pid :: c:: p :: w :: v ->
let v =
| b :: pid :: c:: p :: w :: v ->
let v =
List.rev v
|> Array.of_list
|> Array.of_list
|> Array.map float_of_string
in
let dim =
let dim =
Array.length v
in
Some
{ property = Property.of_string p ;
value = Sample.of_float_array ~dim v ;
weight = Weight.of_float (float_of_string w) ;
weight = Weight.of_float (float_of_string w) ;
compute_node = Compute_node.of_string c;
pid = int_of_string pid;
block_id = Block_id.of_int (int_of_string b) ;
@ -50,7 +50,34 @@ let of_string s =
| _ -> None
let zero =
bytes_of_int 0
let to_bytes b =
(* [ Length of b
[ Length of value ;
Value ;
Length of weight ;
Weight ;
... ] ] *)
let l =
[ Property.to_bytes b.property ;
Sample.to_bytes b.value ;
Weight.to_bytes b.weight ;
bytes_of_int b.pid ;
Block_id.to_bytes b.block_id ;
Compute_node.to_bytes b.compute_node ]
|> List.map (fun x -> [ bytes_of_int (Bytes.length x) ; x ] )
|> List.concat
in
let result =
Bytes.concat Bytes.empty (zero :: l)
in
Bytes.set_int64_le result 8 (Int64.of_int (Bytes.length result));
result
let to_string b =
Printf.sprintf "%s %s # %s %s %s %d"
(Sample.to_string b.value )
@ -60,10 +87,14 @@ let to_string b =
(string_of_int b.pid)
(Block_id.to_int b.block_id)
(*
let of_string s =
Bytes.of_string s
|> of_bytes
*)
let dir_name = lazy(
let ezfio_filename =
let ezfio_filename =
Lazy.force Qputils.ezfio_filename
in
let md5 =
@ -72,8 +103,8 @@ let dir_name = lazy(
let d = Filename.concat ezfio_filename "blocks" in
if not ( Sys.file_exists d ) then
Unix.mkdir d 0o755;
List.fold_right Filename.concat
[ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ] ""
List.fold_right Filename.concat
[ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ] ""
)
@ -84,11 +115,11 @@ let _raw_data =
let update_raw_data ?(locked=true) () =
(* Create array of files to read *)
let dir_name =
let dir_name =
Lazy.force dir_name
in
let files =
let result =
let files =
let result =
if Sys.file_exists dir_name && Sys.is_directory dir_name then
begin
Sys.readdir dir_name
@ -102,7 +133,7 @@ let update_raw_data ?(locked=true) () =
else
List.filter (fun x ->
try
let _ =
let _ =
Str.search_backward (Str.regexp "locked") x ((String.length x) - 1)
in false
with
@ -110,7 +141,7 @@ let update_raw_data ?(locked=true) () =
) result
in
let rec transform new_list = function
let rec transform new_list = function
| [] -> new_list
| head :: tail ->
let head = String.trim head in
@ -137,16 +168,16 @@ let update_raw_data ?(locked=true) () =
let result = aux ic [] in
close_in ic;
result ) files
|> transform []
|> transform []
in
result
let raw_data ?(locked=true) () =
let raw_data ?(locked=true) () =
match !_raw_data with
| Some x -> x
| None ->
let result =
let result =
update_raw_data ~locked ()
in
_raw_data := Some result;
@ -156,7 +187,7 @@ let raw_data ?(locked=true) () =
let properties = lazy (
let h = Hashtbl.create 63 in
List.iter (fun x ->
List.iter (fun x ->
Hashtbl.replace h (Property.to_string x.property) x.property)
(raw_data ());
Hashtbl.fold (fun k v a -> v :: a) h []

View File

@ -11,7 +11,7 @@ type t =
| Error of string
let create m =
let create m =
try
match m with
| [ "cpu" ; c ; pid ; b ; "1" ; v ] ->
@ -23,7 +23,7 @@ let create m =
compute_node = Compute_node.of_string c;
pid = int_of_string pid;
block_id = Block_id.of_int (int_of_string b);
}
}
| [ "accep" ; c ; pid ; b ; "1" ; v ] ->
let open Block in
Property
@ -33,8 +33,8 @@ let create m =
compute_node = Compute_node.of_string c;
pid = int_of_string pid;
block_id = Block_id.of_int (int_of_string b);
}
| [ prop ; c ; pid ; b ; w ; v ] ->
}
| [ prop ; c ; pid ; b ; w ; v ] ->
let open Block in
Property
{ property = Property.of_string prop;
@ -43,19 +43,19 @@ let create m =
compute_node = Compute_node.of_string c;
pid = int_of_string pid;
block_id = Block_id.of_int (int_of_string b);
}
}
| "elec_coord" :: c :: pid :: _ :: n ::walkers ->
begin
let elec_num =
Lazy.force Qputils.elec_num
and n =
and n =
int_of_string n
in
assert (n = List.length walkers);
let rec build_walker accu = function
| (0,tail) ->
let result =
List.rev accu
| (0,tail) ->
let result =
List.rev accu
|> List.rev_map float_of_string
|> List.rev
|> Array.of_list
@ -65,10 +65,10 @@ let create m =
build_walker (head::accu) (n-1, tail)
| _ -> failwith "Bad walkers"
in
let rec build accu = function
let rec build accu = function
| [] -> Array.of_list accu
| w ->
let (result, tail) =
| w ->
let (result, tail) =
build_walker [] (3*elec_num+3, w)
in
build (result::accu) tail
@ -80,13 +80,13 @@ let create m =
| [ "unregister" ; c ; pid ] -> Unregister (Compute_node.of_string c, int_of_string pid)
| [ "Test" ] -> Test
| [ "Ezfio" ; ezfio_msg ] -> Ezfio ezfio_msg
| prop :: c :: pid :: b :: d :: w :: l ->
| prop :: c :: pid :: b :: d :: w :: l ->
let property =
Property.of_string prop
in
begin
assert (not (Property.is_scalar property));
let a =
let a =
Array.of_list l
|> Array.map float_of_string
and dim =
@ -101,7 +101,7 @@ let create m =
compute_node = Compute_node.of_string c;
pid = int_of_string pid;
block_id = Block_id.of_int (int_of_string b);
}
}
end
| l -> Error (String.concat ":" l)
with
@ -114,9 +114,9 @@ let to_string = function
| Walkers (h,p,w) -> Printf.sprintf "Walkers : %s %d : %d walkers"
(Compute_node.to_string h) p (Array.length w)
| GetWalkers n -> Printf.sprintf "GetWalkers %d" (Strictly_positive_int.to_int n)
| Register (h,p) -> Printf.sprintf "Register : %s %d"
| Register (h,p) -> Printf.sprintf "Register : %s %d"
(Compute_node.to_string h) p
| Unregister (h,p) -> Printf.sprintf "Unregister : %s %d"
| Unregister (h,p) -> Printf.sprintf "Unregister : %s %d"
(Compute_node.to_string h) p
| Test -> "Test"
| Ezfio msg -> "Ezfio "^msg

View File

@ -1,6 +1,6 @@
open Sexplib.Std
type t =
type t =
| One_dimensional of float
| Multidimensional of (float array * int)
[@@deriving sexp]
@ -9,27 +9,27 @@ let dimension = function
| One_dimensional _ -> 1
| Multidimensional (_,d) -> d
let to_float ?idx x =
let to_float ?idx x =
match (idx,x) with
| None , One_dimensional x
| Some 0, One_dimensional x -> x
| Some 0, One_dimensional x -> x
| Some i, One_dimensional x ->
failwith "Index should not be specified in One_dimensional"
| None , Multidimensional (x,_) -> x.(0)
| Some i, Multidimensional (x,s) when i < s -> x.(i)
| Some i, Multidimensional (x,s) ->
Printf.sprintf "Index out of bounds in Multidimensional
| Some i, Multidimensional (x,s) ->
Printf.sprintf "Index out of bounds in Multidimensional
%d not in [0,%d[ " i s
|> failwith
let to_float_array = function
let to_float_array = function
| One_dimensional _ -> failwith "Should be Multidimensional"
| Multidimensional (x,_) -> x
let of_float x =
let of_float x =
One_dimensional x
let of_float_array ~dim x =
let of_float_array ~dim x =
if (Array.length x) <> dim then
failwith "Inconsistent array size in of_float_array"
else
@ -39,9 +39,18 @@ let of_float_array ~dim x =
let to_string = function
| One_dimensional x -> string_of_float x
| Multidimensional (x,_) ->
| Multidimensional (x,_) ->
Array.map string_of_float x
|> Array.to_list
|> String.concat " "
|> String.concat " "
|> Printf.sprintf "%s"
let to_bytes = function
| One_dimensional x -> Qptypes.bytes_of_float x
| Multidimensional (x,_) ->
let b = Bytes.create (8 * Array.length x) in
Array.iteri (fun i x ->
Int64.bits_of_float x
|> Bytes.set_int64_le b (i*8) ) x;
b

View File

@ -2,7 +2,8 @@ type t [@@deriving sexp]
val to_float : ?idx:int -> t -> float
val to_float_array : t -> float array
val of_float : float -> t
val of_float_array : dim:int -> float array -> t
val of_float_array : dim:int -> float array -> t
val to_string : t -> string
val to_bytes : t -> bytes
val dimension : t -> int

View File

@ -4,7 +4,12 @@ let global_replace x =
|> Str.global_replace (Str.regexp "Float.of_string") "float_of_string"
|> Str.global_replace (Str.regexp "Int.to_string") "string_of_int"
|> Str.global_replace (Str.regexp "Int.of_string") "int_of_string"
|> Str.global_replace (Str.regexp "String.\\(to\\|of\\)_string") ""
|> Str.global_replace (Str.regexp "Int.to_bytes") "bytes_of_int"
|> Str.global_replace (Str.regexp "Int64.to_bytes") "bytes_of_int64"
|> Str.global_replace (Str.regexp "Float.to_bytes") "bytes_of_float"
|> Str.global_replace (Str.regexp "Int.of_bytes") "int_of_bytes"
|> Str.global_replace (Str.regexp "String.\\(to\\|of\\)_string") ""
|> Str.global_replace (Str.regexp "String.to_bytes") "Bytes.of_string"
let input_data = "
* Positive_float : float
@ -38,7 +43,7 @@ let input_data = "
* Negative_int : int
if not (x <= 0) then
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
assert (x <= 0) ;
assert (x <= 0) ;
* Det_coef : float
if (x < -1.) || (x > 1.) then
@ -167,6 +172,20 @@ let input_ezfio = "
let untouched = "
let bytes_of_int64 i =
let result = Bytes.create 8 in
Bytes.set_int64_le result 0 i;
result
let bytes_of_int i =
Int64.of_int i
|> bytes_of_int64
let bytes_of_float f =
Int64.of_float f
|> bytes_of_int64
"
let template = format_of_string "
@ -175,11 +194,13 @@ module %s : sig
val to_%s : t -> %s
val of_%s : %s %s -> t
val to_string : t -> string
val to_bytes : t -> bytes
end = struct
type t = %s [@@deriving sexp]
let to_%s x = x
let of_%s %s x = ( %s x )
let to_string x = %s.to_string x
let to_bytes x = %s.to_bytes x
end
"
@ -203,7 +224,7 @@ let parse_input input=
and name = String_ext.strip name in
let typ_cap = String.capitalize_ascii typ in
let newstring = Printf.sprintf template name typ typ typ params_val typ typ
typ typ params ( String_ext.strip text ) typ_cap
typ typ params ( String_ext.strip text ) typ_cap typ_cap
in
List.rev (parse (newstring::result) tail )
in
@ -223,9 +244,11 @@ module %s : sig
val get_max : unit -> %s
val of_%s : ?min:%s -> ?max:%s -> %s -> t
val to_string : t -> string
val to_bytes : t -> bytes
end = struct
type t = %s [@@deriving sexp]
let to_string x = %s.to_string x
let to_bytes x = %s.to_bytes x
let get_max () =
if (Ezfio.has_%s ()) then
Ezfio.get_%s ()
@ -271,9 +294,10 @@ let parse_input_ezfio input=
| [ name ; typ ; ezfio_func ; min ; max ; msg ] -> (name, typ, ezfio_func, min, max, msg)
| _ -> assert false
in
let typ_cap = String.capitalize_ascii typ in
Printf.sprintf ezfio_template
name typ typ typ typ typ typ typ typ (String.capitalize_ascii typ)
ezfio_func ezfio_func max min typ typ max msg min name (String.capitalize_ascii typ)
name typ typ typ typ typ typ typ typ typ_cap typ_cap
ezfio_func ezfio_func max min typ typ max msg min name typ_cap
end
| _ -> failwith "Error in input_ezfio"
in
@ -294,7 +318,7 @@ let input_lines filename =
let create_ezfio_handler () =
let lines =
let lines =
input_lines "ezfio.ml"
|> List.mapi (fun i l -> if i > 417 then Some l else None)
|> List.filter (fun x -> x <> None)
@ -303,20 +327,20 @@ let create_ezfio_handler () =
| Some x -> x
| None -> assert false)
in
let functions =
let functions =
List.map (fun x ->
match String.split_on_char ' ' x with
| _ :: x :: "()" :: "=" :: f :: dir :: item :: _-> (x, f, dir, item)
| _ :: x :: "=" :: f :: dir :: item :: _-> (x, f, dir, item)
| _ -> ("","","","")
) lines
) lines
in
let has_functions =
List.filter (fun (x,_,_,_) -> String.sub x 0 4 = "has_") functions
and get_functions =
let has_functions =
List.filter (fun (x,_,_,_) -> String.sub x 0 4 = "has_") functions
and get_functions =
List.filter (fun (x,_,_,_) -> String.sub x 0 4 = "get_") functions
in
let chop s =
let chop s =
match (Str.split_delim (Str.regexp ";;") s) with
| x :: _ -> x
| _ -> assert false
@ -329,17 +353,17 @@ match msg with " ] @
List.map (fun (x,f,d,i) ->
let i = chop i in
if (String.sub f ((String.length f)-6) 6 = "_array") then
Printf.sprintf " | \"%s\" ->
Printf.sprintf " | \"%s\" ->
Ezfio.read_string_array %s %s
|> Ezfio.flattened_ezfio
|> Ezfio.flattened_ezfio
|> Array.to_list
|> String.concat \" \"" x d i
else
Printf.sprintf " | \"%s\" -> Ezfio.read_string %s %s" x d i
) get_functions
) get_functions
) @ (
List.map (fun (x,_,_,_) ->
Printf.sprintf " | \"%s\" -> if (Ezfio.%s ()) then \"T\" else \"F\"" x x
Printf.sprintf " | \"%s\" -> if (Ezfio.%s ()) then \"T\" else \"F\"" x x
) has_functions
)
@ [" | x -> failwith (x^\" : Unknown EZFIO function\")\n;;" ;
@ -347,17 +371,17 @@ match msg with " ] @
(
List.rev_map (fun (x,_,_,_) ->
Printf.sprintf " \"%s\" ; " (String.sub x 4 ((String.length x)-4))
) has_functions
) has_functions
) @ ["]"]
in
String.concat "\n" result
String.concat "\n" result
|> print_endline
(** Main *)
let () =
print_endline untouched;
parse_input input_data ;
parse_input_ezfio input_ezfio;
print_endline untouched;
create_ezfio_handler ()

View File

@ -145,6 +145,10 @@ let to_string = function
for p in properties_qmcvar:
print >>file, """| %(P)s -> "%(P)s" """%{'P':p[1].capitalize(), 'p':p[1]}
print >>file, """;;
let to_bytes x =
to_string x
|> Bytes.of_string
"""
# is_scalar