Merge pull request #40 from haskell-works/move-makeCsPoppyLayerM-to-r…

…eference-module Move makeCsPoppyLayerM to Reference module
haskell-works · Mar 30, 2019 · 8fa7967 · 8fa7967
2 parents 0b7daa4 + b49dee9
commit 8fa7967
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 20 deletions.
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -15,6 +15,7 @@ import HaskellWorks.Data.RankSelect.Base.Select1
 import HaskellWorks.Data.RankSelect.CsPoppy
 import HaskellWorks.Data.RankSelect.CsPoppy.Internal
 import HaskellWorks.Data.RankSelect.CsPoppy.Internal.CsInterleaved
+import HaskellWorks.Data.RankSelect.CsPoppy.Internal.Reference
 import HaskellWorks.Data.RankSelect.Poppy512
 import System.Directory
 import System.Environment

diff --git a/hw-rankselect.cabal b/hw-rankselect.cabal
@@ -74,6 +74,7 @@ library
   exposed-modules:
       HaskellWorks.Data.RankSelect.CsPoppy
       HaskellWorks.Data.RankSelect.CsPoppy.Internal
+      HaskellWorks.Data.RankSelect.CsPoppy.Internal.Reference
       HaskellWorks.Data.RankSelect.CsPoppy.Internal.Vector
       HaskellWorks.Data.RankSelect.CsPoppy.Internal.CsInterleaved
       HaskellWorks.Data.RankSelect.Poppy512

diff --git a/src/HaskellWorks/Data/RankSelect/CsPoppy/Internal.hs b/src/HaskellWorks/Data/RankSelect/CsPoppy/Internal.hs
@@ -7,7 +7,6 @@ module HaskellWorks.Data.RankSelect.CsPoppy.Internal
     ( indexOrZero
     , lastOrZero
     , makeCsPoppyBlocks
-    , makeCsPoppyLayerM
     , makeCsPoppyLayerM2
     , genCsSamples
     ) where
@@ -40,25 +39,6 @@ makeCsPoppyBlocks v = DVS.constructN (((DVS.length v + 8 - 1) `div` 8) + 1) genB
               popCount1 (DVS.unsafeIndex v (j + 7))
           | otherwise -> popCount1 (DVS.take 8 (DVS.drop (i * 8) v))
 
-makeCsPoppyLayerM :: DVS.Vector Word64 -> DVS.Vector Word64
-makeCsPoppyLayerM blocks = DVS.constructN (((DVS.length blocks + 4 - 1) `div` 4) + 1) genLayer1
-  where genLayer1 :: DVS.Vector Word64 -> Word64
-        genLayer1 u =
-          let i  = end u                          in
-          let lx = lastOrZero u                   in
-          let la = indexOrZero blocks (i * 4 - 4) in
-          let lb = indexOrZero blocks (i * 4 - 3) in
-          let lc = indexOrZero blocks (i * 4 - 2) in
-          let ld = indexOrZero blocks (i * 4 - 1) in
-          let nx = lx + (la + lb + lc + ld)       in
-          let na = indexOrZero blocks (i * 4 + 0) in
-          let nb = indexOrZero blocks (i * 4 + 1) in
-          let nc = indexOrZero blocks (i * 4 + 2) in
-          (   ( nx         .&. 0x00000000ffffffff)
-          .|. ((na .<. 32) .&. 0x000003ff00000000)
-          .|. ((nb .<. 42) .&. 0x000ffc0000000000)
-          .|. ((nc .<. 52) .&. 0x3ff0000000000000))
-
 makeCsPoppyLayerM2 :: DVS.Vector Word64 -> DVS.Vector Word64
 makeCsPoppyLayerM2 blocks = DVS.constructN (((DVS.length blocks + 4 - 1) `div` 4) + 1) genLayer1
   where genLayer1 :: DVS.Vector Word64 -> Word64

diff --git a/src/HaskellWorks/Data/RankSelect/CsPoppy/Internal/Reference.hs b/src/HaskellWorks/Data/RankSelect/CsPoppy/Internal/Reference.hs
@@ -0,0 +1,35 @@
+{-# OPTIONS_GHC-funbox-strict-fields #-}
+{-# LANGUAGE MultiWayIf          #-}
+{-# LANGUAGE Rank2Types          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module HaskellWorks.Data.RankSelect.CsPoppy.Internal.Reference
+    ( makeCsPoppyLayerM
+    ) where
+
+import Data.Word
+import HaskellWorks.Data.Bits.BitWise
+import HaskellWorks.Data.Length
+import HaskellWorks.Data.RankSelect.CsPoppy.Internal.Vector
+
+import qualified Data.Vector.Storable as DVS
+
+makeCsPoppyLayerM :: DVS.Vector Word64 -> DVS.Vector Word64
+makeCsPoppyLayerM blocks = DVS.constructN (((DVS.length blocks + 4 - 1) `div` 4) + 1) genLayer1
+  where genLayer1 :: DVS.Vector Word64 -> Word64
+        genLayer1 u =
+          let i  = end u                          in
+          let lx = lastOrZero u                   in
+          let la = indexOrZero blocks (i * 4 - 4) in
+          let lb = indexOrZero blocks (i * 4 - 3) in
+          let lc = indexOrZero blocks (i * 4 - 2) in
+          let ld = indexOrZero blocks (i * 4 - 1) in
+          let nx = lx + (la + lb + lc + ld)       in
+          let na = indexOrZero blocks (i * 4 + 0) in
+          let nb = indexOrZero blocks (i * 4 + 1) in
+          let nc = indexOrZero blocks (i * 4 + 2) in
+          (   ( nx         .&. 0x00000000ffffffff)
+          .|. ((na .<. 32) .&. 0x000003ff00000000)
+          .|. ((nb .<. 42) .&. 0x000ffc0000000000)
+          .|. ((nc .<. 52) .&. 0x3ff0000000000000))
+