fork download
copy 
  1. {-# LANGUAGE TemplateHaskell #-}
  2.  
  3. module Main where
  4.  
  5. import Control.Monad
  6. import Data.Bits
  7. import Data.IORef
  8. import Data.Word
  9. import Foreign.Marshal
  10. import Foreign.Storable
  11.  
  12.  
  13. $( let wbytes' = sizeOf (undefined :: Word)
  14.        wbits'  = 8*wbytes'
  15.        wbits1' = wbits' - 1
  16.        wlog'   = popCount wbits1'
  17.  
  18.    in [d| wbytes = wbytes'
  19.           wbits  = wbits'
  20.           wbits1 = wbits1'
  21.           wlog   = wlog'
  22.        |])
  23.  
  24.  
  25. {-# INLINE soeIO #-}
  26.  
  27. soeIO :: Int -> (Int -> IO ()) -> IO ()
  28. soeIO n usePrime =
  29.     allocaArray (maxW + 1) $ \arr -> do
  30.         let readB ix = do
  31.                 w <- peekElemOff arr (shiftR ix wlog)
  32.                 return (w .&. bit (ix .&. wbits1) /= 0)
  33.  
  34.             clearB ix = do
  35.                 let y = shiftR ix wlog
  36.                 w <- peekElemOff arr y
  37.                 pokeElemOff arr y (w .&. complement (bit (ix .&. wbits1)))
  38.  
  39.         forM_ [0..maxW] (flip (pokeElemOff arr) (-1 :: Word))
  40.  
  41.         forM_ [2..maxN] $ \i -> do
  42.             b <- readB i
  43.             when b $ do
  44.                 usePrime i
  45.                 let j0 = i*i
  46.                 j0 `seq` mapM_ clearB [j0, j0 + i .. maxN]
  47.  
  48.     where
  49.     maxN = n - 1
  50.     maxW = shiftR (n + wbits1) wlog - 1
  51.  
  52.  
  53. main :: IO ()
  54. main = do
  55.     var <- newIORef (0 :: Int)
  56.     soeIO 50000 (\_ -> modifyIORef' var (+ 1))
  57.     readIORef var >>= print
Runtime error #stdin #stdout 0s 6264KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/Z8HX9p
language:
Haskell (ghc 8.4.4)
created:
10 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!