Merge pull request #17 from haskell-works/expose-flags

Expose flags

Author: newhoggy

app/App/Commands.hs

@@ -1,7 +1,8 @@
 module App.Commands where
 
+import App.Commands.Capabilities
 import App.Commands.CreateIndex
-import Data.Semigroup           ((<>))
+import Data.Semigroup            ((<>))
 import Options.Applicative
 
 commands :: Parser (IO ())
@@ -10,4 +11,5 @@ commands = commandsGeneral
 commandsGeneral :: Parser (IO ())
 commandsGeneral = subparser $ mempty
   <>  commandGroup "Commands:"
+  <>  cmdCapabilities
   <>  cmdCreateIndex

app/App/Commands/Capabilities.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module App.Commands.Capabilities
+  ( cmdCapabilities
+  ) where
+
+import Data.Semigroup      ((<>))
+import Options.Applicative hiding (columns)
+
+import qualified HaskellWorks.Data.Json.Simd.Index.Simple   as SIMPLE
+import qualified HaskellWorks.Data.Json.Simd.Index.Standard as STANDARD
+import qualified System.IO                                  as IO
+
+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}
+
+runCapabilities :: () -> IO ()
+runCapabilities opts = do
+  IO.putStrLn "Capabalities:"
+  IO.putStrLn $ "  standard indexing: " <> show STANDARD.enabled
+  IO.putStrLn $ "  simple indexing: "   <> show SIMPLE.enabled
+
+optsCapabilities :: Parser ()
+optsCapabilities = pure ()
+
+cmdCapabilities :: Mod CommandFields (IO ())
+cmdCapabilities = command "capabilities" $ flip info idm $ runCapabilities <$> optsCapabilities

cbits/simd-state.c

@@ -8,9 +8,6 @@
 
 #include "simd.h"
 
