Introduce SIMD implementation for x86_64

.github/workflows/haskell-ci.yml

@@ -16,13 +16,13 @@ jobs:
       fail-fast: true
       matrix:
         os: [ubuntu-latest]
-        ghc: ['9.4', '9.6', '9.8', '9.10']
+        ghc: ['9.4', '9.6', '9.8', '9.10', '9.12']
         include:
         - os: macOS-latest
-          ghc: 'latest'
+          ghc: '9.12'
     steps:
     - uses: actions/checkout@v3
-    - uses: haskell/actions/setup@v2
+    - uses: haskell-actions/setup@v2
       id: setup-haskell-cabal
       with:
         ghc-version: ${{ matrix.ghc }}
@@ -40,12 +40,14 @@ jobs:
         cabal sdist -z -o .
         cabal get base16-*.tar.gz
         cd base16-*/
-        cabal build base16:tests --enable-tests --enable-benchmarks
-        cabal test --enable-tests --enable-benchmarks --test-show-details=direct all
+        cabal configure --enable-tests --enable-benchmarks -f simd
+        cabal build base16:tests
+        cabal test --test-show-details=direct all
     - name: Bench
       run: |
         cd base16-*/
-        cabal bench --enable-tests --enable-benchmarks --benchmark-option=-l all
+        cabal configure --enable-tests --enable-benchmarks -f simd
+        cabal bench --benchmark-option=-l all
     - name: Haddock
       run: |
         cd base16-*/
@@ -60,7 +62,7 @@ jobs:
     runs-on: ubuntu-latest
     steps:
     - uses: actions/checkout@v3
-    - uses: haskell/actions/setup@v2
+    - uses: haskell-actions/setup@v2
       id: setup-haskell-cabal
       with:
         ghc-version: 'latest'
@@ -75,21 +77,3 @@ jobs:
         key: ${{ runner.os }}-latest
     - name: Test
       run: cabal test --ghc-options='-fcheck-prim-bounds -fno-ignore-asserts'
-
-  i386:
-    needs: build
-    runs-on: ubuntu-latest
-    container:
-      image: i386/ubuntu:bionic
-    steps:
-    - name: Install
-      run: |
-        apt-get update -y
-        apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl libncurses5 libtinfo5 libncurses5-dev libtinfo-dev
-        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
-    - uses: actions/checkout@v1
-    - name: Test
-      run: |
-        source ~/.ghcup/env
-        cabal update
-        cabal test

base16.cabal

@@ -32,6 +32,16 @@ source-repository head
   type:     git
   location: https://github.com/emilypi/base16.git
 
+flag simd
+  description: Enable SIMD detection and code paths. It may incur some unnecessary overhead for most workloads.
+  default: False
+  manual: True
+
+flag pure-haskell
+  description: Do not use any C implementation, which is useful when using the JavaScript or WASM compiler backends. This flag disables simd.
+  default: False
+  manual: True
+
 library
   exposed-modules:
     Data.Base16.Types
@@ -62,6 +72,22 @@ library
   default-language: Haskell2010
   ghc-options:      -Wall
 
+  if arch(javascript) || flag(pure-haskell)
+    cpp-options: -DPURE_HASKELL
+
+  if flag(simd) && !(arch(javascript) || flag(pure-haskell))
+    cpp-options: -DSIMD
+
+    exposed-modules: 
+      Data.ByteString.Base16.Internal.Simd
+
+    include-dirs: cbits
+    c-sources:
+      cbits/base16.c
+      cbits/avx_base16.c
+      cbits/sse_base16.c
+    cc-options: -O3 -std=c2x
+
 test-suite base16-tests
   other-modules:    Internal
   default-language: Haskell2010

benchmarks/Base16Bench.hs

@@ -14,93 +14,107 @@ import "base16" Data.ByteString.Base16 as B16
 import "base16" Data.ByteString.Short.Base16 as BS16
 import "base16-bytestring" Data.ByteString.Base16 as Bos
 import Data.ByteString.Random (random)
