2014-08-26 15:31:16 +02:00
|
|
|
open Core.Std;;
|
|
|
|
|
|
|
|
let input_data = "
|
|
|
|
* Positive_float : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x >= 0.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
* Strictly_positive_float : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x > 0.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_float : (x > 0.) : x=%f\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
* Negative_float : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x <= 0.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Negative_float : (x <= 0.) : x=%f\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
* Strictly_negative_float : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x < 0.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
2016-02-19 00:20:28 +01:00
|
|
|
* Positive_int64 : int64
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x >= 0L) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
|
2016-02-19 00:20:28 +01:00
|
|
|
|
2014-08-26 15:31:16 +02:00
|
|
|
* Positive_int : int
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x >= 0) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
* Strictly_positive_int : int
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x > 0) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_int : (x > 0) : x=%d\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
* Negative_int : int
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x <= 0) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
2014-10-20 12:19:12 +02:00
|
|
|
* Det_coef : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if (x < -1.) || (x > 1.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
|
2014-10-20 12:19:12 +02:00
|
|
|
|
|
|
|
* Normalized_float : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if (x < 0.) || (x > 1.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
|
2014-10-20 12:19:12 +02:00
|
|
|
|
2014-08-26 15:31:16 +02:00
|
|
|
* Strictly_negative_int : int
|
2017-06-13 13:13:02 +02:00
|
|
|
if not (x < 0) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_int : (x < 0) : x=%d\" x));
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
* Non_empty_string : string
|
2017-06-13 13:13:02 +02:00
|
|
|
if (x = \"\") then
|
|
|
|
raise (Invalid_argument \"Non_empty_string\");
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
|
2014-10-28 17:16:51 +01:00
|
|
|
* Det_number_max : int
|
|
|
|
assert (x > 0) ;
|
2017-03-01 01:19:17 +01:00
|
|
|
if (x > 10000000000) then
|
|
|
|
warning \"More than 10 billion determinants\";
|
2014-09-17 11:49:00 +02:00
|
|
|
|
2014-10-20 12:19:12 +02:00
|
|
|
* States_number : int
|
|
|
|
assert (x > 0) ;
|
2016-09-25 23:28:25 +02:00
|
|
|
if (x > 1000) then
|
|
|
|
warning \"More than 1000 states\";
|
2014-10-20 12:19:12 +02:00
|
|
|
|
2014-09-17 11:49:00 +02:00
|
|
|
* Bit_kind_size : int
|
|
|
|
begin match x with
|
|
|
|
| 8 | 16 | 32 | 64 -> ()
|
2017-06-13 13:13:02 +02:00
|
|
|
| _ -> raise (Invalid_argument \"Bit_kind_size should be (8|16|32|64).\")
|
2014-09-17 11:49:00 +02:00
|
|
|
end;
|
|
|
|
|
|
|
|
* Bit_kind : int
|
|
|
|
begin match x with
|
|
|
|
| 1 | 2 | 4 | 8 -> ()
|
2017-06-13 13:13:02 +02:00
|
|
|
| _ -> raise (Invalid_argument \"Bit_kind should be (1|2|4|8).\")
|
2014-09-17 11:49:00 +02:00
|
|
|
end;
|
|
|
|
|
2014-10-22 00:12:23 +02:00
|
|
|
* Bitmask_number : int
|
|
|
|
assert (x > 0) ;
|
|
|
|
|
2014-09-18 17:01:43 +02:00
|
|
|
* MO_coef : float
|
|
|
|
|
2014-10-29 16:56:16 +01:00
|
|
|
* MO_occ : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if (x < 0.) || (x > 2.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"MO_occ : (0. <= x <= 2.) : x=%f\" x));
|
2014-10-29 16:56:16 +01:00
|
|
|
|
2014-09-18 17:01:43 +02:00
|
|
|
* AO_coef : float
|
|
|
|
|
2014-10-22 00:12:23 +02:00
|
|
|
* AO_expo : float
|
2017-06-13 13:13:02 +02:00
|
|
|
if (x < 0.) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"AO_expo : (x >= 0.) : x=%f\" x));
|
2014-10-22 00:12:23 +02:00
|
|
|
|
|
|
|
* AO_prim_number : int
|
|
|
|
assert (x > 0) ;
|
|
|
|
|
2016-01-25 15:44:15 +01:00
|
|
|
* R_power : int
|
|
|
|
assert (x >= -2) ;
|
|
|
|
assert (x <= 8) ;
|
|
|
|
|
2014-10-22 00:12:23 +02:00
|
|
|
* Threshold : float
|
|
|
|
assert (x >= 0.) ;
|
|
|
|
assert (x <= 1.) ;
|
|
|
|
|
2015-10-19 17:28:08 +02:00
|
|
|
* Energy : float
|
|
|
|
assert (x <=0.) ;
|
|
|
|
|
|
|
|
* S2 : float
|
|
|
|
assert (x >=0.) ;
|
|
|
|
|
2014-10-22 00:12:23 +02:00
|
|
|
* PT2_energy : float
|
|
|
|
assert (x >=0.) ;
|
|
|
|
|
|
|
|
* Elec_alpha_number : int
|
|
|
|
assert (x > 0) ;
|
|
|
|
|
|
|
|
* Elec_beta_number : int
|
|
|
|
assert (x >= 0) ;
|
|
|
|
|
|
|
|
* Elec_number : int
|
|
|
|
assert (x > 0) ;
|
|
|
|
|
2014-10-26 17:29:11 +01:00
|
|
|
* MD5 : string
|
|
|
|
assert ((String.length x) = 32);
|
2015-01-06 19:12:17 +01:00
|
|
|
assert (String.fold x ~init:true ~f:(fun accu x ->
|
|
|
|
accu && (x < 'g')));
|
2014-10-29 22:13:03 +01:00
|
|
|
|
|
|
|
* Rst_string : string
|
|
|
|
|
2014-11-16 18:24:20 +01:00
|
|
|
* AO_basis_name : string
|
|
|
|
assert (x <> \"\") ;
|
|
|
|
|
2014-08-26 15:31:16 +02:00
|
|
|
"
|
|
|
|
;;
|
|
|
|
|
2014-10-30 16:26:31 +01:00
|
|
|
let input_ezfio = "
|
|
|
|
* MO_number : int
|
|
|
|
mo_basis_mo_tot_num
|
|
|
|
1 : 10000
|
|
|
|
More than 10000 MOs
|
|
|
|
|
|
|
|
* AO_number : int
|
|
|
|
ao_basis_ao_num
|
|
|
|
1 : 10000
|
|
|
|
More than 10000 AOs
|
|
|
|
|
|
|
|
* Nucl_number : int
|
|
|
|
nuclei_nucl_num
|
|
|
|
1 : 10000
|
|
|
|
More than 10000 nuclei
|
|
|
|
|
|
|
|
* N_int_number : int
|
|
|
|
determinants_n_int
|
|
|
|
1 : 30
|
|
|
|
N_int > 30
|
|
|
|
|
|
|
|
* Det_number : int
|
|
|
|
determinants_n_det
|
2017-03-01 01:19:17 +01:00
|
|
|
1 : 10000000000
|
|
|
|
More than 10 billion of determinants
|
2014-10-20 12:19:12 +02:00
|
|
|
|
|
|
|
"
|
2014-10-30 16:26:31 +01:00
|
|
|
;;
|
|
|
|
|
|
|
|
let untouched = "
|
2015-03-20 11:21:26 +01:00
|
|
|
module MO_guess : sig
|
|
|
|
type t with sexp
|
|
|
|
val to_string : t -> string
|
|
|
|
val of_string : string -> t
|
|
|
|
end = struct
|
|
|
|
type t =
|
|
|
|
| Huckel
|
|
|
|
| HCore
|
|
|
|
with sexp
|
|
|
|
|
|
|
|
let to_string = function
|
|
|
|
| Huckel -> \"Huckel\"
|
2015-07-24 11:23:54 +02:00
|
|
|
| HCore -> \"HCore\"
|
2015-03-20 11:21:26 +01:00
|
|
|
|
|
|
|
let of_string s =
|
2015-07-24 11:23:54 +02:00
|
|
|
match (String.lowercase s) with
|
|
|
|
| \"huckel\" -> Huckel
|
|
|
|
| \"hcore\" -> HCore
|
2017-06-13 13:13:02 +02:00
|
|
|
| _ -> raise (Invalid_argument (\"Wrong Guess type : \"^s))
|
2015-03-20 11:21:26 +01:00
|
|
|
|
2015-04-01 12:02:02 +02:00
|
|
|
end
|
|
|
|
|
|
|
|
module Disk_access : sig
|
|
|
|
type t with sexp
|
|
|
|
val to_string : t -> string
|
|
|
|
val of_string : string -> t
|
|
|
|
end = struct
|
|
|
|
type t =
|
|
|
|
| Read
|
|
|
|
| Write
|
|
|
|
| None
|
|
|
|
with sexp
|
|
|
|
|
|
|
|
let to_string = function
|
|
|
|
| Read -> \"Read\"
|
|
|
|
| Write -> \"Write\"
|
|
|
|
| None -> \"None\"
|
|
|
|
let of_string s =
|
2015-07-24 11:23:54 +02:00
|
|
|
match (String.lowercase s) with
|
|
|
|
| \"read\" -> Read
|
|
|
|
| \"write\" -> Write
|
|
|
|
| \"none\" -> None
|
2017-06-13 13:13:02 +02:00
|
|
|
| _ -> raise (Invalid_argument (\"Wrong IO type : \"^s))
|
2015-04-01 12:02:02 +02:00
|
|
|
|
2015-03-20 11:21:26 +01:00
|
|
|
end
|
2014-10-30 16:26:31 +01:00
|
|
|
"
|
2015-04-01 12:02:02 +02:00
|
|
|
|
2015-03-20 11:21:26 +01:00
|
|
|
;;
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
let template = format_of_string "
|
|
|
|
module %s : sig
|
2014-10-25 21:24:21 +02:00
|
|
|
type t with sexp
|
2014-08-26 15:31:16 +02:00
|
|
|
val to_%s : t -> %s
|
2014-10-30 12:08:18 +01:00
|
|
|
val of_%s : %s %s -> t
|
2014-10-17 15:07:07 +02:00
|
|
|
val to_string : t -> string
|
2014-08-26 15:31:16 +02:00
|
|
|
end = struct
|
2014-10-25 21:24:21 +02:00
|
|
|
type t = %s with sexp
|
2014-08-26 15:31:16 +02:00
|
|
|
let to_%s x = x
|
2014-10-30 12:08:18 +01:00
|
|
|
let of_%s %s x = ( %s x )
|
2014-09-18 17:01:43 +02:00
|
|
|
let to_string x = %s.to_string x
|
2014-08-26 15:31:16 +02:00
|
|
|
end
|
|
|
|
|
|
|
|
"
|
|
|
|
;;
|
|
|
|
|
|
|
|
let parse_input input=
|
2014-09-18 17:01:43 +02:00
|
|
|
print_string "open Core.Std;;\nlet warning = print_string;;\n" ;
|
2014-08-26 15:31:16 +02:00
|
|
|
let rec parse result = function
|
|
|
|
| [] -> result
|
|
|
|
| ( "" , "" )::tail -> parse result tail
|
|
|
|
| ( t , text )::tail ->
|
2014-10-30 12:08:18 +01:00
|
|
|
let name,typ,params,params_val =
|
|
|
|
match String.split ~on:':' t with
|
|
|
|
| [name;typ] -> (name,typ,"","")
|
|
|
|
| name::typ::params::params_val -> (name,typ,params,
|
|
|
|
(String.concat params_val ~sep:":") )
|
|
|
|
| _ -> assert false
|
2014-08-26 15:31:16 +02:00
|
|
|
in
|
|
|
|
let typ = String.strip typ
|
2014-09-18 17:01:43 +02:00
|
|
|
and name = String.strip name in
|
|
|
|
let typ_cap = String.capitalize typ in
|
2014-10-30 12:08:18 +01:00
|
|
|
let newstring = Printf.sprintf template name typ typ typ params_val typ typ
|
|
|
|
typ typ params ( String.strip text ) typ_cap
|
2014-08-26 15:31:16 +02:00
|
|
|
in
|
|
|
|
List.rev (parse (newstring::result) tail )
|
|
|
|
in
|
|
|
|
String.split ~on:'*' input
|
|
|
|
|> List.map ~f:(String.lsplit2_exn ~on:'\n')
|
|
|
|
|> parse []
|
|
|
|
|> String.concat
|
|
|
|
|> print_string
|
|
|
|
;;
|
|
|
|
|
2014-10-30 16:26:31 +01:00
|
|
|
|
|
|
|
let ezfio_template = format_of_string "
|
|
|
|
module %s : sig
|
|
|
|
type t with 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 with sexp
|
|
|
|
let to_string x = %s.to_string x
|
|
|
|
let get_max () =
|
|
|
|
if (Ezfio.has_%s ()) then
|
|
|
|
Ezfio.get_%s ()
|
|
|
|
else
|
|
|
|
%s
|
|
|
|
let get_min () =
|
|
|
|
%s
|
|
|
|
let to_%s x = x
|
|
|
|
let of_%s ?(min=get_min ()) ?(max=get_max ()) x =
|
|
|
|
begin
|
|
|
|
assert (x >= min) ;
|
|
|
|
if (x > %s) then
|
|
|
|
warning \"%s\";
|
|
|
|
begin
|
|
|
|
match max with
|
|
|
|
| %s -> ()
|
2017-06-13 13:13:02 +02:00
|
|
|
| i ->
|
|
|
|
if ( x > i ) then
|
|
|
|
raise (Invalid_argument (Printf.sprintf \"%s: %%s\" (%s.to_string x) ))
|
2014-10-30 16:26:31 +01:00
|
|
|
end ;
|
|
|
|
x
|
|
|
|
end
|
|
|
|
end
|
|
|
|
"
|
|
|
|
;;
|
|
|
|
|
|
|
|
let parse_input_ezfio input=
|
|
|
|
let parse s =
|
|
|
|
match (
|
|
|
|
String.split s ~on:'\n'
|
|
|
|
|> List.filter ~f:(fun x -> (String.strip x) <> "")
|
|
|
|
) with
|
|
|
|
| [] -> ""
|
|
|
|
| a :: b :: c :: d :: [] ->
|
|
|
|
begin
|
|
|
|
let (name,typ) = String.lsplit2_exn ~on:':' a
|
|
|
|
and ezfio_func = b
|
|
|
|
and (min, max) = String.lsplit2_exn ~on:':' c
|
|
|
|
and msg = d
|
|
|
|
in
|
2014-11-12 21:58:13 +01:00
|
|
|
let (name, typ, ezfio_func, min, max, msg) =
|
|
|
|
match (List.map [ name ; typ ; ezfio_func ; min ; max ; msg ] ~f:String.strip) with
|
|
|
|
| [ name ; typ ; ezfio_func ; min ; max ; msg ] -> (name, typ, ezfio_func, min, max, msg)
|
2014-11-03 15:37:02 +01:00
|
|
|
| _ -> assert false
|
2014-10-30 16:26:31 +01:00
|
|
|
in
|
|
|
|
Printf.sprintf ezfio_template
|
|
|
|
name typ typ typ typ typ typ typ typ (String.capitalize typ)
|
2017-06-13 13:13:02 +02:00
|
|
|
ezfio_func ezfio_func max min typ typ max msg min name (String.capitalize typ)
|
2014-10-30 16:26:31 +01:00
|
|
|
end
|
|
|
|
| _ -> failwith "Error in input_ezfio"
|
|
|
|
in
|
|
|
|
String.split ~on:'*' input
|
|
|
|
|> List.map ~f:parse
|
|
|
|
|> String.concat
|
|
|
|
|> print_string
|
|
|
|
;;
|
|
|
|
|
2014-10-20 12:19:12 +02:00
|
|
|
let () =
|
|
|
|
parse_input input_data ;
|
2014-10-30 16:26:31 +01:00
|
|
|
parse_input_ezfio input_ezfio;
|
|
|
|
print_endline untouched;
|
|
|
|
|
2014-08-26 15:31:16 +02:00
|
|
|
|
|
|
|
|