Removed core

ocaml/.merlin

@@ -1,3 +1,3 @@
-PKG core cryptokit str zmq
+PKG cryptokit str zmq
 S .
 

ocaml/Block.ml

@@ -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) ;
+          value    = Sample.of_float (float_of_string v) ;
-          weight   = Weight.of_float (Float.of_string w) ; 
+          weight   = Weight.of_float (float_of_string w) ; 
           compute_node = Compute_node.of_string c;
-          pid          = Pid.of_string pid;
+          pid          = int_of_string pid;
-          block_id     = Block_id.of_int (Int.of_string b) ;
+          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;
+          pid          = int_of_string pid;
-          block_id     = Block_id.of_int (Int.of_string b) ;
+          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 
+  List.fold_right Filename.concat 
-    [ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ]
+    [ 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
+       if Sys.is_directory dir_name then
-       | `Yes -> 
          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 ->
+       List.filter (fun x ->
-         match String.substr_index ~pattern:"locked" x with
+         try
-         | Some x -> false
+          let _ = 
-         | None -> true
+            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,13 +118,18 @@ let update_raw_data ?(locked=true) () =
   in
 
   let result =
-  List.map files ~f:(fun filename ->
+    let rec aux ic accu =
-    In_channel.with_file filename ~f:(fun in_channel ->
+      try
-      In_channel.input_all in_channel)
+        aux ic ( (input_line ic)::accu )
-    )
+      with
-  |> String.concat 
+      | End_of_file -> List.rev accu
-  |> String.split_lines 
+    in
-  |> List.rev
+    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_left (fun s x -> StringSet.add (Property.to_string x.property) s) StringSet.empty (raw_data ()) 
-  List.fold (raw_data ()) ~init:set ~f:(fun s x -> Set.add s x.property)
+    |> StringSet.elements
-    |> Set.to_list
 )
 
 

ocaml/Command_line.ml

@@ -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
+
+
+

ocaml/Command_line.mli

@@ -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
+
+

ocaml/Default.ml

@@ -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"             ;

ocaml/Input.ml

@@ -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
+      String.lowercase_ascii t
-      |> Bool.of_string 
+      |> 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))
+      Printf.sprintf "(%s) %s" ch (Property.to_string x)) l
-    |> String.concat ~sep:"\n"
+    |> String.concat "\n"
 
 
   let of_string s =
-    String.split s ~on:'\n'
+    String.split_on_char '\n' s 
-    |> List.map ~f:(fun x ->
+    |> List.map (fun x ->
        let (calc,prop) = 
-         String.strip x
+         String.trim x
-         |> String.rsplit2_exn ~on:' '
+         |> String_ext.rsplit2_exn ~on:' '
        in
        let prop = 
-         String.strip prop 
+         String.trim prop 
          |> Property.of_string
        and calc =
          match calc with

ocaml/Launcher.ml

@@ -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
+  String_ext.input_lines in_channel
-  |> List.map  ~f:String.strip
+  |> List.map  String.trim
-  |> List.iter ~f:( fun host ->
+  |> List.iter ( fun host ->
-       Hashtbl.change h host (function
+       let n = 
-        | Some x -> Some (x+1)
+          match Hashtbl.find_opt h host with
-        | None -> Some 1
+          | 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
+  Hashtbl.fold (fun k v a -> (f (k,v)) :: a) h []
-  |> List.map ~f
+  |> String.concat "\n"
-  |> String.concat  
 
 
 

ocaml/Makefile

@@ -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)
+

ocaml/QmcMd5.ml

@@ -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
+    if not (Sys.is_directory dirname) then 
-    | `No  -> Unix.mkdir  dirname
+      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
+  if Sys.file_exists filename then
-  | `Yes -> 
     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 (fun x -> Printf.sprintf "%s/%s" ezfio_filename x)
-      |> List.map ~f:hash_file
+      |> List.map hash_file
-      |> String.concat
+      |> String.concat ""
     in
 
     let new_md5 = 

ocaml/Qmcchem_config.ml

@@ -1,22 +1,18 @@
-open Core
-
 
 (** QMC=Chem installation directory *)
 let root = lazy (
-  match ( Sys.getenv "QMCCHEM_PATH" ) with
+  try Sys.getenv "QMCCHEM_PATH" with
-  | Some x -> x
+  | Not_found -> failwith "QMCCHEM_PATH environment variable not set"
-  | None   -> 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
+    try Sys.getenv "PATH" with
-    | None -> failwith "PATH environment variable is not set"
+    | Not_found -> failwith "PATH environment variable is not set"
-    | Some p -> p
   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
+      if Sys.file_exists fp then
-      | `Yes -> Some fp
+        Some fp
-      | _    -> in_path_rec tail
+      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
+    try
-    | None -> "mpirun"
+      Sys.getenv "QMCCHEM_MPIRUN"
-    | Some p -> p
+    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
+  let interface =
+    try Some (Sys.getenv "QMCCHEM_NIC")
+    with Not_found -> None
+  in
+  match interface with
   | None ->
       begin
         try
+          let host =
             Lazy.force hostname
-          |> Unix.Inet_addr.of_string_or_getbyname
+            |> Unix.gethostbyname
-          |> Unix.Inet_addr.to_string
+          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
+        let result = get_ipv4_address_for_interface interface in
-        try
+        if String.sub result 0 5 = "error" then                                               
-          ok_exn Linux_ext.get_ipv4_address_for_interface interface
+          Printf.sprintf "Unable to use network interface %s" interface
-        with
+          |> failwith
-        | Unix.Unix_error _ ->
+        else
-            Lazy.force hostname
+          result
-            |> Unix.Inet_addr.of_string_or_getbyname
-            |> Unix.Inet_addr.to_string
-      end
 )
 
 

