diff --git a/doctest/DoctestDriver.hs b/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} +#else +module Main where + +import qualified System.IO as IO + +main :: IO () +main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4" +#endif diff --git a/hw-json-standard-cursor.cabal b/hw-json-standard-cursor.cabal --- a/hw-json-standard-cursor.cabal +++ b/hw-json-standard-cursor.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-json-standard-cursor -version: 0.2.1.2 +version: 0.2.1.3 synopsis: Memory efficient JSON parser description: Memory efficient JSON parser. Please see README.md category: Data @@ -37,40 +37,42 @@ manual: False default: False -common base { build-depends: base >= 4 && < 5 } +common base { build-depends: base >= 4 && < 5 } -common array { build-depends: array >= 0.5 && < 0.6 } -common bits-extra { build-depends: bits-extra >= 0.0.1.3 && < 0.1 } -common bytestring { build-depends: bytestring >= 0.10.6 && < 0.11 } -common criterion { build-depends: criterion >= 1.4 && < 1.6 } -common directory { build-depends: directory >= 1.3 && < 1.4 } -common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 1.3 } -common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } -common hspec { build-depends: hspec >= 2.4 && < 3 } -common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.0 && < 0.4 } -common hw-bits { build-depends: hw-bits >= 0.7.0.5 && < 0.8 } -common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } -common hw-json-simd { build-depends: hw-json-simd >= 0.1.0.2 && < 0.2 } -common hw-prim { build-depends: hw-prim >= 0.6.2.29 && < 0.7 } -common hw-rankselect { build-depends: hw-rankselect >= 0.13 && < 0.14 } -common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } -common lens { build-depends: lens >= 4 && < 5 } -common mmap { build-depends: mmap >= 0.5 && < 0.6 } -common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.16 } -common text { build-depends: text >= 1.2 && < 1.3 } -common vector { build-depends: vector >= 0.12 && < 0.13 } -common word8 { build-depends: word8 >= 0.1 && < 0.2 } +common array { build-depends: array >= 0.5 && < 0.6 } +common bits-extra { build-depends: bits-extra >= 0.0.1.3 && < 0.1 } +common bytestring { build-depends: bytestring >= 0.10.6 && < 0.11 } +common criterion { build-depends: criterion >= 1.4 && < 1.6 } +common directory { build-depends: directory >= 1.3 && < 1.4 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 1.3 } +common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } +common hspec { build-depends: hspec >= 2.4 && < 3 } +common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.0 && < 0.4 } +common hw-bits { build-depends: hw-bits >= 0.7.0.5 && < 0.8 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } +common hw-json-simd { build-depends: hw-json-simd >= 0.1.0.2 && < 0.2 } +common hw-prim { build-depends: hw-prim >= 0.6.2.29 && < 0.7 } +common hw-rankselect { build-depends: hw-rankselect >= 0.13 && < 0.14 } +common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } +common lens { build-depends: lens >= 4 && < 5 } +common mmap { build-depends: mmap >= 0.5 && < 0.6 } +common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.16 } +common text { build-depends: text >= 1.2 && < 1.3 } +common vector { build-depends: vector >= 0.12 && < 0.13 } +common word8 { build-depends: word8 >= 0.1 && < 0.2 } common semigroups { if impl(ghc < 8 ) { build-depends: semigroups >= 0.16 && < 0.19 } } common config - default-language: Haskell2010 - ghc-options: -Wall -O2 -msse4.2 + default-language: Haskell2010 + ghc-options: -Wall -O2 -msse4.2 if flag(sse42) - ghc-options: -msse4.2 + ghc-options: -msse4.2 if flag(bmi2) && impl(ghc >= 8.4.1) - ghc-options: -mbmi2 -msse4.2 - cpp-options: -DBMI2_ENABLED + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED library import: base, config @@ -168,4 +170,15 @@ main-is: Main.hs hs-source-dirs: bench build-depends: hw-json-standard-cursor - other-modules: Paths_hw_json_standard_cursor + +test-suite hw-json-standard-cursor-doctest + import: base, config + , doctest + , doctest-discover + , bits-extra + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: DoctestDriver.hs + HS-Source-Dirs: doctest + build-tool-depends: doctest-discover:doctest-discover diff --git a/src/HaskellWorks/Data/Json/Standard/Cursor/Internal/StateMachine.hs b/src/HaskellWorks/Data/Json/Standard/Cursor/Internal/StateMachine.hs --- a/src/HaskellWorks/Data/Json/Standard/Cursor/Internal/StateMachine.hs +++ b/src/HaskellWorks/Data/Json/Standard/Cursor/Internal/StateMachine.hs @@ -27,21 +27,20 @@ data State = InJson | InString | InEscape | InValue deriving (Eq, Enum, Bounded, Show) phiTable :: DV.Vector (DVS.Vector Word8) -phiTable = DV.constructN 5 gos - where gos :: DV.Vector (DVS.Vector Word8) -> DVS.Vector Word8 - gos v = DVS.constructN 256 go - where vi = DV.length v - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (snd (stateMachine (fromIntegral ui) (toEnum vi))) - where ui = DVS.length u +phiTable = DV.generate 5 gos + where gos :: Int -> DVS.Vector Word8 + gos vj = DVS.generate 256 go + where vi = fromIntegral vj + go :: Int -> Word8 + go uj = fromIntegral (snd (stateMachine (fromIntegral uj) (toEnum vi))) {-# NOINLINE phiTable #-} phiTable2 :: DVS.Vector Word8 -phiTable2 = DVS.constructN (4 * fromIntegral iLen) go +phiTable2 = DVS.generate (4 * fromIntegral iLen) go where iLen = 256 :: Int - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (snd (stateMachine (fromIntegral ui) (toEnum (fromIntegral uj)))) - where (uj, ui) = fromIntegral (DVS.length u) `divMod` iLen + go :: Int -> Word8 + go uj = fromIntegral (snd (stateMachine (fromIntegral ui) (toEnum (fromIntegral uk)))) + where (uk, ui) = fromIntegral uj `divMod` iLen {-# NOINLINE phiTable2 #-} lookupPhiTable :: IntState -> Word8 -> Word8 @@ -49,31 +48,31 @@ {-# INLINE lookupPhiTable #-} phiTableSimd :: DVS.Vector Word32 -phiTableSimd = DVS.constructN 256 go - where go :: DVS.Vector Word32 -> Word32 - go v = (snd (stateMachine vi InJson ) .<. 0) .|. +phiTableSimd = DVS.generate 256 go + where go :: Int -> Word32 + go vj = (snd (stateMachine vi InJson ) .<. 0) .|. (snd (stateMachine vi InString) .<. 8) .|. (snd (stateMachine vi InEscape) .<. 16) .|. (snd (stateMachine vi InValue ) .<. 24) - where vi = fromIntegral (DVS.length v) + where vi = fromIntegral vj {-# NOINLINE phiTableSimd #-} transitionTable :: DV.Vector (DVS.Vector Word8) -transitionTable = DV.constructN 5 gos - where gos :: DV.Vector (DVS.Vector Word8) -> DVS.Vector Word8 - gos v = DVS.constructN 256 go - where vi = DV.length v - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (fromEnum (fst (stateMachine ui (toEnum vi)))) - where ui = fromIntegral (DVS.length u) +transitionTable = DV.generate 5 gos + where gos :: Int -> DVS.Vector Word8 + gos vj = DVS.generate 256 go + where vi = fromIntegral vj + go :: Int -> Word8 + go uj = fromIntegral (fromEnum (fst (stateMachine ui (toEnum vi)))) + where ui = fromIntegral uj {-# NOINLINE transitionTable #-} transitionTable2 :: DVS.Vector Word8 -transitionTable2 = DVS.constructN (4 * fromIntegral iLen) go +transitionTable2 = DVS.generate (4 * fromIntegral iLen) go where iLen = 256 :: Int - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (fromEnum (fst (stateMachine (fromIntegral ui) (toEnum (fromIntegral uj))))) - where (uj, ui) = fromIntegral (DVS.length u) `divMod` iLen + go :: Int -> Word8 + go uj = fromIntegral (fromEnum (fst (stateMachine (fromIntegral ui) (toEnum (fromIntegral uk))))) + where (uk, ui) = fromIntegral uj `divMod` iLen {-# NOINLINE transitionTable2 #-} lookupTransitionTable :: IntState -> Word8 -> IntState @@ -81,13 +80,13 @@ {-# INLINE lookupTransitionTable #-} transitionTableSimd :: DVS.Vector Word64 -transitionTableSimd = DVS.constructN 256 go - where go :: DVS.Vector Word64 -> Word64 - go v = fromIntegral (fromEnum (fst (stateMachine vi InJson ))) .|. +transitionTableSimd = DVS.generate 256 go + where go :: Int -> Word64 + go vj = fromIntegral (fromEnum (fst (stateMachine vi InJson ))) .|. fromIntegral (fromEnum (fst (stateMachine vi InString))) .|. fromIntegral (fromEnum (fst (stateMachine vi InEscape))) .|. fromIntegral (fromEnum (fst (stateMachine vi InValue ))) - where vi = fromIntegral (DVS.length v) + where vi = fromIntegral vj {-# NOINLINE transitionTableSimd #-} stateMachine :: Word8 -> State -> (State, Word32) diff --git a/src/HaskellWorks/Data/Json/Standard/Cursor/SemiIndex.hs b/src/HaskellWorks/Data/Json/Standard/Cursor/SemiIndex.hs --- a/src/HaskellWorks/Data/Json/Standard/Cursor/SemiIndex.hs +++ b/src/HaskellWorks/Data/Json/Standard/Cursor/SemiIndex.hs @@ -219,16 +219,16 @@ where makePreSiChunk :: DVS.Vector Word64 -> PreSiChunk (DVS.Vector Word64) makePreSiChunk v = PreSiChunk (makeIb v) (makeBpOp v) (makeBpCl v) makeIb :: DVS.Vector Word64 -> DVS.Vector Word64 - makeIb v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go - where go :: DVS.Vector Word16 -> Word16 - go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x4444444444444444) + makeIb v = asVector64 $ BS.toByteString $ DVS.generate (DVS.length v) go + where go :: Int -> Word16 + go uj = let ui = fromIntegral uj in fromIntegral (pext (DVS.unsafeIndex v ui) 0x4444444444444444) makeBpOp :: DVS.Vector Word64 -> DVS.Vector Word64 - makeBpOp v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go - where go :: DVS.Vector Word16 -> Word16 - go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x2222222222222222) - makeBpCl v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go - where go :: DVS.Vector Word16 -> Word16 - go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x1111111111111111) + makeBpOp v = asVector64 $ BS.toByteString $ DVS.generate (DVS.length v) go + where go :: Int -> Word16 + go uj = let ui = fromIntegral uj in fromIntegral (pext (DVS.unsafeIndex v ui) 0x2222222222222222) + makeBpCl v = asVector64 $ BS.toByteString $ DVS.generate (DVS.length v) go + where go :: Int -> Word16 + go uj = let ui = fromIntegral uj in fromIntegral (pext (DVS.unsafeIndex v ui) 0x1111111111111111) toIbBpBuilders :: [PreSiChunk (DVS.Vector Word64)] -> [SiChunk (DVS.Vector Word64)] toIbBpBuilders = go 0 0