-extern uint32_t hw_json_simd_transition_table_32[256];
-extern uint32_t hw_json_simd_phi_table_32       [256];
-
 void
 hw_json_simd_sm_process_chunk(
     uint8_t *in_buffer,

cbits/simd.c

@@ -0,0 +1,25 @@
+#include "simd.h"
+
+int hw_json_simd_avx2_enabled() {
+#ifdef __AVX2__
+  return 1;
+#else
+  return 0;
+#endif
+}
+
+int hw_json_simd_bmi2_enabled() {
+#ifdef __BMI2__
+  return 1;
+#else
+  return 0;
+#endif
+}
+
+int hw_json_simd_sse4_2_enabled() {
+#ifdef __BMI2__
+  return 1;
+#else
+  return 0;
+#endif
+}

cbits/simd.h

@@ -9,6 +9,15 @@
 
 typedef struct hw_json_simd_bp_state hw_json_simd_bp_state_t;
 
+int hw_json_simd_avx2_enabled();
+
+int hw_json_simd_bmi2_enabled();
+
+int hw_json_simd_sse4_2_enabled();
+
+extern uint32_t hw_json_simd_transition_table_32[256];
+extern uint32_t hw_json_simd_phi_table_32       [256];
+
 int hw_json_simd_main_spliced(
     int argc,
     char **argv);

hw-json-simd.cabal

@@ -17,6 +17,7 @@ tested-with:    GHC == 8.6.1, GHC == 8.4.3, GHC == 8.2.2
 extra-source-files:
     cbits/debug.h
     cbits/simd.h
+    cbits/simd.c
     cbits/simd-spliced.c
     cbits/simd-state.c
     cbits/simd-phi-table-32.c
@@ -60,6 +61,7 @@ library
           , lens
           , vector
   exposed-modules:
+      HaskellWorks.Data.Json.Simd.Capabilities
       HaskellWorks.Data.Json.Simd.Index.Simple
       HaskellWorks.Data.Json.Simd.Index.Standard
       HaskellWorks.Data.Json.Simd.Internal.Foreign
@@ -76,6 +78,7 @@ library
       cbits
   c-sources:
       cbits/debug.c
+      cbits/simd.c
       cbits/simd-spliced.c
       cbits/simd-state.c
       cbits/simd-phi-table-32.c
@@ -109,6 +112,7 @@ executable hw-json-simd
   autogen-modules:  Paths_hw_json_simd
   other-modules:
       App.Commands
+      App.Commands.Capabilities
       App.Commands.CreateIndex
       App.Commands.Types
       App.Lens

src/HaskellWorks/Data/Json/Simd/Capabilities.hs

@@ -0,0 +1,16 @@
+module HaskellWorks.Data.Json.Simd.Capabilities where
+
+import qualified HaskellWorks.Data.Json.Simd.Internal.Foreign as F
+import qualified System.IO.Unsafe                             as U
+
+avx_2 :: Bool
+avx_2 = U.unsafePerformIO F.enabled_avx_2 /= 0
+{-# NOINLINE avx_2 #-}
+
+sse_4_2 :: Bool
+sse_4_2 = U.unsafePerformIO F.enabled_sse_4_2 /= 0
+{-# NOINLINE sse_4_2 #-}
+
+bmi_2 :: Bool
+bmi_2 = U.unsafePerformIO F.enabled_bmi_2 /= 0
+{-# NOINLINE bmi_2 #-}

src/HaskellWorks/Data/Json/Simd/Index/Simple.hs

@@ -3,6 +3,7 @@
 
 module HaskellWorks.Data.Json.Simd.Index.Simple
   ( makeIbBps
+  , enabled
   ) where
 
 import Control.Monad.ST
@@ -18,6 +19,7 @@ import qualified Foreign.ForeignPtr                           as F
 import qualified Foreign.ForeignPtr.Unsafe                    as F
 import qualified Foreign.Marshal.Unsafe                       as F
 import qualified Foreign.Ptr                                  as F
+import qualified HaskellWorks.Data.Json.Simd.Capabilities     as C
 import qualified HaskellWorks.Data.Json.Simd.Internal.Foreign as F
 import qualified HaskellWorks.Data.Json.Simd.Internal.List    as L
 import qualified System.IO.Unsafe                             as IO
@@ -135,3 +137,6 @@ stepToByteString state (Step step size) = F.unsafeLocalState $ do
   let bpVm = DVSM.unsafeFromForeignPtr (F.castForeignPtr bpFptr) 0 size
   w64Size <- stToIO $ step state bpVm
   return (BSI.PS bpFptr 0 (w64Size * 8))
+
+enabled :: Bool
+enabled = C.avx_2 && C.sse_4_2 && C.bmi_2

src/HaskellWorks/Data/Json/Simd/Index/Standard.hs

@@ -5,6 +5,7 @@
 
 module HaskellWorks.Data.Json.Simd.Index.Standard
   ( makeIbBps
+  , enabled
   ) where
 
 import Control.Monad
@@ -19,6 +20,7 @@ import qualified Foreign.ForeignPtr.Unsafe                    as F
 import qualified Foreign.Marshal.Unsafe                       as F
 import qualified Foreign.Ptr                                  as F
 import qualified Foreign.Storable                             as F
+import qualified HaskellWorks.Data.Json.Simd.Capabilities     as C
 import qualified HaskellWorks.Data.Json.Simd.Internal.Foreign as F
 import qualified System.IO.Unsafe                             as IO
 
@@ -99,3 +101,6 @@ makeIbBps lbs = F.unsafeLocalState $ do
                 )
           rs <- IO.unsafeInterleaveIO $ go wb ws fptrState fptrRemBits fptrRemBitsLen bss
           return (r:rs)
+
+enabled :: Bool
+enabled = C.avx_2 && C.sse_4_2 && C.bmi_2

src/HaskellWorks/Data/Json/Simd/Internal/Foreign.chs

@@ -4,7 +4,7 @@
 module HaskellWorks.Data.Json.Simd.Internal.Foreign where
 
 import Foreign
-import Foreign.C.Types (CChar(..), CSize(..))
+import System.IO.Unsafe
 
 #include "../cbits/simd.h"
 
@@ -13,6 +13,21 @@ type UInt32 = {#type uint32_t#}
 type UInt64 = {#type uint64_t#}
 type Size   = {#type size_t  #}
 
+enabled_avx_2 :: IO Int
+enabled_avx_2 = fromIntegral <$> do
+  {#call unsafe hw_json_simd_avx2_enabled as c_hw_json_simd_avx2_enabled#}
+{-# NOINLINE enabled_avx_2 #-}
+
+enabled_sse_4_2 :: IO Int
+enabled_sse_4_2 = fromIntegral <$> do
+  {#call unsafe hw_json_simd_sse4_2_enabled as c_hw_json_simd_sse4_2_enabled#}
+{-# NOINLINE enabled_sse_4_2 #-}
+
+enabled_bmi_2 :: IO Int
+enabled_bmi_2 = fromIntegral <$> do
+  {#call unsafe hw_json_simd_bmi2_enabled as c_hw_json_simd_bmi2_enabled#}
+{-# NOINLINE enabled_bmi_2 #-}
+
 processChunk :: ()
   => Ptr UInt8    -- in_buffer
   -> Size         -- in_length