let my_thread msg = Printf.printf "%s\n" msg

let main () = 
    let t = Thread.create my_thread "hello, world!" in
    Printf.printf "salut le monde!\n";
    Thread.join t;
    Printf.printf "bye\n"

let () = main ()

let rec my_thread () =
    print_string "Quel est ton nom? J'attends...";
    print_newline ();
    Thread.delay 5.; (* s'endort 5 secondes *)
    my_thread ()
    
let main () = 
    Thread.create my_thread ();
    let nom = input_line stdin in
    print_string "Bonjour, ";
    print_string nom;
    print_newline()
    
let () = main ()

let my_thread () =
    let nom = input_line stdin in
    print_string "Bonjour, ";
    print_string nom;
    print_newline()

    
let main () = 
    Thread.create my_thread ();
    while true do (* <- ???? *)
        print_string "Quel est ton nom? J'attends...";
        print_newline ();
        Thread.delay 5.; 
    done;

let () = main ()

let finished = ref false (* <- variable partagée! *)

let my_thread () =
    let nom = input_line stdin in
    print_string "Bonjour, ";
    print_string nom;
    print_newline();
    finished := true  (* "signal" *)

    
let main () = 
    let t = Thread.create my_thread () in
    while not !finished do (* <- mieux! *)
        print_string "Quel est ton nom? J'attends...";
        print_newline ();
        Thread.delay 5.;
    done;
    Thread.join t (* <- quittons proprement *)

let () = main ()

let cat filename = 
    let ic = open_in filename in
    let rec aux () = 
        try 
            print_string (input_line ic);
            print_newline ();
            aux ()
        with
            End_of_file -> ()
    in aux (); close_in ic
    
let parallel_cat filename1 filename2 =
    let t1 = Thread.create cat filename1 in (* <- passage d'argument *)
    let t2 = Thread.create cat filename2 in
    Thread.join t1; Thread.join t2
    
let () = parallel_cat Sys.argv.(1) Sys.argv.(2)

let parallel_cat filenames_array =
    let thread_handles = ref [] in
    for i = 0 to Array.length filenames_array - 1 do
        let t = Thread.create cat filenames_array.(i) in
        thread_handles := t :: !thread_handles
    done;
    List.iter Thread.join !thread_handles
    (* i.e. for t in thread_handles do Thread.join t done *)
    
let () = parallel_cat (Array.sub Sys.argv 1 (Array.length Sys.argv - 1))

let parallel_cat filenames_array =
    Array.map (Thread.create cat) filenames_array |> Array.iter Thread.join

let parallel_array_iter f array = 
    Array.map (Thread.create f) array |> Array.iter Thread.join
    
let parallel_cat = parallel_array_iter cat

let my_domain greetings =
    let name = read_line () in
    let res = greetings ^ " " ^ name in
    res
    
let main () = 
    let fut = Domain.spawn (fun () -> my_domain "hello") in
    let str = Domain.join fut in
    print_string s;
    print_newline ()

let () = main ()

Domain.spawn : (unit -> 'a) -> 'a Domain.t
Domain.join : 'a Domain.t -> 'a

paresse : (unit -> 'a) -> 'a paresse
force : 'a paresse -> 'a

let nb_occurs x arr = 
  let res = ref 0 in
  for i=0 to Array.length arr - 1 do
    if arr.(i) = x then res := !res + 1
  done;
  !res

let nb_occurs_slice x from upto arr = 
  let res = ref 0 in
  for i = from to upto - 1 do
    if arr.(i) = x then res := !res + 1
  done;
  !res
  
let parallel_nb_occurs x arr = 
  let n = Array.length arr in
  let fut1 = Domain.spawn (fun () -> nb_occurs_slice x 0 (n/2) arr) in
  let fut2 = Domain.spawn (fun () -> nb_occurs_slice x (n/2) n arr) in
  let res1 = Domain.join fut1 in
  let res2 = Domain.join fut2 in
  res1 + res2

List.map (fun x -> x = 0) [0; 1; 2; 3; 0] (* [true; false; false; false; true] *)
Array.map int_of_string [|"1"|] (* [|1|] *)
List.map (Option.map (fun x -> x + 1)) [None; Some 0] (* [None; Some 1] *)

let sequential_map_reduce f (++) _0 array = 
  array |> Array.map f |> Array.fold_left (++) _0
  
(* ou avec une boucle for, pour ceux qui préfèrent *)

let sequential_map_reduce f (++) _0 array =
  let acc = ref _0 in
  for i = 0 to Array.length array - 1 do
     acc := !acc ++ f array.(i)
  done;
  !acc

let sequential_nb_occurs x arr =
   sequential_map_reduce (fun y -> if x=y then 1 else 0) (+) 0 arr

let sequential_max_of_int_array = sequential_map_reduce abs max 0

let mean_of_float_array arr =
  let (++) (x1,n1) (x2,n2) = (x1 +. x2, n1 + n2) in
  let _0 = (0. ,0) in
  let (sum, len) =  sequential_map_reduce (fun x -> (x,1)) (++) _0 in
  sum /. (float len)

let parallel_map_reduce f (++) _0 array =

  let n = Array.length array in
  
  let map_reduce_on_slice from upto =
    let acc = ref _0 in
    for i = from to upto - 1 do acc := !acc ++ f array.(i) done;
    !acc in

  let d1 = Domain.spawn (fun () -> map_reduce_on_slice 0 (n/2)) in
  let d2 = Domain.spawn (fun () -> map_reduce_on_slice (n/2) n) in
  Domain.join d1 ++ Domain.join d2

open Domainslib
let nb_cores_on_my_machine = 8
let pool = Task.setup_pool ~num_additional_domains:(nb_cores_on_my_machine - 1)

let my_task greetings =
    let name = read_line () in
    let res = greetings ^ " " ^ name in
    res

let main () =
    let promise = Task.async pool (fun () -> my_task "hello") in
    let str = Task.await pool promise in
    print_string s;
    print_newline ()

let () = main ()

let is_prime n = 
  let rec iter i = i * i > n || (n mod i <> 0 && iter (i+1)) in
  n >= 2 && iter 2

let count_primes upto = 
  let res = ref 0 in
  for k = 0 to upto - 1 do
     if is_prime k then res := !res + 1
  done; !res

let parallel_count_primes pool upto = 

  (* je lance une tâche par entier, 
     et je stocke les promesses dans un tableau *)
  Array.init upto 
    (fun i -> Task.asynch pool 
        (fun () -> Bool.to_int (is_prime i))) |>
  
  (* je récupère les valeurs de retour des tâches 
     et je les stocke dans un tableau *)
  Array.map (Task.await pool) |>
  
  (* je somme ce dernier tableau *)
  Array.fold_left (+) 0

let finished = ref false (* <- variable partagée *)

let my_thread () =
    let nom = input_line stdin in
    print_string "Bonjour, ";
    print_string nom;
    print_newline();
    finished := true  (* <- accès en écriture *)

    
let main () = 
    let t = Thread.create my_thread () in
    while not !finished do (* <- accès en lecture *)
        print_string "Quel est ton nom? J'attends...";
        print_newline ();
        Thread.delay 5.;
    done;
    Thread.join t

let () = main ()

let c = ref 0
let n = 1_000_000

let f () = 
  let i = ref 0 in
  while !i < n do
    c := !c + 1; (* <- race! *)
    i := !i + 1; (* <- pas race *)
  done

let () = 
  let pool = Task.setup_pool ~num_additional_domains:2 () in
  let t1 = Task.async pool f in
  let t2 = Task.async pool f in
  Task.await pool t1;
  Task.await pool t2;
  Format.printf "!c = %d\n" !c

let x = ref 0
let y = ref 0

let my_domain () = 
   (* quand il démarrera, ce domaine "prendra" le droit d'accès à x *)
   x := 1
   
let main () = 
  (* au départ main "possède" x et u *)

  let fut = Domain.spawn my_domain in
  (* en lançant le domaine secondaire, main lui "transfère" x *)
  (* x := 2 ne serait donc pas légal, ce serait une race *)
  y := 1;  (* <- j'ai le droit, main "possède" toujours y *)

  Domain.join fut;
  x := !x + 1 (* <- j'ai le droit, le join a tranféré x à main *)

let c = Atomic.make 0  (* ref 0 "atomique" *)
let n = 1_000_000

let f () = 
  let i = ref 0 in
  while !i < n do
    Atomic.incr c; (* incrément "atomique" *)
    i := !i + 1; 
  done
  
let () = 
  (* ... *)
  Format.printf "!c = %d\n" (Atomic.get c) (* lecture "atomique" *)

compare_and_set : 'a t -> 'a -> 'a -> bool
(* compare_and_set r seen v sets the new value of r to v only 
   if its current value is physically equal to seen -- 
   the comparison and the set occur atomically. 
   Returns true if the comparison succeeded 
   (so the set happened) and false otherwise. *)

let c = ref 0  (* <- référence non atomique, attention aux races *)

let mut = Mutex.create ()

let f () = 
  let i = ref 0 in
  while !i < n do
    Mutex.lock m; (* entrée en section critique *)
    c := !c + 1 ; (* j'ai le droit, j'ai acquis c *)
    Mutex.unlock m; (* sortie de section critique, je rend c *)    
    i := !i + 1; 
  done

module S = Semaphore.Counting;;
let s = S.make 0;;
(* val s : S.t = <abstr> *)
let f () = S.acquire s;print_int (S.get_value s);;
let d = Domain.spawn f;;
(* rien ne s'affiche *)
S.release s;;
(* affiche 0 *)

module MySemaphore = struct

  type t = int Atomic.t
  
  let make n = assert(n>=0); Atomic.make n
  
  let release sem = Atomic.incr s
  
  let rec acquire sem = 
    let n = Atomic.get sem in
    if n = 0 || not Atomic.compare_and_set sem n (n-1) 
    then acquire sem
end

module MySemaphore = struct

  type t = {
     mutable value: int;
     mutex: Mutex.t;
     not_null: Condition.t;
  }
  
  let make n = 
     assert(n>=0); 
     {value = n; mutex = Mutex.create (); not_null = Condition.create ()}
  
  let release sem =
     Mutex.lock sem.mutex;
     sem.value <- sem.value + 1;
     Condition.signal sem.not_null; 
     (* sort un waiter (s'il y en a) de la file d'attente de not_null 
        et le place dans la file d'attente de son verrou *)
     Mutex.unlock sem.mutex
  
  let rec acquire sem =
    Mutex.lock sem.mutex;
    while sem.value = 0 do
       Condition.wait sem.not_null sem.mutex;
       (* relâche le verrou et s'endort dans la file d'attente de not_null;
          peut reprendre quand il a été signalé puis sorti de la file 
          d'attente de mutex *)
    done;
    sem.value <- sem.value - 1;
    
end

Programmation fonctionnelle¶

Semaine 9 : Programmation multicoeur¶

Etienne Lozes - Université Nice Sophia Antipolis - 2021¶

Plan de la séance¶

Hello, world avec `Thread`¶

Lecture de l'entrée avec relance automatique¶

La communication entre threads¶

Une commande `cat` parallèle¶

Évaluation des performances¶

La programmation multicoeur¶

La librairie `Domain`¶

Parallélisation de boucle¶

Map-reduce¶

Recyclage de domaines: "pool", "workers", et tâches¶

Accès mémoire concurrents : les "data races"¶

Éviter les races: notion de droit d'accès¶

Références atomiques¶

Exclusion mutuelle¶

Interblocage¶

Variables de condition et sémaphores¶

Le mot de la fin¶

Programmation fonctionnelle¶

Semaine 9 : Programmation multicoeur¶

Etienne Lozes - Université Nice Sophia Antipolis - 2021¶

Plan de la séance¶

Hello, world avec Thread¶

Lecture de l'entrée avec relance automatique¶

La communication entre threads¶

Une commande cat parallèle¶

Évaluation des performances¶

La programmation multicoeur¶

La librairie Domain¶

Parallélisation de boucle¶

Map-reduce¶

Recyclage de domaines: "pool", "workers", et tâches¶

Accès mémoire concurrents : les "data races"¶

Éviter les races: notion de droit d'accès¶

Références atomiques¶

Exclusion mutuelle¶

Interblocage¶

Variables de condition et sémaphores¶

Le mot de la fin¶

Hello, world avec `Thread`¶

Une commande `cat` parallèle¶

La librairie `Domain`¶