[Haskell-cafe] Prime ``sieve'' and Haskell demo

[oleg at okmij.org]

Ertugrul So:ylemez wrote:

> How about simply changing `sieve` to `trialDiv`?  It's not that I
> don't like the given example, because it gives a very small use case
> for laziness that is difficult enough to reproduce in an eagerly
> evaluated language.

Is it really so difficult to reproduce in a strict language? Here is
that Haskell example in OCaml

let primes = 
  let rec trialDiv (Cons (p,xs)) =
    Cons (p, lazy (trialDiv @@ filter (fun x -> x mod p <> 0) @@ Lazy.force xs))
  in trialDiv @@ iota 2

roughly the same number of lines, and mainly, exactly the same
method. Some people prefer to write it as

let primes = 
  let rec trialDiv (Cons (p,xs)) =
    Cons (p, lazy (Lazy.force xs |> filter (fun x -> x mod p <> 0) |> trialDiv))
  in iota 2 |> trialDiv

The algorithm is the same, it is just as clearly stated. Now it
becomes clearer when what is evaluated.

OCaml has its own streams (and even a special syntax for them, via a
syntactic extension), but it is not difficult to introduce them from
scratch

type 'a stream = Cons of 'a * 'a stream Lazy.t

let rec iota n = Cons (n,lazy (iota (n+1)))
let rec filter pred (Cons (p,xs)) =
  if pred p then Cons (p,lazy (filter pred (Lazy.force xs)))
  else filter pred (Lazy.force xs)
let rec take n (Cons (p,xs)) = 
  if n <= 0 then [] else p :: take (n-1) (Lazy.force xs)

That's really all there is to it. I should stress that the typechecker
won't lets us forget about lazy and force!

The stress on laziness in Haskell is difficult to understand given how
easy it is to use laziness in essentially any language if needed.


Incidentally, given below is a real sieve of Eratosthenes, written
as a *very* concurrent program, where all the concurrency primitives
(including Haskell-like mvars) are implemented with delimcc.  (The
example is an elaboration of the code kindly sent by Christophe
Deleuze, July 18, 2012). The full code is part of the delimcc
distribution.


open Lwc

(* Send a stream of integers [m..n] on the channel out *)
(* It is a task and hence creates a thunk *)
let iota : int mvar -> int -> int -> task = fun out m n () ->
  for i = m to n do
    put_mvar out i
  done

(* A task to print the values read from the stream *)
let output : int mvar -> task = fun inp () ->
  while true do
    let v = take_mvar inp in
    Printf.printf "%i " v
  done

(* The key step in the Eratosthenes sieve: copy inp to out but replace
   every n-th element with 0
*)
let filter : int -> int mvar -> int mvar -> task = fun n inp out () ->
  let rec loop i =
    let v = take_mvar inp in
    if i <= 1 then 
      (put_mvar out 0; loop n)
    else 
      (put_mvar out v; loop (i-1))
  in loop n

(* The main sieving task: move prime numbers from inp to out 
   by composing filters *)
let rec sift : int mvar -> int mvar -> task = fun inp out () ->
  let n = take_mvar inp in
  if n = 0 then sift inp out ()
  else begin
    put_mvar out n;
    let mid = make_mvar () in
    spawn (filter n inp mid);
    sift mid out ()
  end

(* Start up the task of the sieving job, with n being the upper limit *)
let sieve : int -> task = fun n () ->
  let mi = make_mvar () in
  let mo = make_mvar () in
  spawn (iota mi 2 n);
  spawn (sift mi mo);
  spawn (output mo)