LCPQ/qmcchem
10
1
Fork 1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-12-21 20:03:31 +01:00
Code Releases Activity

Implemented to_bytes in OCaml

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
ocaml/Block.ml
View File

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

34
ocaml/Message.ml
View File

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

29
ocaml/Sample.ml
View File

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

3
ocaml/Sample.mli
View File

@ -2,7 +2,8 @@ type t [@@deriving sexp]
val to_float : ?idx:int -> t -> float val to_float : ?idx:int -> t -> float
val to_float_array : t -> float array val to_float_array : t -> float array
val of_float : float -> t 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_string : t -> string
val to_bytes : t -> bytes
val dimension : t -> int val dimension : t -> int

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

4
scripts/create_properties_ezfio.py
View File

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