#use "bsmlAnalyzer.ml";;
open BsmlAnalyzer

let string_of_list printer gauche sep droite l =
  let rec aux str l =
    match l with 
        [] -> str
      | a::t -> aux (str ^sep^(printer a)) t
  in
  match l with
      [] -> gauche^" "^droite
    | a::t -> gauche^(printer a)^(aux "" t)^droite

let print_list printer g s d l = print_string (string_of_list printer g s d l)

let replicate x = mkpar (fun _-> x)  
let parfun f v = apply (replicate f) v

let id x =x
let this = mkpar id 

let from_to i len = 
  let rec aux j len  l =
    if len = 0 then l else aux (j-1) (len -1) (j::l)
  in
  aux (i+len-1) len []

let procs = from_to 0 bsp_p

let from_0_to_10_pid = mkpar (fun i -> from_to 0 (10*(i+1)))


(** Broadcast naif
    soit [v = <v0; ...; v(p-1) > ] et [Si] la taille de [Some vi]
    Coût de [bcast_proj j v] : 
      hi+ = p*Si 
      hi- = somme des Si pour i de 0 à (p-1)
      h+ = p*max Si
      h- =  somme des Si pour i de 0 à (p-1)
     h = max (h+,h-) = h+
     s=1
  *)
let bcast_proj_naif j v = replicate (proj v j)


let no_some (Some x) = x
(** Broadcast moins naif
    soit [v = <v0; ...; v(p-1)> ] et [Si] la taille de [Some vi]
    
    Coût : 
      t= négligeable
      hi+ = Si i = j alors p*Sj sinon 0
      hi- = Sj
      h+ = p*Sj
      h- =  Sj
     h = max (h+,h-) = h+
     s=1
  *)
let bcast_proj i v = 
  let filtre = apply (mkpar (fun de v->  if de = i then Some  v else None)) v in
  replicate (no_some (proj filtre  i))

(** Broadcast avec put
    soit [v = <v0; ...; v(p-1)> ] et [Si] la taille de [Some vi]
    
    Coût : 
      t= négligeable
      hi+ = Si i = j alors p*Sj sinon 0
      hi- = Sj
      h+ = p*Sj
      h- =  Sj
     h = max (h+,h-) = h+
     s=1
  *)
let bcast_put i v = 
  let send = apply (mkpar (fun de valeur vers -> if de = i then Some valeur else None)) v in
  let rcv = put send in
  parfun (fun f -> match f i with Some a -> a) rcv


let test = bsp_test (fun (i,v) -> bcast_proj_naif i v) (0,from_0_to_10_pid)

let test = bsp_test (fun (i,v) -> bcast_proj i v) (0,from_0_to_10_pid)

let test = bsp_test (fun (i,v) -> bcast_put i v) (0,from_0_to_10_pid)

(* 
coût :
   t = temps de reduction sequentiel 
   h = p * Max Si
   s=1
 *)
let fold f e ap = 
  let seq = proj ap in 
  List.fold_left (fun a pid -> f a (seq pid)) e procs

let apply2 fp v1 v2 =  apply(apply fp v1) v2


