From 5b1379fd9ca39c6fee00d3bc491bdf63f000afbf Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 6 Jan 2022 17:43:31 +0100 Subject: [PATCH] Implemented to_bytes in OCaml --- ocaml/Block.ml | 75 +++++++++++++++++++++--------- ocaml/Message.ml | 34 +++++++------- ocaml/Sample.ml | 29 ++++++++---- ocaml/Sample.mli | 3 +- ocaml/qptypes_generator.ml | 62 ++++++++++++++++-------- scripts/create_properties_ezfio.py | 4 ++ 6 files changed, 138 insertions(+), 69 deletions(-) diff --git a/ocaml/Block.ml b/ocaml/Block.ml index 21cbf62..e5f3bdf 100644 --- a/ocaml/Block.ml +++ b/ocaml/Block.ml @@ -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 [] diff --git a/ocaml/Message.ml b/ocaml/Message.ml index 1c34cea..8f6bb11 100644 --- a/ocaml/Message.ml +++ b/ocaml/Message.ml @@ -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 diff --git a/ocaml/Sample.ml b/ocaml/Sample.ml index 540cb8b..d52b7b1 100644 --- a/ocaml/Sample.ml +++ b/ocaml/Sample.ml @@ -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 + diff --git a/ocaml/Sample.mli b/ocaml/Sample.mli index 58a1f64..07fce20 100644 --- a/ocaml/Sample.mli +++ b/ocaml/Sample.mli @@ -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 diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index e57b9f4..fb9a794 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -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 () diff --git a/scripts/create_properties_ezfio.py b/scripts/create_properties_ezfio.py index ed82d8a..8b80107 100755 --- a/scripts/create_properties_ezfio.py +++ b/scripts/create_properties_ezfio.py @@ -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