Implémentation fonctionnelle d'un crible d'Ératosthène

Voilà l'engin:

module OrderedInt =
struct
  type t = int
  let compare = compare
end

module IntSet = Set.Make(OrderedInt)

let seq_step a b t = 
  let rec do_seq_step a acc = 
    if a > b then 
      acc
    else
      do_seq_step (a + t) (a::acc)
  in
  List.rev (do_seq_step a [])

let sieve n = 
  let rec do_sieve current multiples primes = 
    if current > n then
      primes
    else if IntSet.is_empty multiples || IntSet.min_elt multiples <> current then
      do_sieve 
        (current + 2) 
        (List.fold_left 
           (fun acc e -> IntSet.add e acc)
           multiples
           (seq_step (current * 3) n (current * 2)))
        (current::primes)
    else
      do_sieve (current + 2) (IntSet.remove current multiples) primes
  in
  do_sieve 3 IntSet.empty [2]

Sur ma machine, compilé en natif, trouver les nombres premiers en dessous du million prend 2,7 secondes.