sieve.fs

module FastSieve =
  let rec setNonPrimes (isNonPrimes : _ []) step i =
    if i < isNonPrimes.Length then
      isNonPrimes.[i] <- true
      setNonPrimes isNonPrimes step (i + step)

  let rec scan (isNonPrimes : _ []) i =
    if i < isNonPrimes.Length then
      if isNonPrimes.[i] then
        scan isNonPrimes (i + 1)
      else
        setNonPrimes isNonPrimes i (i + i)
        scan isNonPrimes (i + 1)

  let rec buildResizeArray (ra : ResizeArray<_>) (isNonPrimes : _ []) i =
    if i < isNonPrimes.Length then
      if not isNonPrimes.[i] then
        ra.Add i
      buildResizeArray ra isNonPrimes (i + 1)

  let primesLessThan n =
    let isNonPrimes = Array.zeroCreate n
    isNonPrimes.[0] <- true
    isNonPrimes.[1] <- true

    scan isNonPrimes 2

    let ra = ResizeArray n
    buildResizeArray ra isNonPrimes 0

    ra.ToArray ()

  let run count =
    primesLessThan count |> Seq.sum


module SeqSieve =
  let sieveOutPrime p numbers =
    numbers
    |> Seq.filter (fun n -> n % p <> 0)

  let primesLessThan n =
    let removeFirstPrime s = 
      let s = s |> Seq.cache
      match s with
      | s when Seq.isEmpty s -> None
      | s -> Some(Seq.head s, sieveOutPrime (Seq.head s) (Seq.tail s))

    let remainingPrimes =
      seq {3..2..n}
      |> Seq.unfold removeFirstPrime

    seq { yield 2; yield! remainingPrimes }

  let run count =
    primesLessThan count |> Seq.sum

module ListSieve =
  let sieveOutPrime p numbers =
    numbers
    |> List.filter (fun n -> n % p <> 0)

  let primesLessThan n =
    let removeFirstPrime = function
      | s when List.isEmpty s -> None
      | s -> Some(List.head s, sieveOutPrime (List.head s) (List.tail s))

    let remainingPrimes =
      [|3..2..n|]
      |> List.ofArray
      |> List.unfold removeFirstPrime

    2::remainingPrimes

  let run count =
    primesLessThan count |> List.sum
    
module ArraySieve =
  let sieveOutPrime p numbers =
    numbers
    |> Array.filter (fun n -> n % p <> 0)

  let primesLessThan n =
    let removeFirstPrime = function
      | s when Array.isEmpty s -> None
      | s -> Some(Array.head s, sieveOutPrime (Array.head s) (Array.tail s))

    let remainingPrimes =
      [|3..2..n|]
      |> Array.unfold removeFirstPrime

    Array.concat [|[|2|]; remainingPrimes|]

  let run count =
    primesLessThan count |> Array.sum

