mirror of https://gitlab.com/scemama/qmcchem.git
Removed core
This commit is contained in:
parent
5befb6dfe9
commit
16acf1fe89
|
|
@ -1,3 +1,3 @@
|
|||
PKG core cryptokit str zmq
|
||||
PKG cryptokit str zmq
|
||||
S .
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
open Core
|
||||
open Qptypes
|
||||
|
||||
type t =
|
||||
|
|
@ -6,7 +5,7 @@ type t =
|
|||
value : Sample.t ;
|
||||
weight : Weight.t ;
|
||||
compute_node : Compute_node.t ;
|
||||
pid : Pid.t ;
|
||||
pid : int ;
|
||||
block_id : Block_id.t ;
|
||||
}
|
||||
|
||||
|
|
@ -23,17 +22,17 @@ let of_string s =
|
|||
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) ;
|
||||
value = Sample.of_float (float_of_string v) ;
|
||||
weight = Weight.of_float (float_of_string w) ;
|
||||
compute_node = Compute_node.of_string c;
|
||||
pid = Pid.of_string pid;
|
||||
block_id = Block_id.of_int (Int.of_string b) ;
|
||||
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 ~f:Float.of_string
|
||||
|> Array.map float_of_string
|
||||
in
|
||||
let dim =
|
||||
Array.length v
|
||||
|
|
@ -41,10 +40,10 @@ let of_string s =
|
|||
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 = Pid.of_string pid;
|
||||
block_id = Block_id.of_int (Int.of_string b) ;
|
||||
pid = int_of_string pid;
|
||||
block_id = Block_id.of_int (int_of_string b) ;
|
||||
}
|
||||
| _ -> None
|
||||
with
|
||||
|
|
@ -55,10 +54,10 @@ let of_string s =
|
|||
let to_string b =
|
||||
Printf.sprintf "%s %s # %s %s %s %d"
|
||||
(Sample.to_string b.value )
|
||||
(Weight.to_float b.weight |> Float.to_string)
|
||||
(Weight.to_float b.weight |> string_of_float)
|
||||
(Property.to_string b.property)
|
||||
(Compute_node.to_string b.compute_node)
|
||||
(Pid.to_string b.pid)
|
||||
(string_of_int b.pid)
|
||||
(Block_id.to_int b.block_id)
|
||||
|
||||
|
||||
|
|
@ -70,8 +69,8 @@ let dir_name = lazy(
|
|||
let md5 =
|
||||
QmcMd5.hash ()
|
||||
in
|
||||
List.fold_right ~init:"" ~f:Filename.concat
|
||||
[ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ]
|
||||
List.fold_right Filename.concat
|
||||
[ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ] ""
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -87,29 +86,31 @@ let update_raw_data ?(locked=true) () =
|
|||
in
|
||||
let files =
|
||||
let result =
|
||||
match Sys.is_directory dir_name with
|
||||
| `Yes ->
|
||||
if Sys.is_directory dir_name then
|
||||
begin
|
||||
Sys.readdir dir_name
|
||||
|> Array.map ~f:(fun x -> dir_name^x)
|
||||
|> Array.map (fun x -> dir_name^x)
|
||||
|> Array.to_list
|
||||
end
|
||||
| _ -> []
|
||||
else []
|
||||
in
|
||||
if locked then
|
||||
result
|
||||
else
|
||||
List.filter result ~f:(fun x ->
|
||||
match String.substr_index ~pattern:"locked" x with
|
||||
| Some x -> false
|
||||
| None -> true
|
||||
)
|
||||
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.strip head in
|
||||
let head = String.trim head in
|
||||
let item = of_string head in
|
||||
match item with
|
||||
| None -> transform new_list tail
|
||||
|
|
@ -117,14 +118,19 @@ let update_raw_data ?(locked=true) () =
|
|||
in
|
||||
|
||||
let result =
|
||||
List.map files ~f:(fun filename ->
|
||||
In_channel.with_file filename ~f:(fun in_channel ->
|
||||
In_channel.input_all in_channel)
|
||||
)
|
||||
|> String.concat
|
||||
|> String.split_lines
|
||||
|> List.rev
|
||||
|> transform []
|
||||
let rec aux ic accu =
|
||||
try
|
||||
aux ic ( (input_line ic)::accu )
|
||||
with
|
||||
| End_of_file -> List.rev accu
|
||||
in
|
||||
List.map (fun filename ->
|
||||
let ic = open_in filename in
|
||||
let result = aux ic [] in
|
||||
close_in ic;
|
||||
result ) files
|
||||
|> List.concat
|
||||
|> transform []
|
||||
in
|
||||
result
|
||||
|
||||
|
|
@ -141,10 +147,11 @@ let raw_data ?(locked=true) () =
|
|||
|
||||
|
||||
|
||||
module StringSet = Set.Make(String)
|
||||
|
||||
let properties = lazy (
|
||||
let set = Set.Poly.empty in
|
||||
List.fold (raw_data ()) ~init:set ~f:(fun s x -> Set.add s x.property)
|
||||
|> Set.to_list
|
||||
List.fold_left (fun s x -> StringSet.add (Property.to_string x.property) s) StringSet.empty (raw_data ())
|
||||
|> StringSet.elements
|
||||
)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,199 @@
|
|||
type short_opt = char
|
||||
type long_opt = string
|
||||
type optional = Mandatory | Optional
|
||||
type documentation = string
|
||||
type argument = With_arg of string | Without_arg | With_opt_arg of string
|
||||
|
||||
type description = {
|
||||
short: short_opt ;
|
||||
long : long_opt ;
|
||||
opt : optional ;
|
||||
doc : documentation ;
|
||||
arg : argument ;
|
||||
}
|
||||
|
||||
let anon_args = ref []
|
||||
and header_doc = ref ""
|
||||
and description_doc = ref ""
|
||||
and footer_doc = ref ""
|
||||
and specs = ref []
|
||||
|
||||
let set_header_doc s = header_doc := s
|
||||
let set_description_doc s = description_doc := s
|
||||
let set_footer_doc s = footer_doc := s
|
||||
|
||||
(* Hash table containing all the options *)
|
||||
let dict = Hashtbl.create 67
|
||||
|
||||
let get_bool x = Hashtbl.mem dict x
|
||||
|
||||
let show_help () = get_bool "help"
|
||||
|
||||
let get x =
|
||||
try Some (Hashtbl.find dict x)
|
||||
with Not_found -> None
|
||||
|
||||
let anonymous name opt doc =
|
||||
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
|
||||
|
||||
let output_text t =
|
||||
Format.printf "@[<v 0>";
|
||||
begin
|
||||
match Str.split (Str.regexp "\n") t with
|
||||
| x :: [] -> Format.printf "@[<hov 0>";
|
||||
Str.split (Str.regexp " ") x
|
||||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
||||
Format.printf "@]"
|
||||
| t -> List.iter (fun x ->
|
||||
Format.printf "@[<hov 0>";
|
||||
Str.split (Str.regexp " ") x
|
||||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
||||
Format.printf "@]@;") t
|
||||
end;
|
||||
Format.printf "@]"
|
||||
;;
|
||||
|
||||
|
||||
let output_short x =
|
||||
match x.short, x.opt, x.arg with
|
||||
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
|
||||
| ' ', Optional , _ -> Format.printf "@[[%s]@]" x.long
|
||||
| _ , Mandatory, Without_arg -> Format.printf "@[-%c@]" x.short
|
||||
| _ , Optional , Without_arg -> Format.printf "@[[-%c]@]" x.short
|
||||
| _ , Mandatory, With_arg arg -> Format.printf "@[-%c %s@]" x.short arg
|
||||
| _ , Optional , With_arg arg -> Format.printf "@[[-%c %s]@]" x.short arg
|
||||
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
|
||||
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
|
||||
|
||||
|
||||
let output_long max_width x =
|
||||
let arg =
|
||||
match x.short, x.arg with
|
||||
| ' ' , _ -> x.long
|
||||
| _ , Without_arg -> x.long
|
||||
| _ , With_arg arg -> Printf.sprintf "%s=%s" x.long arg
|
||||
| _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg
|
||||
in
|
||||
let long =
|
||||
let l = String.length arg in
|
||||
arg^(String.make (max_width-l) ' ')
|
||||
in
|
||||
Format.printf "@[<v 0>";
|
||||
begin
|
||||
match x.short with
|
||||
| ' ' -> Format.printf "@[%s @]" long
|
||||
| short -> Format.printf "@[-%c --%s @]" short long
|
||||
end;
|
||||
Format.printf "@]";
|
||||
output_text x.doc
|
||||
|
||||
|
||||
let help () =
|
||||
|
||||
(* Print the header *)
|
||||
output_text !header_doc;
|
||||
Format.printf "@.@.";
|
||||
|
||||
(* Find the anonymous arguments *)
|
||||
let anon =
|
||||
List.filter (fun x -> x.short = ' ') !specs
|
||||
in
|
||||
|
||||
(* Find the options *)
|
||||
let options =
|
||||
List.filter (fun x -> x.short <> ' ') !specs
|
||||
|> List.sort (fun x y -> Char.compare x.short y.short)
|
||||
in
|
||||
|
||||
(* Find column lengths *)
|
||||
let max_width =
|
||||
List.map (fun x ->
|
||||
( match x.arg with
|
||||
| Without_arg -> String.length x.long
|
||||
| With_arg arg -> String.length x.long + String.length arg
|
||||
| With_opt_arg arg -> String.length x.long + String.length arg + 2
|
||||
)
|
||||
+ ( if x.opt = Optional then 2 else 0)
|
||||
) !specs
|
||||
|> List.fold_left max 0
|
||||
in
|
||||
|
||||
|
||||
(* Print usage *)
|
||||
Format.printf "@[<v>@[<v 2>Usage:@,@,@[<hov 4>@[%s@]" Sys.argv.(0);
|
||||
List.iter (fun x -> Format.printf "@ "; output_short x) options;
|
||||
Format.printf "@ @[[--]@]";
|
||||
List.iter (fun x -> Format.printf "@ "; output_short x;) anon;
|
||||
Format.printf "@]@,@]@,";
|
||||
|
||||
|
||||
(* Print arguments and doc *)
|
||||
Format.printf "@[<v 2>Arguments:@,";
|
||||
Format.printf "@[<v 0>" ;
|
||||
List.iter (fun x -> Format.printf "@ "; output_long max_width x) anon;
|
||||
Format.printf "@]@,@]@,";
|
||||
|
||||
|
||||
(* Print options and doc *)
|
||||
Format.printf "@[<v 2>Options:@,";
|
||||
|
||||
Format.printf "@[<v 0>" ;
|
||||
List.iter (fun x -> Format.printf "@ "; output_long max_width x) options;
|
||||
Format.printf "@]@,@]@,";
|
||||
|
||||
|
||||
(* Print footer *)
|
||||
if !description_doc <> "" then
|
||||
begin
|
||||
Format.printf "@[<v 2>Description:@,@,";
|
||||
output_text !description_doc;
|
||||
Format.printf "@,"
|
||||
end;
|
||||
|
||||
(* Print footer *)
|
||||
output_text !footer_doc;
|
||||
Format.printf "@."
|
||||
|
||||
|
||||
|
||||
let set_specs specs_in =
|
||||
specs := { short='h' ;
|
||||
long ="help" ;
|
||||
doc ="Prints the help message." ;
|
||||
arg =Without_arg ;
|
||||
opt =Optional ;
|
||||
} :: specs_in;
|
||||
|
||||
let cmd_specs =
|
||||
List.filter (fun x -> x.short != ' ') !specs
|
||||
|> List.map (fun { short ; long ; opt ; doc ; arg } ->
|
||||
match arg with
|
||||
| With_arg _ ->
|
||||
(short, long, None, Some (fun x -> Hashtbl.replace dict long x) )
|
||||
| Without_arg ->
|
||||
(short, long, Some (fun () -> Hashtbl.replace dict long ""), None)
|
||||
| With_opt_arg _ ->
|
||||
(short, long, Some (fun () -> Hashtbl.replace dict long ""),
|
||||
Some (fun x -> Hashtbl.replace dict long x) )
|
||||
)
|
||||
in
|
||||
|
||||
Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]);
|
||||
|
||||
if show_help () then
|
||||
(help () ; exit 0);
|
||||
|
||||
(* Check that all mandatory arguments are set *)
|
||||
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|
||||
|> List.iter (fun x ->
|
||||
match get x.long with
|
||||
| Some _ -> ()
|
||||
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
||||
)
|
||||
;;
|
||||
|
||||
|
||||
let anon_args () = !anon_args
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,126 @@
|
|||
(** Handles command-line arguments, using getopt.
|
||||
|
||||
Example:
|
||||
|
||||
let () =
|
||||
|
||||
(* Command-line specs *)
|
||||
let open Command_line in
|
||||
begin
|
||||
set_header_doc (Sys.argv.(0) ^ " - quantum_package command");
|
||||
set_description_doc
|
||||
"Opens a text editor to edit the parameters of an EZFIO directory.";
|
||||
|
||||
[ { short='c'; long="check"; opt=Optional;
|
||||
doc="Checks the input data";
|
||||
arg=Without_arg; };
|
||||
|
||||
{ short='n'; long="ndet"; opt=Optional;
|
||||
doc="Truncate the wavefunction to the target number of determinants";
|
||||
arg=With_arg "<int>"; };
|
||||
|
||||
{ short='s'; long="state"; opt=Optional;
|
||||
doc="Extract selected states, for example \"[1,3-5]\"";
|
||||
arg=With_arg "<range>"; };
|
||||
|
||||
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
|
||||
]
|
||||
|> set_specs ;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
(* Handle options *)
|
||||
let ndet =
|
||||
match Command_line.get "ndet" with
|
||||
| None -> None
|
||||
| Some s -> (try Some (int_of_string s)
|
||||
with _ -> failwith "[-n|--ndet] expects an integer")
|
||||
in
|
||||
let state =
|
||||
match Command_line.get "state" with
|
||||
| None -> None
|
||||
| Some s -> (try Some (Range.of_string s)
|
||||
with _ -> failwith "[-s|--state] expects a range")
|
||||
in
|
||||
|
||||
let c = Command_line.get_bool "check" in
|
||||
|
||||
let filename =
|
||||
match Command_line.anon_args () with
|
||||
| [x] -> x
|
||||
| _ -> (Command_line.help () ; failwith "EZFIO_DIR is missing")
|
||||
in
|
||||
|
||||
(* Run the program *)
|
||||
run c ?ndet ?state filename
|
||||
|
||||
|
||||
*)
|
||||
|
||||
|
||||
type short_opt = char
|
||||
|
||||
type long_opt = string
|
||||
|
||||
type optional = Mandatory
|
||||
| Optional
|
||||
|
||||
type documentation = string
|
||||
|
||||
type argument = With_arg of string
|
||||
| Without_arg
|
||||
| With_opt_arg of string
|
||||
|
||||
|
||||
type description =
|
||||
{
|
||||
short : short_opt;
|
||||
long : long_opt;
|
||||
opt : optional;
|
||||
doc : documentation;
|
||||
arg : argument;
|
||||
}
|
||||
|
||||
|
||||
(** Sets the header of the help message. *)
|
||||
val set_header_doc : string -> unit
|
||||
|
||||
|
||||
(** Sets the description of the help message. *)
|
||||
val set_description_doc : string -> unit
|
||||
|
||||
(** Sets the footer of the help message. *)
|
||||
val set_footer_doc : string -> unit
|
||||
|
||||
|
||||
(** Gets the value of an option. If the option is not set, returns [None]. If
|
||||
the option is set, returns Some <string>. *)
|
||||
val get : string -> string option
|
||||
|
||||
|
||||
(** Gets the value of an option with no argument. If the option is set, returns [true]. *)
|
||||
val get_bool : string -> bool
|
||||
|
||||
|
||||
(** True if the '-h' or "--help" option was found. *)
|
||||
val show_help : unit -> bool
|
||||
|
||||
|
||||
(** Creates a specification of an anonymous argument. *)
|
||||
val anonymous : long_opt -> optional -> documentation -> description
|
||||
|
||||
|
||||
(** Prints the help message *)
|
||||
val help : unit -> unit
|
||||
|
||||
|
||||
(** Sets the specification list as a list of tuples:
|
||||
( short option, long option, documentation, argument ) *)
|
||||
val set_specs : description list -> unit
|
||||
|
||||
|
||||
(** Returns the list of anonymous arguments *)
|
||||
val anon_args : unit -> string list
|
||||
|
||||
|
||||
|
|
@ -1,6 +1,3 @@
|
|||
open Core
|
||||
|
||||
|
||||
let simulation_nucl_fitcusp_factor = lazy(
|
||||
let default =
|
||||
1.
|
||||
|
|
@ -26,7 +23,7 @@ let simulation_time_step = lazy ( 0.15 )
|
|||
let simulation_srmc_projection_time = lazy ( 1. )
|
||||
|
||||
let reset_defaults () =
|
||||
List.iter ~f:(fun x -> Sys.remove ( (Lazy.force Qputils.ezfio_filename) ^ x))
|
||||
List.iter (fun x -> Sys.remove ( (Lazy.force Qputils.ezfio_filename) ^ x))
|
||||
[ "/electrons/elec_walk_num" ;
|
||||
"/electrons/elec_walk_num_tot" ;
|
||||
"/jastrow/jast_type" ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
open Core
|
||||
open Qptypes
|
||||
open Qputils
|
||||
|
||||
|
|
@ -38,13 +37,13 @@ end = struct
|
|||
|
||||
let to_string t =
|
||||
to_bool t
|
||||
|> Bool.to_string
|
||||
|> string_of_bool
|
||||
|
||||
|
||||
let of_string t =
|
||||
try
|
||||
String.lowercase t
|
||||
|> Bool.of_string
|
||||
String.lowercase_ascii t
|
||||
|> bool_of_string
|
||||
|> of_bool
|
||||
with
|
||||
| Invalid_argument msg -> failwith msg
|
||||
|
|
@ -119,12 +118,12 @@ Fit is done for r < r_c(f) where r_c(f) = (1s orbital radius) x f. Value of f"
|
|||
|
||||
let to_string t =
|
||||
to_float t
|
||||
|> Float.to_string
|
||||
|> string_of_float
|
||||
|
||||
|
||||
let of_string t =
|
||||
try
|
||||
Float.of_string t
|
||||
float_of_string t
|
||||
|> of_float
|
||||
with
|
||||
| Invalid_argument msg -> failwith msg
|
||||
|
|
@ -181,21 +180,21 @@ end = struct
|
|||
|
||||
let to_string t =
|
||||
to_int t
|
||||
|> Int.to_string
|
||||
|> string_of_int
|
||||
|
||||
|
||||
let of_string t =
|
||||
Int.of_string t
|
||||
int_of_string t
|
||||
|> of_int
|
||||
|
||||
|
||||
let to_float t =
|
||||
to_int t
|
||||
|> Float.of_int
|
||||
|> float_of_int
|
||||
|
||||
|
||||
let of_float t =
|
||||
Int.of_float t
|
||||
int_of_float t
|
||||
|> of_int
|
||||
|
||||
|
||||
|
|
@ -248,11 +247,11 @@ end = struct
|
|||
|
||||
let to_string t =
|
||||
to_int t
|
||||
|> Int.to_string
|
||||
|> string_of_int
|
||||
|
||||
|
||||
let of_string t =
|
||||
Int.of_string t
|
||||
int_of_string t
|
||||
|> of_int
|
||||
|
||||
|
||||
|
|
@ -305,11 +304,11 @@ end = struct
|
|||
|
||||
let to_string t =
|
||||
to_int t
|
||||
|> Int.to_string
|
||||
|> string_of_int
|
||||
|
||||
|
||||
let of_string t =
|
||||
Int.of_string t
|
||||
int_of_string t
|
||||
|> of_int
|
||||
|
||||
|
||||
|
|
@ -364,21 +363,21 @@ end = struct
|
|||
|
||||
let to_string t =
|
||||
to_int t
|
||||
|> Int.to_string
|
||||
|> string_of_int
|
||||
|
||||
|
||||
let of_string t =
|
||||
Int.of_string t
|
||||
int_of_string t
|
||||
|> of_int
|
||||
|
||||
|
||||
let to_float t =
|
||||
to_int t
|
||||
|> Float.of_int
|
||||
|> float_of_int
|
||||
|
||||
|
||||
let of_float t =
|
||||
Int.of_float t
|
||||
int_of_float t
|
||||
|> of_int
|
||||
|
||||
end
|
||||
|
|
@ -456,7 +455,7 @@ end = struct
|
|||
let doc = "Sampling algorithm : [ Langevin | Brownian ]"
|
||||
|
||||
let of_string s =
|
||||
match String.capitalize (String.strip s) with
|
||||
match String.capitalize_ascii (String.trim s) with
|
||||
| "Langevin" -> Langevin
|
||||
| "Brownian" -> Brownian
|
||||
| x -> failwith ("Sampling should be [ Brownian | Langevin ], not "^x^".")
|
||||
|
|
@ -536,13 +535,13 @@ end = struct
|
|||
|
||||
|
||||
let of_string x =
|
||||
Float.of_string x
|
||||
float_of_string x
|
||||
|> of_float
|
||||
|
||||
|
||||
let to_string x =
|
||||
to_float x
|
||||
|> Float.to_string
|
||||
|> string_of_float
|
||||
|
||||
|
||||
end
|
||||
|
|
@ -593,13 +592,13 @@ end = struct
|
|||
|
||||
|
||||
let of_string x =
|
||||
Float.of_string x
|
||||
float_of_string x
|
||||
|> of_float
|
||||
|
||||
|
||||
let to_string x =
|
||||
to_float x
|
||||
|> Float.to_string
|
||||
|> string_of_float
|
||||
|
||||
|
||||
end
|
||||
|
|
@ -652,13 +651,13 @@ contribution to the norm less than t (au)"
|
|||
|
||||
|
||||
let of_string x =
|
||||
Float.of_string x
|
||||
float_of_string x
|
||||
|> of_float
|
||||
|
||||
|
||||
let to_string x =
|
||||
to_float x
|
||||
|> Float.to_string
|
||||
|> string_of_float
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -708,13 +707,13 @@ end = struct
|
|||
|
||||
|
||||
let of_string x =
|
||||
Float.of_string x
|
||||
float_of_string x
|
||||
|> of_float
|
||||
|
||||
|
||||
let to_string x =
|
||||
to_float x
|
||||
|> Float.to_string
|
||||
|> string_of_float
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -764,13 +763,13 @@ end = struct
|
|||
|
||||
|
||||
let of_string x =
|
||||
Float.of_string x
|
||||
float_of_string x
|
||||
|> of_float
|
||||
|
||||
|
||||
let to_string x =
|
||||
to_float x
|
||||
|> Float.to_string
|
||||
|> string_of_float
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -789,7 +788,7 @@ end = struct
|
|||
let doc = "Type of Jastrow factor [ None | Core | Simple ]"
|
||||
|
||||
let of_string s =
|
||||
match String.capitalize (String.strip s) with
|
||||
match String.capitalize (String.trim s) with
|
||||
| "Core" -> Core
|
||||
| "Simple" -> Simple
|
||||
| "None" -> None
|
||||
|
|
@ -841,31 +840,31 @@ end = struct
|
|||
|
||||
|
||||
let read () =
|
||||
List.map Property.all ~f:(fun x -> (x, Property.calc x))
|
||||
List.map (fun x -> (x, Property.calc x)) Property.all
|
||||
|
||||
|
||||
let write l =
|
||||
List.iter l ~f:(fun (x,b) -> Property.set_calc x b)
|
||||
List.iter (fun (x,b) -> Property.set_calc x b) l
|
||||
|
||||
|
||||
let to_string l =
|
||||
List.map l ~f:(fun (x,b) ->
|
||||
List.map (fun (x,b) ->
|
||||
let ch =
|
||||
if b then "X" else " "
|
||||
in
|
||||
Printf.sprintf "(%s) %s" ch (Property.to_string x))
|
||||
|> String.concat ~sep:"\n"
|
||||
Printf.sprintf "(%s) %s" ch (Property.to_string x)) l
|
||||
|> String.concat "\n"
|
||||
|
||||
|
||||
let of_string s =
|
||||
String.split s ~on:'\n'
|
||||
|> List.map ~f:(fun x ->
|
||||
String.split_on_char '\n' s
|
||||
|> List.map (fun x ->
|
||||
let (calc,prop) =
|
||||
String.strip x
|
||||
|> String.rsplit2_exn ~on:' '
|
||||
String.trim x
|
||||
|> String_ext.rsplit2_exn ~on:' '
|
||||
in
|
||||
let prop =
|
||||
String.strip prop
|
||||
String.trim prop
|
||||
|> Property.of_string
|
||||
and calc =
|
||||
match calc with
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
open Core
|
||||
|
||||
type t =
|
||||
| Srun
|
||||
| MPI
|
||||
|
|
@ -50,19 +48,21 @@ let create_nodefile () =
|
|||
in
|
||||
|
||||
let h =
|
||||
String.Table.create ~size:1000 ()
|
||||
Hashtbl.create 1000
|
||||
in
|
||||
|
||||
let in_channel =
|
||||
Unix.open_process_in (launcher_command^" hostname -s")
|
||||
in
|
||||
In_channel.input_lines in_channel
|
||||
|> List.map ~f:String.strip
|
||||
|> List.iter ~f:( fun host ->
|
||||
Hashtbl.change h host (function
|
||||
| Some x -> Some (x+1)
|
||||
| None -> Some 1
|
||||
)
|
||||
String_ext.input_lines in_channel
|
||||
|> List.map String.trim
|
||||
|> List.iter ( fun host ->
|
||||
let n =
|
||||
match Hashtbl.find_opt h host with
|
||||
| Some x -> x+1
|
||||
| None -> 1
|
||||
in
|
||||
Hashtbl.replace h host n
|
||||
);
|
||||
match
|
||||
Unix.close_process_in in_channel
|
||||
|
|
@ -80,9 +80,8 @@ let create_nodefile () =
|
|||
fun (node, n) ->
|
||||
Printf.sprintf "%s %d\n" node n
|
||||
in
|
||||
Hashtbl.to_alist h
|
||||
|> List.map ~f
|
||||
|> String.concat
|
||||
Hashtbl.fold (fun k v a -> (f (k,v)) :: a) h []
|
||||
|> String.concat "\n"
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,58 @@
|
|||
.NOPARALLEL:
|
||||
|
||||
# Check if QMCCHEM_PATH is defined
|
||||
ifndef QMCCHEM_PATH
|
||||
$(info -------------------- Error --------------------)
|
||||
$(info QMCCHEM_PATH undefined. Source the qmcchem.rc script)
|
||||
$(info -----------------------------------------------)
|
||||
$(error )
|
||||
endif
|
||||
|
||||
|
||||
LIBS=
|
||||
PKGS=
|
||||
OCAMLCFLAGS="-g"
|
||||
OCAMLOPTFLAGS="opt -O3 -remove-unused-arguments -rounds 16 -inline 100 -inline-max-unroll 100"
|
||||
OCAMLBUILD=ocamlbuild -j 0 -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS) -ocamlopt $(OCAMLOPTFLAGS)
|
||||
MLLFILES=$(wildcard *.mll)
|
||||
MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml
|
||||
MLIFILES=$(wildcard *.mli)
|
||||
ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))
|
||||
ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) qmcchem.native
|
||||
|
||||
.PHONY: default
|
||||
|
||||
|
||||
default: $(ALL_EXE)
|
||||
tests: $(ALL_TESTS)
|
||||
|
||||
|
||||
%.inferred.mli: $(MLFILES)
|
||||
$(OCAMLBUILD) $*.inferred.mli -use-ocamlfind $(PKGS)
|
||||
mv _build/$*.inferred.mli .
|
||||
|
||||
%.byte: $(MLFILES) $(MLIFILES)
|
||||
rm -f -- $*
|
||||
$(OCAMLBUILD) $*.byte -use-ocamlfind $(PKGS)
|
||||
ln -s $*.byte $*
|
||||
|
||||
%.native: $(MLFILES) $(MLIFILES)
|
||||
rm -f -- $*
|
||||
$(OCAMLBUILD) $*.native -use-ocamlfind $(PKGS)
|
||||
ln -s $*.native $*
|
||||
|
||||
ezfio.ml: ${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml
|
||||
cp ${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml .
|
||||
|
||||
qptypes_generator.byte: qptypes_generator.ml
|
||||
$(OCAMLBUILD) qptypes_generator.byte -use-ocamlfind
|
||||
|
||||
Qptypes.ml: qptypes_generator.byte
|
||||
./qptypes_generator.byte > Qptypes.ml
|
||||
|
||||
${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml:
|
||||
${MAKE) -C ${QMCCHEM_PATH}/EZFIO/
|
||||
|
||||
clean:
|
||||
rm -rf _build Qptypes.ml $(ALL_EXE) $(ALL_TESTS)
|
||||
|
||||
|
|
@ -1,5 +1,3 @@
|
|||
open Core
|
||||
|
||||
(** Directory containing the list of input files. The directory is created is inexistant. *)
|
||||
let input_directory = lazy (
|
||||
|
||||
|
|
@ -12,9 +10,8 @@ let input_directory = lazy (
|
|||
in
|
||||
|
||||
begin
|
||||
match ( Sys.is_directory dirname ) with
|
||||
| `No -> Unix.mkdir dirname
|
||||
| _ -> ()
|
||||
if not (Sys.is_directory dirname) then
|
||||
Unix.mkdir dirname 0o777
|
||||
end ;
|
||||
|
||||
dirname
|
||||
|
|
@ -83,14 +80,17 @@ let files_to_track = [
|
|||
|
||||
(** Get an MD5 ke from the content of a file. *)
|
||||
let hash_file filename =
|
||||
match Sys.is_file filename with
|
||||
| `Yes ->
|
||||
if Sys.file_exists filename then
|
||||
begin
|
||||
In_channel.with_file filename ~f:(fun ic ->
|
||||
let ic = open_in filename in
|
||||
let result =
|
||||
Cryptokit.hash_channel (Cryptokit.Hash.md5 ()) ic
|
||||
|> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) )
|
||||
|> Cryptokit.transform_string (Cryptokit.Hexa.encode ())
|
||||
in
|
||||
close_in ic;
|
||||
result
|
||||
end
|
||||
| _ -> ""
|
||||
else ""
|
||||
|
||||
|
||||
(** Cache containing the current value of the MD5 hash. *)
|
||||
|
|
@ -111,9 +111,9 @@ let hash () =
|
|||
in
|
||||
let md5_string =
|
||||
files_to_track
|
||||
|> List.map ~f:(fun x -> Printf.sprintf "%s/%s" ezfio_filename x)
|
||||
|> List.map ~f:hash_file
|
||||
|> String.concat
|
||||
|> List.map (fun x -> Printf.sprintf "%s/%s" ezfio_filename x)
|
||||
|> List.map hash_file
|
||||
|> String.concat ""
|
||||
in
|
||||
|
||||
let new_md5 =
|
||||
|
|
|
|||
|
|
@ -1,22 +1,18 @@
|
|||
open Core
|
||||
|
||||
|
||||
(** QMC=Chem installation directory *)
|
||||
let root = lazy (
|
||||
match ( Sys.getenv "QMCCHEM_PATH" ) with
|
||||
| Some x -> x
|
||||
| None -> failwith "QMCCHEM_PATH environment variable not set"
|
||||
try Sys.getenv "QMCCHEM_PATH" with
|
||||
| Not_found -> failwith "QMCCHEM_PATH environment variable not set"
|
||||
)
|
||||
|
||||
|
||||
(* PATH environment variable as a list of strings *)
|
||||
let path = lazy (
|
||||
let p =
|
||||
match Sys.getenv "PATH" with
|
||||
| None -> failwith "PATH environment variable is not set"
|
||||
| Some p -> p
|
||||
try Sys.getenv "PATH" with
|
||||
| Not_found -> failwith "PATH environment variable is not set"
|
||||
in
|
||||
String.split ~on:':' p
|
||||
String.split_on_char ':' p
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -30,9 +26,10 @@ let full_path exe =
|
|||
let fp =
|
||||
Filename.concat head exe
|
||||
in
|
||||
match (Sys.is_file fp) with
|
||||
| `Yes -> Some fp
|
||||
| _ -> in_path_rec tail
|
||||
if Sys.file_exists fp then
|
||||
Some fp
|
||||
else
|
||||
in_path_rec tail
|
||||
end
|
||||
in
|
||||
Lazy.force path
|
||||
|
|
@ -42,7 +39,7 @@ let full_path exe =
|
|||
|
||||
(* True if an executable is in the PATH *)
|
||||
let in_path x =
|
||||
match (full_path x) with
|
||||
match full_path x with
|
||||
| Some _ -> true
|
||||
| None -> false
|
||||
|
||||
|
|
@ -51,13 +48,13 @@ let has_parallel = lazy( in_path "parallel" )
|
|||
let has_mpirun = lazy( in_path "mpirun" )
|
||||
let has_srun = lazy( in_path "parallel" )
|
||||
let has_qmc = lazy( in_path "qmc" )
|
||||
let has_qmc_mic = lazy( in_path "qmc_mic" )
|
||||
|
||||
|
||||
let mpirun = lazy (
|
||||
match Sys.getenv "QMCCHEM_MPIRUN" with
|
||||
| None -> "mpirun"
|
||||
| Some p -> p
|
||||
try
|
||||
Sys.getenv "QMCCHEM_MPIRUN"
|
||||
with
|
||||
| Not_found -> "mpirun"
|
||||
)
|
||||
|
||||
let qmcchem = lazy(
|
||||
|
|
@ -69,9 +66,7 @@ and qmc = lazy(
|
|||
and qmcchem_info = lazy(
|
||||
Filename.concat (Lazy.force root) "bin/qmcchem_info"
|
||||
)
|
||||
and qmc_mic = lazy(
|
||||
Filename.concat (Lazy.force root) "bin/qmc_mic"
|
||||
)
|
||||
|
||||
and qmc_create_walkers = lazy(
|
||||
Filename.concat (Lazy.force root) "bin/qmc_create_walkers"
|
||||
)
|
||||
|
|
@ -87,28 +82,35 @@ let hostname = lazy (
|
|||
)
|
||||
|
||||
|
||||
external get_ipv4_address_for_interface : string -> string =
|
||||
"get_ipv4_address_for_interface"
|
||||
|
||||
|
||||
let ip_address = lazy (
|
||||
match Sys.getenv "QMCCHEM_NIC" with
|
||||
| None ->
|
||||
let interface =
|
||||
try Some (Sys.getenv "QMCCHEM_NIC")
|
||||
with Not_found -> None
|
||||
in
|
||||
match interface with
|
||||
| None ->
|
||||
begin
|
||||
try
|
||||
Lazy.force hostname
|
||||
|> Unix.Inet_addr.of_string_or_getbyname
|
||||
|> Unix.Inet_addr.to_string
|
||||
let host =
|
||||
Lazy.force hostname
|
||||
|> Unix.gethostbyname
|
||||
in
|
||||
Unix.string_of_inet_addr host.h_addr_list.(0);
|
||||
with
|
||||
| Unix.Unix_error _ ->
|
||||
failwith "Unable to find IP address from host name."
|
||||
end
|
||||
| Some interface ->
|
||||
begin
|
||||
try
|
||||
ok_exn Linux_ext.get_ipv4_address_for_interface interface
|
||||
with
|
||||
| Unix.Unix_error _ ->
|
||||
Lazy.force hostname
|
||||
|> Unix.Inet_addr.of_string_or_getbyname
|
||||
|> Unix.Inet_addr.to_string
|
||||
end
|
||||
let result = get_ipv4_address_for_interface interface in
|
||||
if String.sub result 0 5 = "error" then
|
||||
Printf.sprintf "Unable to use network interface %s" interface
|
||||
|> failwith
|
||||
else
|
||||
result
|
||||
)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
open Core
|
||||
|
||||
let file_header filename = Printf.sprintf
|
||||
"
|
||||
+----------------------------------------------------------------+
|
||||
|
|
@ -12,7 +10,7 @@ Editing file `%s`
|
|||
|
||||
let make_header s =
|
||||
let l = String.length s in
|
||||
"\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n"
|
||||
"\n\n"^s^"\n"^(String.init l (fun _ -> '='))^"\n\n"
|
||||
|
||||
|
||||
type field =
|
||||
|
|
@ -84,11 +82,11 @@ let create_temp_file ?temp_filename ezfio_filename fields =
|
|||
| None -> Filename.temp_file "qmcchem_edit_" ".rst"
|
||||
| Some name -> name
|
||||
in
|
||||
Out_channel.with_file filename ~f:(fun out_channel ->
|
||||
(file_header ezfio_filename) :: (List.map ~f:get fields)
|
||||
|> String.concat ~sep:"\n"
|
||||
|> Out_channel.output_string out_channel
|
||||
)
|
||||
let out_channel = open_out filename in
|
||||
(file_header ezfio_filename) :: (List.map get fields)
|
||||
|> String.concat "\n"
|
||||
|> output_string out_channel
|
||||
; close_out out_channel
|
||||
; filename
|
||||
|
||||
|
||||
|
|
@ -104,7 +102,7 @@ let write_input_in_ezfio ezfio_filename fields =
|
|||
let input_filename =
|
||||
create_temp_file ~temp_filename ezfio_filename fields
|
||||
in
|
||||
assert (Sys.file_exists_exn input_filename)
|
||||
assert (Sys.file_exists input_filename)
|
||||
|
||||
|
||||
(** Run the edit command *)
|
||||
|
|
@ -133,19 +131,19 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
|
|||
in ();
|
||||
in
|
||||
|
||||
handle_option Input.Ref_energy.(of_float , write) e;
|
||||
handle_option Input.Trial_wf_energy.(of_float , write) et;
|
||||
handle_option Input.Ref_energy.(of_string, write) e;
|
||||
handle_option Input.Trial_wf_energy.(of_string, write) et;
|
||||
handle_option Input.Jastrow_type.(of_string, write) j;
|
||||
handle_option Input.Block_time.(of_int , write) l;
|
||||
handle_option Input.Block_time.(of_string, write) l;
|
||||
handle_option Input.Method.(of_string, write) m;
|
||||
handle_option Input.Stop_time.(of_int , write) t;
|
||||
handle_option Input.Stop_time.(of_string, write) t;
|
||||
handle_option Input.Sampling.(of_string, write) s;
|
||||
handle_option Input.Fitcusp_factor.(of_float , write) f;
|
||||
handle_option Input.Time_step.(of_float , write) ts;
|
||||
handle_option Input.Walk_num.(of_int , write) w;
|
||||
handle_option Input.Walk_num_tot.(of_int , write) wt;
|
||||
handle_option Input.CI_threshold.(of_float , write) n;
|
||||
handle_option Input.SRMC_projection_time.(of_float , write) p;
|
||||
handle_option Input.Fitcusp_factor.(of_string, write) f;
|
||||
handle_option Input.Time_step.(of_string, write) ts;
|
||||
handle_option Input.Walk_num.(of_string, write) w;
|
||||
handle_option Input.Walk_num_tot.(of_string, write) wt;
|
||||
handle_option Input.CI_threshold.(of_string, write) n;
|
||||
handle_option Input.SRMC_projection_time.(of_string, write) p;
|
||||
|
||||
|
||||
let fields =
|
||||
|
|
@ -179,21 +177,24 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
|
|||
if (not !interactive) then
|
||||
failwith "Input file not allowed with command line arguments"
|
||||
else
|
||||
begin
|
||||
let rc =
|
||||
Printf.sprintf "cp %s %s" filename temp_filename
|
||||
|> Sys.command_exn ;
|
||||
end
|
||||
|> Sys.command
|
||||
in
|
||||
assert (rc = 0)
|
||||
end
|
||||
| None ->
|
||||
begin
|
||||
(* Open the temp file with external editor *)
|
||||
let editor =
|
||||
match Sys.getenv "EDITOR" with
|
||||
| Some editor -> editor
|
||||
| None -> "vi"
|
||||
try Sys.getenv "EDITOR" with
|
||||
| Not_found -> "vi"
|
||||
in
|
||||
Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename
|
||||
|> Sys.command_exn
|
||||
let rc =
|
||||
Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename
|
||||
|> Sys.command
|
||||
in
|
||||
assert (rc = 0)
|
||||
end
|
||||
in
|
||||
|
||||
|
|
@ -203,18 +204,20 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
|
|||
and re_prop =
|
||||
Str.regexp "([ xX]) .*$"
|
||||
and raw_data =
|
||||
In_channel.with_file temp_filename ~f:In_channel.input_lines
|
||||
let ic = open_in temp_filename in
|
||||
let result = String_ext.input_lines ic in
|
||||
close_in ic ; result
|
||||
in
|
||||
let data =
|
||||
( List.filter raw_data ~f:(fun x -> Str.string_match re_data x 0)
|
||||
|> List.map ~f:String.strip ) @
|
||||
( List.filter (fun x -> Str.string_match re_data x 0) raw_data
|
||||
|> List.map String.trim ) @
|
||||
[
|
||||
List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0)
|
||||
|> List.map ~f:String.strip
|
||||
|> String.concat ~sep:"\n" ]
|
||||
List.filter (fun x -> Str.string_match re_prop x 0) raw_data
|
||||
|> List.map String.trim
|
||||
|> String.concat "\n" ]
|
||||
in
|
||||
let open Input in
|
||||
List.iter2_exn data fields ~f:(fun s f ->
|
||||
List.iter2 (fun s f ->
|
||||
try
|
||||
begin
|
||||
match f with
|
||||
|
|
@ -235,7 +238,7 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
|
|||
end
|
||||
with
|
||||
| Failure msg -> Printf.eprintf "%s\n" msg
|
||||
);
|
||||
) data fields ;
|
||||
|
||||
(* Remove temp_file *)
|
||||
Sys.remove temp_filename;
|
||||
|
|
@ -244,27 +247,26 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
|
|||
;
|
||||
|
||||
if c then
|
||||
begin
|
||||
let dirname =
|
||||
Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ())
|
||||
in
|
||||
let rec clean_dir y =
|
||||
match Sys.is_directory y with
|
||||
| `Yes ->
|
||||
Sys.ls_dir y
|
||||
|> List.map ~f:(Filename.concat y)
|
||||
|> List.iter ~f:(function x ->
|
||||
match ( Sys.is_directory x, Sys.is_file x ) with
|
||||
| (`Yes, _) -> clean_dir x
|
||||
| (_, `Yes) -> Sys.remove x
|
||||
| (_,_) -> ()
|
||||
);
|
||||
begin
|
||||
let dirname =
|
||||
Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ())
|
||||
in
|
||||
let rec clean_dir y =
|
||||
if Sys.is_directory y then
|
||||
begin
|
||||
Sys.readdir y
|
||||
|> Array.map (fun x -> Filename.concat y x)
|
||||
|> Array.iter (function x ->
|
||||
if Sys.is_directory x then
|
||||
clean_dir x
|
||||
else
|
||||
Sys.remove x
|
||||
);
|
||||
Unix.rmdir y
|
||||
| `Unknown
|
||||
| `No -> ()
|
||||
in clean_dir dirname;
|
||||
Printf.printf "Blocks cleared\n"
|
||||
end
|
||||
end
|
||||
in clean_dir dirname;
|
||||
Printf.printf "Blocks cleared\n"
|
||||
end
|
||||
;
|
||||
|
||||
Input.validate ();
|
||||
|
|
@ -272,51 +274,96 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
|
|||
write_input_in_ezfio ezfio_filename fields
|
||||
|
||||
|
||||
let spec =
|
||||
let open Command.Spec in
|
||||
empty
|
||||
+> flag "c" no_arg
|
||||
~doc:(" Clear blocks")
|
||||
+> flag "f" (optional float)
|
||||
~doc:("float "^Input.Fitcusp_factor.doc)
|
||||
+> flag "t" (optional int)
|
||||
~doc:("seconds "^Input.Stop_time.doc)
|
||||
+> flag "l" (optional int)
|
||||
~doc:("seconds "^Input.Block_time.doc)
|
||||
+> flag "m" (optional string)
|
||||
~doc:("method "^Input.Method.doc)
|
||||
+> flag "e" (optional float)
|
||||
~doc:("energy "^Input.Ref_energy.doc)
|
||||
+> flag "et" (optional float)
|
||||
~doc:("energy "^Input.Trial_wf_energy.doc)
|
||||
+> flag "s" (optional string)
|
||||
~doc:("sampling "^Input.Sampling.doc)
|
||||
+> flag "ts" (optional float)
|
||||
~doc:("time_step "^Input.Time_step.doc)
|
||||
+> flag "w" (optional int)
|
||||
~doc:("walk_num "^Input.Walk_num.doc)
|
||||
+> flag "wt" (optional int)
|
||||
~doc:("walk_num_tot "^Input.Walk_num_tot.doc)
|
||||
+> flag "n" (optional float)
|
||||
~doc:("norm "^Input.CI_threshold.doc)
|
||||
+> flag "j" (optional string)
|
||||
~doc:("jastrow_type "^Input.Jastrow_type.doc)
|
||||
+> flag "p" (optional float)
|
||||
~doc:("projection_time "^Input.SRMC_projection_time.doc)
|
||||
+> anon ("ezfio_file" %: string)
|
||||
+> anon (maybe ("input" %: string))
|
||||
;;
|
||||
let () =
|
||||
let open Command_line in
|
||||
begin
|
||||
set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
|
||||
set_description_doc "Edits input data";
|
||||
|
||||
let command =
|
||||
Command.basic_spec
|
||||
~summary: "Edit input data"
|
||||
~readme:(fun () ->
|
||||
"
|
||||
Edit input data
|
||||
")
|
||||
spec
|
||||
(fun c f t l m e et s ts w wt n j p ezfio_file input () ->
|
||||
run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file )
|
||||
[ { short='c' ; long="clear" ; opt=Optional ;
|
||||
doc="Clears blocks" ;
|
||||
arg=Without_arg ; };
|
||||
|
||||
{ short='e' ; long="ref-energy" ; opt=Optional ;
|
||||
doc=Input.Ref_energy.doc;
|
||||
arg=With_arg "<float>"; };
|
||||
|
||||
{ short='f' ; long="fitcusp" ; opt=Optional ;
|
||||
doc=Input.Fitcusp_factor.doc;
|
||||
arg=With_arg "<float>"; };
|
||||
|
||||
{ short='i' ; long="time-step" ; opt=Optional ;
|
||||
doc=Input.Time_step.doc;
|
||||
arg=With_arg "<float>"; };
|
||||
|
||||
{ short='j' ; long="jastrow" ; opt=Optional ;
|
||||
doc=Input.Jastrow_type.doc;
|
||||
arg=With_arg "<string>"; };
|
||||
|
||||
{ short='l' ; long="block-time" ; opt=Optional ;
|
||||
doc=Input.Block_time.doc;
|
||||
arg=With_arg "<int>"; };
|
||||
|
||||
{ short='m' ; long="method" ; opt=Optional ;
|
||||
doc=Input.Method.doc;
|
||||
arg=With_arg "<string>"; };
|
||||
|
||||
{ short='n' ; long="norm" ; opt=Optional ;
|
||||
doc=Input.CI_threshold.doc;
|
||||
arg=With_arg "<float>"; };
|
||||
|
||||
{ short='p' ; long="projection-time" ; opt=Optional ;
|
||||
doc=Input.SRMC_projection_time.doc;
|
||||
arg=With_arg "<float>"; };
|
||||
|
||||
{ short='r' ; long="trial-energy" ; opt=Optional ;
|
||||
doc=Input.Trial_wf_energy.doc;
|
||||
arg=With_arg "<float>"; };
|
||||
|
||||
{ short='s' ; long="sampling" ; opt=Optional ;
|
||||
doc=Input.Sampling.doc;
|
||||
arg=With_arg "<string>"; };
|
||||
|
||||
{ short='t' ; long="stop-time" ; opt=Optional ;
|
||||
doc=Input.Stop_time.doc;
|
||||
arg=With_arg "<int>"; };
|
||||
|
||||
{ short='w' ; long="walk-num" ; opt=Optional ;
|
||||
doc=Input.Walk_num.doc;
|
||||
arg=With_arg "<int>"; };
|
||||
|
||||
{ short='x' ; long="walk-num-tot" ; opt=Optional ;
|
||||
doc=Input.Walk_num_tot.doc;
|
||||
arg=With_arg "<int>"; };
|
||||
|
||||
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
|
||||
anonymous "FILE" Optional "Name of the input file";
|
||||
]
|
||||
|> set_specs ;
|
||||
end;
|
||||
|
||||
let c = Command_line.get_bool "clear" in
|
||||
let f = Command_line.get "fitcusp" in
|
||||
let t = Command_line.get "stop-time" in
|
||||
let l = Command_line.get "block-time" in
|
||||
let m = Command_line.get "method" in
|
||||
let e = Command_line.get "ref-energy" in
|
||||
let et = Command_line.get "trial-energy" in
|
||||
let s = Command_line.get "stop-time" in
|
||||
let ts = Command_line.get "time-step" in
|
||||
let w = Command_line.get "walk-num" in
|
||||
let wt = Command_line.get "walk-num-tot" in
|
||||
let n = Command_line.get "norm" in
|
||||
let j = Command_line.get "jastrow" in
|
||||
let p = Command_line.get "projection-time" in
|
||||
|
||||
let ezfio_file, input =
|
||||
match Command_line.anon_args () with
|
||||
| ezfio_file :: [] -> ezfio_file, None
|
||||
| ezfio_file :: file :: [] -> ezfio_file, (Some file)
|
||||
| _ -> (Command_line.help () ; failwith "Inconsistent command line")
|
||||
in
|
||||
run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,27 +1,26 @@
|
|||
open Core
|
||||
|
||||
let split_re =
|
||||
Str.regexp " +"
|
||||
|
||||
|
||||
let split s =
|
||||
String.strip s
|
||||
String.trim s
|
||||
|> Str.split split_re
|
||||
|
||||
|
||||
let set_ezfio_filename ezfio_filename =
|
||||
let () =
|
||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
||||
if (not (Sys.file_exists ezfio_filename)) then
|
||||
failwith (ezfio_filename^" does not exist")
|
||||
in
|
||||
let () =
|
||||
match (Sys.is_directory ezfio_filename) with
|
||||
| `Yes -> Ezfio.set_file ezfio_filename ;
|
||||
| _ -> failwith ("Error : "^ezfio_filename^" is not a directory")
|
||||
if Sys.is_directory ezfio_filename then
|
||||
Ezfio.set_file ezfio_filename
|
||||
else
|
||||
failwith ("Error : "^ezfio_filename^" is not a directory")
|
||||
in
|
||||
let dir, result =
|
||||
Filename.realpath ezfio_filename
|
||||
|> Filename.split
|
||||
Filename.dirname ezfio_filename,
|
||||
Filename.basename ezfio_filename
|
||||
in
|
||||
Unix.chdir dir ;
|
||||
Ezfio.set_file result
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
open Core
|
||||
open Qptypes
|
||||
|
||||
type t =
|
||||
|
|
@ -26,7 +25,7 @@ module Skewness: sig
|
|||
val to_string : t -> string
|
||||
end = struct
|
||||
type t = float
|
||||
let to_string = Float.to_string
|
||||
let to_string = string_of_float
|
||||
let to_float x = x
|
||||
let of_float x = x
|
||||
end
|
||||
|
|
@ -38,7 +37,7 @@ module Kurtosis: sig
|
|||
val to_string : t -> string
|
||||
end = struct
|
||||
type t = float
|
||||
let to_string = Float.to_string
|
||||
let to_string = string_of_float
|
||||
let to_float x = x
|
||||
let of_float x = x
|
||||
end
|
||||
|
|
@ -64,7 +63,7 @@ end = struct
|
|||
(x -. mu) *. ( x -. mu) /. sigma2
|
||||
in
|
||||
let pi =
|
||||
Float.acos (-1.)
|
||||
acos (-1.)
|
||||
in
|
||||
let c =
|
||||
1. /. (sqrt (sigma2 *. (pi +. pi)))
|
||||
|
|
@ -79,15 +78,15 @@ end
|
|||
let of_raw_data ?(locked=true) ~range property =
|
||||
let data =
|
||||
Block.raw_data ~locked ()
|
||||
|> List.filter ~f:(fun x -> x.Block.property = property)
|
||||
|> List.filter (fun x -> x.Block.property = property)
|
||||
in
|
||||
|
||||
let data_in_range rmin rmax =
|
||||
|
||||
let total_weight =
|
||||
List.fold_left data ~init:0. ~f:(fun accu x ->
|
||||
(Weight.to_float x.Block.weight) +. accu
|
||||
)
|
||||
List.fold_left (fun accu x ->
|
||||
(Weight.to_float x.Block.weight) +. accu
|
||||
) 0. data
|
||||
in
|
||||
|
||||
let wmin, wmax =
|
||||
|
|
@ -96,7 +95,7 @@ let of_raw_data ?(locked=true) ~range property =
|
|||
in
|
||||
|
||||
let (_, new_data) =
|
||||
List.fold_left data ~init:(0.,[]) ~f:(fun (wsum, l) x ->
|
||||
List.fold_left (fun (wsum, l) x ->
|
||||
if (wsum > wmax) then
|
||||
(wsum,l)
|
||||
else
|
||||
|
|
@ -109,7 +108,7 @@ let of_raw_data ?(locked=true) ~range property =
|
|||
else
|
||||
(wsum_new, l)
|
||||
end
|
||||
)
|
||||
) (0.,[]) data
|
||||
in
|
||||
List.rev new_data
|
||||
in
|
||||
|
|
@ -127,13 +126,13 @@ let of_raw_data ?(locked=true) ~range property =
|
|||
let average { property ; data } =
|
||||
if Property.is_scalar property then
|
||||
let (num,denom) =
|
||||
List.fold ~init:(0., 0.) ~f:(fun (an, ad) x ->
|
||||
List.fold_left (fun (an, ad) x ->
|
||||
let num =
|
||||
(Weight.to_float x.Block.weight) *. (Sample.to_float x.Block.value)
|
||||
and den =
|
||||
(Weight.to_float x.Block.weight)
|
||||
in (an +. num, ad +. den)
|
||||
) data
|
||||
) (0., 0.) data
|
||||
in
|
||||
num /. denom
|
||||
|> Average.of_float
|
||||
|
|
@ -144,20 +143,18 @@ let average { property ; data } =
|
|||
| x :: tl -> Sample.dimension x.Block.value
|
||||
in
|
||||
let (num,denom) =
|
||||
List.fold ~init:(Array.create ~len:dim 0. , 0.) ~f:(fun (an, ad) x ->
|
||||
List.fold_left (fun (an, ad) x ->
|
||||
let num =
|
||||
Array.map (Sample.to_float_array x.Block.value) ~f:(fun y ->
|
||||
(Weight.to_float x.Block.weight) *. y)
|
||||
Array.map (fun y -> (Weight.to_float x.Block.weight) *. y)
|
||||
(Sample.to_float_array x.Block.value)
|
||||
and den = (Weight.to_float x.Block.weight)
|
||||
in (
|
||||
Array.mapi an ~f:(fun i y -> y +. num.(i)) ,
|
||||
ad +. den)
|
||||
) data
|
||||
in ( Array.mapi (fun i y -> y +. num.(i)) an , ad +. den)
|
||||
) (Array.make dim 0. , 0.) data
|
||||
in
|
||||
let denom_inv =
|
||||
1. /. denom
|
||||
in
|
||||
Array.map num ~f:(fun x -> x *. denom_inv)
|
||||
Array.map (fun x -> x *. denom_inv) num
|
||||
|> Average.of_float_array ~dim
|
||||
|
||||
|
||||
|
|
@ -166,10 +163,10 @@ let average { property ; data } =
|
|||
|
||||
(** Compute sum (for CPU/Wall time) *)
|
||||
let sum { property ; data } =
|
||||
List.fold data ~init:0. ~f:(fun accu x ->
|
||||
List.fold_left (fun accu x ->
|
||||
let num = (Weight.to_float x.Block.weight) *. (Sample.to_float x.Block.value)
|
||||
in accu +. num
|
||||
)
|
||||
) 0. data
|
||||
|
||||
|
||||
|
||||
|
|
@ -181,7 +178,7 @@ let ave_error { property ; data } =
|
|||
begin
|
||||
if (n > 0.) then
|
||||
( Average.of_float (sum /. ansum),
|
||||
Some (Error.of_float (sqrt ( Float.abs ( avsq /.( ansum *. n)))) ))
|
||||
Some (Error.of_float (sqrt ( abs_float ( avsq /.( ansum *. n)))) ))
|
||||
else
|
||||
( Average.of_float (sum /. ansum), None)
|
||||
end
|
||||
|
|
@ -220,10 +217,10 @@ let ave_error { property ; data } =
|
|||
in
|
||||
|
||||
if (Property.is_scalar property) then
|
||||
List.map data ~f:(fun x ->
|
||||
List.map (fun x ->
|
||||
(Sample.to_float x.Block.value,
|
||||
Weight.to_float x.Block.weight)
|
||||
)
|
||||
) data
|
||||
|> ave_error_scalar
|
||||
else
|
||||
match data with
|
||||
|
|
@ -234,22 +231,22 @@ let ave_error { property ; data } =
|
|||
|> Sample.dimension
|
||||
in
|
||||
let result =
|
||||
Array.init dim ~f:(fun idx ->
|
||||
List.map list_of_samples ~f:(fun x ->
|
||||
Array.init dim (fun idx ->
|
||||
List.map (fun x ->
|
||||
(Sample.to_float ~idx x.Block.value,
|
||||
Weight.to_float x.Block.weight)
|
||||
)
|
||||
) list_of_samples
|
||||
|> ave_error_scalar
|
||||
)
|
||||
in
|
||||
( Array.map result ~f:(fun (x,_) -> Average.to_float x)
|
||||
( Array.map (fun (x,_) -> Average.to_float x) result
|
||||
|> Average.of_float_array ~dim ,
|
||||
if (Array.length result < 2) then
|
||||
None
|
||||
else
|
||||
Some (Array.map result ~f:(function
|
||||
Some (Array.map (function
|
||||
| (_,Some y) -> Error.to_float y
|
||||
| (_,None) -> 0.)
|
||||
| (_,None) -> 0.) result
|
||||
|> Average.of_float_array ~dim)
|
||||
)
|
||||
|
||||
|
|
@ -258,14 +255,17 @@ let ave_error { property ; data } =
|
|||
|
||||
(** Fold function for block values *)
|
||||
let fold_blocks ~f { property ; data } =
|
||||
let init = match List.hd data with
|
||||
| None -> 0.
|
||||
| Some block -> Sample.to_float block.Block.value
|
||||
let init =
|
||||
try
|
||||
let block = List.hd data in
|
||||
Sample.to_float block.Block.value
|
||||
with
|
||||
| Failure "hd" -> 0.
|
||||
in
|
||||
List.fold_left data ~init:init ~f:(fun accu block ->
|
||||
List.fold_left (fun accu block ->
|
||||
let x = Sample.to_float block.Block.value
|
||||
in f accu x
|
||||
)
|
||||
) init data
|
||||
|
||||
|
||||
|
||||
|
|
@ -288,7 +288,7 @@ let convergence { property ; data } =
|
|||
in
|
||||
let accu =
|
||||
if (n > 0.) then
|
||||
(sum /. ansum, sqrt ( Float.abs ( avsq /.( ansum *. n))))::accu
|
||||
(sum /. ansum, sqrt ( abs_float ( avsq /.( ansum *. n))))::accu
|
||||
else
|
||||
(sum /. ansum, 0.)::accu
|
||||
in
|
||||
|
|
@ -478,7 +478,7 @@ let error_x_over_y = function
|
|||
n := !n +. 1.
|
||||
);
|
||||
let arg =
|
||||
Float.abs (!avsq /.(!ansum *. (!n -. 1.)))
|
||||
abs_float (!avsq /.(!ansum *. (!n -. 1.)))
|
||||
in
|
||||
let error =
|
||||
sqrt arg
|
||||
|
|
@ -720,11 +720,11 @@ let autocovariance { property ; data } =
|
|||
in
|
||||
let f i =
|
||||
let denom =
|
||||
if (i > 1) then (Float.of_int i) else 1.
|
||||
if (i > 1) then (float_of_int i) else 1.
|
||||
in
|
||||
let r =
|
||||
Array.sub ~pos:0 ~len:i x_t
|
||||
|> Array.fold ~init:0. ~f:(fun accu x ->
|
||||
|> Array.fold_left ~init:0. ~f:(fun accu x ->
|
||||
accu +. x *. x_t.(i))
|
||||
in
|
||||
r /. denom
|
||||
|
|
@ -749,7 +749,7 @@ let centered_cumulants { property ; data } =
|
|||
in
|
||||
let var =
|
||||
let (num, denom) =
|
||||
List.fold ~init:(0., 0.) ~f:(fun (a2, ad) (w,x) ->
|
||||
List.fold_left ~init:(0., 0.) ~f:(fun (a2, ad) (w,x) ->
|
||||
let x2 = x *. x
|
||||
in
|
||||
let var = w *. x2
|
||||
|
|
@ -770,7 +770,7 @@ let centered_cumulants { property ; data } =
|
|||
in
|
||||
let (cum3,cum4) =
|
||||
let (cum3, cum4, denom) =
|
||||
List.fold ~init:(0., 0., 0.) ~f:(fun (a3, a4, ad) (w,x) ->
|
||||
List.fold_left ~init:(0., 0., 0.) ~f:(fun (a3, a4, ad) (w,x) ->
|
||||
let x2 = x *. x
|
||||
in
|
||||
let cum3 = w *. x2 *. x
|
||||
|
|
@ -796,13 +796,13 @@ let histogram { property ; data } =
|
|||
max -. min
|
||||
and n =
|
||||
List.length data
|
||||
|> Float.of_int
|
||||
|> float_of_int
|
||||
|> sqrt
|
||||
in
|
||||
let delta_x =
|
||||
length /. (n-.1.)
|
||||
and result =
|
||||
Array.init ~f:(fun _ -> 0.) (Int.of_float (n +. 1.))
|
||||
Array.init ~f:(fun _ -> 0.) (int_of_float (n +. 1.))
|
||||
in
|
||||
List.iter ~f:(fun x ->
|
||||
let w =
|
||||
|
|
@ -812,17 +812,17 @@ let histogram { property ; data } =
|
|||
in
|
||||
let i =
|
||||
(x -. min) /. delta_x +. 0.5
|
||||
|> Float.to_int
|
||||
|> int_of_float
|
||||
in
|
||||
result.(i) <- result.(i) +. w
|
||||
) data
|
||||
;
|
||||
let norm =
|
||||
1. /. ( delta_x *. (
|
||||
Array.fold ~init:0. ~f:(fun accu x -> accu +. x) result
|
||||
Array.fold_left ~init:0. ~f:(fun accu x -> accu +. x) result
|
||||
) )
|
||||
in
|
||||
Array.mapi ~f:(fun i x -> (min +. (Float.of_int i)*.delta_x, x *. norm) ) result
|
||||
Array.mapi ~f:(fun i x -> (min +. (float_of_int i)*.delta_x, x *. norm) ) result
|
||||
|> Array.to_list
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
open Core
|
||||
|
||||
type t =
|
||||
| One_dimensional of float
|
||||
| Multidimensional of (float array * int)
|
||||
|
|
@ -38,9 +36,10 @@ let of_float_array ~dim x =
|
|||
| _ -> Multidimensional (x, dim)
|
||||
|
||||
let to_string = function
|
||||
| One_dimensional x -> Float.to_string x
|
||||
| One_dimensional x -> string_of_float x
|
||||
| Multidimensional (x,_) ->
|
||||
Array.map x ~f:Float.to_string
|
||||
|> String.concat_array ~sep:" "
|
||||
Array.map string_of_float x
|
||||
|> Array.to_list
|
||||
|> String.concat " "
|
||||
|> Printf.sprintf "%s"
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
open Core
|
||||
|
||||
type t [@@ deriving sexp]
|
||||
val to_float : ?idx:int -> t -> float
|
||||
val to_float_array : t -> float array
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
open Core
|
||||
|
||||
type t =
|
||||
| SGE
|
||||
| PBS
|
||||
|
|
@ -18,12 +16,10 @@ let to_string = function
|
|||
let find () =
|
||||
let scheduler =
|
||||
[ "SLURM_NODELIST" ; "PE_HOSTFILE" ; "PBS_NODEFILE" ]
|
||||
|> List.map ~f:(function x ->
|
||||
match (Sys.getenv x) with
|
||||
| Some _ -> x
|
||||
| None -> ""
|
||||
|> List.map (function x ->
|
||||
try Some (Sys.getenv x) with
|
||||
| Not_found -> None
|
||||
)
|
||||
|> List.filter ~f:(function x -> x <> "")
|
||||
|> List.hd
|
||||
in
|
||||
let result =
|
||||
|
|
|
|||
|
|
@ -0,0 +1,160 @@
|
|||
include String
|
||||
|
||||
(** Split a string on a given character *)
|
||||
let split ?(on=' ') str =
|
||||
split_on_char on str
|
||||
|
||||
|
||||
(** Strip blanks on the left of a string *)
|
||||
let ltrim s =
|
||||
let rec do_work s l =
|
||||
match s.[0] with
|
||||
| '\n'
|
||||
| ' ' -> do_work (sub s 1 (l-1)) (l-1)
|
||||
| _ -> s
|
||||
in
|
||||
let l =
|
||||
length s
|
||||
in
|
||||
if (l > 0) then
|
||||
do_work s l
|
||||
else
|
||||
s
|
||||
|
||||
(** Strip blanks on the right of a string *)
|
||||
let rtrim s =
|
||||
let rec do_work s l =
|
||||
let newl =
|
||||
l-1
|
||||
in
|
||||
match s.[newl] with
|
||||
| '\n'
|
||||
| ' ' -> do_work (sub s 0 (newl)) (newl)
|
||||
| _ -> s
|
||||
in
|
||||
let l =
|
||||
length s
|
||||
in
|
||||
if (l > 0) then
|
||||
do_work s l
|
||||
else
|
||||
s
|
||||
|
||||
|
||||
(** Strip blanks on the right and left of a string *)
|
||||
let strip = String.trim
|
||||
|
||||
|
||||
(** Split a string in two pieces when a character is found the 1st time from the left *)
|
||||
let lsplit2_exn ?(on=' ') s =
|
||||
let length =
|
||||
String.length s
|
||||
in
|
||||
let rec do_work i =
|
||||
if (i = length) then
|
||||
begin
|
||||
raise Not_found
|
||||
end
|
||||
else if (s.[i] = on) then
|
||||
( String.sub s 0 i,
|
||||
String.sub s (i+1) (length-i-1) )
|
||||
else
|
||||
do_work (i+1)
|
||||
in
|
||||
do_work 0
|
||||
|
||||
|
||||
(** Split a string in two pieces when a character is found the 1st time from the right *)
|
||||
let rsplit2_exn ?(on=' ') s =
|
||||
let length =
|
||||
String.length s
|
||||
in
|
||||
let rec do_work i =
|
||||
if (i = -1) then
|
||||
begin
|
||||
raise Not_found
|
||||
end
|
||||
else if (s.[i] = on) then
|
||||
( String.sub s 0 i,
|
||||
String.sub s (i+1) (length-i-1) )
|
||||
else
|
||||
do_work (i-1)
|
||||
in
|
||||
do_work (length-1)
|
||||
|
||||
|
||||
let lsplit2 ?(on=' ') s =
|
||||
try
|
||||
Some (lsplit2_exn ~on s)
|
||||
with
|
||||
| Not_found -> None
|
||||
|
||||
|
||||
let rsplit2 ?(on=' ') s =
|
||||
try
|
||||
Some (rsplit2_exn ~on s)
|
||||
with
|
||||
| Not_found -> None
|
||||
|
||||
|
||||
let to_list s =
|
||||
Array.init (String.length s) (fun i -> s.[i])
|
||||
|> Array.to_list
|
||||
|
||||
|
||||
let of_list l =
|
||||
let a = Array.of_list l in
|
||||
String.init (Array.length a) (fun i -> a.(i))
|
||||
|
||||
let rev s =
|
||||
to_list s
|
||||
|> List.rev
|
||||
|> of_list
|
||||
|
||||
let fold ~init ~f s =
|
||||
to_list s
|
||||
|> List.fold_left f init
|
||||
|
||||
|
||||
let is_prefix ~prefix s =
|
||||
let len =
|
||||
String.length prefix
|
||||
in
|
||||
if len > String.length s then
|
||||
false
|
||||
else
|
||||
prefix = String.sub s 0 len
|
||||
|
||||
|
||||
let of_char c =
|
||||
String.make 1 c
|
||||
|
||||
let tr ~target ~replacement s =
|
||||
String.map (fun c -> if c = target then replacement else c) s
|
||||
|
||||
|
||||
let substr_index ?(pos=0) ~pattern s =
|
||||
try
|
||||
let regexp =
|
||||
Str.regexp pattern
|
||||
in
|
||||
Some (Str.search_forward regexp s pos)
|
||||
with Not_found -> None
|
||||
|
||||
|
||||
let substr_replace_all ~pattern ~with_ s =
|
||||
let regexp =
|
||||
Str.regexp pattern
|
||||
in
|
||||
Str.global_replace regexp with_ s
|
||||
|
||||
|
||||
let input_lines ic =
|
||||
let rec aux ic accu =
|
||||
try
|
||||
aux ic ((input_line ic)::accu)
|
||||
with
|
||||
| End_of_file -> List.rev accu
|
||||
in
|
||||
aux ic []
|
||||
|
||||
|
|
@ -1,5 +1,3 @@
|
|||
open Core
|
||||
|
||||
let _list = ref [] ;;
|
||||
let _running = ref false;;
|
||||
let _threads = ref [] ;;
|
||||
|
|
@ -7,10 +5,10 @@ let _threads = ref [] ;;
|
|||
(** Kill the current process and all children *)
|
||||
let kill () =
|
||||
let kill pid =
|
||||
Signal.send_i Signal.int (`Pid pid);
|
||||
Printf.printf "Killed %d\n%!" (Pid.to_int pid)
|
||||
Unix.kill pid Sys.sigint;
|
||||
Printf.printf "Killed %d\n%!" pid
|
||||
in
|
||||
List.iter ~f:kill (!_list);
|
||||
List.iter kill (!_list);
|
||||
exit 1
|
||||
;;
|
||||
|
||||
|
|
@ -25,14 +23,11 @@ let start () =
|
|||
_running := true;
|
||||
|
||||
let pause () =
|
||||
Time.Span.of_sec 1.
|
||||
|> Time.pause
|
||||
Unix.sleep 1
|
||||
in
|
||||
|
||||
let pid_is_running pid =
|
||||
match (Sys.file_exists ("/proc/"^(Pid.to_string pid)^"/stat")) with
|
||||
| `No | `Unknown -> false
|
||||
| `Yes -> true
|
||||
Sys.file_exists ("/proc/"^(string_of_int pid)^"/stat")
|
||||
in
|
||||
|
||||
let f () =
|
||||
|
|
@ -41,13 +36,13 @@ let start () =
|
|||
pause () ;
|
||||
|
||||
(*DEBUG
|
||||
List.iter (!_list) ~f:(fun x -> Printf.printf "%d\n%!" (Pid.to_int x));
|
||||
List.iter (fun x -> Printf.printf "%d\n%!" x) (!_list) ;
|
||||
*)
|
||||
|
||||
let continue () =
|
||||
List.fold_left (!_list) ~init:true ~f:(
|
||||
fun accu x -> accu && (pid_is_running x)
|
||||
)
|
||||
List.fold_left
|
||||
( fun accu x -> accu && (pid_is_running x))
|
||||
true (!_list)
|
||||
in
|
||||
if ( not (continue ()) ) then
|
||||
kill ()
|
||||
|
|
@ -90,24 +85,24 @@ let del pid =
|
|||
;;
|
||||
|
||||
(** Fork and exec a new process *)
|
||||
let fork_exec ~prog ~argv () =
|
||||
let fork_exec ~prog ~args () =
|
||||
let pid =
|
||||
Unix.fork_exec ~prog ~argv ()
|
||||
match Unix.fork () with
|
||||
| 0 -> (* Chile process *)
|
||||
let _ = Unix.execv prog args in 0
|
||||
| pid -> pid
|
||||
in
|
||||
|
||||
let f () =
|
||||
add pid;
|
||||
let success =
|
||||
match (Unix.waitpid pid) with
|
||||
| Core_kernel.Std.Result.Ok () -> true
|
||||
| Core_kernel.Std.Result.Error (`Exit_non_zero n) ->
|
||||
( Printf.printf "PID %d exited with code %d\n%!"
|
||||
(Pid.to_int pid) n ;
|
||||
match (Unix.waitpid [] pid) with
|
||||
| pid , Unix.WEXITED n -> true
|
||||
| pid , Unix.WSIGNALED n ->
|
||||
( Printf.printf "PID %d killed with signal %d\n%!" pid n;
|
||||
false )
|
||||
| Core_kernel.Std.Result.Error (`Signal n) ->
|
||||
( Printf.printf "PID %d killed with signal %d (%s)\n%!"
|
||||
(Pid.to_int pid) (Signal.to_system_int n)
|
||||
(Signal.to_string n) ;
|
||||
| pid , Unix.WSTOPPED n ->
|
||||
( Printf.printf "PID %d stopped with signal %d\n%!" pid n;
|
||||
false )
|
||||
in
|
||||
del pid ;
|
||||
|
|
@ -121,6 +116,6 @@ let fork_exec ~prog ~argv () =
|
|||
(** Wait for threads to finish *)
|
||||
let join () =
|
||||
(* if (!_running) then stop (); *)
|
||||
List.iter ~f:Thread.join (!_threads);
|
||||
List.iter Thread.join (!_threads);
|
||||
assert (not !_running)
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
true: package(cryptokit,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt)
|
||||
true: thread
|
||||
false: profile
|
||||
<*byte> : linkdep(c_bindings.o), custom
|
||||
<*.native>: linkdep(c_bindings.o)
|
||||
|
||||
|
|
@ -1,84 +0,0 @@
|
|||
MAIN=qmcchem
|
||||
# Main program to build
|
||||
|
||||
PACKAGES=-package core,cryptokit,str,zmq
|
||||
#,ppx_sexp_conv
|
||||
# Required opam packages, for example:
|
||||
# PACKAGES=-package core,sexplib.syntax
|
||||
|
||||
THREAD=-thread
|
||||
# If you need threding support, use:
|
||||
# THREAD=-thread
|
||||
|
||||
SYNTAX=
|
||||
# If you need pre-processing, use:
|
||||
# SYNTAX=-syntax camlp4o
|
||||
|
||||
OCAMLC_FLAGS=-g -warn-error A
|
||||
# Flags to give to ocamlc, for example:
|
||||
# OCAMLC_FLAGS=-g -warn-error A
|
||||
|
||||
LINK_FLAGS=
|
||||
# Flags to give to the linker, for example:
|
||||
# LINK_FLAGS=-cclib '-Wl,-rpath=../lib,--enable-new-dtags'
|
||||
|
||||
GENERATED_NINJA=generated.ninja
|
||||
# Name of the auto-generated ninja file
|
||||
|
||||
rule run_ninja
|
||||
command = ../scripts/compile_ocaml.sh $target
|
||||
description = Compiling OCaml executables
|
||||
pool = console
|
||||
|
||||
rule run_ninja_ocaml
|
||||
command = ../scripts/compile_ocaml_dep.sh
|
||||
description = Finding dependencies in OCaml files
|
||||
|
||||
rule run_clean
|
||||
command = ninja -f $GENERATED_NINJA -t clean ; rm -f $GENERATED_NINJA rm -f *.cmx *.cmi *.o .ls_md5 ; ninja -t clean
|
||||
pool = console
|
||||
description = Cleaning directory
|
||||
|
||||
rule ocamlc
|
||||
command = ocamlfind ocamlc -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in
|
||||
description = Compiling $in (bytecode)
|
||||
|
||||
rule ocamlopt
|
||||
command = ocamlfind ocamlopt -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in
|
||||
description = Compiling $in (native)
|
||||
|
||||
rule ocamlc_link
|
||||
command = ocamlfind ocamlc $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in
|
||||
description = Compiling $out (bytecode)
|
||||
|
||||
rule ocamlopt_link
|
||||
command = ocamlfind ocamlopt $OCAMLC_FLAGS $THREAD -linkpkg $PACKAGES $PACKAGES $SYNTAX -o $out $in
|
||||
description = Compiling $out (native)
|
||||
|
||||
rule create_qptypes
|
||||
command = ./$in
|
||||
description = Creating $out
|
||||
|
||||
rule copy
|
||||
command = cp $in $out
|
||||
description = Copying $in to $out
|
||||
|
||||
build always: phony
|
||||
build $GENERATED_NINJA: run_ninja_ocaml | Qptypes.ml ezfio.ml always
|
||||
build ezfio.ml: copy ../EZFIO/Ocaml/ezfio.ml
|
||||
build Qptypes.ml: create_qptypes qptypes_generator | ezfio.ml
|
||||
build qptypes_generator.o qptypes_generator.cmx: ocamlopt qptypes_generator.ml | ezfio.ml
|
||||
build qptypes_generator: ocamlopt_link qptypes_generator.cmx
|
||||
|
||||
build clean: run_clean
|
||||
|
||||
build $MAIN: run_ninja | ezfio.ml Qptypes.ml $GENERATED_NINJA
|
||||
target = $MAIN
|
||||
|
||||
build all: run_ninja | ezfio.ml Qptypes.ml $GENERATED_NINJA
|
||||
target =
|
||||
|
||||
default $MAIN
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
#include <caml/mlvalues.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
#include <caml/custom.h>
|
||||
#include <caml/threads.h>
|
||||
|
||||
#include <string.h>
|
||||
|
||||
|
||||
|
||||
/* Adapted from
|
||||
https://github.com/monadbobo/ocaml-core/blob/master/base/core/lib/linux_ext_stubs.c
|
||||
*/
|
||||
|
||||
#include <unistd.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <net/if.h>
|
||||
#include <sys/socket.h>
|
||||
#include <netinet/in.h>
|
||||
#include <arpa/inet.h>
|
||||
|
||||
CAMLprim value get_ipv4_address_for_interface(value v_interface)
|
||||
{
|
||||
CAMLparam1(v_interface);
|
||||
struct ifreq ifr;
|
||||
int fd = -1;
|
||||
value res;
|
||||
char* error = NULL;
|
||||
|
||||
memset(&ifr, 0, sizeof(ifr));
|
||||
ifr.ifr_addr.sa_family = AF_INET;
|
||||
/* [ifr] is already initialized to zero, so it doesn't matter if the
|
||||
incoming string is too long, and [strncpy] fails to add a \0. */
|
||||
strncpy(ifr.ifr_name, String_val(v_interface), IFNAMSIZ - 1);
|
||||
|
||||
caml_enter_blocking_section();
|
||||
fd = socket(AF_INET, SOCK_DGRAM, 0);
|
||||
|
||||
if (fd == -1)
|
||||
error = "error: couldn't allocate socket";
|
||||
else {
|
||||
if (ioctl(fd, SIOCGIFADDR, &ifr) < 0)
|
||||
error = "error: ioctl(fd, SIOCGIFADDR, ...) failed";
|
||||
|
||||
(void) close(fd);
|
||||
}
|
||||
|
||||
caml_leave_blocking_section();
|
||||
|
||||
if (error == NULL) {
|
||||
/* This is weird but doing the usual casting causes errors when using
|
||||
* the new gcc on CentOS 6. This solution was picked up on Red Hat's
|
||||
* bugzilla or something. It also works to memcpy a sockaddr into
|
||||
* a sockaddr_in. This is faster hopefully.
|
||||
*/
|
||||
union {
|
||||
struct sockaddr sa;
|
||||
struct sockaddr_in sain;
|
||||
} u;
|
||||
u.sa = ifr.ifr_addr;
|
||||
res = caml_copy_string(inet_ntoa(u.sain.sin_addr));
|
||||
}
|
||||
else
|
||||
res = caml_copy_string(error);
|
||||
CAMLreturn(res);
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
open Ocamlbuild_plugin;;
|
||||
|
||||
dispatch begin function
|
||||
| Before_rules ->
|
||||
begin
|
||||
end
|
||||
| After_rules ->
|
||||
begin
|
||||
flag ["ocaml";"compile";"native";"gprof"] (S [ A "-p"]);
|
||||
pdep ["link"] "linkdep" (fun param -> [param]);
|
||||
end
|
||||
| _ -> ()
|
||||
end
|
||||
|
|
@ -1,85 +1,98 @@
|
|||
open Core
|
||||
let global_replace x =
|
||||
x
|
||||
|> Str.global_replace (Str.regexp "Float.to_string") "string_of_float"
|
||||
|> 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") ""
|
||||
|
||||
let input_data = "
|
||||
* Positive_float : float
|
||||
assert (x >= 0.) ;
|
||||
* Positive_float : float
|
||||
if not (x >= 0.) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\" x));
|
||||
|
||||
* Strictly_positive_float : float
|
||||
assert (x > 0.) ;
|
||||
* Strictly_positive_float : float
|
||||
if not (x > 0.) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_float : (x > 0.) : x=%f\" x));
|
||||
|
||||
* Negative_float : float
|
||||
assert (x <= 0.) ;
|
||||
* Negative_float : float
|
||||
if not (x <= 0.) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Negative_float : (x <= 0.) : x=%f\" x));
|
||||
|
||||
* Strictly_negative_float : float
|
||||
assert (x < 0.) ;
|
||||
* Strictly_negative_float : float
|
||||
if not (x < 0.) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
|
||||
|
||||
* Positive_int : int
|
||||
assert (x >= 0) ;
|
||||
* Positive_int64 : int64
|
||||
if not (x >= 0L) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
|
||||
|
||||
* Strictly_positive_int : int
|
||||
assert (x > 0) ;
|
||||
* Positive_int : int
|
||||
if not (x >= 0) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
|
||||
|
||||
* Negative_int : int
|
||||
* Strictly_positive_int : int
|
||||
if not (x > 0) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_int : (x > 0) : x=%d\" x));
|
||||
|
||||
* Negative_int : int
|
||||
if not (x <= 0) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
|
||||
assert (x <= 0) ;
|
||||
|
||||
* Det_coef : float
|
||||
assert (x >= -1.) ;
|
||||
assert (x <= 1.) ;
|
||||
if (x < -1.) || (x > 1.) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
|
||||
|
||||
* Normalized_float : float
|
||||
assert (x <= 1.) ;
|
||||
assert (x >= 0.) ;
|
||||
if (x < 0.) || (x > 1.) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
|
||||
|
||||
* Strictly_negative_int : int
|
||||
assert (x < 0) ;
|
||||
* Strictly_negative_int : int
|
||||
if not (x < 0) then
|
||||
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_int : (x < 0) : x=%d\" x));
|
||||
|
||||
* Non_empty_string : string
|
||||
assert (x <> \"\") ;
|
||||
if (x = \"\") then
|
||||
raise (Invalid_argument \"Non_empty_string\");
|
||||
|
||||
|
||||
* Det_number_max : int
|
||||
assert (x > 0) ;
|
||||
if (x > 100000000) then
|
||||
* Det_number_max : int
|
||||
assert (x > 0) ;
|
||||
if (x > 100_000_000) then
|
||||
warning \"More than 100 million determinants\";
|
||||
"^
|
||||
(*
|
||||
"
|
||||
* States_number : int
|
||||
assert (x > 0) ;
|
||||
if (x > 100) then
|
||||
warning \"More than 100 states\";
|
||||
if (Ezfio.has_determinants_n_states_diag ()) then
|
||||
assert (x <= (Ezfio.get_determinants_n_states_diag ()))
|
||||
else if (Ezfio.has_determinants_n_states ()) then
|
||||
assert (x <= (Ezfio.get_determinants_n_states ()));
|
||||
|
||||
* Bit_kind_size : int
|
||||
* States_number : int
|
||||
assert (x > 0) ;
|
||||
if (x > 1000) then
|
||||
warning \"More than 1000 states\";
|
||||
|
||||
* Bit_kind_size : int
|
||||
begin match x with
|
||||
| 8 | 16 | 32 | 64 -> ()
|
||||
| _ -> raise (Failure \"Bit_kind_size should be (8|16|32|64).\")
|
||||
| _ -> raise (Invalid_argument \"Bit_kind_size should be (8|16|32|64).\")
|
||||
end;
|
||||
|
||||
* Bit_kind : int
|
||||
* Bit_kind : int
|
||||
begin match x with
|
||||
| 1 | 2 | 4 | 8 -> ()
|
||||
| _ -> raise (Failure \"Bit_kind should be (1|2|4|8).\")
|
||||
| _ -> raise (Invalid_argument \"Bit_kind should be (1|2|4|8).\")
|
||||
end;
|
||||
|
||||
* Bitmask_number : int
|
||||
assert (x > 0) ;
|
||||
"^
|
||||
*)
|
||||
"
|
||||
|
||||
* MO_coef : float
|
||||
|
||||
* MO_occ : float
|
||||
assert (x >= 0.);
|
||||
if x < 0. then 0. else
|
||||
if x > 2. then 2. else
|
||||
|
||||
* AO_coef : float
|
||||
|
||||
* AO_expo : float
|
||||
assert (x >= 0.) ;
|
||||
* AO_expo : float
|
||||
if (x < 0.) then
|
||||
raise (Invalid_argument (Printf.sprintf \"AO_expo : (x >= 0.) : x=%f\" x));
|
||||
|
||||
* AO_prim_number : int
|
||||
assert (x > 0) ;
|
||||
|
|
@ -102,6 +115,12 @@ let input_data = "
|
|||
|
||||
* MD5 : string
|
||||
assert ((String.length x) = 32);
|
||||
assert (
|
||||
let a =
|
||||
Array.init (String.length x) (fun i -> x.[i])
|
||||
in
|
||||
Array.fold_left (fun accu x -> accu && (x < 'g')) true a
|
||||
);
|
||||
|
||||
* Rst_string : string
|
||||
|
||||
|
|
@ -116,96 +135,96 @@ let input_data = "
|
|||
assert (x <> \"\") ;
|
||||
|
||||
"
|
||||
;;
|
||||
|
||||
|
||||
let input_ezfio = "
|
||||
* MO_number : int
|
||||
mo_basis_mo_tot_num
|
||||
1 : 10000
|
||||
More than 10000 MOs
|
||||
1 : 10_000
|
||||
More than 10_000 MOs
|
||||
|
||||
* AO_number : int
|
||||
ao_basis_ao_num
|
||||
1 : 10000
|
||||
More than 10000 AOs
|
||||
1 : 10_000
|
||||
More than 10_000 AOs
|
||||
|
||||
* Nucl_number : int
|
||||
nuclei_nucl_num
|
||||
1 : 10000
|
||||
More than 10000 nuclei
|
||||
1 : 10_000
|
||||
More than 10_000 nuclei
|
||||
|
||||
"^
|
||||
(*
|
||||
"
|
||||
* N_int_number : int
|
||||
determinants_n_int
|
||||
spindeterminants_n_int
|
||||
1 : 30
|
||||
N_int > 30
|
||||
|
||||
* Det_number : int
|
||||
determinants_n_det
|
||||
1 : 100000000
|
||||
spindeterminants_n_det
|
||||
1 : 100_000_000
|
||||
More than 100 million determinants
|
||||
"
|
||||
*)
|
||||
""
|
||||
;;
|
||||
|
||||
"
|
||||
|
||||
|
||||
let untouched = "
|
||||
"
|
||||
|
||||
let template = format_of_string "
|
||||
module %s : sig
|
||||
type t [@@ deriving sexp]
|
||||
type t [@@deriving sexp]
|
||||
val to_%s : t -> %s
|
||||
val of_%s : %s %s -> t
|
||||
val to_string : t -> string
|
||||
end = struct
|
||||
type t = %s [@@ deriving sexp]
|
||||
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
|
||||
end
|
||||
|
||||
"
|
||||
;;
|
||||
|
||||
|
||||
|
||||
let parse_input input=
|
||||
print_string "open Sexplib.Std\nlet warning = print_string\n" ;
|
||||
let rec parse result = function
|
||||
| [] -> result
|
||||
| ( "" , "" )::tail -> parse result tail
|
||||
| ( t , text )::tail ->
|
||||
let name,typ,params,params_val =
|
||||
match String.split ~on:':' t with
|
||||
| ( t , text )::tail ->
|
||||
let name,typ,params,params_val =
|
||||
match String.split_on_char ':' t with
|
||||
| [name;typ] -> (name,typ,"","")
|
||||
| name::typ::params::params_val -> (name,typ,params,
|
||||
(String.concat params_val ~sep:":") )
|
||||
(String.concat ":" params_val) )
|
||||
| _ -> assert false
|
||||
in
|
||||
let typ = String.strip typ
|
||||
and name = String.strip name in
|
||||
let typ_cap = String.capitalize typ in
|
||||
let newstring = Printf.sprintf template name typ typ typ params_val typ typ
|
||||
typ typ params ( String.strip text ) typ_cap
|
||||
let typ = String_ext.strip typ
|
||||
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
|
||||
in
|
||||
List.rev (parse (newstring::result) tail )
|
||||
in
|
||||
String.split ~on:'*' input
|
||||
|> List.map ~f:(String.lsplit2_exn ~on:'\n')
|
||||
String_ext.split ~on:'*' input
|
||||
|> List.map (String_ext.lsplit2_exn ~on:'\n')
|
||||
|> parse []
|
||||
|> String.concat
|
||||
;;
|
||||
|> String.concat ""
|
||||
|> global_replace
|
||||
|> print_string
|
||||
|
||||
|
||||
|
||||
let ezfio_template = format_of_string "
|
||||
module %s : sig
|
||||
type t [@@ deriving sexp]
|
||||
type t [@@deriving sexp]
|
||||
val to_%s : t -> %s
|
||||
val get_max : unit -> %s
|
||||
val of_%s : ?min:%s -> ?max:%s -> %s -> t
|
||||
val to_string : t -> string
|
||||
end = struct
|
||||
type t = %s [@@ deriving sexp]
|
||||
type t = %s [@@deriving sexp]
|
||||
let to_string x = %s.to_string x
|
||||
let get_max () =
|
||||
if (Ezfio.has_%s ()) then
|
||||
|
|
@ -215,7 +234,7 @@ end = struct
|
|||
let get_min () =
|
||||
%s
|
||||
let to_%s x = x
|
||||
let of_%s ?(min=get_min ()) ?(max=get_max ()) x =
|
||||
let of_%s ?(min=get_min ()) ?(max=get_max ()) x =
|
||||
begin
|
||||
assert (x >= min) ;
|
||||
if (x > %s) then
|
||||
|
|
@ -223,7 +242,9 @@ end = struct
|
|||
begin
|
||||
match max with
|
||||
| %s -> ()
|
||||
| i -> assert ( x <= i )
|
||||
| i ->
|
||||
if ( x > i ) then
|
||||
raise (Invalid_argument (Printf.sprintf \"%s: %%s\" (%s.to_string x) ))
|
||||
end ;
|
||||
x
|
||||
end
|
||||
|
|
@ -232,104 +253,103 @@ end
|
|||
|
||||
|
||||
let parse_input_ezfio input=
|
||||
let parse s =
|
||||
let parse s =
|
||||
match (
|
||||
String.split s ~on:'\n'
|
||||
|> List.filter ~f:(fun x -> (String.strip x) <> "")
|
||||
String_ext.split s ~on:'\n'
|
||||
|> List.filter (fun x -> (String_ext.strip x) <> "")
|
||||
) with
|
||||
| [] -> ""
|
||||
| a :: b :: c :: d :: [] ->
|
||||
begin
|
||||
let (name,typ) = String.lsplit2_exn ~on:':' a
|
||||
let (name,typ) = String_ext.lsplit2_exn ~on:':' a
|
||||
and ezfio_func = b
|
||||
and (min, max) = String.lsplit2_exn ~on:':' c
|
||||
and (min, max) = String_ext.lsplit2_exn ~on:':' c
|
||||
and msg = d
|
||||
in
|
||||
let (name, typ, ezfio_func, min, max, msg) =
|
||||
match (List.map [ name ; typ ; ezfio_func ; min ; max ; msg ] ~f:String.strip) with
|
||||
in
|
||||
let (name, typ, ezfio_func, min, max, msg) =
|
||||
match List.map String_ext.strip [ name ; typ ; ezfio_func ; min ; max ; msg ] with
|
||||
| [ name ; typ ; ezfio_func ; min ; max ; msg ] -> (name, typ, ezfio_func, min, max, msg)
|
||||
| _ -> assert false
|
||||
in
|
||||
Printf.sprintf ezfio_template
|
||||
name typ typ typ typ typ typ typ typ (String.capitalize typ)
|
||||
ezfio_func ezfio_func max min typ typ max msg min
|
||||
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)
|
||||
end
|
||||
| _ -> failwith "Error in input_ezfio"
|
||||
in
|
||||
String.split ~on:'*' input
|
||||
|> List.map ~f:parse
|
||||
|> String.concat
|
||||
String_ext.split ~on:'*' input
|
||||
|> List.map parse
|
||||
|> String.concat ""
|
||||
|> global_replace
|
||||
|> print_string
|
||||
|
||||
|
||||
|
||||
(** EZFIO *)
|
||||
let input_lines filename =
|
||||
let ic = open_in filename in
|
||||
let result = String_ext.input_lines ic in
|
||||
close_in ic;
|
||||
result
|
||||
|
||||
|
||||
let create_ezfio_handler () =
|
||||
let lines =
|
||||
In_channel.with_file "ezfio.ml" ~f:In_channel.input_lines
|
||||
|> List.filteri ~f:(fun i _ -> i > 470)
|
||||
input_lines "ezfio.ml"
|
||||
|> List.mapi (fun i l -> if i > 470 then Some l else None)
|
||||
|> List.filter (fun x -> x <> None)
|
||||
|> List.map (fun x ->
|
||||
match x with
|
||||
| Some x -> x
|
||||
| None -> assert false)
|
||||
in
|
||||
let functions =
|
||||
List.map lines ~f:(fun x ->
|
||||
match String.split x ~on:' ' with
|
||||
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
|
||||
in
|
||||
let has_functions =
|
||||
List.filter functions ~f:(fun (x,_,_,_) -> String.is_prefix ~prefix:"has_" x)
|
||||
List.filter (fun (x,_,_,_) -> String.sub x 0 4 = "has_") functions
|
||||
and get_functions =
|
||||
List.filter functions ~f:(fun (x,_,_,_) -> String.is_prefix ~prefix:"get_" x)
|
||||
List.filter (fun (x,_,_,_) -> String.sub x 0 4 = "get_") functions
|
||||
in
|
||||
let chop s =
|
||||
match (Str.split_delim (Str.regexp ";;") s) with
|
||||
| x :: _ -> x
|
||||
| _ -> assert false
|
||||
in
|
||||
|
||||
let result =
|
||||
[ "let decode_ezfio_message msg =
|
||||
match msg with " ] @
|
||||
(
|
||||
List.map get_functions ~f:(fun (x,f,d,i) ->
|
||||
let i =
|
||||
match (String.chop_suffix i ~suffix:";;") with
|
||||
| Some x -> x
|
||||
| None -> i
|
||||
in
|
||||
if (String.is_suffix f ~suffix:"_array") then
|
||||
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\" ->
|
||||
Ezfio.read_string_array %s %s
|
||||
|> Ezfio.flattened_ezfio
|
||||
|> Array.to_list
|
||||
|> String.concat ~sep:\" \"" x d i
|
||||
|> String.concat \" \"" x d i
|
||||
else
|
||||
Printf.sprintf " | \"%s\" -> Ezfio.read_string %s %s" x d i
|
||||
)
|
||||
) get_functions
|
||||
) @ (
|
||||
List.map has_functions ~f:(fun (x,_,_,_) ->
|
||||
List.map (fun (x,_,_,_) ->
|
||||
Printf.sprintf " | \"%s\" -> if (Ezfio.%s ()) then \"T\" else \"F\"" x x
|
||||
)
|
||||
) has_functions
|
||||
) @ [" | x -> failwith (x^\" : Unknown EZFIO function\")\n;;"]
|
||||
in
|
||||
String.concat result ~sep:"\n"
|
||||
String.concat "\n" result
|
||||
|
||||
(** Main *)
|
||||
|
||||
let () =
|
||||
let input =
|
||||
String.concat ~sep:"\n"
|
||||
[ "open Core\nlet warning = print_string\n\n" ;
|
||||
parse_input input_data ;
|
||||
parse_input_ezfio input_ezfio ;
|
||||
create_ezfio_handler ();
|
||||
untouched ]
|
||||
|
||||
and old_input =
|
||||
let filename =
|
||||
"Qptypes.ml"
|
||||
in
|
||||
match Sys.file_exists filename with
|
||||
| `Yes -> In_channel.read_all "Qptypes.ml"
|
||||
| `No | `Unknown -> "empty"
|
||||
|
||||
in
|
||||
|
||||
if input <> old_input then
|
||||
Out_channel.write_all "Qptypes.ml" ~data:input
|
||||
let () =
|
||||
parse_input input_data ;
|
||||
parse_input_ezfio input_ezfio;
|
||||
print_endline untouched
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue