lib/cml/tests/primes-multicast.sml

   1
   2 structure Main =
   3 struct
   4    open CML
   5    structure MC = Multicast
   6
   7    val print = TextIO.print
   8
   9    fun makeNatStream c =
  10       let
  11          val mch = MC.mChannel ()
  12          fun count i = (MC.multicast(mch, i)
  13                         ; count(i+1))
  14          val _ = spawn (fn () =>
  15                         (print (concat ["makeNatStream: ",
  16                                         tidToString (getTid ()),
  17                                         "\n"])
  18                          ; count c))
  19       in
  20          mch
  21       end
  22
  23    fun makeFilter (p, inMCh) =
  24       let
  25          val inP = MC.port inMCh
  26          val outMCh = MC.mChannel ()
  27          fun loop () =
  28             let
  29                val i = sync (MC.recvEvt inP)
  30             in
  31                if ((i mod p) <> 0)
  32                   then MC.multicast(outMCh, i)
  33                   else ()
  34                ; loop ()
  35             end
  36          val _ = spawn loop
  37       in
  38          outMCh
  39       end
  40
  41    fun makePrimes () =
  42       let
  43          val primes = MC.mChannel ()
  44          fun head mch =
  45             let
  46                val p = MC.recv (MC.port mch)
  47             in
  48                MC.multicast(primes, p)
  49                ; head (makeFilter (p, mch))
  50             end
  51          val _ = spawn (fn () =>
  52                         (print (concat ["makePrimes: ",
  53                                         tidToString (getTid ()),
  54                                         "\n"])
  55                          ; head (makeNatStream 2)))
  56       in
  57          primes
  58       end
  59
  60    fun makeNatPrinter mch n =
  61       let
  62          val p = MC.port mch
  63          fun loop i =
  64             if i > n then RunCML.shutdown OS.Process.success
  65                else let
  66                        val m = MC.recv p
  67                        val m' = Int.toString m
  68                        fun loop' j =
  69                           if j > m then ()
  70                           else (print (m' ^ "\n")
  71                                 ; loop' (j + 1))
  72                     in
  73                        loop' m
  74                        ; loop (i + 1)
  75                     end
  76          val _ = spawn (fn () =>
  77                         (print (concat ["makeNatPrinter: ",
  78                                         tidToString (getTid ()),
  79                                         "\n"])
  80                          ; loop 0))
  81       in
  82          ()
  83       end
  84
  85    fun doit' n =
  86       RunCML.doit
  87       (fn () =>
  88        let
  89           val mch = makePrimes ()
  90           val _ = makeNatPrinter mch n
  91        in
  92           ()
  93        end,
  94        SOME (Time.fromMilliseconds 10))
  95
  96    fun doit n =
  97       let
  98          val x = doit' n
  99       in
 100          x
 101       end
 102 end