ocaml/Qmcchem_edit.ml

@@ -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 ->
+  let out_channel = open_out filename in
-      (file_header ezfio_filename) :: (List.map ~f:get fields)
+  (file_header ezfio_filename) :: (List.map get fields)
-      |> String.concat ~sep:"\n"
+  |> String.concat "\n"
-      |> Out_channel.output_string out_channel
+  |> 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.Ref_energy.(of_string, write) e;
-  handle_option Input.Trial_wf_energy.(of_float , write) et;
+  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.Fitcusp_factor.(of_string, write) f;
-  handle_option       Input.Time_step.(of_float , write) ts;
+  handle_option       Input.Time_step.(of_string, write) ts;
-  handle_option        Input.Walk_num.(of_int   , write) w;
+  handle_option        Input.Walk_num.(of_string, write) w;
-  handle_option    Input.Walk_num_tot.(of_int   , write) wt;
+  handle_option    Input.Walk_num_tot.(of_string, write) wt;
-  handle_option    Input.CI_threshold.(of_float , write) n;
+  handle_option    Input.CI_threshold.(of_string, write) n;
-  handle_option Input.SRMC_projection_time.(of_float , write) p;
+  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 ;
+                |> Sys.command 
-              end
+              in
+              assert (rc = 0)
           end
         | None          -> 
           begin
             (* Open the temp file with external editor *)
             let editor =
-              match Sys.getenv "EDITOR" with
+              try Sys.getenv "EDITOR" with
-              | Some editor -> editor
+              | Not_found -> "vi"
-              | None -> "vi"
             in
+            let rc = 
               Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename 
-            |> Sys.command_exn 
+              |> 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.filter (fun x -> Str.string_match re_data x 0) raw_data
-          |> List.map ~f:String.strip ) @
+          |> List.map String.trim ) @
         [
-        List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0)
+        List.filter (fun x -> Str.string_match re_prop x 0) raw_data 
-        |> List.map ~f:String.strip
+        |> List.map String.trim
-        |> String.concat ~sep:"\n" ]
+        |> 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;
@@ -249,19 +252,18 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
         Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ()) 
       in
       let rec clean_dir y =
