From be4baee2e88649c0723846c621e24f5cdb2e5639 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 12 Nov 2014 21:58:13 +0100 Subject: [PATCH] Now ocaml compiles again --- ocaml/Generic_input_of_rst.ml | 60 ++++++++++++++++++++++++++++++++ ocaml/Makefile | 2 +- ocaml/qptypes_generator.ml | 6 ++-- ocaml/test_basis.ml | 4 +-- ocaml/test_input.ml | 45 +++++++++++++++++------- src/Perturbation/selection.irp.f | 1 - 6 files changed, 99 insertions(+), 19 deletions(-) create mode 100644 ocaml/Generic_input_of_rst.ml diff --git a/ocaml/Generic_input_of_rst.ml b/ocaml/Generic_input_of_rst.ml new file mode 100644 index 00000000..81388824 --- /dev/null +++ b/ocaml/Generic_input_of_rst.ml @@ -0,0 +1,60 @@ +open Core.Std;; +open Qptypes;; + + +let fail_msg str (ex,range) = + let msg = match ex with + | Failure msg -> msg + | _ -> raise ex + in + let range = match range with + | Sexp.Annotated.Atom (range,_) -> range + | Sexp.Annotated.List (range,_,_) -> range + in + let open Sexp.Annotated in + let start_pos = range.start_pos.offset + and end_pos = range.end_pos.offset + in + let pre = String.sub ~pos:0 ~len:start_pos str + and mid = String.sub ~pos:start_pos ~len:(end_pos-start_pos) str + and post = String.sub ~pos:(end_pos) + ~len:((String.length str)-(end_pos)) str + in + let str = Printf.sprintf "%s ## %s ## %s" pre mid post + in + let str = String.tr str ~target:'(' ~replacement:' ' + |> String.split ~on:')' + |> List.map ~f:String.strip + |> List.filter ~f:(fun x -> + match String.substr_index x ~pos:0 ~pattern:"##" with + | None -> false + | Some _ -> true + ) + |> String.concat ~sep:"\n" + in + Printf.eprintf "Error: (%s)\n\n %s\n\n" msg str; +;; + + +let evaluate_sexp t_of_sexp s = + let sexp = ("("^s^")") in + match ( Sexp.of_string_conv sexp t_of_sexp ) with + | `Result r -> Some r + | `Error ex -> ( fail_msg sexp ex; None) +;; + +let of_rst t_of_sexp s = + Rst_string.to_string s + |> String.split ~on:'\n' + |> List.filter ~f:(fun line -> + String.contains line '=') + |> List.map ~f:(fun line -> + "("^( + String.tr line ~target:'=' ~replacement:' ' + )^")" ) + |> String.concat + |> evaluate_sexp t_of_sexp +;; + + + diff --git a/ocaml/Makefile b/ocaml/Makefile index 9e137a64..030fdd38 100644 --- a/ocaml/Makefile +++ b/ocaml/Makefile @@ -11,7 +11,7 @@ endif LIBS= PKGS= OCAMLCFLAGS="-g -warn-error A" -OCAMLBUILD=ocamlbuild -j 0 -syntax camlp4o -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS) +OCAMLBUILD=ocamlbuild -j 0 -syntax camlp4o -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS) -ocamlopt ocamlc.opt MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml MLIFILES=$(wildcard *.mli) ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml)) diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index 63a53775..14eee88f 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -228,9 +228,9 @@ let parse_input_ezfio input= and (min, max) = String.lsplit2_exn ~on:':' c and msg = d in - let name :: typ :: ezfio_func :: min :: max :: msg :: [] = - match (name :: typ :: ezfio_func :: min :: max :: msg :: []) with - | l -> List.map ~f:String.strip l + 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) | _ -> assert false in Printf.sprintf ezfio_template diff --git a/ocaml/test_basis.ml b/ocaml/test_basis.ml index 79492101..f58d30db 100644 --- a/ocaml/test_basis.ml +++ b/ocaml/test_basis.ml @@ -9,12 +9,12 @@ let test_module () = In_channel.create (Qpackage.root^"/data/basis/"^(String.lowercase b)) in +(* let molecule = let xyz_file = "F2.xyz" in Molecule.of_xyz_file xyz_file in - - let nuclei = molecule.Molecule.nuclei in +*) let basis = (Basis.read_element basis_channel (Nucl_number.of_int 1) Element.F) @ diff --git a/ocaml/test_input.ml b/ocaml/test_input.ml index 613f3b1a..92469c6e 100644 --- a/ocaml/test_input.ml +++ b/ocaml/test_input.ml @@ -16,7 +16,10 @@ let test_bielec_intergals () = in print_endline output; let rst = Input.Bielec_integrals.to_rst b in - let b2 = Input.Bielec_integrals.of_rst rst in + let b2 = match Input.Bielec_integrals.of_rst rst with + | Some x -> x + | None -> assert false + in if (b = b2) then print_endline "OK" else @@ -43,8 +46,11 @@ let test_dets () = in print_endline (Input.Determinants.to_rst b |> Rst_string.to_string ) ; print_endline (Input.Determinants.sexp_of_t b |> Sexplib.Sexp.to_string ) ; - let r = Input.Determinants.to_rst b in - let b2 = Input.Determinants.of_rst r in + let rst = Input.Determinants.to_rst b in + let b2 = match Input.Determinants.of_rst rst with + | Some x -> x + | None -> assert false + in if (b2 = b) then print_endline "OK" else @@ -57,7 +63,10 @@ let test_cisd_sc2 () = in print_endline (Input.Cisd_sc2.to_string b); let rst = Input.Cisd_sc2.to_rst b in - let b2 = Input.Cisd_sc2.of_rst rst in + let b2 = match Input.Cisd_sc2.of_rst rst with + | Some x -> x + | None -> assert false + in if (b = b2) then print_endline "OK" else @@ -71,8 +80,11 @@ let test_electrons () = in print_endline (Input.Electrons.to_string b); let rst = Input.Electrons.to_rst b in - let new_b = Input.Electrons.of_rst rst in - if (b = new_b) then + let b2 = match Input.Electrons.of_rst rst with + | Some x -> x + | None -> assert false + in + if (b = b2) then print_endline "OK" else print_endline "Failed in rst" @@ -84,9 +96,12 @@ let test_fci () = in print_endline (Input.Full_ci.to_string b); let rst = Input.Full_ci.to_rst b in - let new_b = Input.Full_ci.of_rst rst in + let b2 = match Input.Full_ci.of_rst rst with + | Some x -> x + | None -> assert false + in print_endline (Input.Full_ci.to_string b); - if (b = new_b) then + if (b = b2) then print_endline "OK" else print_endline "Failed in rst" @@ -98,9 +113,12 @@ let test_hf () = in print_endline (Input.Hartree_fock.to_string b); let rst = Input.Hartree_fock.to_rst b in - let new_b = Input.Hartree_fock.of_rst rst in + let b2 = match Input.Hartree_fock.of_rst rst with + | Some x -> x + | None -> assert false + in print_endline (Input.Hartree_fock.to_string b); - if (b = new_b) then + if (b = b2) then print_endline "OK" else print_endline "Failed in rst" @@ -117,9 +135,12 @@ let test_nucl () = Ezfio.set_file "F2.ezfio" ; let b = Input.Nuclei.read () in let rst = Input.Nuclei.to_rst b in - let new_b = Input.Nuclei.of_rst rst in + let b2 = match Input.Nuclei.of_rst rst with + | Some x -> x + | None -> assert false + in print_endline (Input.Nuclei.to_string b); - if (b = new_b) then + if (b = b2) then print_endline "OK" else print_endline "Failed in rst" diff --git a/src/Perturbation/selection.irp.f b/src/Perturbation/selection.irp.f index 8751b818..01d8c0af 100644 --- a/src/Perturbation/selection.irp.f +++ b/src/Perturbation/selection.irp.f @@ -148,7 +148,6 @@ subroutine make_s2_eigenfunction integer, parameter :: bufsze = 1000 logical, external :: is_in_wavefunction - print *, irp_here ! !TODO DEBUG ! do i=1,N_det ! do j=i+1,N_det