mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-09 15:03:37 +01:00
210 lines
5.0 KiB
OCaml
210 lines
5.0 KiB
OCaml
|
module RunningMap = Map.Make (Id.Task)
|
||
|
module TasksMap = Map.Make (Id.Task)
|
||
|
module ClientsSet = Set.Make (Id.Client)
|
||
|
|
||
|
type t =
|
||
|
{ queued_front : Id.Task.t list ;
|
||
|
queued_back : Id.Task.t list ;
|
||
|
running : Id.Client.t RunningMap.t;
|
||
|
tasks : string TasksMap.t;
|
||
|
clients : ClientsSet.t;
|
||
|
next_client_id : Id.Client.t;
|
||
|
next_task_id : Id.Task.t;
|
||
|
number_of_queued : int;
|
||
|
number_of_running : int;
|
||
|
number_of_tasks : int;
|
||
|
number_of_clients : int;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
let create () =
|
||
|
{ queued_front = [] ;
|
||
|
queued_back = [] ;
|
||
|
running = RunningMap.empty ;
|
||
|
tasks = TasksMap.empty;
|
||
|
clients = ClientsSet.empty;
|
||
|
next_client_id = Id.Client.of_int 1;
|
||
|
next_task_id = Id.Task.of_int 1;
|
||
|
number_of_queued = 0;
|
||
|
number_of_running = 0;
|
||
|
number_of_tasks = 0;
|
||
|
number_of_clients = 0;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
let add_task ~task q =
|
||
|
let task_id =
|
||
|
q.next_task_id
|
||
|
in
|
||
|
{ q with
|
||
|
queued_front = task_id :: q.queued_front ;
|
||
|
tasks = TasksMap.add task_id task q.tasks;
|
||
|
next_task_id = Id.Task.increment task_id ;
|
||
|
number_of_queued = q.number_of_queued + 1;
|
||
|
number_of_tasks = q.number_of_tasks + 1;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
let add_client q =
|
||
|
let client_id =
|
||
|
q.next_client_id
|
||
|
in
|
||
|
{ q with
|
||
|
clients = ClientsSet.add client_id q.clients;
|
||
|
next_client_id = Id.Client.increment client_id;
|
||
|
number_of_clients = q.number_of_clients + 1;
|
||
|
}, client_id
|
||
|
|
||
|
|
||
|
let pop_task ~client_id q =
|
||
|
let { queued_front ; queued_back ; running ; _ } =
|
||
|
q
|
||
|
in
|
||
|
assert (ClientsSet.mem client_id q.clients);
|
||
|
let queued_front', queued_back' =
|
||
|
match queued_front, queued_back with
|
||
|
| (l, []) -> ( [], List.rev l)
|
||
|
| t -> t
|
||
|
in
|
||
|
match queued_back' with
|
||
|
| task_id :: new_queue ->
|
||
|
let new_q =
|
||
|
{ q with
|
||
|
queued_front= queued_front' ;
|
||
|
queued_back = new_queue ;
|
||
|
running = RunningMap.add task_id client_id running;
|
||
|
number_of_queued = q.number_of_queued - 1;
|
||
|
number_of_running = q.number_of_running + 1;
|
||
|
}
|
||
|
and found =
|
||
|
try Some (TasksMap.find task_id q.tasks)
|
||
|
with Caml.Not_found -> None
|
||
|
in new_q, Some task_id, found
|
||
|
| [] -> q, None, None
|
||
|
|
||
|
|
||
|
let del_client ~client_id q =
|
||
|
assert (ClientsSet.mem client_id q.clients);
|
||
|
{ q with
|
||
|
clients = ClientsSet.remove client_id q.clients;
|
||
|
number_of_clients = q.number_of_clients - 1
|
||
|
}
|
||
|
|
||
|
|
||
|
let end_task ~task_id ~client_id q =
|
||
|
let { running ; tasks ; _ } =
|
||
|
q
|
||
|
in
|
||
|
assert (ClientsSet.mem client_id q.clients);
|
||
|
let () =
|
||
|
let client_id_check =
|
||
|
try RunningMap.find task_id running with
|
||
|
Caml.Not_found -> failwith "Task already finished"
|
||
|
in
|
||
|
assert (client_id_check = client_id)
|
||
|
in
|
||
|
{ q with
|
||
|
running = RunningMap.remove task_id running ;
|
||
|
number_of_running = q.number_of_running - 1
|
||
|
}
|
||
|
|
||
|
let del_task ~task_id q =
|
||
|
let { tasks ; _ } =
|
||
|
q
|
||
|
in
|
||
|
|
||
|
if (TasksMap.mem task_id tasks) then
|
||
|
{ q with
|
||
|
tasks = TasksMap.remove task_id tasks;
|
||
|
number_of_tasks = q.number_of_tasks - 1;
|
||
|
}
|
||
|
else
|
||
|
Printf.sprintf "Task %d is already deleted" (Id.Task.to_int task_id)
|
||
|
|> failwith
|
||
|
|
||
|
|
||
|
|
||
|
let number_of_tasks q =
|
||
|
assert (q.number_of_tasks >= 0);
|
||
|
q.number_of_tasks
|
||
|
|
||
|
let number_of_queued q =
|
||
|
assert (q.number_of_queued >= 0);
|
||
|
q.number_of_queued
|
||
|
|
||
|
let number_of_running q =
|
||
|
assert (q.number_of_running >= 0);
|
||
|
q.number_of_running
|
||
|
|
||
|
let number_of_clients q =
|
||
|
assert (q.number_of_clients >= 0);
|
||
|
q.number_of_clients
|
||
|
|
||
|
|
||
|
let to_string qs =
|
||
|
let { queued_back ; queued_front ; running ; tasks ; _ } = qs in
|
||
|
let q =
|
||
|
(List.map Id.Task.to_string queued_front) @
|
||
|
(List.map Id.Task.to_string @@ List.rev queued_back)
|
||
|
|> String.concat " ; "
|
||
|
and r =
|
||
|
RunningMap.bindings running
|
||
|
|> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", "
|
||
|
^(Id.Client.to_string c)^")")
|
||
|
|> String.concat " ; "
|
||
|
and t =
|
||
|
TasksMap.bindings tasks
|
||
|
|> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", \""
|
||
|
^c^"\")")
|
||
|
|> String.concat " ; "
|
||
|
in
|
||
|
Printf.sprintf "{
|
||
|
Tasks : %d Queued : %d Running : %d Clients : %d
|
||
|
queued : { %s }
|
||
|
running : { %s }
|
||
|
tasks : [ %s
|
||
|
]
|
||
|
}"
|
||
|
(number_of_tasks qs) (number_of_queued qs) (number_of_running qs) (number_of_clients qs)
|
||
|
q r t
|
||
|
|
||
|
|
||
|
|
||
|
let test () =
|
||
|
let q =
|
||
|
create ()
|
||
|
|> add_task ~task:"First Task"
|
||
|
|> add_task ~task:"Second Task"
|
||
|
in
|
||
|
let q, client_id =
|
||
|
add_client q
|
||
|
in
|
||
|
let q, task_id, task_content =
|
||
|
match pop_task ~client_id q with
|
||
|
| q, Some x, Some y -> q, Id.Task.to_int x, y
|
||
|
| _ -> assert false
|
||
|
in
|
||
|
Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content;
|
||
|
to_string q |> print_endline ;
|
||
|
let q, task_id, task_content =
|
||
|
match pop_task ~client_id q with
|
||
|
| q, Some x, Some y -> q, Id.Task.to_int x, y
|
||
|
| _ -> assert false
|
||
|
in
|
||
|
Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content;
|
||
|
let q, task_id, task_content =
|
||
|
match pop_task ~client_id q with
|
||
|
| q, None, None -> q, 0, "None"
|
||
|
| _ -> assert false
|
||
|
in
|
||
|
Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content;
|
||
|
q
|
||
|
|> to_string
|
||
|
|> print_endline
|
||
|
|