open Unix
 
 module TmpNumSet= struct
   module IntSet= Set.Make(struct type t= int let compare= compare end)
   type t= {top: int; availableNums: IntSet.t}
   let empty= {top= 1; availableNums= IntSet.empty}
   let get set=
     if IntSet.is_empty set.availableNums then
       let num= set.top in
       (num, {set with top= num+1})
     else
       let num= IntSet.min_elt set.availableNums in
       (num, {set with availableNums= IntSet.remove num set.availableNums})
   let put num set=
     let rec shrink num availableNums=
       if num > 0
         && num = (try IntSet.max_elt availableNums with Not_found -> 0)
       then shrink (num-1) (IntSet.remove num availableNums)
       else (num, availableNums)
     in
     if num > 0 && num < set.top then
       if num = set.top - 1 then
         let (num, availableNums)= shrink (num-1) set.availableNums in
         {top= num+1; availableNums}
       else
         {set with availableNums= IntSet.add num set.availableNums}
     else
       raise (Failure ("unused tmpNum " ^ string_of_int num))
   let ifFree num set= (num >= set.top) || IntSet.mem num set.availableNums
 end
 
 let timerIdPool= ref TmpNumSet.empty
 let timers= Hashtbl.create 8
let scheduleList= ref []
let alreadyTimeout= ref false

type lastActivedTimers= {mutable updated: bool; mutable timers: int list}
let lastActivedTimers= {updated= true; timers= []}

let notifier, notify= pipe ()

let displayTimers l=
  let rec displayTimers l=
    match l with
    | []-> ()
    | id::next->
      let status= Hashtbl.find timers id in
      Printf.printf "%d: interval: %f, value: %f\n" id status.it_interval status.it_value;
      displayTimers next
  in 
  displayTimers l; print_newline ()

let update_timers timePast=
  Hashtbl.iter
    (fun k v->
      Hashtbl.replace timers k
        {v with it_value= v.it_value -. timePast})
    timers

let resetSysTimer ()=
  (match !scheduleList with
  | [] -> (*printf "set sys 0. 0.\n";*) Unix.(setitimer ITIMER_REAL {it_interval= 0.; it_value= 0.})
  | id::_ ->
    let {it_interval;it_value}= Hashtbl.find timers id in
    Unix.(setitimer ITIMER_REAL
      {it_interval= it_value; it_value}))
  |> ignore

let add_scheduleUnit newid=
  let curr= (Hashtbl.find timers newid).it_value in
  let rec add newid l=
    (match l with
    | []-> [newid]
    | id::next->
      let min= (Hashtbl.find timers id).it_value in
      if curr < min
      then newid::l
      else id::add newid next)
  in
  scheduleList:= add newid !scheduleList;
  resetSysTimer ()

let new_timer status=
  let (id, pool)= TmpNumSet.get !timerIdPool in
  timerIdPool:= pool;
  Hashtbl.add timers id status;
  add_scheduleUnit id;
  id

let del_timer id=
  if not (TmpNumSet.ifFree id !timerIdPool) then
    Hashtbl.replace timers id
      (let status= Hashtbl.find timers id in
      {status with it_interval= 0.})

let getActivedTimers ()=
  if not lastActivedTimers.updated then
    let {it_interval= timePast; _}= Unix.(getitimer ITIMER_REAL) in
    let rec iterTimers l ids= match l with
      | []-> ids
      | id::next ->
        let
          {it_interval= interval; it_value= value}
          = Hashtbl.find timers id
        in
        if value <= 0. then
          (scheduleList:= next; iterTimers next (id::ids))
        else ids
    in begin
      update_timers timePast;
      lastActivedTimers.timers <- iterTimers !scheduleList [];
      lastActivedTimers.updated <- true;
      lastActivedTimers.timers;
    end
   else lastActivedTimers.timers

let timerHandler sgnl= alreadyTimeout:= true

let rec add ids=
  match ids with
  | [] -> ()
  | id::rest ->
    let
      {it_interval; it_value}
      as status= Hashtbl.find timers id in
    if it_interval <= 0. then
      (Hashtbl.remove timers id;
      timerIdPool:= TmpNumSet.put id !timerIdPool (* release the tiemr id*))
    else
      (Hashtbl.replace
        timers id
        {status with it_value= it_interval};
      add_scheduleUnit id
      ) ;
      add rest

let select r w e timeout=
  add (getActivedTimers ());
  lastActivedTimers.updated <- false;
  let r=
    if !alreadyTimeout then
      ([], [], [])
    else 
      (try Unix.select (notifier::r) [] [] timeout with
      | Unix_error (EINTR,_,_) -> ([], [], []))
  in
  alreadyTimeout:= false;
  (getActivedTimers (), r)

let ()=
  Sys.(set_signal sigalrm (Signal_handle timerHandler))