-          match Sys.is_directory y with
+        if Sys.is_directory y then
-          | `Yes ->
+          begin
-            Sys.ls_dir y
+            Sys.readdir y
-            |> List.map ~f:(Filename.concat y)
+            |> Array.map (fun x -> Filename.concat y x)
-            |> List.iter ~f:(function x ->
+            |> Array.iter (function x ->
-                match ( Sys.is_directory x, Sys.is_file x ) with
+                if Sys.is_directory x  then
-                | (`Yes, _) -> clean_dir x
+                  clean_dir x
-                | (_, `Yes) -> Sys.remove x
+                else
-                | (_,_)     -> ()
+                  Sys.remove x
               );
             Unix.rmdir y
-          | `Unknown
+          end
-          | `No -> ()
       in clean_dir dirname;
       Printf.printf "Blocks cleared\n"
     end
@@ -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 () = 
-  let open Command.Spec in
+  let open Command_line in
-  empty
+  begin
-  +> flag "c"  no_arg
+    set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
-     ~doc:(" Clear blocks")
+    set_description_doc "Edits input data";
-  +> 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 command =
+    [ { short='c' ; long="clear" ; opt=Optional ;
-    Command.basic_spec
+        doc="Clears blocks" ;
-    ~summary: "Edit input data"
+        arg=Without_arg ; };
-    ~readme:(fun () ->
+
-      "
+      { short='e' ; long="ref-energy" ; opt=Optional ;
-Edit input data
+        doc=Input.Ref_energy.doc;
-      ")
+        arg=With_arg "<float>"; };
-    spec
+    
-    (fun c f t l m e et s ts w wt n j p ezfio_file input () -> 
+      { short='f' ; long="fitcusp" ; opt=Optional ;
-      run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file )
+        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
 
 
 

ocaml/Qputils.ml

@@ -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
+    if Sys.is_directory ezfio_filename then
-    | `Yes -> Ezfio.set_file ezfio_filename ;
+      Ezfio.set_file ezfio_filename 
-    | _ -> failwith ("Error : "^ezfio_filename^" is not a directory")
+    else
+      failwith ("Error : "^ezfio_filename^" is not a directory")
   in 
   let dir, result =
-    Filename.realpath ezfio_filename
+    Filename.dirname ezfio_filename,
-    |> Filename.split
+    Filename.basename ezfio_filename
   in
   Unix.chdir dir ;
   Ezfio.set_file result

ocaml/Random_variable.ml

@@ -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 ->
+          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 -> 
+          Array.map (fun y -> (Weight.to_float x.Block.weight) *. y)
-          (Weight.to_float x.Block.weight) *. y)
+            (Sample.to_float_array x.Block.value) 
         and den = (Weight.to_float x.Block.weight)
