* Add map.ml and map.mli from Ocaml 3.12

* Add server code (seed and pulse initialization)
* Command line parsing and main loop


git-svn-id: https://scm.gforge.inria.fr/svn/pacemaker@15 30fcff6e-8de6-41c7-acce-77ff6d1dd07b

3 files changed, 663 insertions, 65 deletions

diff --git a/sources/thibaut/map.ml b/sources/thibaut/map.ml
new file mode 100644
index 0000000..3d9597a
--- /dev/null
+++ b/sources/thibaut/map.ml
@@ -0,0 +1,314 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+module type OrderedType =
+  sig
+    type t
+    val compare: t -> t -> int
+  end
+
+module type S =
+  sig
+    type key
+    type +'a t
+    val empty: 'a t
+    val is_empty: 'a t -> bool
+    val mem:  key -> 'a t -> bool
+    val add: key -> 'a -> 'a t -> 'a t
+    val singleton: key -> 'a -> 'a t
+    val remove: key -> 'a t -> 'a t
+    val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter: (key -> 'a -> unit) -> 'a t -> unit
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all: (key -> 'a -> bool) -> 'a t -> bool
+    val exists: (key -> 'a -> bool) -> 'a t -> bool
+    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal: 'a t -> int
+    val bindings: 'a t -> (key * 'a) list
+    val min_binding: 'a t -> (key * 'a)
+    val max_binding: 'a t -> (key * 'a)
+    val choose: 'a t -> (key * 'a)
+    val split: key -> 'a t -> 'a t * 'a option * 'a t
+    val find: key -> 'a t -> 'a
+    val map: ('a -> 'b) -> 'a t -> 'b t
+    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
+  end
+
+module Make(Ord: OrderedType) = struct
+
+    type key = Ord.t
+
+    type 'a t =
+        Empty
+      | Node of 'a t * key * 'a * 'a t * int
+
+    let height = function
+        Empty -> 0
+      | Node(_,_,_,_,h) -> h
+
+    let create l x d r =
+      let hl = height l and hr = height r in
+      Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+    let singleton x d = Node(Empty, x, d, Empty, 1)
+
+    let bal l x d r =
+      let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
+      let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
+      if hl > hr + 2 then begin
+        match l with
+          Empty -> invalid_arg "Map.bal"
+        | Node(ll, lv, ld, lr, _) ->
+            if height ll >= height lr then
+              create ll lv ld (create lr x d r)
+            else begin
+              match lr with
+                Empty -> invalid_arg "Map.bal"
+              | Node(lrl, lrv, lrd, lrr, _)->
+                  create (create ll lv ld lrl) lrv lrd (create lrr x d r)
+            end
+      end else if hr > hl + 2 then begin
+        match r with
+          Empty -> invalid_arg "Map.bal"
+        | Node(rl, rv, rd, rr, _) ->
+            if height rr >= height rl then
+              create (create l x d rl) rv rd rr
+            else begin
+              match rl with
+                Empty -> invalid_arg "Map.bal"
+              | Node(rll, rlv, rld, rlr, _) ->
+                  create (create l x d rll) rlv rld (create rlr rv rd rr)
+            end
+      end else
+        Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+    let empty = Empty
+
+    let is_empty = function Empty -> true | _ -> false
+
+    let rec add x data = function
+        Empty ->
+          Node(Empty, x, data, Empty, 1)
+      | Node(l, v, d, r, h) ->
+          let c = Ord.compare x v in
+          if c = 0 then
+            Node(l, x, data, r, h)
+          else if c < 0 then
+            bal (add x data l) v d r
+          else
+            bal l v d (add x data r)
+
+    let rec find x = function
+        Empty ->
+          raise Not_found
+      | Node(l, v, d, r, _) ->
+          let c = Ord.compare x v in
+          if c = 0 then d
+          else find x (if c < 0 then l else r)
+
+    let rec mem x = function
+        Empty ->
+          false
+      | Node(l, v, d, r, _) ->
+          let c = Ord.compare x v in
+          c = 0 || mem x (if c < 0 then l else r)
+
+    let rec min_binding = function
+        Empty -> raise Not_found
+      | Node(Empty, x, d, r, _) -> (x, d)
+      | Node(l, x, d, r, _) -> min_binding l
+
+    let rec max_binding = function
+        Empty -> raise Not_found
+      | Node(l, x, d, Empty, _) -> (x, d)
+      | Node(l, x, d, r, _) -> max_binding r
+
+    let rec remove_min_binding = function
+        Empty -> invalid_arg "Map.remove_min_elt"
+      | Node(Empty, x, d, r, _) -> r
+      | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r
+
+    let merge t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          bal t1 x d (remove_min_binding t2)
+
+    let rec remove x = function
+        Empty ->
+          Empty
+      | Node(l, v, d, r, h) ->
+          let c = Ord.compare x v in
+          if c = 0 then
+            merge l r
+          else if c < 0 then
+            bal (remove x l) v d r
+          else
+            bal l v d (remove x r)
+
+    let rec iter f = function
+        Empty -> ()
+      | Node(l, v, d, r, _) ->
+          iter f l; f v d; iter f r
+
+    let rec map f = function
+        Empty ->
+          Empty
+      | Node(l, v, d, r, h) ->
+          let l' = map f l in
+          let d' = f d in
+          let r' = map f r in
+          Node(l', v, d', r', h)
+
+    let rec mapi f = function
+        Empty ->
+          Empty
+      | Node(l, v, d, r, h) ->
+          let l' = mapi f l in
+          let d' = f v d in
+          let r' = mapi f r in
+          Node(l', v, d', r', h)
+
+    let rec fold f m accu =
+      match m with
+        Empty -> accu
+      | Node(l, v, d, r, _) ->
+          fold f r (f v d (fold f l accu))
+
+    let rec for_all p = function
+        Empty -> true
+      | Node(l, v, d, r, _) -> p v d && for_all p l && for_all p r
+
+    let rec exists p = function
+        Empty -> false
+      | Node(l, v, d, r, _) -> p v d || exists p l || exists p r
+
+    let filter p s =
+      let rec filt accu = function
+        | Empty -> accu
+        | Node(l, v, d, r, _) ->
+            filt (filt (if p v d then add v d accu else accu) l) r in
+      filt Empty s
+
+    let partition p s =
+      let rec part (t, f as accu) = function
+        | Empty -> accu
+        | Node(l, v, d, r, _) ->
+            part (part (if p v d then (add v d t, f) else (t, add v d f)) l) r in
+      part (Empty, Empty) s
+
+    (* Same as create and bal, but no assumptions are made on the
+       relative heights of l and r. *)
+
+    let rec join l v d r =
+      match (l, r) with
+        (Empty, _) -> add v d r
+      | (_, Empty) -> add v d l
+      | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) ->
+          if lh > rh + 2 then bal ll lv ld (join lr v d r) else
+          if rh > lh + 2 then bal (join l v d rl) rv rd rr else
+          create l v d r
+
+    (* Merge two trees l and r into one.
+       All elements of l must precede the elements of r.
+       No assumption on the heights of l and r. *)
+
+    let concat t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          join t1 x d (remove_min_binding t2)
+
+    let concat_or_join t1 v d t2 =
+      match d with
+      | Some d -> join t1 v d t2
+      | None -> concat t1 t2
+
+    let rec split x = function
+        Empty ->
+          (Empty, None, Empty)
+      | Node(l, v, d, r, _) ->
+          let c = Ord.compare x v in
+          if c = 0 then (l, Some d, r)
+          else if c < 0 then
+            let (ll, pres, rl) = split x l in (ll, pres, join rl v d r)
+          else
+            let (lr, pres, rr) = split x r in (join l v d lr, pres, rr)
+
+    let rec merge f s1 s2 =
+      match (s1, s2) with
+        (Empty, Empty) -> Empty
+      | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
+          let (l2, d2, r2) = split v1 s2 in
+          concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
+      | (_, Node (l2, v2, d2, r2, h2)) ->
+          let (l1, d1, r1) = split v2 s1 in
+          concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
+      | _ ->
+          assert false
+
+    type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
+
+    let rec cons_enum m e =
+      match m with
+        Empty -> e
+      | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
+
+    let compare cmp m1 m2 =
+      let rec compare_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> 0
+        | (End, _)  -> -1
+        | (_, End) -> 1
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            let c = Ord.compare v1 v2 in
+            if c <> 0 then c else
+            let c = cmp d1 d2 in
+            if c <> 0 then c else
+            compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in compare_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let equal cmp m1 m2 =
+      let rec equal_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> true
+        | (End, _)  -> false
+        | (_, End) -> false
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            Ord.compare v1 v2 = 0 && cmp d1 d2 &&
+            equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in equal_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let rec cardinal = function
+        Empty -> 0
+      | Node(l, _, _, r, _) -> cardinal l + 1 + cardinal r
+
+    let rec bindings_aux accu = function
+        Empty -> accu
+      | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l
+
+    let bindings s =
+      bindings_aux [] s
+
+    let choose = min_binding
+
+end
diff --git a/sources/thibaut/map.mli b/sources/thibaut/map.mli
new file mode 100644
index 0000000..b025b8c
--- /dev/null
+++ b/sources/thibaut/map.mli
@@ -0,0 +1,194 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(** Association tables over ordered types.
+
+   This module implements applicative association tables, also known as
+   finite maps or dictionaries, given a total ordering function
+   over the keys.
+   All operations over maps are purely applicative (no side-effects).
+   The implementation uses balanced binary trees, and therefore searching
+   and insertion take time logarithmic in the size of the map.
+*)
+
+module type OrderedType =
+  sig
+    type t
+      (** The type of the map keys. *)
+    val compare : t -> t -> int
+      (** A total ordering function over the keys.
+          This is a two-argument function [f] such that
+          [f e1 e2] is zero if the keys [e1] and [e2] are equal,
+          [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+          and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+          Example: a suitable ordering function is the generic structural
+          comparison function {!Pervasives.compare}. *)
+  end
+(** Input signature of the functor {!Map.Make}. *)
+
+module type S =
+  sig
+    type key
+    (** The type of the map keys. *)
+
+    type (+'a) t
+    (** The type of maps from type [key] to type ['a]. *)
+
+    val empty: 'a t
+    (** The empty map. *)
+
+    val is_empty: 'a t -> bool
+    (** Test whether a map is empty or not. *)
+
+    val mem: key -> 'a t -> bool
+    (** [mem x m] returns [true] if [m] contains a binding for [x],
+       and [false] otherwise. *)
+
+    val add: key -> 'a -> 'a t -> 'a t
+    (** [add x y m] returns a map containing the same bindings as
+       [m], plus a binding of [x] to [y]. If [x] was already bound
+       in [m], its previous binding disappears. *)
+
+    val singleton: key -> 'a -> 'a t
+    (** [singleton x y] returns the one-element map that contains a binding [y]
+        for [x].
+        @since 3.12.0
+     *)
+
+    val remove: key -> 'a t -> 'a t
+    (** [remove x m] returns a map containing the same bindings as
+       [m], except for [x] which is unbound in the returned map. *)
+
+    val merge:
+         (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    (** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1]
+        and of [m2]. The presence of each such binding, and the corresponding
+        value, is determined with the function [f].
+        @since 3.12.0
+     *)
+
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    (** Total ordering between maps.  The first argument is a total ordering
+        used to compare data associated with equal keys in the two maps. *)
+
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
+       equal, that is, contain equal keys and associate them with
+       equal data.  [cmp] is the equality predicate used to compare
+       the data associated with the keys. *)
+
+    val iter: (key -> 'a -> unit) -> 'a t -> unit
+    (** [iter f m] applies [f] to all bindings in map [m].
+       [f] receives the key as first argument, and the associated value
+       as second argument.  The bindings are passed to [f] in increasing
+       order with respect to the ordering over the type of the keys. *)
+
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
+       where [k1 ... kN] are the keys of all bindings in [m]
+       (in increasing order), and [d1 ... dN] are the associated data. *)
+
+    val for_all: (key -> 'a -> bool) -> 'a t -> bool
+    (** [for_all p m] checks if all the bindings of the map
+        satisfy the predicate [p].
+        @since 3.12.0
+     *)
+
+    val exists: (key -> 'a -> bool) -> 'a t -> bool
+    (** [exists p m] checks if at least one binding of the map
+        satisfy the predicate [p].
+        @since 3.12.0
+     *)
+
+    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+    (** [filter p m] returns the map with all the bindings in [m]
+        that satisfy predicate [p].
+        @since 3.12.0
+     *)
+
+    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    (** [partition p m] returns a pair of maps [(m1, m2)], where
+        [m1] contains all the bindings of [s] that satisfy the
+        predicate [p], and [m2] is the map with all the bindings of
+        [s] that do not satisfy [p].
+        @since 3.12.0
+     *)
+
+    val cardinal: 'a t -> int
+    (** Return the number of bindings of a map.
+        @since 3.12.0
+     *)
+
+    val bindings: 'a t -> (key * 'a) list
+    (** Return the list of all bindings of the given map.
+       The returned list is sorted in increasing order with respect
+       to the ordering [Ord.compare], where [Ord] is the argument
+       given to {!Map.Make}.
+        @since 3.12.0
+     *)
+
+    val min_binding: 'a t -> (key * 'a)
+    (** Return the smallest binding of the given map
+       (with respect to the [Ord.compare] ordering), or raise
+       [Not_found] if the map is empty.
+        @since 3.12.0
+     *)
+
+    val max_binding: 'a t -> (key * 'a)
+    (** Same as {!Map.S.min_binding}, but returns the largest binding
+        of the given map.
+        @since 3.12.0
+     *)
+
+    val choose: 'a t -> (key * 'a)
+    (** Return one binding of the given map, or raise [Not_found] if
+       the map is empty. Which binding is chosen is unspecified,
+       but equal bindings will be chosen for equal maps.
+        @since 3.12.0
+     *)
+
+    val split: key -> 'a t -> 'a t * 'a option * 'a t
+    (** [split x m] returns a triple [(l, data, r)], where
+          [l] is the map with all the bindings of [m] whose key
+        is strictly less than [x];
+          [r] is the map with all the bindings of [m] whose key
+        is strictly greater than [x];
+          [data] is [None] if [m] contains no binding for [x],
+          or [Some v] if [m] binds [v] to [x].
+        @since 3.12.0
+     *)
+
+    val find: key -> 'a t -> 'a
+    (** [find x m] returns the current binding of [x] in [m],
+       or raises [Not_found] if no such binding exists. *)
+
+    val map: ('a -> 'b) -> 'a t -> 'b t
+    (** [map f m] returns a map with same domain as [m], where the
+       associated value [a] of all bindings of [m] has been
+       replaced by the result of the application of [f] to [a].
+       The bindings are passed to [f] in increasing order
+       with respect to the ordering over the type of the keys. *)
+
+    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
+    (** Same as {!Map.S.map}, but the function receives as arguments both the
+       key and the associated value for each binding of the map. *)
+
+
+  end
+(** Output signature of the functor {!Map.Make}. *)
+
+module Make (Ord : OrderedType) : S with type key = Ord.t
+(** Functor building an implementation of the map structure
+   given a totally ordered type. *)
diff --git a/sources/thibaut/simul.ml b/sources/thibaut/simul.ml
index 006c4d8..560e6e6 100644
--- a/sources/thibaut/simul.ml
+++ b/sources/thibaut/simul.ml
@@ -9,7 +9,7 @@ end
 
 module Int = struct
     type t = int
-    let compare = Pervasives.compare
+    let compare a b =  - (Pervasives.compare a b)
 end
 
 module HashMap = Map.Make(PeerId)
@@ -39,11 +39,13 @@ type round_data = {
 type peer = {
     id : peer_id;
     mutable con_state : state;
-    neighbours : peer array;
+    neighbours : node array;
     mutable rounds_data : round_data RoundMap.t;
     messages : message Queue.t;
     mutable history : (int * (int HashMap.t list)) RoundMap.t (* seed, branch *)
-}
+} and
+
+node = None | Some of peer
 
 let find_reply hash replies = 
     let rec aux n replies = match replies with
@@ -65,77 +67,165 @@ let peer_init_round peer round seed duration =
     } in
     peer.rounds_data <- RoundMap.add round data peer.rounds_data
 
-let send_message message receiver =
-    Queue.push message receiver.messages 
+let send_message message receiver = match receiver with
+    | None -> ()
+    | Some peer -> Queue.push message peer.messages
+
+let server_init_seed peer round duration = 
+    let data = {
+        phase = SEEDING;
+        duration = duration;
+        seed = Random.int (1 lsl 31);
+        hmap = HashMap.empty;
+        included = 0;
+        replies = []
+    } in 
+    peer.rounds_data <- RoundMap.add round data peer.rounds_data;
+    let message = {
+        sender = peer.id;
+        round = round;
+        content = Seed (data.seed, data.duration)
+    } in
+    Array.iter (send_message message) peer.neighbours
+    
+let server_init_pulse peer round = 
+    let data = RoundMap.find round peer.rounds_data in
+    data.phase <- IDLE;
+    let message = {
+        sender = peer.id;
+        round = round;
+        content = Pulse (data.seed, [data.hmap])
+    } in
+    Array.iter (send_message message) peer.neighbours
     
 let rec verify_branch branch = match branch with
     | [] -> true
     | [h] -> true 
     | h1::h2::t -> (HashMap.mem (Hashtbl.hash h1) h2 && verify_branch t)
+    
+let process_message peer m = match m.content with
+    | Seed(seed,duration) -> 
+        if not (RoundMap.mem m.round peer.rounds_data) then
+            peer_init_round peer m.round seed duration;
+        let message = {
+            sender = peer.id;
+            round = m.round;
+            content = Seed(seed, duration)
+        } in
+        Array.iter (send_message message) peer.neighbours
+    | SeedReply(hash) ->
+        begin try
+            let data = RoundMap.find m.round peer.rounds_data in
+            if data.phase = SEEDING then
+                data.hmap <- HashMap.add m.sender hash data.hmap;
+        with
+            Not_found -> ()
+        end
+    | Pulse(seed, branch) ->
+        begin try
+            let data = RoundMap.find m.round peer.rounds_data in
+            match branch with
+                | [] -> ()
+                | h::t -> try
+                    let hash = HashMap.find peer.id h in
+                    let n,hmap = find_reply hash data.replies in
+                    if data.included > n && verify_branch branch
+                    then begin
+                        let branch2 = hmap::branch in
+                        data.included <- n;
+                        data.phase <- IDLE;
+                        let message = {
+                            sender = peer.id;
+                            round = m.round;
+                            content = Pulse(seed, branch2)
+                        } in
+                        Array.iter (send_message message) peer.neighbours;
+                        peer.history <- RoundMap.add m.round 
+                                                      (seed, branch2)
+                                                      peer.history
+                    end
+                    with
+                        | Not_found -> ()
+        with
+            Not_found -> ()
+        end
 
-let do_peer peer = 
-    let process_message m = match m.content with
-        | Seed(seed,duration) -> 
-            if not (RoundMap.mem m.round peer.rounds_data) then begin
-                peer_init_round peer m.round seed duration;
+let do_peer peer =
+    Queue.iter (process_message peer) peer.messages;
+    Queue.clear peer.messages;
+    try
+        let aux round data = 
+            if data.phase = SEEDING then begin
+                let hash = Hashtbl.hash data.hmap in
+                data.replies <- (hash, data.hmap)::data.replies;
                 let message = {
                     sender = peer.id;
-                    round = m.round;
-                    content = Seed(seed, duration)
+                    round = round;
+                    content = SeedReply(Hashtbl.hash data.hmap)
                 } in
-                Array.iter (send_message message) peer.neighbours
-            end
-        | SeedReply(hash) ->
-            begin try
-                let data = RoundMap.find m.round peer.rounds_data in
-                if data.phase = SEEDING then
-                    data.hmap <- HashMap.add m.sender hash data.hmap;
-            with
-                Not_found -> ()
-            end
-        | Pulse(seed, branch) ->
-            begin try
-                let data = RoundMap.find m.round peer.rounds_data in
-                match branch with
-                    | [] -> ()
-                    | h::t -> try
-                        let hash = HashMap.find peer.id h in
-                        let n,hmap = find_reply hash data.replies in
-                        if data.included > n && verify_branch branch
-                        then begin
-                            let branch2 = hmap::branch in
-                            data.included <- n;
-                            data.phase <- IDLE;
-                            let message = {
-                                sender = peer.id;
-                                round = m.round;
-                                content = Pulse(seed, branch2)
-                            } in
-                            Array.iter (send_message message) peer.neighbours;
-                            peer.history <- RoundMap.add m.round 
-                                                        (seed, branch2)
-                                                        peer.history
-                        end
-                        with
-                            | Not_found -> ()
-            with
-                Not_found -> ()
-            end
+                Array.iter (send_message message) peer.neighbours;
+            end else
+                failwith "not seeding"
+        in
+        RoundMap.iter aux peer.rounds_data
+    with
+        Failure _ -> ()
+        
+let do_server peer = 
+    let aux m = match m.content with
+        | SeedReply _ ->  process_message peer m
+        | _ -> ()
     in
-    Queue.iter process_message peer.messages;
-    Queue.clear peer.messages;
-    
-    let round,data = RoundMap.max_binding peer.rounds_data in
-    if data.phase = SEEDING then begin
-        let hash = Hashtbl.hash data.hmap in
-        data.replies <- (hash, data.hmap)::data.replies;
-        let message = {
-            sender = peer.id;
-            round = round;
-            content = SeedReply(Hashtbl.hash data.hmap)
-        } in
-        Array.iter (send_message message) peer.neighbours;
+    Queue.iter aux peer.messages;
+    Queue.clear peer.messages
+
+let npeers = ref 0
+let degree = ref 0
+let days = ref 0
+let tpm = ref 0
+let accuracy = ref 0
+let duration = ref 0
+let seed = ref 0
+
+let arg_list = [
+    "--peers", Arg.Set_int npeers, " <n> number of peers";
+    "--degree", Arg.Set_int degree, " <n> maximum number of neighbours";
+    "--days", Arg.Set_int degree, " <n> numbers of days";
+    "--tpm", Arg.Set_int tpm, " <n> number of ticks per minute";
+    "--accuracy", Arg.Set_int accuracy, " <n> number of ticks between rounds";
+    "--duration", Arg.Set_int duration, " <n> number of ticks during seeding";
+    "--seed", Arg.Set_int seed, " <n> random seed"
+]
+
+let _ = 
+    Arg.parse (Arg.align arg_list) (fun s -> ()) "";
+    Random.init !seed
+
+let peers = Array.init !npeers (fun i -> {
+    id = i;
+    con_state = ON;
+    neighbours = Array.make !degree None;
+    rounds_data = RoundMap.empty;
+    messages = Queue.create();
+    history = RoundMap.empty
+})
+
+let nticks = !days*24*60*(!tpm)
+let round = ref 0
+
+let _ = for i = 0 to (nticks-1) do
+    if i mod !accuracy = 0 then begin
+        incr round;
+        server_init_seed peers.(0) !round !duration
     end
-                                    
-            
+    else if i mod !accuracy = !duration then
+        server_init_pulse peers.(0) !round;
+        
+    do_server peers.(0);
+    for i = 1 to (!npeers-1) do
+        let peer = peers.(i) in
+        if peer.con_state = ON then
+            do_peer peer
+    done
+done