From f203fbad2d0ed1265a039b95ec173574bfb0e4a1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 13 Mar 2019 13:02:29 +0100 Subject: [PATCH] Removing Core --- ocaml/Atom.ml | 12 ++-- ocaml/Bit.ml | 12 ++-- ocaml/Bitlist.ml | 27 ++++----- ocaml/Charge.ml | 12 ++-- ocaml/Excitation.ml | 5 +- ocaml/GaussianPrimitive.ml | 12 ++-- ocaml/Generic_input_of_rst.ml | 44 +++++++------- ocaml/Message.ml | 20 +++---- ocaml/Molecule.ml | 2 +- ocaml/Multiplicity.ml | 15 ++--- ocaml/Progress_bar.ml | 30 +++++----- ocaml/Pseudo.ml | 69 +++++++++++----------- ocaml/Qpackage.ml | 108 ++++++++++++++++++---------------- ocaml/Qputils.ml | 8 +++ ocaml/String_ext.ml | 45 +++++++------- ocaml/TaskServer.ml | 2 +- ocaml/create_git_sha1.sh | 7 +-- ocaml/element_create_db.ml | 35 ++++++----- 18 files changed, 236 insertions(+), 229 deletions(-) diff --git a/ocaml/Atom.ml b/ocaml/Atom.ml index bfe71c4c..d02b20d8 100644 --- a/ocaml/Atom.ml +++ b/ocaml/Atom.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std exception AtomError of string @@ -11,20 +11,20 @@ type t = (** Read xyz coordinates of the atom *) let of_string ~units s = let buffer = s - |> String.split ~on:' ' - |> List.filter ~f:(fun x -> x <> "") + |> String_ext.split ~on:' ' + |> List.filter (fun x -> x <> "") in match buffer with | [ name; charge; x; y; z ] -> { element = Element.of_string name ; charge = Charge.of_string charge ; - coord = Point3d.of_string ~units (String.concat [x; y; z] ~sep:" ") + coord = Point3d.of_string ~units (String.concat " " [x; y; z] ) } | [ name; x; y; z ] -> let e = Element.of_string name in { element = e ; charge = Element.to_charge e; - coord = Point3d.of_string ~units (String.concat [x; y; z] ~sep:" ") + coord = Point3d.of_string ~units (String.concat " " [x; y; z]) } | _ -> raise (AtomError s) @@ -33,7 +33,7 @@ let to_string ~units a = [ Element.to_string a.element ; Charge.to_string a.charge ; Point3d.to_string ~units a.coord ] - |> String.concat ~sep:" " + |> String.concat " " let to_xyz a = diff --git a/ocaml/Bit.ml b/ocaml/Bit.ml index ad532a44..4be0584d 100644 --- a/ocaml/Bit.ml +++ b/ocaml/Bit.ml @@ -1,4 +1,4 @@ -open Core;; +open Sexplib.Std (* Type for bits @@ -16,31 +16,31 @@ type t = let to_string = function | Zero -> "0" | One -> "1" -;; + let and_operator a b = match a, b with | Zero, _ -> Zero | _, Zero -> Zero | _, _ -> One -;; + let or_operator a b = match a, b with | One, _ -> One | _, One -> One | _, _ -> Zero -;; + let xor_operator a b = match a, b with | One, Zero -> One | Zero, One -> One | _, _ -> Zero -;; + let not_operator = function | One -> Zero | Zero -> One -;; + diff --git a/ocaml/Bitlist.ml b/ocaml/Bitlist.ml index 0a230d57..88f9b4dd 100644 --- a/ocaml/Bitlist.ml +++ b/ocaml/Bitlist.ml @@ -1,5 +1,4 @@ open Qptypes -open Core (* Type for bits strings @@ -22,15 +21,15 @@ let to_string b = let of_string ?(zero='0') ?(one='1') s = - String.to_list s - |> List.rev_map ~f:( fun c -> + List.init (String.length s) (String.get s) + |> List.rev_map ( fun c -> if (c = zero) then Bit.Zero else if (c = one) then Bit.One else (failwith ("Error in bitstring ") ) ) let of_string_mp s = - String.to_list s - |> List.rev_map ~f:(function + List.init (String.length s) (String.get s) + |> List.rev_map (function | '-' -> Bit.Zero | '+' -> Bit.One | _ -> failwith ("Error in bitstring ") ) @@ -44,7 +43,7 @@ let of_int64 i = | 1L -> Bit.One :: accu |> List.rev | i -> let b = - match (Int64.bit_and i 1L ) with + match (Int64.logand i 1L ) with | 0L -> Bit.Zero | 1L -> Bit.One | _ -> raise (Failure "i land 1 not in (0,1)") @@ -70,18 +69,18 @@ let to_int64 l = let rec do_work accu = function | [] -> accu | Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail - | Bit.One::tail -> do_work Int64.(bit_or one (shift_left accu 1)) tail + | Bit.One::tail -> do_work Int64.(logor one (shift_left accu 1)) tail in do_work Int64.zero (List.rev l) (* Create a bit list from a list of int64 *) let of_int64_list l = - List.map ~f:of_int64 l + List.map of_int64 l |> List.concat (* Create a bit list from an array of int64 *) let of_int64_array l = - Array.map ~f:of_int64 l + Array.map of_int64 l |> Array.to_list |> List.concat @@ -116,7 +115,7 @@ let to_int64_list l = in let l = do_work [] [] 1 l in - List.rev_map ~f:to_int64 l + List.rev_map to_int64 l (* Create an array of int64 from a bit list *) let to_int64_array l = @@ -127,8 +126,8 @@ let to_int64_array l = let of_mo_number_list n_int l = let n_int = N_int_number.to_int n_int in let length = n_int*64 in - let a = Array.create length (Bit.Zero) in - List.iter ~f:(fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l; + let a = Array.make length (Bit.Zero) in + List.iter (fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l; Array.to_list a @@ -183,10 +182,10 @@ let not_operator b = logical_operator1 Bit.not_operator b let popcnt b = - List.fold_left b ~init:0 ~f:(fun accu -> function + List.fold_left (fun accu -> function | Bit.One -> accu+1 | Bit.Zero -> accu - ) + ) 0 b diff --git a/ocaml/Charge.ml b/ocaml/Charge.ml index 64ecbd81..076fd61e 100644 --- a/ocaml/Charge.ml +++ b/ocaml/Charge.ml @@ -1,14 +1,14 @@ -open Core +open Sexplib.Std type t = float [@@deriving sexp] -let of_float x = x -let of_int i = Float.of_int i -let of_string s = Float.of_string s +let of_float x = x +let of_int i = float_of_int i +let of_string s = float_of_string s -let to_float x = x -let to_int x = Float.to_int x +let to_float x = x +let to_int x = int_of_float x let to_string x = if x >= 0. then Printf.sprintf "+%f" x diff --git a/ocaml/Excitation.ml b/ocaml/Excitation.ml index 58e18b11..5897cff2 100644 --- a/ocaml/Excitation.ml +++ b/ocaml/Excitation.ml @@ -1,4 +1,3 @@ -open Core open Qptypes module Hole = struct @@ -56,7 +55,7 @@ let to_string = function "," ; (MO_class.to_string (Particle.to_mo_class p)); "]"] - |> String.concat ~sep:" " + |> String.concat " " | Double (h1,p1,h2,p2) -> [ "Double Exc. : [" ; (MO_class.to_string (Hole.to_mo_class h1)); @@ -67,6 +66,6 @@ let to_string = function "," ; (MO_class.to_string (Particle.to_mo_class p2)); "]"] - |> String.concat ~sep:" " + |> String.concat " " diff --git a/ocaml/GaussianPrimitive.ml b/ocaml/GaussianPrimitive.ml index 0b5e910c..d2144dec 100644 --- a/ocaml/GaussianPrimitive.ml +++ b/ocaml/GaussianPrimitive.ml @@ -1,16 +1,16 @@ open Qptypes -open Core +open Sexplib.Std type t = -{ sym : Symmetry.t ; - expo : AO_expo.t ; -} [@@deriving sexp] + { sym : Symmetry.t ; + expo : AO_expo.t ; + } [@@deriving sexp] let to_string p = let { sym = s ; expo = e } = p in Printf.sprintf "(%s, %22e)" - (Symmetry.to_string s) - (AO_expo.to_float e) + (Symmetry.to_string s) + (AO_expo.to_float e) let of_sym_expo s e = diff --git a/ocaml/Generic_input_of_rst.ml b/ocaml/Generic_input_of_rst.ml index cd2607b6..ec7de8c9 100644 --- a/ocaml/Generic_input_of_rst.ml +++ b/ocaml/Generic_input_of_rst.ml @@ -1,5 +1,6 @@ -open Core;; -open Qptypes;; +open Sexplib +open Sexplib.Std +open Qptypes let fail_msg str (ex,range) = @@ -15,25 +16,25 @@ let fail_msg str (ex,range) = 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 + let pre = String.sub str 0 start_pos + and mid = String.sub str start_pos (end_pos-start_pos) + and post = String.sub str (end_pos) + ((String.length str)-(end_pos)) 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 + let str = String_ext.tr str ~target:'(' ~replacement:' ' + |> String_ext.split ~on:')' + |> List.map String_ext.strip + |> List.filter (fun x -> + match String_ext.substr_index ~pos:0 ~pattern:"##" x with | None -> false | Some _ -> true ) - |> String.concat ~sep:"\n" + |> String.concat "\n" in - Printf.eprintf "Error: (%s)\n\n %s\n\n" msg str; -;; + Printf.eprintf "Error: (%s)\n\n %s\n\n" msg str + let evaluate_sexp t_of_sexp s = @@ -41,20 +42,19 @@ let evaluate_sexp t_of_sexp s = 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_ext.split ~on:'\n' + |> List.filter (fun line -> String.contains line '=') + |> List.map (fun line -> "("^( - String.tr line ~target:'=' ~replacement:' ' + String_ext.tr ~target:'=' ~replacement:' ' line )^")" ) - |> String.concat + |> String.concat "" |> evaluate_sexp t_of_sexp -;; + diff --git a/ocaml/Message.ml b/ocaml/Message.ml index beffc436..2ea1d38c 100644 --- a/ocaml/Message.ml +++ b/ocaml/Message.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std open Qptypes (** New job : Request to create a new multi-tasked job *) @@ -161,7 +161,7 @@ end = struct } let create ~state ~tasks = { state = State.of_string state ; tasks } let to_string x = - Printf.sprintf "add_task %s %s" (State.to_string x.state) (String.concat ~sep:"|" x.tasks) + Printf.sprintf "add_task %s %s" (State.to_string x.state) (String.concat "|" x.tasks) end @@ -193,12 +193,12 @@ end = struct } let create ~state ~task_ids = { state = State.of_string state ; - task_ids = List.map ~f:Id.Task.of_int task_ids + task_ids = List.map Id.Task.of_int task_ids } let to_string x = Printf.sprintf "del_task %s %s" (State.to_string x.state) - (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids) + (String.concat "|" @@ List.map Id.Task.to_string x.task_ids) end @@ -219,7 +219,7 @@ end = struct else "done" in Printf.sprintf "del_task_reply %s %s" - more (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids) + more (String.concat "|" @@ List.map Id.Task.to_string x.task_ids) end @@ -303,11 +303,11 @@ end = struct "get_tasks_reply ok" let to_string_list x = "get_tasks_reply ok" :: ( - List.map x ~f:(fun (task_id, task) -> + List.map (fun (task_id, task) -> match task_id with | Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task | None -> Printf.sprintf "0 terminate" - ) ) + ) x ) end @@ -408,14 +408,14 @@ end = struct let create ~state ~client_id ~task_ids = { client_id = Id.Client.of_int client_id ; state = State.of_string state ; - task_ids = List.map ~f:Id.Task.of_int task_ids; + task_ids = List.map Id.Task.of_int task_ids; } let to_string x = Printf.sprintf "task_done %s %d %s" (State.to_string x.state) (Id.Client.to_int x.client_id) - (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids) + (String.concat "|" @@ List.map Id.Task.to_string x.task_ids) end (** Terminate *) @@ -460,7 +460,7 @@ end = struct type t = string let create x = x let to_string x = - String.concat ~sep:" " [ "error" ; x ] + String.concat " " [ "error" ; x ] end diff --git a/ocaml/Molecule.ml b/ocaml/Molecule.ml index 94d937dd..f368f15f 100644 --- a/ocaml/Molecule.ml +++ b/ocaml/Molecule.ml @@ -207,7 +207,7 @@ let distance_matrix molecule = -open Core ;; + include To_md5 let to_md5 = to_md5 sexp_of_t diff --git a/ocaml/Multiplicity.ml b/ocaml/Multiplicity.ml index 1a64954a..9b5549e9 100644 --- a/ocaml/Multiplicity.ml +++ b/ocaml/Multiplicity.ml @@ -1,10 +1,11 @@ -open Core;; -open Qptypes ;; +open Qptypes +open Sexplib.Std type t = Strictly_positive_int.t [@@deriving sexp] -let of_int = Strictly_positive_int.of_int ;; -let to_int = Strictly_positive_int.to_int ;; +let of_int = Strictly_positive_int.of_int + +let to_int = Strictly_positive_int.to_int let to_string m = match (to_int m) with @@ -18,7 +19,7 @@ let to_string m = | 8 -> "Octet" | 9 -> "Nonet" | i -> Printf.sprintf "%d-et" i -;; + let of_alpha_beta a b = let a = Elec_alpha_number.to_int a @@ -26,11 +27,11 @@ let of_alpha_beta a b = in assert (a >= b); of_int (1 + a - b) -;; + let to_alpha_beta ne m = let ne = Elec_number.to_int ne in let nb = (ne-(to_int m)+1)/2 in let na = ne - nb in (Elec_alpha_number.of_int na, Elec_beta_number.of_int nb) -;; + diff --git a/ocaml/Progress_bar.ml b/ocaml/Progress_bar.ml index 13b7b9df..bc720b95 100644 --- a/ocaml/Progress_bar.ml +++ b/ocaml/Progress_bar.ml @@ -1,5 +1,3 @@ -open Core - type t = { title: string; @@ -7,14 +5,14 @@ type t = cur_value : float; end_value : float; bar_length : int; - init_time : Time.t; + init_time : float; dirty : bool; - next : Time.t; + next : float; } let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title = { title ; start_value ; end_value ; bar_length ; cur_value=start_value ; - init_time= Time.now () ; dirty = false ; next = Time.now () } + init_time= Unix.time () ; dirty = false ; next = Unix.time () } let update ~cur_value bar = { bar with cur_value ; dirty=true } @@ -40,23 +38,23 @@ let display_tty bar = |> Float.to_int in let hashes = - String.init bar.bar_length ~f:(fun i -> + String.init bar.bar_length (fun i -> if (i < n_hashes) then '#' else ' ' ) in let now = - Time.now () + Unix.time () in let running_time = - Time.abs_diff now bar.init_time + now -. bar.init_time in - Printf.eprintf "%s : [%s] %4.1f%% | %10s\r%!" + Printf.eprintf "%s : [%s] %4.1f%% | %8.0f s\r%!" bar.title hashes percent - (Time.Span.to_string running_time); - { bar with dirty = false ; next = Time.add now (Time.Span.of_sec 0.1) } + running_time; + { bar with dirty = false ; next = now +. 0.1 } let display_file bar = @@ -65,19 +63,19 @@ let display_file bar = (bar.end_value -. bar.start_value) in let running_time = - Time.abs_diff (Time.now ()) bar.init_time + (Unix.time ()) -. bar.init_time in - Printf.eprintf "%5.2f %% in %20s \n%!" + Printf.eprintf "%5.2f %% in %20.0f seconds \n%!" percent - (Time.Span.to_string running_time); - { bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_sec 10.) } + running_time; + { bar with dirty = false ; next = (Unix.time ()) +. 10. } let display bar = if (not bar.dirty) then bar - else if (Time.now () < bar.next) then + else if (Unix.time () < bar.next) then bar else begin diff --git a/ocaml/Pseudo.ml b/ocaml/Pseudo.ml index 976f119d..0fd2c263 100644 --- a/ocaml/Pseudo.ml +++ b/ocaml/Pseudo.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std open Qptypes @@ -81,12 +81,12 @@ let to_string_local = function | t -> "Local component:" :: ( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) :: - ( List.map t ~f:(fun (l,c) -> Printf.sprintf "%20f %8d %20f" + ( List.map (fun (l,c) -> Printf.sprintf "%20f %8d %20f" (AO_coef.to_float c) (R_power.to_int l.GaussianPrimitive_local.r_power) (AO_expo.to_float l.GaussianPrimitive_local.expo) - ) ) - |> String.concat ~sep:"\n" + ) t ) + |> String.concat "\n" (** Transform the non-local component of the pseudopotential to a string *) @@ -95,7 +95,7 @@ let to_string_non_local = function | t -> "Non-local component:" :: ( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") :: - ( List.map t ~f:(fun (l,c) -> + ( List.map (fun (l,c) -> let p = Positive_int.to_int l.GaussianPrimitive_non_local.proj in @@ -104,8 +104,8 @@ let to_string_non_local = function (R_power.to_int l.GaussianPrimitive_non_local.r_power) (AO_expo.to_float l.GaussianPrimitive_non_local.expo) p p - ) ) - |> String.concat ~sep:"\n" + ) t ) + |> String.concat "\n" (** Transform the Pseudopotential to a string *) let to_string t = @@ -116,29 +116,30 @@ let to_string t = :: to_string_local t.local :: to_string_non_local t.non_local :: [] - |> List.filter ~f:(fun x -> x <> "") - |> String.concat ~sep:"\n" + |> List.filter (fun x -> x <> "") + |> String.concat "\n" (** Find an element in the file *) let find in_channel element = - In_channel.seek in_channel 0L; + seek_in in_channel 0; let loop, element_read, old_pos = ref true, ref None, - ref (In_channel.pos in_channel) + ref (pos_in in_channel) in while !loop do try let buffer = - old_pos := In_channel.pos in_channel; - match In_channel.input_line in_channel with - | Some line -> String.split ~on:' ' line - |> List.hd_exn - | None -> raise End_of_file + old_pos := pos_in in_channel; + try + input_line in_channel + |> String_ext.split ~on:' ' + |> List.hd + with _ -> raise End_of_file in element_read := Some (Element.of_string buffer); loop := !element_read <> (Some element) @@ -146,7 +147,7 @@ let find in_channel element = | Element.ElementError _ -> () | End_of_file -> loop := false done ; - In_channel.seek in_channel !old_pos; + seek_in in_channel !old_pos; !element_read @@ -156,13 +157,13 @@ let read_element in_channel element = | Some e when e = element -> begin let rec read result = - match In_channel.input_line in_channel with - | None -> result - | Some line -> - if (String.strip line = "") then + try + let line = input_line in_channel in + if (String.trim line = "") then result else read (line::result) + with _ -> result in let data = @@ -171,20 +172,20 @@ let read_element in_channel element = in let debug_data = - String.concat ~sep:"\n" data + String.concat "\n" data in let decode_first_line = function | first_line :: rest -> begin let first_line_split = - String.split first_line ~on:' ' - |> List.filter ~f:(fun x -> (String.strip x) <> "") + String_ext.split first_line ~on:' ' + |> List.filter (fun x -> (String.trim x) <> "") in match first_line_split with | e :: "GEN" :: n :: p -> { element = Element.of_string e ; - n_elec = Int.of_string n |> Positive_int.of_int ; + n_elec = int_of_string n |> Positive_int.of_int ; local = [] ; non_local = [] }, rest @@ -200,18 +201,18 @@ let read_element in_channel element = | (n,line::rest) -> begin match - String.split line ~on:' ' - |> List.filter ~f:(fun x -> String.strip x <> "") + String_ext.split line ~on:' ' + |> List.filter (fun x -> String.trim x <> "") with | c :: i :: e :: [] -> let i = - Int.of_string i + int_of_string i in let elem = ( create_primitive - (Float.of_string e |> AO_expo.of_float) + (float_of_string e |> AO_expo.of_float) (i-2 |> R_power.of_int), - Float.of_string c |> AO_coef.of_float + float_of_string c |> AO_coef.of_float ) in loop create_primitive (elem::accu) (n-1, rest) @@ -230,8 +231,8 @@ let read_element in_channel element = match data with | n :: rest -> let n = - String.strip n - |> Int.of_string + String.trim n + |> int_of_string |> Positive_int.of_int in decode_local_n n rest @@ -250,8 +251,8 @@ let read_element in_channel element = match data with | n :: rest -> let n = - String.strip n - |> Int.of_string + String.trim n + |> int_of_string |> Positive_int.of_int in let result = diff --git a/ocaml/Qpackage.ml b/ocaml/Qpackage.ml index b766d066..5099a231 100644 --- a/ocaml/Qpackage.ml +++ b/ocaml/Qpackage.ml @@ -1,45 +1,45 @@ -open Core;; -open Qptypes;; -open Qputils;; +open Qptypes +open Qputils (** Variables related to the quantum package installation *) let root = - match (Sys.getenv "QP_ROOT") with + match (Sys.getenv_opt "QP_ROOT") with | None -> failwith "QP_ROOT environment variable is not set. Please source the quantum_package.rc file." | Some x -> x -;; + let bit_kind_size = lazy ( let filename = root^"/src/bitmask/bitmasks_module.f90" in - if not (Sys.file_exists_exn filename) then + if not (Sys.file_exists filename) then raise (Failure ("File "^filename^" not found")); - let in_channel = In_channel.create filename in - let lines = In_channel.input_lines in_channel in - In_channel.close in_channel; + let in_channel = open_in filename in + let lines = input_lines in_channel in + close_in in_channel; let rec get_data = function | [] -> raise (Failure ("bit_kind_size not found in "^filename)) | line::tail -> - let line = - begin match String.split ~on:'!' line |> List.hd with - | Some x -> x - | None -> "" - end in - begin match (String.rsplit2 ~on:':' line) with - | Some (_ ,buffer) -> - begin match (String.split ~on:'=' buffer |> List.map ~f:String.strip) with - | ["bit_kind_size"; x] -> - Int.of_string x |> Bit_kind_size.of_int - | _ -> get_data tail - end - | _ -> get_data tail - end + let line = + try + String_ext.split ~on:'!' line + |> List.hd + with _ -> line + in + begin match (String_ext.rsplit2 ~on:':' line) with + | Some (_ ,buffer) -> + begin match (String_ext.split ~on:'=' buffer |> List.map String.trim) with + | ["bit_kind_size"; x] -> + int_of_string x |> Bit_kind_size.of_int + | _ -> get_data tail + end + | _ -> get_data tail + end in get_data lines ) -;; + let bit_kind = lazy ( Lazy.force bit_kind_size @@ -47,23 +47,26 @@ let bit_kind = lazy ( |> fun x -> x / 8 |> Bit_kind.of_int ) -;; + let executables = lazy ( - let filename = root^"/data/executables" - and func in_channel = - In_channel.input_lines in_channel - |> List.map ~f:(fun x -> - let e = String.split ~on:' ' x - |> List.filter ~f:(fun x -> x <> "") + let filename = root^"/data/executables" in + let lines = + let in_channel = open_in filename in + let result = input_lines in_channel in + close_in in_channel; + result + in + lines + |> List.map (fun x -> + let e = String_ext.split ~on:' ' x + |> List.filter (fun x -> x <> "") in match e with - | [a;b] -> (a,String.substr_replace_all ~pattern:"$QP_ROOT" ~with_:root b) + | [a;b] -> (a,String_ext.substr_replace_all ~pattern:"$QP_ROOT" ~with_:root b) | _ -> ("","") ) - in - In_channel.with_file filename ~f:func - |> List.sort ~compare:(fun (x,_) (y,_) -> + |> List.sort (fun (x,_) (y,_) -> if x < y then -1 else if x > y then 1 else 0) @@ -72,33 +75,37 @@ let executables = lazy ( let get_ezfio_default_in_file ~directory ~data ~filename = - let lines = In_channel.with_file filename ~f:(fun in_channel -> - In_channel.input_lines in_channel) in + let lines = + let in_channel = open_in filename in + let result = input_lines in_channel in + close_in in_channel; + result + in let rec find_dir = function | line :: rest -> - if ((String.strip line) = directory) then + if ((String.trim line) = directory) then rest else find_dir rest - | [] -> raise Caml.Not_found + | [] -> raise Not_found in let rec find_data = function | line :: rest -> if (line = "") then - raise Caml.Not_found + raise Not_found else if (line.[0] <> ' ') then - raise Caml.Not_found + raise Not_found else begin - match (String.lsplit2 ~on:' ' (String.strip line)) with + match (String_ext.lsplit2 ~on:' ' (String.trim line)) with | Some (l,r) -> if (l = data) then - String.strip r + String.trim r else find_data rest - | None -> raise Caml.Not_found + | None -> raise Not_found end - | [] -> raise Caml.Not_found + | [] -> raise Not_found in find_dir lines |> find_data ; @@ -111,7 +118,7 @@ let get_ezfio_default directory data = | [] -> begin Printf.printf "%s/%s not found\n%!" directory data; - raise Caml.Not_found + raise Not_found end | filename :: tail -> let filename = @@ -120,7 +127,7 @@ let get_ezfio_default directory data = try get_ezfio_default_in_file ~directory ~data ~filename with - | Caml.Not_found -> aux tail + | Not_found -> aux tail in Sys.readdir dirname |> Array.to_list @@ -131,10 +138,7 @@ let ezfio_work ezfio_file = let result = Filename.concat ezfio_file "work" in - begin - match Sys.is_directory result with - | `Yes -> () - | _ -> ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false) - end; + if not (Sys.file_exists result) then + ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false); result ;; diff --git a/ocaml/Qputils.ml b/ocaml/Qputils.ml index 9601d875..f10f1a0d 100644 --- a/ocaml/Qputils.ml +++ b/ocaml/Qputils.ml @@ -42,3 +42,11 @@ let rmdir dirname = +let input_lines ic = + let n = in_channel_length ic in + let s = Bytes.create n in + really_input ic s 0 n; + close_in ic; + Bytes.to_string s + |> String_ext.split ~on:'\n' + diff --git a/ocaml/String_ext.ml b/ocaml/String_ext.ml index a2911ebe..4c90b575 100644 --- a/ocaml/String_ext.ml +++ b/ocaml/String_ext.ml @@ -3,27 +3,6 @@ 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 -> - let new_s = - (length s) - 1 - |> sub s 1 - in - if (s.[0] = on) then - let new_accu = - left :: accu - in - do_work ~accu:new_accu new_s - else - let new_left = - concat "" [ left ; make 1 s.[0] ] - in - do_work ~accu ~left:new_left new_s - in - do_work str -*) (** Strip blanks on the left of a string *) @@ -88,7 +67,7 @@ let lsplit2_exn ?(on=' ') s = (** 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 + String.length s in let rec do_work i = if (i = -1) then @@ -101,7 +80,7 @@ let rsplit2_exn ?(on=' ') s = else do_work (i-1) in - do_work length + do_work (length-1) let lsplit2 ?(on=' ') s = @@ -140,3 +119,23 @@ let is_prefix ~prefix s = 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 + diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 0d457e38..6f2d01f7 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -33,7 +33,7 @@ type t = let debug_env = try - Sys.getenv "QP_TASK_DEBUG"; true + Sys.getenv "QP_TASK_DEBUG" = "1" with Not_found -> false diff --git a/ocaml/create_git_sha1.sh b/ocaml/create_git_sha1.sh index 35cbb7d5..64f08442 100755 --- a/ocaml/create_git_sha1.sh +++ b/ocaml/create_git_sha1.sh @@ -4,9 +4,8 @@ SHA1=$(git log -1 | head -1 | cut -d ' ' -f 2) DATE=$(git log -1 | grep Date | cut -d ':' -f 2-) MESSAGE=$(git log -1 | tail -1 | sed 's/"/\\"/g') cat << EOF > Git.ml -open Core -let sha1 = "$SHA1" |> String_ext.strip -let date = "$DATE" |> String_ext.strip -let message = "$MESSAGE" |> String_ext.strip +let sha1 = "$SHA1" |> String.trim +let date = "$DATE" |> String.trim +let message = "$MESSAGE" |> String.trim EOF diff --git a/ocaml/element_create_db.ml b/ocaml/element_create_db.ml index 7d3e26f4..36f0e58a 100644 --- a/ocaml/element_create_db.ml +++ b/ocaml/element_create_db.ml @@ -1,4 +1,3 @@ -open Core open Qptypes open Element @@ -6,22 +5,22 @@ let () = let indices = Array.init 78 (fun i -> i) in - Out_channel.with_file (Qpackage.root ^ "/data/list_element.txt") - ~f:(fun out_channel -> - Array.init 110 ~f:(fun i -> - let element = - try - Some (of_charge (Charge.of_int i)) - with - | _ -> None - in - match element with - | None -> "" - | Some x -> Printf.sprintf "%3d %3s %s %f\n" - i (to_string x) (to_long_string x) (Positive_float.to_float @@ mass x ) - ) - |> Array.to_list - |> String.concat ~sep:"" - |> Out_channel.output_string out_channel + let out_channel = + open_out (Qpackage.root ^ "/data/list_element.txt") + in + Array.init 110 (fun i -> + let element = + try + Some (of_charge (Charge.of_int i)) + with + | _ -> None + in + match element with + | None -> "" + | Some x -> Printf.sprintf "%3d %3s %s %f\n" + i (to_string x) (to_long_string x) (Positive_float.to_float @@ mass x ) ) + |> Array.to_list + |> String.concat "" + |> Printf.fprintf out_channel "%s"