+import Data.ByteString.Base16.Internal.Simd (c_isSIMDAvailable)
+import qualified Data.ByteString.Base16.Internal.Simd as Simd
 
 
 main :: IO ()
 main =
   defaultMain
     [ env bs $ \ ~((bs25,bs100,bs1k,bs10k,bs100k,bs1mm),(bs25L,bs100L,bs1kL,bs10kL,bs100kL,bs1mmL)) ->
       bgroup "encode"
-      [ bgroup "25"
-        [ bench "base16-short" $ whnf BS16.encodeBase16' bs25L
+      [ bgroup "25" [ bench "base16-short" $ whnf BS16.encodeBase16' bs25L
         , bench "base16-bytestring" $ whnf Bos.encode bs25
-        , bench "base16" $ whnf B16.encodeBase16' bs25
+        , bench "base16 (scalar)" $ whnf (assertBase16 . B16.encodeBase16_) bs25
+        , bench "base16 (simd)" $ whnf Simd.encodeBase16SIMD bs25
         ]
-      , bgroup "100"
-        [ bench "base16-short" $ whnf BS16.encodeBase16' bs100L
+      , bgroup "100" [ bench "base16-short" $ whnf BS16.encodeBase16' bs100L
         , bench "base16-bytestring" $ whnf Bos.encode bs100
-        , bench "base16" $ whnf B16.encodeBase16' bs100
+        , bench "base16 (scalar)" $ whnf (assertBase16 . B16.encodeBase16_) bs100
+        , bench "base16 (simd)" $ whnf Simd.encodeBase16SIMD bs100
         ]
-      , bgroup "1k"
-        [ bench "base16-short" $ whnf BS16.encodeBase16' bs1kL
+      , bgroup "1k" [ bench "base16-short" $ whnf BS16.encodeBase16' bs1kL
         , bench "base16-bytestring" $ whnf Bos.encode bs1k
-        , bench "base16" $ whnf B16.encodeBase16' bs1k
+        , bench "base16 (scalar)" $ whnf (assertBase16 . B16.encodeBase16_) bs1k
+        , bench "base16 (simd)" $ whnf Simd.encodeBase16SIMD bs1k
         ]
-      , bgroup "10k"
-        [ bench "base16-short" $ whnf BS16.encodeBase16' bs10kL
+      , bgroup "10k" [ bench "base16-short" $ whnf BS16.encodeBase16' bs10kL
         , bench "base16-bytestring" $ whnf Bos.encode bs10k
-        , bench "base16" $ whnf B16.encodeBase16' bs10k
+        , bench "base16 (scalar)" $ whnf (assertBase16 . B16.encodeBase16_) bs10k
+        , bench "base16 (simd)" $ whnf Simd.encodeBase16SIMD bs10k
         ]
-      , bgroup "100k"
-        [ bench "base16-short" $ whnf BS16.encodeBase16' bs100kL
+      , bgroup "100k" [ bench "base16-short" $ whnf BS16.encodeBase16' bs100kL
         , bench "base16-bytestring" $ whnf Bos.encode bs100k
-        , bench "base16" $ whnf B16.encodeBase16' bs100k
+        , bench "base16 (scalar)" $ whnf (assertBase16 . B16.encodeBase16_) bs100k
+        , bench "base16 (simd)" $ whnf Simd.encodeBase16SIMD bs100k
         ]
-      , bgroup "1mm"
-        [ bench "base16-short" $ whnf BS16.encodeBase16' bs1mmL
+      , bgroup "1mm" [ bench "base16-short" $ whnf BS16.encodeBase16' bs1mmL
         , bench "base16-bytestring" $ whnf Bos.encode bs1mm
-        , bench "base16" $ whnf B16.encodeBase16' bs1mm
+        , bench "base16 (scalar)" $ whnf (assertBase16 . B16.encodeBase16_) bs1mm
+        , bench "base16 (simd)" $ whnf Simd.encodeBase16SIMD bs1mm
         ]
       ]
     , env bs' $ \ ~((bs25,bs100,bs1k,bs10k,bs100k,bs1mm),(bs25L,bs100L,bs1kL,bs10kL,bs100kL,bs1mmL)) ->
       bgroup "decode"
-      [ bgroup "25"
-        [ bench "base16-short" $ whnf BS16.decodeBase16 bs25L
+      [ bgroup "25" [ bench "base16-short" $ whnf BS16.decodeBase16 bs25L
         , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs25
-        , bench "base16" $ whnf B16.decodeBase16 bs25
-        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs25
+        , bench "base16 (scalar)" $ whnf B16.decodeBase16Typed_ bs25
+        , bench "base16 (simd)" $ whnf Simd.decodeBase16SIMD bs25
+        , bench "base16-untyped (scalar)" $ whnf B16.decodeBase16_ $ extractBase16 bs25
+        , bench "base16-untyped (simd)" $ whnf Simd.decodeBase16UntypedSIMD $ extractBase16 bs25
         , bench "isBase16" $ whnf B16.isBase16 $ extractBase16 bs25
-        , bench "isValidBase16" $ whnf B16.isValidBase16 $ extractBase16 bs25
+        , bench "isValidBase16 (scalar)" $ whnf B16.isValidBase16 $ extractBase16 bs25
+        , bench "isValidBase16 (simd)" $ whnf Simd.isValidBase16SIMD $ extractBase16 bs25
         ]
-      , bgroup "100"
-        [ bench "base16-short" $ whnf BS16.decodeBase16 bs100L
+      , bgroup "100" [ bench "base16-short" $ whnf BS16.decodeBase16 bs100L
         , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs100
-        , bench "base16" $ whnf B16.decodeBase16 bs100
-        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs100
+        , bench "base16 (scalar)" $ whnf B16.decodeBase16Typed_ bs100
+        , bench "base16 (simd)" $ whnf Simd.decodeBase16SIMD bs100
+        , bench "base16-untyped (scalar)" $ whnf B16.decodeBase16_ $ extractBase16 bs100
+        , bench "base16-untyped (simd)" $ whnf Simd.decodeBase16UntypedSIMD $ extractBase16 bs100
         , bench "isBase16" $ whnf B16.isBase16 $ extractBase16 bs100
-        , bench "isValidBase16" $ whnf B16.isValidBase16 $ extractBase16 bs100
+        , bench "isValidBase16 (scalar)" $ whnf B16.isValidBase16 $ extractBase16 bs100
+        , bench "isValidBase16 (simd)" $ whnf Simd.isValidBase16SIMD $ extractBase16 bs100
         ]
-      , bgroup "1k"
-        [ bench "base16-short" $ whnf BS16.decodeBase16 bs1kL
+      , bgroup "1k" [ bench "base16-short" $ whnf BS16.decodeBase16 bs1kL
         , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs1k
-        , bench "base16" $ whnf B16.decodeBase16 bs1k
-        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs1k
+        , bench "base16 (scalar)" $ whnf B16.decodeBase16Typed_ bs1k
+        , bench "base16 (simd)" $ whnf Simd.decodeBase16SIMD bs1k
+        , bench "base16-untyped (scalar)" $ whnf B16.decodeBase16_ $ extractBase16 bs1k
+        , bench "base16-untyped (simd)" $ whnf Simd.decodeBase16UntypedSIMD $ extractBase16 bs1k
         , bench "isBase16" $ whnf B16.isBase16 $ extractBase16 bs1k
-        , bench "isValidBase16" $ whnf B16.isValidBase16 $ extractBase16 bs1k
+        , bench "isValidBase16 (scalar)" $ whnf B16.isValidBase16 $ extractBase16 bs1k
+        , bench "isValidBase16 (simd)" $ whnf Simd.isValidBase16SIMD $ extractBase16 bs1k
         ]
-      , bgroup "10k"
-        [ bench "base16-short" $ whnf BS16.decodeBase16 bs10kL
+      , bgroup "10k" [ bench "base16-short" $ whnf BS16.decodeBase16 bs10kL
         , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs10k
-        , bench "base16" $ whnf B16.decodeBase16 bs10k
-        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs10k
+        , bench "base16 (scalar)" $ whnf B16.decodeBase16Typed_ bs10k
+        , bench "base16 (simd)" $ whnf Simd.decodeBase16SIMD bs10k
+        , bench "base16-untyped (scalar)" $ whnf B16.decodeBase16_ $ extractBase16 bs10k
+        , bench "base16-untyped (simd)" $ whnf Simd.decodeBase16UntypedSIMD $ extractBase16 bs10k
         , bench "isBase16" $ whnf B16.isBase16 $ extractBase16 bs10k
-        , bench "isValidBase16" $ whnf B16.isValidBase16 $ extractBase16 bs10k
+        , bench "isValidBase16 (scalar)" $ whnf B16.isValidBase16 $ extractBase16 bs10k
+        , bench "isValidBase16 (simd)" $ whnf Simd.isValidBase16SIMD $ extractBase16 bs10k
         ]
-      , bgroup "100k"
-        [ bench "base16-short" $ whnf BS16.decodeBase16 bs100kL
+      , bgroup "100k" [ bench "base16-short" $ whnf BS16.decodeBase16 bs100kL
         , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs100k
-        , bench "base16" $ whnf B16.decodeBase16 bs100k
-        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs100k
+        , bench "base16 (scalar)" $ whnf B16.decodeBase16Typed_ bs100k
+        , bench "base16 (simd)" $ whnf Simd.decodeBase16SIMD bs100k
+        , bench "base16-untyped (scalar)" $ whnf B16.decodeBase16_ $ extractBase16 bs100k
+        , bench "base16-untyped (simd)" $ whnf Simd.decodeBase16UntypedSIMD $ extractBase16 bs100k
         , bench "isBase16" $ whnf B16.isBase16 $ extractBase16 bs100k
-        , bench "isValidBase16" $ whnf B16.isValidBase16 $ extractBase16 bs100k
+        , bench "isValidBase16 (scalar)" $ whnf B16.isValidBase16 $ extractBase16 bs100k
+        , bench "isValidBase16 (simd)" $ whnf Simd.isValidBase16SIMD $ extractBase16 bs100k
         ]
-      , bgroup "1mm"
-        [ bench "base16-short" $ whnf BS16.decodeBase16 bs1mmL
+      , bgroup "1mm" [ bench "base16-short" $ whnf BS16.decodeBase16 bs1mmL
         , bench "base16-bytestring" $ whnf Bos.decode $ extractBase16 bs1mm
-        , bench "base16" $ whnf B16.decodeBase16 bs1mm
-        , bench "base16-untyped" $ whnf B16.decodeBase16Untyped $ extractBase16 bs1mm
+        , bench "base16 (scalar)" $ whnf B16.decodeBase16Typed_ bs1mm
+        , bench "base16 (simd)" $ whnf Simd.decodeBase16SIMD bs1mm
+        , bench "base16-untyped (scalar)" $ whnf B16.decodeBase16_ $ extractBase16 bs1mm
+        , bench "base16-untyped (simd)" $ whnf Simd.decodeBase16UntypedSIMD $ extractBase16 bs1mm
         , bench "isBase16" $ whnf B16.isBase16 $ extractBase16 bs1mm
-        , bench "isValidBase16" $ whnf B16.isValidBase16 $ extractBase16 bs1mm
+        , bench "isValidBase16 (scalar)" $ whnf B16.isValidBase16 $ extractBase16 bs1mm
+        , bench "isValidBase16 (simd)" $ whnf Simd.isValidBase16SIMD $ extractBase16 bs1mm
         ]
       ]
     ]