summaryrefslogtreecommitdiff
path: root/src/example.ml
blob: 2aade1f61bbae8fa2edcaee7dcb54f9e383db883 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
open Util

module Example (K : Kahn.S) = struct
  module K = K
  module Lib = Kahn.Lib(K)
  open Lib

  (* First test : distribute calculation of 50 first Fibonacci numbers *)

  let integers first step nmax (qo : int K.out_port) : unit K.process =
    let rec loop n =
      if n > nmax then
        K.put (-1) qo
      else begin
        (K.put n qo) >>= (fun () -> loop (n + step))
    end
    in
    loop first

  let rec fib n =
    if n < 2 then n
    else fib (n-1) + fib (n-2)

  let rec slow_fib (qi : int K.in_port) (qo : (int * int) K.out_port) : unit K.process =
    (K.get qi) >>=
      (fun i ->
        if i <> -1 then
          (K.put (i, fib i) qo) >>= (fun () -> slow_fib qi qo)
        else (K.put (i, i) qo) >>= (fun () -> K.return ()))

  let output (qi : (int * int) K.in_port) : unit K.process =
    let rec loop () =
        (K.get qi) >>=
        (fun (v, s) ->
          if v <> -1 then
            begin K.output @@ Format.sprintf "f(%d) = %d@." v s; loop () end
          else K.return ())
    in
    loop ()

  let main : unit K.process =
    let max = 4 in
    let rec aux n =
      (delay K.new_channel ()) >>= (fun (q_in, q_out) -> 
        (delay K.new_channel ()) >>= (fun (q_in2, q_out2) -> 
            K.doco [ integers n max 50 q_out ; slow_fib q_in q_out2 ; output q_in2 ]))
    in
    let rec aux2 n =
      if n = max then []
      else aux n :: aux2 (n+1)
    in
      (K.return ()) >>= (fun () -> K.doco (aux2 0))

  (* Second test : distribute the calculation of fib 53 *)

  let rec fib_rec n r (qo : int K.out_port) =
    (K.return ()) >>= (fun () ->
      if r = 0 then
        K.put (fib n) qo
      else
        (delay K.new_channel ()) >>= (fun (q_in, q_out) -> 
          (delay K.new_channel ()) >>= (fun (q_in2, q_out2) -> 
            K.doco
              [
                fib_rec (n-2) (r-1) q_out ;
                fib_rec (n-1) (r-1) q_out2 ;
                K.get q_in >>= (fun x ->
                   	(K.get q_in2) >>=
                    (fun y ->
                      K.output @@ Format.sprintf "f(%d) = %d@." n (x+y);
                      K.put (x+y) qo))
              ]
            )))


  let main2 : int K.process =
    (delay K.new_channel()) >>=
      (fun (qi, qo) ->
        (fib_rec 53 7 qo) >>=
		(fun () -> K.get qi))

end

module E = Example(Kahn_stdio.ProtoKahn)

let () =
	let r = E.K.run E.main2 in
	Format.eprintf "Final result: %d@." r