Haskell bit striping solution by GordonBGood (#559)

PrimeHaskell/solution_2/.gitignore

@@ -0,0 +1 @@
+

PrimeHaskell/solution_2/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for dragrace-haskell2
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

PrimeHaskell/solution_2/Dockerfile

@@ -0,0 +1,22 @@
+FROM haskell:8.10
+
+WORKDIR /opt/sieve
+
+RUN cabal update
+
+RUN apt-get update
+RUN apt-get install --yes lsb-release wget software-properties-common
+
+RUN wget https://apt.llvm.org/llvm.sh
+RUN chmod +x llvm.sh
+RUN ./llvm.sh 9
+
+COPY ./dragrace-haskell2.cabal /opt/sieve/dragrace-haskell2.cabal
+
+RUN cabal update && cabal build --only-dependencies -j4
+
+COPY . /opt/sieve
+
+RUN PATH=/usr/lib/llvm-9/bin:$PATH cabal build dragrace-haskell2  	 	
+
+CMD [ "cabal","run","dragrace-haskell2" ]

PrimeHaskell/solution_2/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2021, W. Gordon Goodsman (GordonBGood)
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of W. Gordon Goodsman (GordonBGood) nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

PrimeHaskell/solution_2/README.md

@@ -0,0 +1,36 @@
+# Haskell "Loop Unpeeling" solution by GordonBGood
+
+This Haskell solution is implemented in an imperative style using `forM_` so that the core algorithm remains recognizable.  Unlike the earlier solution, this solution does not use imported libraries to accomplish the task, so thus is `faithful to base`.  The number representation is one bit per odd number.
+
+The implementation uses the same algorithm as the Rust "striped" algorithm, so thus is `faithful base`, although the actual loops are very simple and thus no separate storage implementation is used.  The outer loop starting at code line 50 searches for the base prime values as required; The next inner loop level has a limit set at code line 55 so that it never runs more than eight times, then loops starting at code line 56 by just setting up the constant mask value and starting byte index to be used in the innermost actual marking loops as per code lines 59 to 61.  The boolean deliverable array is returned at code line 62.
+
+Note that there are two views into the same array as set up in code lines 45 to 47, one as a boolean one-bit-per-value array and one as a Word8 byte array, with search for base prime values done in the boolean representation and culling done in the Word8 byte representation for the "striping"/"loop unpeeling" algorithm.  The returned view is the boolean one because then we can use the Haskell built-in `assocs` function to produce the returned lazy list of prime values as a list comprehension in code lines 41 and 42.
+
+## Run instructions
+
+If you have [GHC Haskell installed on your machine](https://www.haskell.org/ghc/download_ghc_8_10_5.html); on Windows, LLVM does not work on Windows for versions newer than 8.6.5 up to 9.0.1 so [version 8.6.5 must be used](https://www.haskell.org/ghc/download_ghc_8_6_5.html).
+
+Once LLVM and GHC Haskell are installed (as well as GIMP if using that version), just run "ghc primes" to compile and "./primes" to run the application.
+
+Otherwise, use the provided `Dockerfile`.
+
+## Output
+
+- Intel SkyLake i5-6500, no LLVM
+
+  ```
+  GordonBGood_unpeeled;3831;5.000076052;1;algorithm=base;faithful=yes;bits=1
+  ```
+
+- Intel SkyLake i5-6500, with LLVM
+
+  ```
+  GordonBGood_unpeeled;11042;5.000068131s;1;algorithm=base;faithful=yes;bits=1
+
+  ```
+
+- Intel SkyLake i5-6500, docker, with LLVM
+
+  ```
+  GordonBGood_unpeeled;11075;5.00014;1;algorithm=base,bits=1,faithful=no
+  ```

PrimeHaskell/solution_2/cabal.project.local

@@ -0,0 +1 @@
+ignore-project: False

PrimeHaskell/solution_2/dragrace-haskell2.cabal

@@ -0,0 +1,38 @@
+cabal-version:      2.4
+name:               dragrace-haskell2
+version:            0.1.0.0
+synopsis:           Sieve of Eratosthenes Benchmark
+
+-- A longer description of the package.
+-- description:
+homepage:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+license:            BSD-3-Clause
+license-file:       LICENSE
+author:             W. Gordon Goodsman (GordonBGood)
+maintainer:         [email protected]
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files:
+    CHANGELOG.md
+    README.md
+
+executable dragrace-haskell2
+    main-is:          primes.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base >=4.7 && <5
+                    , array
+                    , time
+
+    -- Directories containing source files.
+    -- hs-source-dirs:
+    default-language: Haskell2010

PrimeHaskell/solution_2/primes.hs

@@ -0,0 +1,85 @@
+-- implementation of "unpeeling"/"striping" Sieve of Eratosthenes benchmark...
+
+{-# OPTIONS_GHC -O2 -fllvm #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+import Data.Time.Clock.POSIX ( getPOSIXTime, POSIXTime )
+import Data.Word ( Word8, Word64 )
+import Data.Bits ( Bits((.|.), (.&.), shiftL, shiftR) )
+import Control.Monad ( forM_ )
+import Control.Monad.ST ( ST, runST )
+import Data.Array.Base ( MArray(newArray), STUArray, castSTUArray,
+                         unsafeRead, unsafeWrite,
+                         UArray, listArray, assocs, unsafeAt )
+import Data.Array.ST ( runSTUArray )
+
+type Prime = Word64
+
+cLIMIT :: Prime
+cLIMIT = 1000000
+
+-- | Historical data for validating our results - the number of primes
+-- to be found under some limit, such as 168 primes under 1000
+primeCounts :: [(Prime, Int)]
+primeCounts =
+  [ (          10, 4         )
+  , (         100, 25        )
+  , (        1000, 168       )
+  , (       10000, 1229      )
+  , (      100000, 9592      )
+  , (     1000000, 78498     )
+  , (    10000000, 664579    )
+  ]
+
+cEXPECTED :: Int
+cEXPECTED = maybe 0 id $ lookup cLIMIT primeCounts
+
+cBITMASK :: UArray Int Word8
+cBITMASK = listArray (0, 7) [ 1, 2, 4, 8, 16, 32, 64, 128 ]
+
+primesSoE :: Prime -> [Prime] -- force evaluation of array
+primesSoE limit = cmpsts `seq` 2 : [ fromIntegral (i + i + 3)
+                                       | (i, False) <- assocs cmpsts ] where
+  cmpsts = runSTUArray $ do -- following in ST Monad so can mutate array
+    let bitlmt = fromIntegral ((limit - 3) `div` 2)
+    csb <- newArray (0, bitlmt) False -- boolean and Word8 views of array
+    cs <- (castSTUArray :: STUArray s Int Bool ->
+                             ST s (STUArray s Int Word8)) csb
+    let lastByteIndex = bitlmt `shiftR` 3
+        sqrtlmtndx = floor (sqrt (fromIntegral limit) - 3) `div` 2
+    forM_ [ 0 .. sqrtlmtndx ] $ \ ndx -> do -- outer loop finding base primes
+      b <- unsafeRead csb ndx
+      if b then return () else do -- all cases must be covered; found one!
+        let basePrime = ndx + ndx + 3
+            startIndex = (basePrime * basePrime - 3) `shiftR` 1
+            loopLimit = min bitlmt $ startIndex + (basePrime `shiftL` 3) - 1
+        forM_ [ startIndex, startIndex + basePrime .. loopLimit ] $ \ loop -> do
+          let mask = unsafeAt cBITMASK (loop .&. 7) -- for eight culling loops
+              startByteIndex = loop `shiftR` 3
+          forM_ [ startByteIndex, startByteIndex + basePrime .. lastByteIndex ]
+                    $ \ cull -> do -- simple sub loops by constant mask
+            v <- unsafeRead cs cull; unsafeWrite cs cull (v .|. mask)
+    return csb -- actual deliverable is boolean for convenience in decoding
+
+printResults :: Double -> Int -> Int -> IO ()
+printResults duration passes count = do
+  if count == cEXPECTED then
+    putStrLn $ "GordonBGood_unpeeled;" ++ show passes ++ ";" ++ show (1.0 *duration) ++
+               ";1;algorithm=base;faithful=yes;bits=1\n"
+  else putStrLn $ "Invalid result:  " ++ show count ++ " primes."
+
+benchMark :: POSIXTime -> [Prime] -> IO ()
+benchMark strttm = loop 0 where
+  loop _ [] = error "Should never get here!!!"
+  loop passes (hd : rst) = do
+    let primes = primesSoE hd
+    now <- primes `seq` getPOSIXTime -- force immediate, no deferred, execution
+    let duration = now - strttm
+    if duration < 5 then passes `seq` loop (passes + 1) rst
+    else printResults (realToFrac duration) passes (length primes)
+
+main :: IO ()
+main = do
+  startTime <- getPOSIXTime
+  benchMark startTime $ repeat cLIMIT
+