mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
117 lines
2.5 KiB
OCaml
117 lines
2.5 KiB
OCaml
|
open Core.Std
|
||
|
|
||
|
|
||
|
type t =
|
||
|
{ queued : Id.Task.t list ;
|
||
|
running : (Id.Task.t, Id.Client.t) Map.Poly.t ;
|
||
|
tasks : (Id.Task.t, string) Map.Poly.t;
|
||
|
clients : Id.Client.t Set.Poly.t;
|
||
|
next_client_id : Id.Client.t;
|
||
|
next_task_id : Id.Task.t;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
let create () =
|
||
|
{ queued = [] ;
|
||
|
running = Map.Poly.empty ;
|
||
|
tasks = Map.Poly.empty;
|
||
|
clients = Set.Poly.empty;
|
||
|
next_client_id = Id.Client.of_int 1;
|
||
|
next_task_id = Id.Task.of_int 1;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
let add_task ~task q =
|
||
|
let task_id =
|
||
|
q.next_task_id
|
||
|
in
|
||
|
{ q with
|
||
|
queued = q.queued @ [ task_id ] ;
|
||
|
tasks = Map.add q.tasks ~key:task_id ~data:task ;
|
||
|
next_task_id = Id.Task.increment task_id ;
|
||
|
}, task_id
|
||
|
|
||
|
|
||
|
let add_client q =
|
||
|
let client_id =
|
||
|
q.next_client_id
|
||
|
in
|
||
|
{ q with
|
||
|
clients = Set.add q.clients client_id;
|
||
|
next_client_id = Id.Client.increment client_id;
|
||
|
}, client_id
|
||
|
|
||
|
|
||
|
let pop_task ~client_id q =
|
||
|
let { queued ; running ; _ } =
|
||
|
q
|
||
|
in
|
||
|
assert (Set.mem q.clients client_id);
|
||
|
match queued with
|
||
|
| task_id :: new_queue ->
|
||
|
let new_q =
|
||
|
{ q with
|
||
|
queued = new_queue ;
|
||
|
running = Map.add running ~key:task_id ~data:client_id ;
|
||
|
}
|
||
|
in new_q, Some task_id, (Map.find q.tasks task_id)
|
||
|
| [] -> q, None, None
|
||
|
|
||
|
|
||
|
let del_client ~client_id q =
|
||
|
assert (Set.mem q.clients client_id);
|
||
|
{ q with
|
||
|
clients = Set.remove q.clients client_id }
|
||
|
|
||
|
|
||
|
let end_task ~task_id ~client_id q =
|
||
|
let { running ; tasks ; _ } =
|
||
|
q
|
||
|
in
|
||
|
assert (Set.mem q.clients client_id);
|
||
|
let () =
|
||
|
match Map.Poly.find running task_id with
|
||
|
| None -> failwith "Task already finished"
|
||
|
| Some client_id_check -> assert (client_id_check = client_id)
|
||
|
in
|
||
|
{ q with
|
||
|
running = Map.remove running task_id ;
|
||
|
tasks = Map.remove tasks task_id ;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
let number_of_queued q =
|
||
|
List.length q.queued
|
||
|
|
||
|
let number_of_running q =
|
||
|
Map.length q.running
|
||
|
|
||
|
|
||
|
let to_string { queued ; running ; tasks ; _ } =
|
||
|
let q =
|
||
|
List.map ~f:Id.Task.to_string queued
|
||
|
|> String.concat ~sep:" ; "
|
||
|
and r =
|
||
|
Map.Poly.to_alist running
|
||
|
|> List.map ~f:(fun (t,c) -> "("^(Id.Task.to_string t)^", "
|
||
|
^(Id.Client.to_string c)^")")
|
||
|
|> String.concat ~sep:" ; "
|
||
|
and t =
|
||
|
Map.Poly.to_alist tasks
|
||
|
|> List.map ~f:(fun (t,c) -> "("^(Id.Task.to_string t)^", \""
|
||
|
^c^"\")")
|
||
|
|> String.concat ~sep:" ; "
|
||
|
in
|
||
|
Printf.sprintf "{
|
||
|
queued : { %s }
|
||
|
running : { %s }
|
||
|
tasks : [ %s
|
||
|
]
|
||
|
}" q r t
|
||
|
|
||
|
|