{-# OPTIONS -O2 -optc-O -fbang-patterns -fglasgow-exts -optc-march=pentium4 #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
-- nsieve over an ST monad Bool array
--

import Control.Monad.ST
--import Data.Array.ST
--import Data.Array.Base
import System
import Control.Monad
import Data.Bits
import Text.Printf
import Data.Array.Vector.ST

import GHC.ST

main = do
    n <- getArgs >>= readIO . head :: IO Int
    mapM_ (\i -> sieve (10000 `shiftL` (n-i))) [0, 1, 2]

sieve n = do
   let r = runST (do t <- new n True
                     go t n 2 0)
   printf "Primes up to %8d %8d\n" (n::Int) (r::Int) :: IO ()

go !a !m !n !c
    | n == m    = return c
    | otherwise = do
          e <- get a n
          if e then let loop j
                          | j < m    = do
                              x <- get a j
                              when x $ set a j False
                              loop (j+n)
                          | otherwise = go a m (n+1) (c+1)
                    in loop (n `shiftL` 1)
               else go a m (n+1) c