module LazySieve =

  type [<Struct>] LazyResult<'T> =
    | LazyEmpty
    | LazyCons  of 'T*LazyList<'T>
  and [<Struct>] LazyList<'T> = LL of (unit -> LazyResult<'T>)


  module LazyList =
    module Details =
      let mutable runs = 0
      let inline run (LL lt) = 
        runs <- runs + 1
        lt ()
    open Details

    let fold f z l =
      let rec loop s l =
        match run l with
        | LazyEmpty         -> s
        | LazyCons  (h, t)  -> loop (f s h) t
      loop z l

    let unfold g z : LazyList<_> =
      LL <| fun () ->
        let rec loop s () =
          match g s with
          | None          -> LazyEmpty
          | Some (v, ns)  -> LazyCons (v, LL (loop ns))
        loop z ()

    let empty<'T> : LazyList<'T> = 
      LL <| fun () ->
        LazyEmpty

    let cons h t : LazyList<_> =
      LL <| fun () ->
        LazyCons (h, t)

    let head l : _ =
      match run l with
      | LazyEmpty         -> failwith "lazy list is empty"
      | LazyCons  (h, _)  -> h

    let tail l : LazyList<_> =
      LL <| fun () ->
        match run l with
        | LazyEmpty         -> failwith "lazy list is empty"
        | LazyCons  (_, t)  -> run t

    let isEmpty l : bool =
      match run l with
      | LazyEmpty         -> true
      | LazyCons  (_, _)  -> false

    let filter f l : LazyList<_> =
      LL <| fun () ->
        let rec loop ll () =
          match run ll with
          | LazyEmpty         -> LazyEmpty
          | LazyCons  (h, t)  -> 
            if f h then
              LazyCons (h, LL (loop t))
            else
              loop t ()
        loop l ()

    let map m l : LazyList<_> =
      LL <| fun () ->
        let rec loop ll () =
          match run ll with
          | LazyEmpty         -> LazyEmpty
          | LazyCons  (h, t)  -> 
            LazyCons (m h, LL (loop t))
        loop l ()

    let ofArray (vs : _ []) : LazyList<_> =
      LL <| fun () ->
        let rec loop i () =
          if i < vs.Length then
            LazyCons (vs.[i], LL (loop (i + 1)))
          else
            LazyEmpty
        loop 0 ()

    let toArray l : _ [] =
      let ra = ResizeArray 16

      let rec loop l =
        match run l with
        | LazyEmpty       -> ()
        | LazyCons (h, t) ->
          ra.Add h
          loop t

      loop l

      ra.ToArray ()

    let inline sum l =
      let mutable sum = LanguagePrimitives.GenericZero<_>

      let rec loop l =
        match run l with
        | LazyEmpty       -> ()
        | LazyCons (h, t) ->
          sum <- sum + h
          loop t

      loop l

      sum

    let cache l : LazyList<_> =
      l |> toArray |> ofArray

    module Tests =
      open FsCheck

      type Properties () =
        static member ``fromArray >> toArray`` (vs : int[]) =
          let e = vs
          let a = vs |> ofArray |> toArray

          e = a

        static member ``isEmpty`` (vs : int[]) =
          let e = vs |> Array.isEmpty 
          let a = vs |> ofArray |> isEmpty

          e = a

        static member ``cons`` (v : int) (vs : int[]) =
          let e = Array.concat [|[|v|]; vs|]
          let a = vs |> ofArray |> cons v |> toArray

          e = a

        static member ``head`` (vs : int[]) =
          vs.Length > 0 ==> fun () ->
            let e = vs |> Array.head
            let a = vs |> ofArray |> head

            e = a

        static member ``tail`` (vs : int[]) =
          vs.Length > 0 ==> fun () ->
            let e = vs |> Array.tail
            let a = vs |> ofArray |> tail |> toArray

            e = a

        static member ``filter`` (vs : int[]) =
          let f v = v % 2 = 0
          let e = vs |> Array.filter f
          let a = vs |> ofArray |> filter f |> toArray

          e = a

        static member ``map`` (vs : int[]) =
          let m v = v + 2
          let e = vs |> Array.map m
          let a = vs |> ofArray |> map m |> toArray

          e = a

        static member ``fold`` (z : int) (vs : int[]) =
          let e = vs |> Array.fold (+) z
          let a = vs |> ofArray |> fold (+) z

          e = a

        static member ``unfold`` (z : int) (v : int) =
          let g s =
            if s < v then
              Some (s, s + 1)
            else
              None
            
          let e = Array.unfold g z
          let a = unfold g z |> toArray

          e = a

      let run () =
        let config = { Config.Quick with MaxTest = 1000; MaxFail = 1000 }
        Check.All<Properties> config

  let sieveOutPrime p numbers =
    numbers
    |> LazyList.filter (fun n -> n % p <> 0)

  let primesLessThan n =
    let removeFirstPrime s = 
      let s = s |> LazyList.cache
      match s with
      | s when LazyList.isEmpty s -> None
      | s -> Some(LazyList.head s, sieveOutPrime (LazyList.head s) (LazyList.tail s))

    let remainingPrimes =
      [|3..2..n|]
      |> LazyList.ofArray
      |> LazyList.unfold removeFirstPrime

    LazyList.cons 2 remainingPrimes

  let run count =
    primesLessThan count |> LazyList.sum

open LazySieve

// now () returns current time in milliseconds since start
let now : unit -> int64 =
  let sw = System.Diagnostics.Stopwatch ()
  sw.Start ()
  fun () -> sw.ElapsedMilliseconds

// time estimates the time 'action' repeated a number of times
let time repeat action =
  let inline cc i       = System.GC.CollectionCount i

  let v                 = action ()

  System.GC.Collect (2, System.GCCollectionMode.Forced, true)

  let bcc0, bcc1, bcc2  = cc 0, cc 1, cc 2
  let b                 = now ()

  for i in 1..repeat do
    action () |> ignore

  let e = now ()
  let ecc0, ecc1, ecc2  = cc 0, cc 1, cc 2

  v, (e - b), ecc0 - bcc0, ecc1 - bcc1, ecc2 - bcc2
[<EntryPoint>]
let main argv = 
//  LazySieve.LazyList.Tests.run ()

  let testCases =
    [|
      "seq"       , SeqSieve.run
      "list"      , ListSieve.run
      "array"     , ArraySieve.run
//      "lazy-list" , LazySieve.run
      "mutable"   , FastSieve.run
    |]

  let outer = 10
  let inner = 4000

  for name, action in testCases do
    printfn "Running '%s' ..." name
    let v, diff, cc0, cc1, cc2 = time outer (fun () -> action inner)
    printfn "  it took %d ms with cc (%d, %d, %d), the result is: %A" diff cc0 cc1 cc2 v


  printfn "Lazy evaluations: %A" LazySieve.LazyList.Details.runs
  0