diff options
| -rw-r--r-- | sources/thibaut/simul.ml | 126 |
1 files changed, 62 insertions, 64 deletions
diff --git a/sources/thibaut/simul.ml b/sources/thibaut/simul.ml index 8781a67..006c4d8 100644 --- a/sources/thibaut/simul.ml +++ b/sources/thibaut/simul.ml @@ -14,7 +14,7 @@ end module HashMap = Map.Make(PeerId) -module IntMap = Map.Make(Int) +module RoundMap = Map.Make(Int) type message_content = | Seed of int * int (* seed, duration *) @@ -39,19 +39,12 @@ type round_data = { type peer = { id : peer_id; mutable con_state : state; - neighbours : peer_id array; - mutable rounds_data : round_data IntMap.t; - messages : message Queue.t + neighbours : peer array; + mutable rounds_data : round_data RoundMap.t; + messages : message Queue.t; + mutable history : (int * (int HashMap.t list)) RoundMap.t (* seed, branch *) } -let peers = Array.init 1000 (fun i -> { - id = i; - con_state = OFF; - neighbours = Array.make 10 0; - rounds_data = IntMap.empty; - messages = Queue.create() -}) - let find_reply hash replies = let rec aux n replies = match replies with | [] -> raise Not_found @@ -70,10 +63,10 @@ let peer_init_round peer round seed duration = included = 0; replies = [] } in - peer.rounds_data <- IntMap.add round data peer.rounds_data + peer.rounds_data <- RoundMap.add round data peer.rounds_data -let send_message message receiver_id = - Queue.push message peers.(receiver_id).messages +let send_message message receiver = + Queue.push message receiver.messages let rec verify_branch branch = match branch with | [] -> true @@ -83,61 +76,66 @@ let rec verify_branch branch = match branch with let do_peer peer = let process_message m = match m.content with | Seed(seed,duration) -> - begin - if not (IntMap.mem m.round peer.rounds_data) then begin - 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 - end + if not (RoundMap.mem m.round peer.rounds_data) then begin + 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 end | SeedReply(hash) -> - begin - try - let data = IntMap.find m.round peer.rounds_data in - if data.phase = SEEDING then begin - data.hmap <- HashMap.add m.sender hash data.hmap; - peer.rounds_data <- IntMap.add m.round data peer.rounds_data - end - with - Not_found -> () + 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 = IntMap.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 - let branch2 = hmap::branch in - begin - data.included <- n; - data.phase <- IDLE; - peer.rounds_data <- IntMap.add m.round data peer.rounds_data; - let message = { - sender = peer.id; - round = m.round; - content = Pulse(seed, branch2) - } in - Array.iter (send_message message) peer.neighbours - end - with - | Not_found -> () - with - Not_found -> () + 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 - - in Queue.iter process_message peer.messages; - Queue.clear; - + 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; + end + |