Improving the performance of sequence

I am implementing two versions of Eratosthenes's Sieve, the first one is imperative:

let primesUntilArray n =
    let isqrt x =
        let mutable root = 0UL
        let mutable p = 1UL <<< 31

        while p > 0UL do
            while x < (root + p) * (root + p) do
                p <- p >>> 1

            root <- root + p
            p <- p >>> 1

        root

    let isPrime = Array.create (int <| n + 1) true
    let bound = int <| isqrt (uint64 n)

    let mutable i = 2

    while i <= bound do
        if isPrime.[i] then
            let mutable j = i * i

            while j <= n do
                isPrime.[j] <- false
                j <- j + i

        i <- i + 1

    let mutable primes = []
    let mutable i = 2

    while i <= n do
        if isPrime.[i] then
            primes <- i :: primes

        i <- i + 1

    List.rev primes

while the second one is functional (with F#'s sequence):

let primesUntilSequence n =
    let rec pickPrimes s =
        let sieveWith p =
            Seq.filter (fun n -> n < p * p || n % p <> 0)

        let p = Seq.head s

        seq {
            yield p
            yield! pickPrimes (sieveWith p (Seq.tail s))
        }

    Seq.initInfinite (fun i -> i + 2)
    |> pickPrimes
    |> Seq.takeWhile (fun p -> p <= n)
    |> Seq.toList

The time complexity of both is about O(n log log n), but the performance of the version using sequence is very bad, e.g.

> primesUntilArray 9000 |> List.length |> printfn "%d";;
1117
Real: 00:00:00.004, CPU: 00:00:00.000, GC Gen0: 1, Gen1: 0, Gen2: 0
val it: unit = ()

> primesUntilSequence 9000 |> List.length |> printfn "%d";;
1117
Real: 00:00:15.388, CPU: 00:00:15.375, GC Gen0: 592, Gen1: 64, Gen2: 0
val it: unit = ()

That means about 4000 times slower in generating primes until 9000. How can I improve the performance of the second one?

Thank you all. Following is a slightly modified version of the solution of @Tomas Petricek

let primesUntilList n =
    let rec pickPrimes ps xs =
        let sieveWith p =
            List.filter (fun n -> n < p * p || n % p <> 0)

        match xs with
        | p :: xs' ->
            if p * p > n then
                (List.rev xs) @ ps
            else
                pickPrimes (p :: ps) (sieveWith p xs')
        | _ -> ps

    List.rev <| pickPrimes [] [ 2..n ]

This list based version is still about two times less efficient than using array, but much better than my initial sequence based version.

Solution

The issue with your sequence-based version is that deconstructing a sequence using Seq.head and Seq.tail recursively is very inefficient. The sequence returned by Seq.tail iterates the original sequence, but skips the first element. This means that by applying Seq.tail recursively, you are creating more and more sequences (I guess this is O(N^2)) that you need to iterate over.

This gets much more efficient if you use a list, where pattern matching against x::xs simply takes a reference to the next cons cell:

let primesUntilList n =
  let rec pickPrimes s =
      let sieveWith p =
          List.filter (fun n -> n < p * p || n % p <> 0)
      match s with 
      | [] -> []
      | p::ps -> p :: pickPrimes (sieveWith p ps)

  [ 2 .. n ] |> pickPrimes

This is still less efficient than the array-based version (and I think that is to be expected), but it does not perform as badly as your sequence-based version.