mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-12-21 11:53:30 +01:00
Implemented to_bytes in OCaml
This commit is contained in:
parent
6fe10712d0
commit
5b1379fd9c
@ -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 []
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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 ()
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user