Removing Core

This commit is contained in:
Anthony Scemama 2019-03-13 13:02:29 +01:00
parent da3ba4ef4b
commit f203fbad2d
18 changed files with 236 additions and 229 deletions

View File

@ -1,4 +1,4 @@
open Core open Sexplib.Std
exception AtomError of string exception AtomError of string
@ -11,20 +11,20 @@ type t =
(** Read xyz coordinates of the atom *) (** Read xyz coordinates of the atom *)
let of_string ~units s = let of_string ~units s =
let buffer = s let buffer = s
|> String.split ~on:' ' |> String_ext.split ~on:' '
|> List.filter ~f:(fun x -> x <> "") |> List.filter (fun x -> x <> "")
in in
match buffer with match buffer with
| [ name; charge; x; y; z ] -> | [ name; charge; x; y; z ] ->
{ element = Element.of_string name ; { element = Element.of_string name ;
charge = Charge.of_string charge ; 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 ] -> | [ name; x; y; z ] ->
let e = Element.of_string name in let e = Element.of_string name in
{ element = e ; { element = e ;
charge = Element.to_charge 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) | _ -> raise (AtomError s)
@ -33,7 +33,7 @@ let to_string ~units a =
[ Element.to_string a.element ; [ Element.to_string a.element ;
Charge.to_string a.charge ; Charge.to_string a.charge ;
Point3d.to_string ~units a.coord ] Point3d.to_string ~units a.coord ]
|> String.concat ~sep:" " |> String.concat " "
let to_xyz a = let to_xyz a =

View File

@ -1,4 +1,4 @@
open Core;; open Sexplib.Std
(* (*
Type for bits Type for bits
@ -16,31 +16,31 @@ type t =
let to_string = function let to_string = function
| Zero -> "0" | Zero -> "0"
| One -> "1" | One -> "1"
;;
let and_operator a b = let and_operator a b =
match a, b with match a, b with
| Zero, _ -> Zero | Zero, _ -> Zero
| _, Zero -> Zero | _, Zero -> Zero
| _, _ -> One | _, _ -> One
;;
let or_operator a b = let or_operator a b =
match a, b with match a, b with
| One, _ -> One | One, _ -> One
| _, One -> One | _, One -> One
| _, _ -> Zero | _, _ -> Zero
;;
let xor_operator a b = let xor_operator a b =
match a, b with match a, b with
| One, Zero -> One | One, Zero -> One
| Zero, One -> One | Zero, One -> One
| _, _ -> Zero | _, _ -> Zero
;;
let not_operator = function let not_operator = function
| One -> Zero | One -> Zero
| Zero -> One | Zero -> One
;;

View File

@ -1,5 +1,4 @@
open Qptypes open Qptypes
open Core
(* (*
Type for bits strings Type for bits strings
@ -22,15 +21,15 @@ let to_string b =
let of_string ?(zero='0') ?(one='1') s = let of_string ?(zero='0') ?(one='1') s =
String.to_list s List.init (String.length s) (String.get s)
|> List.rev_map ~f:( fun c -> |> List.rev_map ( fun c ->
if (c = zero) then Bit.Zero if (c = zero) then Bit.Zero
else if (c = one) then Bit.One else if (c = one) then Bit.One
else (failwith ("Error in bitstring ") ) ) else (failwith ("Error in bitstring ") ) )
let of_string_mp s = let of_string_mp s =
String.to_list s List.init (String.length s) (String.get s)
|> List.rev_map ~f:(function |> List.rev_map (function
| '-' -> Bit.Zero | '-' -> Bit.Zero
| '+' -> Bit.One | '+' -> Bit.One
| _ -> failwith ("Error in bitstring ") ) | _ -> failwith ("Error in bitstring ") )
@ -44,7 +43,7 @@ let of_int64 i =
| 1L -> Bit.One :: accu |> List.rev | 1L -> Bit.One :: accu |> List.rev
| i -> | i ->
let b = let b =
match (Int64.bit_and i 1L ) with match (Int64.logand i 1L ) with
| 0L -> Bit.Zero | 0L -> Bit.Zero
| 1L -> Bit.One | 1L -> Bit.One
| _ -> raise (Failure "i land 1 not in (0,1)") | _ -> raise (Failure "i land 1 not in (0,1)")
@ -70,18 +69,18 @@ let to_int64 l =
let rec do_work accu = function let rec do_work accu = function
| [] -> accu | [] -> accu
| Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail | 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) in do_work Int64.zero (List.rev l)
(* Create a bit list from a list of int64 *) (* Create a bit list from a list of int64 *)
let of_int64_list l = let of_int64_list l =
List.map ~f:of_int64 l List.map of_int64 l
|> List.concat |> List.concat
(* Create a bit list from an array of int64 *) (* Create a bit list from an array of int64 *)
let of_int64_array l = let of_int64_array l =
Array.map ~f:of_int64 l Array.map of_int64 l
|> Array.to_list |> Array.to_list
|> List.concat |> List.concat
@ -116,7 +115,7 @@ let to_int64_list l =
in in
let l = do_work [] [] 1 l let l = do_work [] [] 1 l
in in
List.rev_map ~f:to_int64 l List.rev_map to_int64 l
(* Create an array of int64 from a bit list *) (* Create an array of int64 from a bit list *)
let to_int64_array l = let to_int64_array l =
@ -127,8 +126,8 @@ let to_int64_array l =
let of_mo_number_list n_int l = let of_mo_number_list n_int l =
let n_int = N_int_number.to_int n_int in let n_int = N_int_number.to_int n_int in
let length = n_int*64 in let length = n_int*64 in
let a = Array.create length (Bit.Zero) in let a = Array.make length (Bit.Zero) in
List.iter ~f:(fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l; List.iter (fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l;
Array.to_list a Array.to_list a
@ -183,10 +182,10 @@ let not_operator b = logical_operator1 Bit.not_operator b
let popcnt 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.One -> accu+1
| Bit.Zero -> accu | Bit.Zero -> accu
) ) 0 b

View File

@ -1,14 +1,14 @@
open Core open Sexplib.Std
type t = float [@@deriving sexp] type t = float [@@deriving sexp]
let of_float x = x let of_float x = x
let of_int i = Float.of_int i let of_int i = float_of_int i
let of_string s = Float.of_string s let of_string s = float_of_string s
let to_float x = x let to_float x = x
let to_int x = Float.to_int x let to_int x = int_of_float x
let to_string x = let to_string x =
if x >= 0. then if x >= 0. then
Printf.sprintf "+%f" x Printf.sprintf "+%f" x

View File

@ -1,4 +1,3 @@
open Core
open Qptypes open Qptypes
module Hole = struct module Hole = struct
@ -56,7 +55,7 @@ let to_string = function
"," ; "," ;
(MO_class.to_string (Particle.to_mo_class p)); (MO_class.to_string (Particle.to_mo_class p));
"]"] "]"]
|> String.concat ~sep:" " |> String.concat " "
| Double (h1,p1,h2,p2) -> | Double (h1,p1,h2,p2) ->
[ "Double Exc. : [" ; [ "Double Exc. : [" ;
(MO_class.to_string (Hole.to_mo_class h1)); (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)); (MO_class.to_string (Particle.to_mo_class p2));
"]"] "]"]
|> String.concat ~sep:" " |> String.concat " "

View File

@ -1,16 +1,16 @@
open Qptypes open Qptypes
open Core open Sexplib.Std
type t = type t =
{ sym : Symmetry.t ; { sym : Symmetry.t ;
expo : AO_expo.t ; expo : AO_expo.t ;
} [@@deriving sexp] } [@@deriving sexp]
let to_string p = let to_string p =
let { sym = s ; expo = e } = p in let { sym = s ; expo = e } = p in
Printf.sprintf "(%s, %22e)" Printf.sprintf "(%s, %22e)"
(Symmetry.to_string s) (Symmetry.to_string s)
(AO_expo.to_float e) (AO_expo.to_float e)
let of_sym_expo s e = let of_sym_expo s e =

View File

@ -1,5 +1,6 @@
open Core;; open Sexplib
open Qptypes;; open Sexplib.Std
open Qptypes
let fail_msg str (ex,range) = let fail_msg str (ex,range) =
@ -15,25 +16,25 @@ let fail_msg str (ex,range) =
let start_pos = range.start_pos.offset let start_pos = range.start_pos.offset
and end_pos = range.end_pos.offset and end_pos = range.end_pos.offset
in in
let pre = String.sub ~pos:0 ~len:start_pos str let pre = String.sub str 0 start_pos
and mid = String.sub ~pos:start_pos ~len:(end_pos-start_pos) str and mid = String.sub str start_pos (end_pos-start_pos)
and post = String.sub ~pos:(end_pos) and post = String.sub str (end_pos)
~len:((String.length str)-(end_pos)) str ((String.length str)-(end_pos))
in in
let str = Printf.sprintf "%s ## %s ## %s" pre mid post let str = Printf.sprintf "%s ## %s ## %s" pre mid post
in in
let str = String.tr str ~target:'(' ~replacement:' ' let str = String_ext.tr str ~target:'(' ~replacement:' '
|> String.split ~on:')' |> String_ext.split ~on:')'
|> List.map ~f:String.strip |> List.map String_ext.strip
|> List.filter ~f:(fun x -> |> List.filter (fun x ->
match String.substr_index x ~pos:0 ~pattern:"##" with match String_ext.substr_index ~pos:0 ~pattern:"##" x with
| None -> false | None -> false
| Some _ -> true | Some _ -> true
) )
|> String.concat ~sep:"\n" |> String.concat "\n"
in 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 = 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 match ( Sexp.of_string_conv sexp t_of_sexp ) with
| `Result r -> Some r | `Result r -> Some r
| `Error ex -> ( fail_msg sexp ex; None) | `Error ex -> ( fail_msg sexp ex; None)
;;
let of_rst t_of_sexp s = let of_rst t_of_sexp s =
Rst_string.to_string s Rst_string.to_string s
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
|> List.filter ~f:(fun line -> |> List.filter (fun line -> String.contains line '=')
String.contains line '=') |> List.map (fun line ->
|> List.map ~f:(fun line ->
"("^( "("^(
String.tr line ~target:'=' ~replacement:' ' String_ext.tr ~target:'=' ~replacement:' ' line
)^")" ) )^")" )
|> String.concat |> String.concat ""
|> evaluate_sexp t_of_sexp |> evaluate_sexp t_of_sexp
;;

View File

@ -1,4 +1,4 @@
open Core open Sexplib.Std
open Qptypes open Qptypes
(** New job : Request to create a new multi-tasked job *) (** 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 create ~state ~tasks = { state = State.of_string state ; tasks }
let to_string x = 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 end
@ -193,12 +193,12 @@ end = struct
} }
let create ~state ~task_ids = let create ~state ~task_ids =
{ state = State.of_string state ; { 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 = let to_string x =
Printf.sprintf "del_task %s %s" Printf.sprintf "del_task %s %s"
(State.to_string x.state) (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 end
@ -219,7 +219,7 @@ end = struct
else "done" else "done"
in in
Printf.sprintf "del_task_reply %s %s" 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 end
@ -303,11 +303,11 @@ end = struct
"get_tasks_reply ok" "get_tasks_reply ok"
let to_string_list x = let to_string_list x =
"get_tasks_reply ok" :: ( "get_tasks_reply ok" :: (
List.map x ~f:(fun (task_id, task) -> List.map (fun (task_id, task) ->
match task_id with match task_id with
| Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task | Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task
| None -> Printf.sprintf "0 terminate" | None -> Printf.sprintf "0 terminate"
) ) ) x )
end end
@ -408,14 +408,14 @@ end = struct
let create ~state ~client_id ~task_ids = let create ~state ~client_id ~task_ids =
{ client_id = Id.Client.of_int client_id ; { client_id = Id.Client.of_int client_id ;
state = State.of_string state ; 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 = let to_string x =
Printf.sprintf "task_done %s %d %s" Printf.sprintf "task_done %s %d %s"
(State.to_string x.state) (State.to_string x.state)
(Id.Client.to_int x.client_id) (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 end
(** Terminate *) (** Terminate *)
@ -460,7 +460,7 @@ end = struct
type t = string type t = string
let create x = x let create x = x
let to_string x = let to_string x =
String.concat ~sep:" " [ "error" ; x ] String.concat " " [ "error" ; x ]
end end

View File

@ -207,7 +207,7 @@ let distance_matrix molecule =
open Core ;;
include To_md5 include To_md5
let to_md5 = to_md5 sexp_of_t let to_md5 = to_md5 sexp_of_t

View File

@ -1,10 +1,11 @@
open Core;; open Qptypes
open Qptypes ;; open Sexplib.Std
type t = Strictly_positive_int.t [@@deriving sexp] type t = Strictly_positive_int.t [@@deriving sexp]
let of_int = Strictly_positive_int.of_int ;; let of_int = Strictly_positive_int.of_int
let to_int = Strictly_positive_int.to_int ;;
let to_int = Strictly_positive_int.to_int
let to_string m = let to_string m =
match (to_int m) with match (to_int m) with
@ -18,7 +19,7 @@ let to_string m =
| 8 -> "Octet" | 8 -> "Octet"
| 9 -> "Nonet" | 9 -> "Nonet"
| i -> Printf.sprintf "%d-et" i | i -> Printf.sprintf "%d-et" i
;;
let of_alpha_beta a b = let of_alpha_beta a b =
let a = Elec_alpha_number.to_int a let a = Elec_alpha_number.to_int a
@ -26,11 +27,11 @@ let of_alpha_beta a b =
in in
assert (a >= b); assert (a >= b);
of_int (1 + a - b) of_int (1 + a - b)
;;
let to_alpha_beta ne m = let to_alpha_beta ne m =
let ne = Elec_number.to_int ne in let ne = Elec_number.to_int ne in
let nb = (ne-(to_int m)+1)/2 in let nb = (ne-(to_int m)+1)/2 in
let na = ne - nb in let na = ne - nb in
(Elec_alpha_number.of_int na, Elec_beta_number.of_int nb) (Elec_alpha_number.of_int na, Elec_beta_number.of_int nb)
;;

View File

@ -1,5 +1,3 @@
open Core
type t = type t =
{ {
title: string; title: string;
@ -7,14 +5,14 @@ type t =
cur_value : float; cur_value : float;
end_value : float; end_value : float;
bar_length : int; bar_length : int;
init_time : Time.t; init_time : float;
dirty : bool; dirty : bool;
next : Time.t; next : float;
} }
let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title = let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title =
{ title ; start_value ; end_value ; bar_length ; cur_value=start_value ; { 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 = let update ~cur_value bar =
{ bar with cur_value ; dirty=true } { bar with cur_value ; dirty=true }
@ -40,23 +38,23 @@ let display_tty bar =
|> Float.to_int |> Float.to_int
in in
let hashes = let hashes =
String.init bar.bar_length ~f:(fun i -> String.init bar.bar_length (fun i ->
if (i < n_hashes) then '#' if (i < n_hashes) then '#'
else ' ' else ' '
) )
in in
let now = let now =
Time.now () Unix.time ()
in in
let running_time = let running_time =
Time.abs_diff now bar.init_time now -. bar.init_time
in in
Printf.eprintf "%s : [%s] %4.1f%% | %10s\r%!" Printf.eprintf "%s : [%s] %4.1f%% | %8.0f s\r%!"
bar.title bar.title
hashes hashes
percent percent
(Time.Span.to_string running_time); running_time;
{ bar with dirty = false ; next = Time.add now (Time.Span.of_sec 0.1) } { bar with dirty = false ; next = now +. 0.1 }
let display_file bar = let display_file bar =
@ -65,19 +63,19 @@ let display_file bar =
(bar.end_value -. bar.start_value) (bar.end_value -. bar.start_value)
in in
let running_time = let running_time =
Time.abs_diff (Time.now ()) bar.init_time (Unix.time ()) -. bar.init_time
in in
Printf.eprintf "%5.2f %% in %20s \n%!" Printf.eprintf "%5.2f %% in %20.0f seconds \n%!"
percent percent
(Time.Span.to_string running_time); running_time;
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_sec 10.) } { bar with dirty = false ; next = (Unix.time ()) +. 10. }
let display bar = let display bar =
if (not bar.dirty) then if (not bar.dirty) then
bar bar
else if (Time.now () < bar.next) then else if (Unix.time () < bar.next) then
bar bar
else else
begin begin

View File

@ -1,4 +1,4 @@
open Core open Sexplib.Std
open Qptypes open Qptypes
@ -81,12 +81,12 @@ let to_string_local = function
| t -> | t ->
"Local component:" :: "Local component:" ::
( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) :: ( 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) (AO_coef.to_float c)
(R_power.to_int l.GaussianPrimitive_local.r_power) (R_power.to_int l.GaussianPrimitive_local.r_power)
(AO_expo.to_float l.GaussianPrimitive_local.expo) (AO_expo.to_float l.GaussianPrimitive_local.expo)
) ) ) t )
|> String.concat ~sep:"\n" |> String.concat "\n"
(** Transform the non-local component of the pseudopotential to a string *) (** Transform the non-local component of the pseudopotential to a string *)
@ -95,7 +95,7 @@ let to_string_non_local = function
| t -> | t ->
"Non-local component:" :: "Non-local component:" ::
( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") :: ( 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 = let p =
Positive_int.to_int l.GaussianPrimitive_non_local.proj Positive_int.to_int l.GaussianPrimitive_non_local.proj
in in
@ -104,8 +104,8 @@ let to_string_non_local = function
(R_power.to_int l.GaussianPrimitive_non_local.r_power) (R_power.to_int l.GaussianPrimitive_non_local.r_power)
(AO_expo.to_float l.GaussianPrimitive_non_local.expo) (AO_expo.to_float l.GaussianPrimitive_non_local.expo)
p p p p
) ) ) t )
|> String.concat ~sep:"\n" |> String.concat "\n"
(** Transform the Pseudopotential to a string *) (** Transform the Pseudopotential to a string *)
let to_string t = let to_string t =
@ -116,29 +116,30 @@ let to_string t =
:: to_string_local t.local :: to_string_local t.local
:: to_string_non_local t.non_local :: to_string_non_local t.non_local
:: [] :: []
|> List.filter ~f:(fun x -> x <> "") |> List.filter (fun x -> x <> "")
|> String.concat ~sep:"\n" |> String.concat "\n"
(** Find an element in the file *) (** Find an element in the file *)
let find in_channel element = let find in_channel element =
In_channel.seek in_channel 0L; seek_in in_channel 0;
let loop, element_read, old_pos = let loop, element_read, old_pos =
ref true, ref true,
ref None, ref None,
ref (In_channel.pos in_channel) ref (pos_in in_channel)
in in
while !loop while !loop
do do
try try
let buffer = let buffer =
old_pos := In_channel.pos in_channel; old_pos := pos_in in_channel;
match In_channel.input_line in_channel with try
| Some line -> String.split ~on:' ' line input_line in_channel
|> List.hd_exn |> String_ext.split ~on:' '
| None -> raise End_of_file |> List.hd
with _ -> raise End_of_file
in in
element_read := Some (Element.of_string buffer); element_read := Some (Element.of_string buffer);
loop := !element_read <> (Some element) loop := !element_read <> (Some element)
@ -146,7 +147,7 @@ let find in_channel element =
| Element.ElementError _ -> () | Element.ElementError _ -> ()
| End_of_file -> loop := false | End_of_file -> loop := false
done ; done ;
In_channel.seek in_channel !old_pos; seek_in in_channel !old_pos;
!element_read !element_read
@ -156,13 +157,13 @@ let read_element in_channel element =
| Some e when e = element -> | Some e when e = element ->
begin begin
let rec read result = let rec read result =
match In_channel.input_line in_channel with try
| None -> result let line = input_line in_channel in
| Some line -> if (String.trim line = "") then
if (String.strip line = "") then
result result
else else
read (line::result) read (line::result)
with _ -> result
in in
let data = let data =
@ -171,20 +172,20 @@ let read_element in_channel element =
in in
let debug_data = let debug_data =
String.concat ~sep:"\n" data String.concat "\n" data
in in
let decode_first_line = function let decode_first_line = function
| first_line :: rest -> | first_line :: rest ->
begin begin
let first_line_split = let first_line_split =
String.split first_line ~on:' ' String_ext.split first_line ~on:' '
|> List.filter ~f:(fun x -> (String.strip x) <> "") |> List.filter (fun x -> (String.trim x) <> "")
in in
match first_line_split with match first_line_split with
| e :: "GEN" :: n :: p -> | e :: "GEN" :: n :: p ->
{ element = Element.of_string e ; { 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 = [] ; local = [] ;
non_local = [] non_local = []
}, rest }, rest
@ -200,18 +201,18 @@ let read_element in_channel element =
| (n,line::rest) -> | (n,line::rest) ->
begin begin
match match
String.split line ~on:' ' String_ext.split line ~on:' '
|> List.filter ~f:(fun x -> String.strip x <> "") |> List.filter (fun x -> String.trim x <> "")
with with
| c :: i :: e :: [] -> | c :: i :: e :: [] ->
let i = let i =
Int.of_string i int_of_string i
in in
let elem = let elem =
( create_primitive ( create_primitive
(Float.of_string e |> AO_expo.of_float) (float_of_string e |> AO_expo.of_float)
(i-2 |> R_power.of_int), (i-2 |> R_power.of_int),
Float.of_string c |> AO_coef.of_float float_of_string c |> AO_coef.of_float
) )
in in
loop create_primitive (elem::accu) (n-1, rest) loop create_primitive (elem::accu) (n-1, rest)
@ -230,8 +231,8 @@ let read_element in_channel element =
match data with match data with
| n :: rest -> | n :: rest ->
let n = let n =
String.strip n String.trim n
|> Int.of_string |> int_of_string
|> Positive_int.of_int |> Positive_int.of_int
in in
decode_local_n n rest decode_local_n n rest
@ -250,8 +251,8 @@ let read_element in_channel element =
match data with match data with
| n :: rest -> | n :: rest ->
let n = let n =
String.strip n String.trim n
|> Int.of_string |> int_of_string
|> Positive_int.of_int |> Positive_int.of_int
in in
let result = let result =