-        in (
+        in ( Array.mapi (fun i y -> y +. num.(i)) an , ad +. den) 
-          Array.mapi an ~f:(fun i y -> y +. num.(i)) , 
+      ) (Array.make dim 0. , 0.) data
-          ad +. den)
-      ) 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 ->
+        Array.init dim (fun idx ->
-          List.map  list_of_samples  ~f:(fun x ->
+          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
+  let init =
-  | None -> 0.
+    try
-  | Some block -> Sample.to_float block.Block.value
+      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
 
 

ocaml/Sample.ml

@@ -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
+      Array.map string_of_float x
-      |> String.concat_array ~sep:" " 
+      |> Array.to_list
+      |> String.concat " " 
       |> Printf.sprintf "%s"
 

ocaml/Sample.mli

@@ -1,5 +1,3 @@
-open Core
-
 type t [@@ deriving sexp]
 val to_float        : ?idx:int -> t -> float
 val to_float_array  : t -> float array

ocaml/Scheduler.ml

@@ -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 -> 
+    |> List.map (function x -> 
-         match (Sys.getenv x) with
+         try Some (Sys.getenv x) with
-           | Some _ -> x
+         | Not_found -> None
-           | None -> ""
          )
-    |> List.filter ~f:(function x -> x <> "")
     |> List.hd
   in
   let result = 

ocaml/String_ext.ml

@@ -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 [] 
+

ocaml/Watchdog.ml

@@ -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);
+    Unix.kill pid Sys.sigint;
-    Printf.printf "Killed %d\n%!" (Pid.to_int pid)
+    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.
+        Unix.sleep 1
-        |> Time.pause 
       in
 
       let pid_is_running pid =
-         match (Sys.file_exists ("/proc/"^(Pid.to_string pid)^"/stat")) with
+         Sys.file_exists ("/proc/"^(string_of_int pid)^"/stat")
-         | `No | `Unknown ->  false
-         | `Yes -> true
       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:(
+            List.fold_left
-              fun accu x -> accu && (pid_is_running x)
+              ( 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
+      match (Unix.waitpid [] pid) with
-      | Core_kernel.Std.Result.Ok () -> true
+      | pid , Unix.WEXITED n -> true
-      | Core_kernel.Std.Result.Error (`Exit_non_zero n) ->
+      | pid , Unix.WSIGNALED n -> 
-          ( Printf.printf "PID %d exited with code %d\n%!"
+          ( Printf.printf "PID %d killed with signal %d\n%!" pid n;
-              (Pid.to_int pid) n ;
             false )
-      | Core_kernel.Std.Result.Error (`Signal n) ->
+      | pid , Unix.WSTOPPED n -> 
-          ( Printf.printf "PID %d killed with signal %d (%s)\n%!"
+          ( Printf.printf "PID %d stopped with signal %d\n%!" pid n;
-              (Pid.to_int pid) (Signal.to_system_int n)
-              (Signal.to_string 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)
 ;;

ocaml/_tags

@@ -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)
+

ocaml/build.ninja

@@ -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
-
-
-

ocaml/c_bindings.c

@@ -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);
+
+}
+
+
+

ocaml/myocamlbuild.ml

@@ -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

ocaml/qptypes_generator.ml

@@ -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.) ; 
+  if not (x >= 0.) then
+    raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\"  x));
 
 * Strictly_positive_float : float
-  assert (x > 0.) ; 
+  if not (x > 0.) then
+    raise (Invalid_argument (Printf.sprintf \"Strictly_positive_float : (x > 0.) : x=%f\" x));
 
 * Negative_float : float
-  assert (x <= 0.) ; 
+  if not (x <= 0.) then
+    raise (Invalid_argument (Printf.sprintf \"Negative_float : (x <= 0.) : x=%f\" x));
 
 * Strictly_negative_float : float
-  assert (x < 0.) ; 
+  if not (x < 0.) then
+    raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
+
+* Positive_int64 : int64
+  if not (x >= 0L) then
+    raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
 
 * Positive_int : int
-  assert (x >= 0) ; 
+  if not (x >= 0) then
+    raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
 
 * Strictly_positive_int : int
-  assert (x > 0) ; 
+  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.) ; 
+  if (x < -1.) || (x > 1.) then
-  assert (x <=  1.) ; 
+    raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
 
 * Normalized_float : float
-  assert (x <= 1.) ; 
+  if (x < 0.) || (x > 1.) then
-  assert (x >= 0.) ; 
+    raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
 
 * Strictly_negative_int : int
-  assert (x < 0) ; 
+  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
+  if (x > 100_000_000) then
     warning \"More than 100 million determinants\";
-"^
+
-(*
-"
 * States_number : int
   assert (x > 0) ;
-  if (x > 100) then
+  if (x > 1000) then
-    warning \"More than 100 states\";
+    warning \"More than 1000 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
   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
   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.) ; 
+  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
+  1 : 10_000
-  More than 10000 MOs
+  More than 10_000 MOs
 
 * AO_number : int
   ao_basis_ao_num
-  1 : 10000
+  1 : 10_000
-  More than 10000 AOs
+  More than 10_000 AOs
 
 * Nucl_number : int
   nuclei_nucl_num
-  1 : 10000
+  1 : 10_000
-  More than 10000 nuclei
+  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
+  spindeterminants_n_det
-  1 : 100000000
+  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
+          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
+        let typ  = String_ext.strip typ
-        and name = String.strip name in
+        and name = String_ext.strip name in
-        let typ_cap = String.capitalize typ 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.strip text ) typ_cap
+          typ typ params ( String_ext.strip text ) typ_cap
         in
         List.rev (parse (newstring::result) tail )
   in
-     String.split ~on:'*' input
+     String_ext.split ~on:'*' input
-  |> List.map ~f:(String.lsplit2_exn ~on:'\n') 
+  |> 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
@@ -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
@@ -234,102 +255,101 @@ end
 let parse_input_ezfio input=
   let parse s =
     match (
-      String.split s ~on:'\n'
+      String_ext.split s ~on:'\n'
-      |> List.filter ~f:(fun x -> (String.strip x) <> "")
+      |> 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
+        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)
+          name typ typ typ typ typ typ typ typ (String.capitalize_ascii typ)
-          ezfio_func ezfio_func max min typ typ max msg min
+          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
+     String_ext.split ~on:'*' input
-  |> List.map ~f:parse
+  |> List.map parse
-  |> String.concat 
+  |> 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
+    input_lines "ezfio.ml"
-    |> List.filteri ~f:(fun i _ -> i > 470)
+    |> 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 ->
+    List.map (fun x ->
-      match String.split x ~on:' ' with
+      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) ->
+      List.map (fun (x,f,d,i) ->
-        let i =
+        let i = chop i in
-          match (String.chop_suffix i ~suffix:";;") with
+        if (String.sub f ((String.length f)-6) 6 = "_array") then
-          | Some x -> x
-          | None -> i
-        in
-        if (String.is_suffix f ~suffix:"_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 ;
+  parse_input_ezfio input_ezfio;
-      create_ezfio_handler ();
+  print_endline untouched
-      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