(*  fold_put prend en parametre une fonction str_of_elem afin d'afficher les valeurs communiquées.
    (aide à la chasse aux erreurs)
    coût :
    t :   log p * (max pour tout i,j de  (f vi vj))
    si la taille de (f v1 v2) est  max(s1, s2) (comme par exemple pour l'addition)
    h :  log p * max si (nombre de super étape fois taille max echangée à chaque super étape)
    + p*(taille resultat) pour le proj final
    S= log p + 2
    
 *)
let fold_put str_of_elem f e ap =
  let rec aux shift v = 
    print_endline ("aux shift = "^string_of_int shift^ " bsp_p: "^string_of_int bsp_p);
    (* Dernière étape : récupération de la valeur *)
    if shift > 2*bsp_p then
      proj v 0
    else
      (* 1 processeur sur shift reçoit des données *)
      let receiver i = (i mod shift = 0)  in
      (* tous les processeurs ayant reçu une donnée à l'étape précédente, mais ne devant plus participer au calcul envoient des données *)
      let sender i = (i mod (shift/2) = 0)&& not (receiver i) in
      (* échange de données; i envoie à i-shift s'il est [sender] *)
      let to_be_sent = 
        ( apply (mkpar (
          fun source v dest -> 
            if sender source && 
              dest = source - (shift/2)
            then Some v
            else None )
          ) 
            v )
      in
      (* affichage des valeurs envoyées,
         ne fonctionne pas si bsml n'est pas complètement installé
      *)
      let _ = Stdlib.Base.parprint
        (print_list str_of_elem "[" ";" "]") 
        (parfun (fun f -> List.map f procs) to_be_sent) in        
      (* communications *)
      let comms = put to_be_sent  in
      (* récupération de la donnée evoyée par i+shift : les proc receiver recoivent une donnée, les autres recoivent None *)
      let (received  : ('a option) Bsml.par) = 
        apply 
          comms 
          (mkpar (fun i -> let x = i + (shift/2) in if x < bsp_p then x else 0)) in
      (* Opération entre la donnée locale et la donnée reçue; les processeurs ne participant contiennent la donnée [e] *)
      (* affichage des valeurs reçues 
         ne fonctionne pas si bsml n'est pas complètement installé
      *)
      let _ = Stdlib.Base.parprint
        (print_list str_of_elem "[" ";" "]") 
        (parfun (fun f -> List.map f procs) comms) in
      let new_data = apply2 
        (mkpar ( fun (i:int) (loc_v : 'a) (recv_v : ('a option)) -> 
          if receiver i then 
            if  i+shift < bsp_p then 
              f loc_v (no_some (recv_v)) 
            else 
              f loc_v e 
          else
            e
         )) 
        v 
        received
      in
      aux (shift*2) new_data
  in
  aux 2 ap


let _ = bsp_test (fun (e, vec) -> fold_put (function  Some i ->  string_of_int i | None -> "None") (+) e vec ) (0, this) ;;


let rec take i l = if i=0 then [] else (List.hd l)::(take (i-1) (List.tl l))
let rec drop i l = if i=0 then l else drop (i-1) (List.tl l)


(* 

   cout : pour un liste de taille n au processeur initial
   t : cout des concaténations (attention : implanté ici de manière non-optimale)
   le même broadcast avec des tableaux au lieux des listes serait probablement bien plus efficace car 
   la concaténation serait probablement moins couteuse.
   h : (p-1)*(n/p) + ((n/p) * (p-1)) = qu'on approximera à 2*n
   S=2
 *)
let bcast2phase (broadcasting_processor : int) (data : 'a list Bsml.par) =
  let cut data  i = 
    let len = List.length data in
    let len_sur_bsp = len/bsp_p 
    and len_mod_bsp = len mod bsp_p
    in
    take 
      (len_sur_bsp + (if i > len_mod_bsp then 0 else 1)) 
      (drop 
         (if i > len_mod_bsp then (len_sur_bsp * i) + len_mod_bsp else (len_sur_bsp + 1)*i)
         data
      )
  in
  let sender =
    apply 
      (mkpar (fun from local_data dest -> 
        if from = broadcasting_processor 
        then cut local_data dest 
        else [])
      )
      data
  in
  let received =
     put sender
  in
  let chunks = apply received (replicate broadcasting_processor)
  in
  let allchunks = put (apply (replicate (fun v dest -> v)) chunks)
  in
  parfun (fun chunk_of  ->  List.fold_left (fun chunks i -> chunks@(chunk_of i)) [] procs) allchunks
    

let test = bcast2phase 3 from_0_to_10_pid

(* 
Fold par bloc :  calcul local puis fold
 *)
let fold_par_bloc f (e:'a) (ap:'a list par) = 
  let data = parfun (List.fold_left f e) ap in
  fold f e data

 (*
   décalage circulaire de données
 *)