open Qptypes type t = { property : Property.t ; value : Sample.t ; weight : Weight.t ; compute_node : Compute_node.t ; pid : int ; block_id : Block_id.t ; } let re = Str.regexp "[ |#|\n]+" let of_string s = try let lst = Str.split re s |> List.rev in match lst with | 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) ; 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 = List.rev v |> Array.of_list |> Array.map float_of_string in 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) ; compute_node = Compute_node.of_string c; pid = int_of_string pid; block_id = Block_id.of_int (int_of_string b) ; } | _ -> None with | _ -> None let to_short_string b = Printf.sprintf "%s # %s %d %d" (Property.to_string b.property) (Compute_node.to_string b.compute_node) b.pid (Block_id.to_int b.block_id) let to_string b = Printf.sprintf "%s %s # %s %s %s %d" (Sample.to_string b.value ) (Weight.to_float b.weight |> string_of_float) (Property.to_string b.property) (Compute_node.to_string b.compute_node) (string_of_int b.pid) (Block_id.to_int b.block_id) 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 0 (Int64.of_int ((Bytes.length result) - 8)); result let read_bytes b = (* Reads m, the first 8 bytes as an int64 containing the number of bytes to read. Then, read the next m bytes and return a tuple containing the decoded data and the rest. *) let l = Bytes.length b in if l < 8 then failwith "Zero-sized bytes" else let m = Bytes.get_int64_le b 0 |> Int64.to_int in let nl = l-m-8 in if nl > 0 then (Bytes.sub b 8 m, Some (Bytes.sub b (8+m) nl)) else (Bytes.sub b 8 m, None) let of_bytes b = let rec loop accu s = match read_bytes s with | data, None -> List.rev (data :: accu) | data, (Some rest) -> loop (data :: accu) rest in let result = match loop [] b with | property :: value :: weight :: pid :: block_id :: compute_node :: [] -> Some { property = Property.of_bytes property; value = Sample.of_bytes value; weight = Weight.of_bytes weight; pid = int_of_bytes pid; block_id = Block_id.of_bytes block_id; compute_node = Compute_node.of_bytes compute_node; } | _ -> None in result let of_string_or_bytes s = if Qmcchem_config.binary_io then Bytes.of_string s |> of_bytes else of_string s let dir_name = lazy( let ezfio_filename = Lazy.force Qputils.ezfio_filename in let md5 = QmcMd5.hash () in 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 ] "" ) (* Fetch raw data from the EZFIO file *) let _raw_data = ref None let update_raw_data ?(locked=true) () = (* Create array of files to read *) let dir_name = Lazy.force dir_name in let files = let result = if Sys.file_exists dir_name && Sys.is_directory dir_name then begin Sys.readdir dir_name |> Array.map (fun x -> dir_name^x) |> Array.to_list end else [] in if locked then result else List.filter (fun x -> try let _ = Str.search_backward (Str.regexp "locked") x ((String.length x) - 1) in false with | Not_found -> true ) result in let rec transform new_list = function | [] -> new_list | head :: tail -> let head = String.trim head in let item = of_string head in match item with | None -> transform new_list tail | Some x -> transform (x::new_list) tail in if Qmcchem_config.binary_io then begin let result = let rec aux buf accu = (* Read one block *) let item, rest = read_bytes buf in match of_bytes item with | None -> [] | Some item -> match rest with | None -> List.rev (item::accu) | Some rest -> (aux [@tailcall]) rest (item::accu) in List.concat_map (fun filename -> let ic = open_in filename in let length = in_channel_length ic in let result = if length > 0 then let buf = Bytes.create length in really_input ic buf 0 length; aux buf [] else [] in close_in ic; result ) files in result end else begin let result = let rec aux ic accu = let l = try Some (input_line ic) with | End_of_file -> None in match l with | None -> List.rev accu | Some l -> (aux [@tailcall]) ic (l::accu) in List.concat_map (fun filename -> let ic = open_in filename in let result = aux ic [] in close_in ic; result ) files |> transform [] in result end let to_string_or_bytes b = if Qmcchem_config.binary_io then to_bytes b |> Bytes.to_string else to_string b let raw_data ?(locked=true) () = match !_raw_data with | Some x -> x | None -> let result = update_raw_data ~locked () in _raw_data := Some result; result let properties = lazy ( let h = Hashtbl.create 63 in 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 [] )