diff --git a/ocaml/Address.ml b/ocaml/Address.ml index 1e1df8f4..a419806c 100644 --- a/ocaml/Address.ml +++ b/ocaml/Address.ml @@ -1,4 +1,3 @@ -open Core module Tcp : sig type t @@ -8,7 +7,7 @@ module Tcp : sig end = struct type t = string let of_string x = - if not (String.is_prefix ~prefix:"tcp://" x) then + if not (String_ext.is_prefix ~prefix:"tcp://" x) then invalid_arg "Address Invalid" ; x @@ -26,7 +25,7 @@ module Ipc : sig end = struct type t = string let of_string x = - assert (String.is_prefix ~prefix:"ipc://" x); + assert (String_ext.is_prefix ~prefix:"ipc://" x); x let create name = Printf.sprintf "ipc://%s" name @@ -41,7 +40,7 @@ module Inproc : sig end = struct type t = string let of_string x = - assert (String.is_prefix ~prefix:"inproc://" x); + assert (String_ext.is_prefix ~prefix:"inproc://" x); x let create name = Printf.sprintf "inproc://%s" name diff --git a/ocaml/Basis.ml b/ocaml/Basis.ml index 647e53f5..30af6577 100644 --- a/ocaml/Basis.ml +++ b/ocaml/Basis.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std open Qptypes type t = (Gto.t * Nucl_number.t) list [@@deriving sexp] @@ -16,7 +16,7 @@ let read in_channel at_number = (** Find an element in the basis set file *) let find in_channel element = - In_channel.seek in_channel 0L; + seek_in in_channel 0; let element_read = ref Element.X in while !element_read <> element do @@ -56,13 +56,13 @@ let to_string_general ~fmt ~atom_sep ?ele_array b = do_work ((Gto.to_string ~fmt g)::accu) n tail in do_work [new_nucleus 1] 1 b - |> String.concat ~sep:"\n" + |> String.concat "\n" let to_string_gamess ?ele_array = to_string_general ?ele_array ~fmt:Gto.Gamess ~atom_sep:"" let to_string_gaussian ?ele_array b = - String.concat ~sep:"\n" + String.concat "\n" [ to_string_general ?ele_array ~fmt:Gto.Gaussian ~atom_sep:"****" b ; "****" ] let to_string ?(fmt=Gto.Gamess) = diff --git a/ocaml/Determinant.ml b/ocaml/Determinant.ml index bdfb84fc..a6d754b0 100644 --- a/ocaml/Determinant.ml +++ b/ocaml/Determinant.ml @@ -1,5 +1,5 @@ -open Core;; -open Qptypes;; +open Qptypes +open Sexplib.Std type t = int64 array [@@deriving sexp] @@ -9,8 +9,8 @@ let to_int64_array (x:t) = (x:int64 array) let to_alpha_beta x = let x = to_int64_array x in let n_int = (Array.length x)/2 in - ( Array.init n_int ~f:(fun i -> x.(i)) , - Array.init n_int ~f:(fun i -> x.(i+n_int)) ) + ( Array.init n_int (fun i -> x.(i)) , + Array.init n_int (fun i -> x.(i+n_int)) ) let to_bitlist_couple x = @@ -28,12 +28,14 @@ let bitlist_to_string ~mo_tot_num x = let len = MO_number.to_int mo_tot_num in - List.map x ~f:(function - | Bit.Zero -> "-" - | Bit.One -> "+" - ) - |> String.concat - |> String.sub ~pos:0 ~len + let s = + List.map (function + | Bit.Zero -> "-" + | Bit.One -> "+" + ) x + |> String.concat "" + in + String.sub s 0 len @@ -77,6 +79,6 @@ let to_string ~mo_tot_num x = let (xa,xb) = to_bitlist_couple x in [ " " ; bitlist_to_string ~mo_tot_num xa ; "\n" ; " " ; bitlist_to_string ~mo_tot_num xb ] - |> String.concat + |> String.concat "" diff --git a/ocaml/Gto.ml b/ocaml/Gto.ml index 28e72e0c..ab265202 100644 --- a/ocaml/Gto.ml +++ b/ocaml/Gto.ml @@ -1,5 +1,5 @@ -open Core open Qptypes +open Sexplib.Std exception GTO_Read_Failure of string exception End_Of_Basis @@ -15,7 +15,7 @@ type t = let of_prim_coef_list pc = - let (p,c) = List.hd_exn pc in + let (p,c) = List.hd pc in let sym = p.GaussianPrimitive.sym in let rec check = function | [] -> `OK @@ -37,12 +37,12 @@ let of_prim_coef_list pc = let read_one in_channel = (* Fetch number of lines to read on first line *) let buffer = input_line in_channel in - if ( (String.strip buffer) = "" ) then + if ( (String_ext.strip buffer) = "" ) then raise End_Of_Basis; let sym_str = String.sub buffer 0 2 in let n_str = String.sub buffer 2 ((String.length buffer)-2) in - let sym = Symmetry.of_string (String.strip sym_str) in - let n = Int.of_string (String.strip n_str) in + let sym = Symmetry.of_string (String_ext.strip sym_str) in + let n = int_of_string (String_ext.strip n_str) in (* Read all the primitives *) let rec read_lines result = function | 0 -> result @@ -50,18 +50,19 @@ let read_one in_channel = begin let line_buffer = input_line in_channel in let buffer = line_buffer - |> String.split ~on:' ' - |> List.filter ~f:(fun x -> x <> "") + |> String_ext.split ~on:' ' + |> List.filter (fun x -> x <> "") in match buffer with | [ j ; expo ; coef ] -> begin - let coef = String.tr ~target:'D' ~replacement:'e' coef + let coef = + Str.global_replace (Str.regexp "D") "e" coef in let p = GaussianPrimitive.of_sym_expo sym - (AO_expo.of_float (Float.of_string expo) ) - and c = AO_coef.of_float (Float.of_string coef) in + (AO_expo.of_float (float_of_string expo) ) + and c = AO_coef.of_float (float_of_string coef) in read_lines ( (p,c)::result) (i-1) end | _ -> raise (GTO_Read_Failure line_buffer) @@ -89,7 +90,7 @@ let to_string_gamess { sym = sym ; lc = lc } = do_work (result::accu) (i+1) tail in (do_work [result] 1 lc) - |> String.concat ~sep:"\n" + |> String.concat "\n" (** Write the GTO in Gaussian format *) @@ -109,7 +110,7 @@ let to_string_gaussian { sym = sym ; lc = lc } = do_work (result::accu) (i+1) tail in (do_work [result] 1 lc) - |> String.concat ~sep:"\n" + |> String.concat "\n" (** Transform the gto to a string *) diff --git a/ocaml/Long_basis.ml b/ocaml/Long_basis.ml index 2167a6b9..06ea2ed5 100644 --- a/ocaml/Long_basis.ml +++ b/ocaml/Long_basis.ml @@ -1,5 +1,5 @@ -open Core;; -open Qptypes;; +open Qptypes +open Sexplib.Std type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t ) list [@@deriving sexp] @@ -10,14 +10,14 @@ let of_basis b = begin let new_accu = Symmetry.Xyz.of_symmetry g.Gto.sym - |> List.rev_map ~f:(fun x-> (x,g,n)) + |> List.rev_map (fun x-> (x,g,n)) in do_work (new_accu@accu) tail end in do_work [] b |> List.rev -;; + let to_basis b = let rec do_work accu = function @@ -25,7 +25,7 @@ let to_basis b = | (s,g,n)::tail -> let first_sym = Symmetry.Xyz.of_symmetry g.Gto.sym - |> List.hd_exn + |> List.hd in let new_accu = if ( s = first_sym ) then @@ -36,19 +36,19 @@ let to_basis b = do_work new_accu tail in do_work [] b -;; + let to_string b = - let middle = List.map ~f:(fun (x,y,z) -> - "( "^((Int.to_string (Nucl_number.to_int z)))^", "^ + let middle = List.map (fun (x,y,z) -> + "( "^((string_of_int (Nucl_number.to_int z)))^", "^ (Symmetry.Xyz.to_string x)^", "^(Gto.to_string y) ^" )" ) b - |> String.concat ~sep:",\n" + |> String.concat ",\n" in "("^middle^")" -;; -include To_md5;; + +include To_md5 let to_md5 = to_md5 sexp_of_t -;; + diff --git a/ocaml/Qputils.ml b/ocaml/Qputils.ml index b1b964c4..4bde831c 100644 --- a/ocaml/Qputils.ml +++ b/ocaml/Qputils.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib (* let rec transpose = function @@ -14,12 +14,12 @@ let rec transpose = function let input_to_sexp s = let result = - String.split_lines s - |> List.filter ~f:(fun x-> - (String.strip x) <> "") - |> List.map ~f:(fun x-> - "("^(String.tr '=' ' ' x)^")") - |> String.concat + String_ext.split ~on:'\n' s + |> List.filter (fun x-> (String_ext.strip x) <> "") + |> List.map (fun x-> "("^ + (Str.global_replace (Str.regexp "=") " " x) + ^")") + |> String.concat "" in print_endline ("("^result^")"); "("^result^")" @@ -29,10 +29,10 @@ let rmdir dirname = let rec remove_one dir = Sys.chdir dir; Sys.readdir "." - |> Array.iter ~f:(fun x -> - match (Sys.is_directory x, Sys.is_file x) with - | (`Yes, _) -> remove_one x - | (_, `Yes) -> Sys.remove x + |> Array.iter (fun x -> + match (Sys.is_directory x, Sys.file_exists x) with + | (true, _) -> remove_one x + | (_, true) -> Sys.remove x | _ -> failwith ("Unable to remove file "^x^".") ); Sys.chdir ".."; diff --git a/ocaml/Range.ml b/ocaml/Range.ml index 7f5f2e71..91fcbcce 100644 --- a/ocaml/Range.ml +++ b/ocaml/Range.ml @@ -1,4 +1,4 @@ -open Core;; +open Sexplib.Std (* A range is a string of the type: * @@ -12,14 +12,14 @@ open Core;; *) -type t = int list [@@deriving sexp] +type t = int list [@@deriving sexp] let expand_range r = - match String.lsplit2 ~on:'-' r with + match String_ext.lsplit2 ~on:'-' r with | Some (s, f) -> begin - let start = Int.of_string s - and finish = Int.of_string f + let start = int_of_string s + and finish = int_of_string f in assert (start <= finish) ; let rec do_work = function @@ -31,9 +31,9 @@ let expand_range r = begin match r with | "" -> [] - | _ -> [Int.of_string r] + | _ -> [int_of_string r] end -;; + let of_string s = match s.[0] with @@ -43,36 +43,37 @@ let of_string s = assert (s.[0] = '[') ; assert (s.[(String.length s)-1] = ']') ; let s = String.sub s 1 ((String.length s) - 2) in - let l = String.split ~on:',' s in - let l = List.map ~f:expand_range l in - List.concat l |> List.dedup ~compare:Int.compare |> List.sort ~cmp:Int.compare -;; + let l = String_ext.split ~on:',' s in + let l = List.map expand_range l in + List.concat l + |> List.sort_uniq compare + let to_string l = let rec do_work buf symbol = function | [] -> buf | a::([] as t) -> - do_work (buf^symbol^(Int.to_string a)) "" t + do_work (buf^symbol^(string_of_int a)) "" t | a::(b::q as t) -> if (b-a = 1) then do_work buf "-" t else - do_work (buf^symbol^(Int.to_string a)^","^(Int.to_string b)) "" t + do_work (buf^symbol^(string_of_int a)^","^(string_of_int b)) "" t in let result = match l with | [] -> "[]" | h::t -> - do_work ("["^(Int.to_string h)) "" l in + do_work ("["^(string_of_int h)) "" l in (String.sub result 0 ((String.length result)))^"]" -;; + let test_module () = let s = "[72-107,36-53,126-131]" in let l = of_string s in - print_string s ; Out_channel.newline stdout ; - List.iter ~f:(fun x -> Printf.printf "%d, " x) l ; Out_channel.newline stdout ; - to_string l |> print_string ; Out_channel.newline stdout -;; + print_string s ; print_newline () ; + List.iter (fun x -> Printf.printf "%d, " x) l ; print_newline () ; + to_string l |> print_string ; print_newline (); + diff --git a/ocaml/Range.mli b/ocaml/Range.mli index 27e1e9b7..e186ccf9 100644 --- a/ocaml/Range.mli +++ b/ocaml/Range.mli @@ -1,4 +1,4 @@ -type t = int list [@@deriving sexp] +type t = int list [@@deriving sexp] (** A range is a sorted list of ints in an interval. It is created using a string : diff --git a/ocaml/String_ext.ml b/ocaml/String_ext.ml index 3b0f256e..ae8378bf 100644 --- a/ocaml/String_ext.ml +++ b/ocaml/String_ext.ml @@ -2,6 +2,8 @@ include String (** Split a string on a given character *) let split ?(on=' ') str = + split_on_char on str +(* let rec do_work ?(accu=[]) ?(left="") = function | "" -> List.rev (left::accu) | s -> @@ -21,6 +23,7 @@ let split ?(on=' ') str = do_work ~accu ~left:new_left new_s in do_work str +*) (** Strip blanks on the left of a string *) @@ -101,12 +104,39 @@ let rsplit2_exn ?(on=' ') s = do_work length +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 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 diff --git a/ocaml/Symmetry.ml b/ocaml/Symmetry.ml index 72e2b926..7b088b73 100644 --- a/ocaml/Symmetry.ml +++ b/ocaml/Symmetry.ml @@ -1,5 +1,5 @@ open Qptypes -open Core +open Sexplib.Std type t = S|P|D|F|G|H|I|J|K|L [@@deriving sexp] @@ -86,7 +86,7 @@ module Xyz = struct let flush state accu number = let n = if (number = "") then 1 - else (Int.of_string number) + else (int_of_string number) in match state with | X -> { x= Positive_int.(of_int ( (to_int accu.x) +n)); @@ -111,10 +111,9 @@ module Xyz = struct | 'Z'::rest | 'z'::rest -> let new_accu = flush state accu number in do_work Z new_accu "" rest - | c::rest -> do_work state accu (number^(String.of_char c)) rest + | c::rest -> do_work state accu (number^(String_ext.of_char c)) rest in - String.to_list_rev s - |> List.rev + String_ext.to_list s |> do_work Null { x=Positive_int.of_int 0 ; y=Positive_int.of_int 0 ; diff --git a/ocaml/To_md5.ml b/ocaml/To_md5.ml index b93fa026..bc6608f9 100644 --- a/ocaml/To_md5.ml +++ b/ocaml/To_md5.ml @@ -1,5 +1,5 @@ -open Core;; -open Qptypes;; +open Qptypes +open Sexplib let to_md5 sexp_of_t t = sexp_of_t t diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index b4707e99..e1c14ee6 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -1,4 +1,10 @@ -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 @@ -118,8 +124,12 @@ let input_data = " * MD5 : string assert ((String.length x) = 32); - assert (String.fold x ~init:true ~f:(fun accu x -> - accu && (x < 'g'))); + 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 @@ -127,7 +137,7 @@ let input_data = " assert (x <> \"\") ; " -;; + let input_ezfio = " * MO_number : int @@ -156,7 +166,7 @@ let input_ezfio = " More than 10 billion of determinants " -;; + let untouched = " module MO_guess : sig @@ -206,7 +216,7 @@ end = struct end " -;; + let template = format_of_string " module %s : sig @@ -222,35 +232,36 @@ end = struct end " -;; + let parse_input input= - print_string "open Core;;\nlet warning = print_string;;\n" ; + 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_ext.split ~on:':' 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 = String_ext.strip typ + and name = String_ext.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 + 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 " @@ -287,24 +298,24 @@ end = struct end end " -;; + let parse_input_ezfio input= 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 + 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 @@ -314,16 +325,17 @@ let parse_input_ezfio input= 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 -;; + let () = parse_input input_data ; parse_input_ezfio input_ezfio; - print_endline untouched; + print_endline untouched diff --git a/ocaml/test_symmetry.ml b/ocaml/test_symmetry.ml index a84c77c7..e8323c14 100644 --- a/ocaml/test_symmetry.ml +++ b/ocaml/test_symmetry.ml @@ -1,15 +1,13 @@ -open Core open Qputils open Qptypes open Symmetry let () = "SPDFGHIJKL" - |> String.to_list_rev - |> List.rev - |> List.map ~f:of_char - |> List.map ~f:Xyz.of_symmetry - |> List.iter ~f:(fun x -> List.iter x ~f:(fun y -> Xyz.to_string y |> print_endline) ; + |> String_ext.to_list + |> List.map of_char + |> List.map Xyz.of_symmetry + |> List.iter (fun x -> List.iter (fun y -> Xyz.to_string y |> print_endline) x ; print_newline ();) diff --git a/ocaml/test_task_server.ml b/ocaml/test_task_server.ml index e6a6106b..00573a9d 100644 --- a/ocaml/test_task_server.ml +++ b/ocaml/test_task_server.ml @@ -1,5 +1,3 @@ -open Core - let () = TaskServer.run 12345 diff --git a/scripts/ezfio_interface/ezfio_generate_ocaml.py b/scripts/ezfio_interface/ezfio_generate_ocaml.py index f36441b6..e866a67e 100755 --- a/scripts/ezfio_interface/ezfio_generate_ocaml.py +++ b/scripts/ezfio_interface/ezfio_generate_ocaml.py @@ -170,7 +170,7 @@ class EZFIO_ocaml(object): else: l_template += [" {0:<30} : {1};".format(p, t.ocaml)] - l_template += [" } with sexp", + l_template += [" } [@@deriving sexp]", ";;"] # ~#~#~#~#~#~ # diff --git a/scripts/ezfio_interface/qp_edit_template b/scripts/ezfio_interface/qp_edit_template index 9d327124..55a35f83 100644 --- a/scripts/ezfio_interface/qp_edit_template +++ b/scripts/ezfio_interface/qp_edit_template @@ -4,7 +4,7 @@ open Qputils open Qptypes -open Core.Std +open Core (** Interactive editing of the input.