View File

@ -1,45 +1,45 @@
open Core;; open Qptypes
open Qptypes;; open Qputils
open Qputils;;
(** Variables related to the quantum package installation *) (** Variables related to the quantum package installation *)
let root = let root =
match (Sys.getenv "QP_ROOT") with match (Sys.getenv_opt "QP_ROOT") with
| None -> failwith "QP_ROOT environment variable is not set. | None -> failwith "QP_ROOT environment variable is not set.
Please source the quantum_package.rc file." Please source the quantum_package.rc file."
| Some x -> x | Some x -> x
;;
let bit_kind_size = lazy ( let bit_kind_size = lazy (
let filename = root^"/src/bitmask/bitmasks_module.f90" in 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")); raise (Failure ("File "^filename^" not found"));
let in_channel = In_channel.create filename in let in_channel = open_in filename in
let lines = In_channel.input_lines in_channel in let lines = input_lines in_channel in
In_channel.close in_channel; close_in in_channel;
let rec get_data = function let rec get_data = function
| [] -> raise (Failure ("bit_kind_size not found in "^filename)) | [] -> raise (Failure ("bit_kind_size not found in "^filename))
| line::tail -> | line::tail ->
let line = let line =
begin match String.split ~on:'!' line |> List.hd with try
| Some x -> x String_ext.split ~on:'!' line
| None -> "" |> List.hd
end in with _ -> line
begin match (String.rsplit2 ~on:':' line) with in
| Some (_ ,buffer) -> begin match (String_ext.rsplit2 ~on:':' line) with
begin match (String.split ~on:'=' buffer |> List.map ~f:String.strip) with | Some (_ ,buffer) ->
| ["bit_kind_size"; x] -> begin match (String_ext.split ~on:'=' buffer |> List.map String.trim) with
Int.of_string x |> Bit_kind_size.of_int | ["bit_kind_size"; x] ->
| _ -> get_data tail int_of_string x |> Bit_kind_size.of_int
end | _ -> get_data tail
| _ -> get_data tail end
end | _ -> get_data tail
end
in in
get_data lines ) get_data lines )
;;
let bit_kind = lazy ( let bit_kind = lazy (
Lazy.force bit_kind_size Lazy.force bit_kind_size
@ -47,23 +47,26 @@ let bit_kind = lazy (
|> fun x -> x / 8 |> fun x -> x / 8
|> Bit_kind.of_int |> Bit_kind.of_int
) )
;;
let executables = lazy ( let executables = lazy (
let filename = root^"/data/executables" let filename = root^"/data/executables" in
and func in_channel = let lines =
In_channel.input_lines in_channel let in_channel = open_in filename in
|> List.map ~f:(fun x -> let result = input_lines in_channel in
let e = String.split ~on:' ' x close_in in_channel;
|> List.filter ~f:(fun x -> x <> "") result
in
lines
|> List.map (fun x ->
let e = String_ext.split ~on:' ' x
|> List.filter (fun x -> x <> "")
in in
match e with 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 |> List.sort (fun (x,_) (y,_) ->
In_channel.with_file filename ~f:func
|> List.sort ~compare:(fun (x,_) (y,_) ->
if x < y then -1 if x < y then -1
else if x > y then 1 else if x > y then 1
else 0) else 0)
@ -72,33 +75,37 @@ let executables = lazy (
let get_ezfio_default_in_file ~directory ~data ~filename = let get_ezfio_default_in_file ~directory ~data ~filename =
let lines = In_channel.with_file filename ~f:(fun in_channel -> let lines =
In_channel.input_lines in_channel) in 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 let rec find_dir = function
| line :: rest -> | line :: rest ->
if ((String.strip line) = directory) then if ((String.trim line) = directory) then
rest rest
else else
find_dir rest find_dir rest
| [] -> raise Caml.Not_found | [] -> raise Not_found
in in
let rec find_data = function let rec find_data = function
| line :: rest -> | line :: rest ->
if (line = "") then if (line = "") then
raise Caml.Not_found raise Not_found
else if (line.[0] <> ' ') then else if (line.[0] <> ' ') then
raise Caml.Not_found raise Not_found
else else
begin begin
match (String.lsplit2 ~on:' ' (String.strip line)) with match (String_ext.lsplit2 ~on:' ' (String.trim line)) with
| Some (l,r) -> | Some (l,r) ->
if (l = data) then if (l = data) then
String.strip r String.trim r
else else
find_data rest find_data rest
| None -> raise Caml.Not_found | None -> raise Not_found
end end
| [] -> raise Caml.Not_found | [] -> raise Not_found
in in
find_dir lines find_dir lines
|> find_data ; |> find_data ;
@ -111,7 +118,7 @@ let get_ezfio_default directory data =
| [] -> | [] ->
begin begin
Printf.printf "%s/%s not found\n%!" directory data; Printf.printf "%s/%s not found\n%!" directory data;
raise Caml.Not_found raise Not_found
end end
| filename :: tail -> | filename :: tail ->
let filename = let filename =
@ -120,7 +127,7 @@ let get_ezfio_default directory data =
try try
get_ezfio_default_in_file ~directory ~data ~filename get_ezfio_default_in_file ~directory ~data ~filename
with with
| Caml.Not_found -> aux tail | Not_found -> aux tail
in in
Sys.readdir dirname Sys.readdir dirname
|> Array.to_list |> Array.to_list
@ -131,10 +138,7 @@ let ezfio_work ezfio_file =
let result = let result =
Filename.concat ezfio_file "work" Filename.concat ezfio_file "work"
in in
begin if not (Sys.file_exists result) then
match Sys.is_directory result with ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false);
| `Yes -> ()
| _ -> ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false)
end;
result result
;; ;;

View File

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

View File

@ -3,27 +3,6 @@ include String
(** Split a string on a given character *) (** Split a string on a given character *)
let split ?(on=' ') str = let split ?(on=' ') str =
split_on_char 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 *) (** 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 *) (** Split a string in two pieces when a character is found the 1st time from the right *)
let rsplit2_exn ?(on=' ') s = let rsplit2_exn ?(on=' ') s =
let length = let length =
String.length s String.length s
in in
let rec do_work i = let rec do_work i =
if (i = -1) then if (i = -1) then
@ -101,7 +80,7 @@ let rsplit2_exn ?(on=' ') s =
else else
do_work (i-1) do_work (i-1)
in in
do_work length do_work (length-1)
let lsplit2 ?(on=' ') s = let lsplit2 ?(on=' ') s =
@ -140,3 +119,23 @@ let is_prefix ~prefix s =
let of_char c = let of_char c =
String.make 1 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

View File

@ -33,7 +33,7 @@ type t =
let debug_env = let debug_env =
try try
Sys.getenv "QP_TASK_DEBUG"; true Sys.getenv "QP_TASK_DEBUG" = "1"
with Not_found -> false with Not_found -> false

View File

@ -4,9 +4,8 @@ SHA1=$(git log -1 | head -1 | cut -d ' ' -f 2)
DATE=$(git log -1 | grep Date | cut -d ':' -f 2-) DATE=$(git log -1 | grep Date | cut -d ':' -f 2-)
MESSAGE=$(git log -1 | tail -1 | sed 's/"/\\"/g') MESSAGE=$(git log -1 | tail -1 | sed 's/"/\\"/g')
cat << EOF > Git.ml cat << EOF > Git.ml
open Core let sha1 = "$SHA1" |> String.trim
let sha1 = "$SHA1" |> String_ext.strip let date = "$DATE" |> String.trim
let date = "$DATE" |> String_ext.strip let message = "$MESSAGE" |> String.trim
let message = "$MESSAGE" |> String_ext.strip
EOF EOF

View File

@ -1,4 +1,3 @@
open Core
open Qptypes open Qptypes
open Element open Element
@ -6,22 +5,22 @@ let () =
let indices = let indices =
Array.init 78 (fun i -> i) Array.init 78 (fun i -> i)
in in
Out_channel.with_file (Qpackage.root ^ "/data/list_element.txt") let out_channel =
~f:(fun out_channel -> open_out (Qpackage.root ^ "/data/list_element.txt")
Array.init 110 ~f:(fun i -> in
let element = Array.init 110 (fun i ->
try let element =
Some (of_charge (Charge.of_int i)) try
with Some (of_charge (Charge.of_int i))
| _ -> None with
in | _ -> None
match element with in
| None -> "" match element with
| Some x -> Printf.sprintf "%3d %3s %s %f\n" | None -> ""
i (to_string x) (to_long_string x) (Positive_float.to_float @@ mass x ) | 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
) )
|> Array.to_list
|> String.concat ""
|> Printf.fprintf out_channel "%s"