mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-22 12:23:43 +01:00
OCaml code modernization
This commit is contained in:
parent
78dcb2c4d5
commit
75c59840dd
@ -1,3 +1,5 @@
|
|||||||
|
exception Error of string
|
||||||
|
|
||||||
type short_opt = char
|
type short_opt = char
|
||||||
type long_opt = string
|
type long_opt = string
|
||||||
type optional = Mandatory | Optional
|
type optional = Mandatory | Optional
|
||||||
@ -181,15 +183,16 @@ let set_specs specs_in =
|
|||||||
Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]);
|
Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]);
|
||||||
|
|
||||||
if show_help () then
|
if show_help () then
|
||||||
(help () ; exit 0);
|
help ()
|
||||||
|
else
|
||||||
(* Check that all mandatory arguments are set *)
|
(* Check that all mandatory arguments are set *)
|
||||||
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|
||||||
|> List.iter (fun x ->
|
|> List.iter (fun x ->
|
||||||
match get x.long with
|
match get x.long with
|
||||||
| Some _ -> ()
|
| Some _ -> ()
|
||||||
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
| None -> raise (Error ("--"^x.long^" option is missing."))
|
||||||
)
|
)
|
||||||
|
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
@ -59,6 +59,8 @@ let () =
|
|||||||
*)
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
exception Error of string
|
||||||
|
|
||||||
type short_opt = char
|
type short_opt = char
|
||||||
|
|
||||||
type long_opt = string
|
type long_opt = string
|
||||||
|
@ -29,7 +29,7 @@ tests: $(ALL_TESTS)
|
|||||||
.gitignore: $(MLFILES) $(MLIFILES)
|
.gitignore: $(MLFILES) $(MLIFILES)
|
||||||
@for i in .gitignore ezfio.ml element_create_db Qptypes.ml Git.ml *.byte *.native _build $(ALL_EXE) $(ALL_TESTS) \
|
@for i in .gitignore ezfio.ml element_create_db Qptypes.ml Git.ml *.byte *.native _build $(ALL_EXE) $(ALL_TESTS) \
|
||||||
$(patsubst %.ml,%,$(wildcard test_*.ml)) $(patsubst %.ml,%,$(wildcard qp_*.ml)) \
|
$(patsubst %.ml,%,$(wildcard test_*.ml)) $(patsubst %.ml,%,$(wildcard qp_*.ml)) \
|
||||||
$(shell grep Input Input_auto_generated.ml | awk '{print $$2 ".ml"}') \
|
Input_*.ml \
|
||||||
qp_edit.ml qp_edit qp_edit.native Input_auto_generated.ml;\
|
qp_edit.ml qp_edit qp_edit.native Input_auto_generated.ml;\
|
||||||
do \
|
do \
|
||||||
echo $$i ; \
|
echo $$i ; \
|
||||||
|
@ -63,11 +63,11 @@ end
|
|||||||
|
|
||||||
module Connect_msg : sig
|
module Connect_msg : sig
|
||||||
type t = Tcp | Inproc | Ipc
|
type t = Tcp | Inproc | Ipc
|
||||||
val create : typ:string -> t
|
val create : string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t = Tcp | Inproc | Ipc
|
type t = Tcp | Inproc | Ipc
|
||||||
let create ~typ =
|
let create typ =
|
||||||
match typ with
|
match typ with
|
||||||
| "tcp" -> Tcp
|
| "tcp" -> Tcp
|
||||||
| "inproc" -> Inproc
|
| "inproc" -> Inproc
|
||||||
@ -515,9 +515,9 @@ let of_string s =
|
|||||||
| Connect_ socket ->
|
| Connect_ socket ->
|
||||||
Connect (Connect_msg.create socket)
|
Connect (Connect_msg.create socket)
|
||||||
| NewJob_ { state ; push_address_tcp ; push_address_inproc } ->
|
| NewJob_ { state ; push_address_tcp ; push_address_inproc } ->
|
||||||
Newjob (Newjob_msg.create push_address_tcp push_address_inproc state)
|
Newjob (Newjob_msg.create ~address_tcp:push_address_tcp ~address_inproc:push_address_inproc ~state)
|
||||||
| EndJob_ state ->
|
| EndJob_ state ->
|
||||||
Endjob (Endjob_msg.create state)
|
Endjob (Endjob_msg.create ~state)
|
||||||
| GetData_ { state ; client_id ; key } ->
|
| GetData_ { state ; client_id ; key } ->
|
||||||
GetData (GetData_msg.create ~client_id ~state ~key)
|
GetData (GetData_msg.create ~client_id ~state ~key)
|
||||||
| PutData_ { state ; client_id ; key } ->
|
| PutData_ { state ; client_id ; key } ->
|
||||||
|
@ -101,7 +101,7 @@ let to_string_general ~f m =
|
|||||||
|> String.concat "\n"
|
|> String.concat "\n"
|
||||||
|
|
||||||
let to_string =
|
let to_string =
|
||||||
to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x)
|
to_string_general ~f:(fun x -> Atom.to_string ~units:Units.Angstrom x)
|
||||||
|
|
||||||
let to_xyz =
|
let to_xyz =
|
||||||
to_string_general ~f:Atom.to_xyz
|
to_string_general ~f:Atom.to_xyz
|
||||||
@ -113,7 +113,7 @@ let of_xyz_string
|
|||||||
s =
|
s =
|
||||||
let l = String_ext.split s ~on:'\n'
|
let l = String_ext.split s ~on:'\n'
|
||||||
|> List.filter (fun x -> x <> "")
|
|> List.filter (fun x -> x <> "")
|
||||||
|> list_map (fun x -> Atom.of_string units x)
|
|> list_map (fun x -> Atom.of_string ~units x)
|
||||||
in
|
in
|
||||||
let ne = ( get_charge {
|
let ne = ( get_charge {
|
||||||
nuclei=l ;
|
nuclei=l ;
|
||||||
|
@ -10,7 +10,7 @@ type t =
|
|||||||
next : float;
|
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= Unix.time () ; dirty = false ; next = Unix.time () }
|
init_time= Unix.time () ; dirty = false ; next = Unix.time () }
|
||||||
|
|
||||||
|
@ -56,3 +56,7 @@ let string_of_string s = s
|
|||||||
let list_map f l =
|
let list_map f l =
|
||||||
List.rev_map f l
|
List.rev_map f l
|
||||||
|> List.rev
|
|> List.rev
|
||||||
|
|
||||||
|
let socket_convert socket =
|
||||||
|
((Obj.magic (Obj.repr socket)) : [ `Xsub ] Zmq.Socket.t )
|
||||||
|
|
||||||
|
@ -155,7 +155,7 @@ let new_job msg program_state rep_socket pair_socket =
|
|||||||
~start_value:0.
|
~start_value:0.
|
||||||
~end_value:1.
|
~end_value:1.
|
||||||
~bar_length:20
|
~bar_length:20
|
||||||
~title:(Message.State.to_string state)
|
(Message.State.to_string state)
|
||||||
in
|
in
|
||||||
|
|
||||||
let result =
|
let result =
|
||||||
@ -776,7 +776,7 @@ let run ~port =
|
|||||||
Zmq.Socket.create zmq_context Zmq.Socket.rep
|
Zmq.Socket.create zmq_context Zmq.Socket.rep
|
||||||
in
|
in
|
||||||
Zmq.Socket.set_linger_period rep_socket 1_000_000;
|
Zmq.Socket.set_linger_period rep_socket 1_000_000;
|
||||||
bind_socket "REP" rep_socket port;
|
bind_socket ~socket_type:"REP" ~socket:rep_socket ~port;
|
||||||
|
|
||||||
let initial_program_state =
|
let initial_program_state =
|
||||||
{ queue = Queuing_system.create () ;
|
{ queue = Queuing_system.create () ;
|
||||||
|
@ -677,6 +677,7 @@ let run ?o b au c d m p cart xyz_file =
|
|||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
|
||||||
|
try (
|
||||||
|
|
||||||
let open Command_line in
|
let open Command_line in
|
||||||
begin
|
begin
|
||||||
@ -734,7 +735,7 @@ If a file with the same name as the basis set exists, this file will be read. O
|
|||||||
|
|
||||||
let basis =
|
let basis =
|
||||||
match Command_line.get "basis" with
|
match Command_line.get "basis" with
|
||||||
| None -> assert false
|
| None -> ""
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
in
|
in
|
||||||
|
|
||||||
@ -773,10 +774,14 @@ If a file with the same name as the basis set exists, this file will be read. O
|
|||||||
|
|
||||||
let xyz_filename =
|
let xyz_filename =
|
||||||
match Command_line.anon_args () with
|
match Command_line.anon_args () with
|
||||||
| [x] -> x
|
| [] -> failwith "input file is missing"
|
||||||
| _ -> (Command_line.help () ; failwith "input file is missing")
|
| x::_ -> x
|
||||||
in
|
in
|
||||||
|
|
||||||
run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
|
run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
|
||||||
|
)
|
||||||
|
with
|
||||||
|
| Failure txt -> Printf.eprintf "Fatal error: %s\n%!" txt
|
||||||
|
| Command_line.Error txt -> Printf.eprintf "Command line error: %s\n%!" txt
|
||||||
|
|
||||||
|
|
||||||
|
@ -110,7 +110,7 @@ let run slave ?prefix exe ezfio_file =
|
|||||||
let task_thread =
|
let task_thread =
|
||||||
let thread =
|
let thread =
|
||||||
Thread.create ( fun () ->
|
Thread.create ( fun () ->
|
||||||
TaskServer.run port_number )
|
TaskServer.run ~port:port_number )
|
||||||
in
|
in
|
||||||
thread ();
|
thread ();
|
||||||
in
|
in
|
||||||
@ -155,6 +155,7 @@ let run slave ?prefix exe ezfio_file =
|
|||||||
in
|
in
|
||||||
Printf.printf "Wall time: %d:%2.2d:%2.2d" (d*24+h) m s ;
|
Printf.printf "Wall time: %d:%2.2d:%2.2d" (d*24+h) m s ;
|
||||||
Printf.printf "\n\n";
|
Printf.printf "\n\n";
|
||||||
|
Unix.sleep 1;
|
||||||
if (exit_code <> 0) then
|
if (exit_code <> 0) then
|
||||||
exit exit_code
|
exit exit_code
|
||||||
|
|
||||||
|
@ -131,37 +131,64 @@ let () =
|
|||||||
Sys.set_signal Sys.sigint handler;
|
Sys.set_signal Sys.sigint handler;
|
||||||
|
|
||||||
|
|
||||||
let new_thread req_or_sub addr_in addr_out =
|
let new_thread_req addr_in addr_out =
|
||||||
let socket_in, socket_out =
|
let socket_in, socket_out =
|
||||||
match req_or_sub with
|
|
||||||
| REQ ->
|
|
||||||
create_socket Zmq.Socket.router Zmq.Socket.bind addr_in,
|
create_socket Zmq.Socket.router Zmq.Socket.bind addr_in,
|
||||||
create_socket Zmq.Socket.dealer Zmq.Socket.connect addr_out
|
create_socket Zmq.Socket.dealer Zmq.Socket.connect addr_out
|
||||||
| SUB ->
|
in
|
||||||
|
|
||||||
|
|
||||||
|
let action_in =
|
||||||
|
fun () -> Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out
|
||||||
|
in
|
||||||
|
|
||||||
|
let action_out =
|
||||||
|
fun () -> Zmq.Socket.recv_all socket_out |> Zmq.Socket.send_all socket_in
|
||||||
|
in
|
||||||
|
|
||||||
|
let pollitem =
|
||||||
|
Zmq.Poll.mask_of
|
||||||
|
[| (socket_convert socket_in, Zmq.Poll.In) ; (socket_convert socket_out, Zmq.Poll.In) |]
|
||||||
|
in
|
||||||
|
|
||||||
|
while !run_status do
|
||||||
|
|
||||||
|
let polling =
|
||||||
|
Zmq.Poll.poll ~timeout:1000 pollitem
|
||||||
|
in
|
||||||
|
|
||||||
|
match polling with
|
||||||
|
| [| Some Zmq.Poll.In ; Some Zmq.Poll.In |] -> ( action_out () ; action_in () )
|
||||||
|
| [| _ ; Some Zmq.Poll.In |] -> action_out ()
|
||||||
|
| [| Some Zmq.Poll.In ; _ |] -> action_in ()
|
||||||
|
| _ -> ()
|
||||||
|
done;
|
||||||
|
|
||||||
|
Zmq.Socket.close socket_in;
|
||||||
|
Zmq.Socket.close socket_out;
|
||||||
|
in
|
||||||
|
|
||||||
|
let new_thread_sub addr_in addr_out =
|
||||||
|
let socket_in, socket_out =
|
||||||
create_socket Zmq.Socket.sub Zmq.Socket.connect addr_in,
|
create_socket Zmq.Socket.sub Zmq.Socket.connect addr_in,
|
||||||
create_socket Zmq.Socket.pub Zmq.Socket.bind addr_out
|
create_socket Zmq.Socket.pub Zmq.Socket.bind addr_out
|
||||||
in
|
in
|
||||||
|
|
||||||
if req_or_sub = SUB then
|
|
||||||
Zmq.Socket.subscribe socket_in "";
|
Zmq.Socket.subscribe socket_in "";
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let action_in =
|
let action_in =
|
||||||
match req_or_sub with
|
fun () -> Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out
|
||||||
| REQ -> (fun () -> Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out)
|
|
||||||
| SUB -> (fun () -> Zmq.Socket.recv_all socket_in |> Zmq.Socket.send_all socket_out)
|
|
||||||
in
|
in
|
||||||
|
|
||||||
let action_out =
|
let action_out =
|
||||||
match req_or_sub with
|
fun () -> ()
|
||||||
| REQ -> (fun () -> Zmq.Socket.recv_all socket_out |> Zmq.Socket.send_all socket_in )
|
|
||||||
| SUB -> (fun () -> () )
|
|
||||||
in
|
in
|
||||||
|
|
||||||
let pollitem =
|
let pollitem =
|
||||||
Zmq.Poll.mask_of
|
Zmq.Poll.mask_of
|
||||||
[| (socket_in, Zmq.Poll.In) ; (socket_out, Zmq.Poll.In) |]
|
[| (socket_convert socket_in, Zmq.Poll.In) ; (socket_convert socket_out, Zmq.Poll.In) |]
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
@ -194,7 +221,7 @@ let () =
|
|||||||
in
|
in
|
||||||
|
|
||||||
let f () =
|
let f () =
|
||||||
new_thread REQ addr_in addr_out
|
new_thread_req addr_in addr_out
|
||||||
in
|
in
|
||||||
|
|
||||||
(Thread.create f) ()
|
(Thread.create f) ()
|
||||||
@ -212,7 +239,7 @@ let () =
|
|||||||
in
|
in
|
||||||
|
|
||||||
let f () =
|
let f () =
|
||||||
new_thread REQ addr_in addr_out
|
new_thread_req addr_in addr_out
|
||||||
in
|
in
|
||||||
(Thread.create f) ()
|
(Thread.create f) ()
|
||||||
in
|
in
|
||||||
@ -228,7 +255,7 @@ let () =
|
|||||||
in
|
in
|
||||||
|
|
||||||
let f () =
|
let f () =
|
||||||
new_thread SUB addr_in addr_out
|
new_thread_sub addr_in addr_out
|
||||||
in
|
in
|
||||||
(Thread.create f) ()
|
(Thread.create f) ()
|
||||||
in
|
in
|
||||||
@ -417,5 +444,3 @@ Or from this host connect to clients using:
|
|||||||
Printf.printf "qp_tunnel exited properly.\n"
|
Printf.printf "qp_tunnel exited properly.\n"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user