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-balancedparens.cabal b/hw-balancedparens.cabal --- a/hw-balancedparens.cabal +++ b/hw-balancedparens.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-balancedparens -version: 0.3.0.2 +version: 0.3.0.3 synopsis: Balanced parentheses description: Balanced parentheses. category: Data, Bit, Succinct Data Structures, Data Structures @@ -20,21 +20,29 @@ type: git location: https://github.com/haskell-works/hw-balancedparens -common base { build-depends: base >= 4.10 && < 5 } +common base { build-depends: base >= 4.10 && < 5 } -common criterion { build-depends: criterion >= 1.2 && < 1.6 } -common deepseq { build-depends: deepseq >= 1.4.2.0 && < 1.5 } -common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 } -common hspec { build-depends: hspec >= 2.2 && < 3.0 } -common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } -common hw-bits { build-depends: hw-bits >= 0.4.0.0 && < 0.8 } -common hw-excess { build-depends: hw-excess >= 0.2.2.0 && < 0.3 } -common hw-fingertree { build-depends: hw-fingertree >= 0.1.1.0 && < 0.2 } -common hw-prim { build-depends: hw-prim >= 0.6.2.25 && < 0.7 } -common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } -common transformers { build-depends: transformers >= 0.5.6.2 && < 0.6 } -common vector { build-depends: vector >= 0.12 && < 0.13 } +common criterion { build-depends: criterion >= 1.2 && < 1.6 } +common deepseq { build-depends: deepseq >= 1.4.2.0 && < 1.5 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 } +common hspec { build-depends: hspec >= 2.2 && < 3.0 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } +common hw-bits { build-depends: hw-bits >= 0.4.0.0 && < 0.8 } +common hw-excess { build-depends: hw-excess >= 0.2.2.0 && < 0.3 } +common hw-fingertree { build-depends: hw-fingertree >= 0.1.1.0 && < 0.2 } +common hw-prim { build-depends: hw-prim >= 0.6.2.25 && < 0.7 } +common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } +common transformers { build-depends: transformers >= 0.5.2 && < 0.6 } +common vector { build-depends: vector >= 0.12 && < 0.13 } +common hw-balancedparens + build-depends: hw-balancedparens + +common hw-balancedparens-gen + build-depends: hw-balancedparens-gen + common config default-language: Haskell2010 ghc-options: -Wall -O2 -msse4.2 @@ -78,11 +86,11 @@ , deepseq , hedgehog , hspec + , hw-balancedparens , hw-prim , vector exposed-modules: HaskellWorks.Data.BalancedParens.Gen Paths_hw_balancedparens - build-depends: hw-balancedparens hs-source-dirs: gen autogen-modules: Paths_hw_balancedparens @@ -90,6 +98,8 @@ import: base, config , hedgehog , hspec + , hw-balancedparens + , hw-balancedparens-gen , hw-bits , hw-hspec-hedgehog , hw-prim @@ -104,8 +114,6 @@ HaskellWorks.Data.BalancedParens.RangeMinSpec HaskellWorks.Data.BalancedParens.SimpleSpec Paths_hw_balancedparens - build-depends: hw-balancedparens - , hw-balancedparens-gen hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N autogen-modules: Paths_hw_balancedparens @@ -115,6 +123,8 @@ import: base, config , criterion , hedgehog + , hw-balancedparens + , hw-balancedparens-gen , hw-bits , hw-prim , vector @@ -123,5 +133,15 @@ other-modules: Paths_hw_balancedparens autogen-modules: Paths_hw_balancedparens hs-source-dirs: bench - build-depends: hw-balancedparens - , hw-balancedparens-gen + +test-suite doctest + import: base, config + , doctest + , doctest-discover + , hw-balancedparens + 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/BalancedParens/Broadword.hs b/src/HaskellWorks/Data/BalancedParens/Broadword.hs --- a/src/HaskellWorks/Data/BalancedParens/Broadword.hs +++ b/src/HaskellWorks/Data/BalancedParens/Broadword.hs @@ -7,7 +7,6 @@ module HaskellWorks.Data.BalancedParens.Broadword ( findCloseW64 , ocCalc8 - , ocCalc64 , showPadded , kkBitDiffPos , kkBitDiff @@ -16,15 +15,11 @@ import Data.Int import Data.Word -import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.Broadword import qualified Data.Bits as DB -traceW :: String -> Word64 -> Word64 -traceW s w = w -- trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ show w ++ ", " ++ show (fromIntegral w :: Int64)) w - findCloseW64 :: Word64 -> Word64 findCloseW64 x = -- let !_ = traceW "x00" x in let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in -- let !_ = traceW "b00" b00 in @@ -55,68 +50,9 @@ r00 {-# INLINE findCloseW64 #-} --- µ0 :: Word64 --- µ0 = 0x5555555555555555 - -µ1 :: Word64 -µ1 = 0x3333333333333333 - -µ2 :: Word64 -µ2 = 0x0F0F0F0F0F0F0F0F - -µ3 :: Word64 -µ3 = 0x00FF00FF00FF00FF - -µ4 :: Word64 -µ4 = 0x0000FFFF0000FFFF - -µ5 :: Word64 -µ5 = 0x00000000FFFFFFFF - -ocCalc64 :: Word64 -> (Word64, Word64) -ocCalc64 x = - let b0 = x .&. 0x5555555555555555 in let !_ = traceW "b0 " b0 in - let b1 = (x .&. 0xAAAAAAAAAAAAAAAA) .>. 1 in let !_ = traceW "b1 " b1 in - let ll = (b0 .^. b1) .&. b1 in let !_ = traceW "ll " ll in - let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceW "o1 " o1 in - let c1 = ((b0 .|. b1) .^. 0x5555555555555555) .<. 1 .|. ll in let !_ = traceW "c1 " c1 in - - let eo1 = o1 .&. µ1 in let !_ = traceW "eo1" eo1 in - let ec1 = ((c1 .&. µ1) .<. 2) .>. 2 in let !_ = traceW "ec1" ec1 in - let o2 = (((o1 .&. µ1) .<. 2) .>. 2) + kBitDiffPos 8 eo1 ec1 in let !_ = traceW "o2 " o2 in - let c2 = (c1 .&. µ1) + kBitDiffPos 8 ec1 eo1 in let !_ = traceW "c2 " c2 in - - let eo2 = o2 .&. µ2 in let !_ = traceW "eo2" eo2 in - let ec2 = ((c2 .&. µ2) .<. 4) .>. 4 in let !_ = traceW "ec2" ec2 in - let o3 = (((o2 .&. µ2) .<. 4) .>. 4) + kBitDiffPos 8 eo2 ec2 in let !_ = traceW "o3 " o3 in - let c3 = (c2 .&. µ2) + kBitDiffPos 8 ec2 eo2 in let !_ = traceW "c3 " c3 in - - let eo3 = o3 .&. µ3 in let !_ = traceW "eo3" eo3 in - let ec3 = ((c3 .&. µ3) .<. 8) .>. 8 in let !_ = traceW "ec3" ec3 in - let o4 = (((o3 .&. µ3) .<. 8) .>. 8) + kBitDiffPos 8 eo3 ec3 in let !_ = traceW "o4 " o4 in - let c4 = (c3 .&. µ3) + kBitDiffPos 8 ec3 eo3 in let !_ = traceW "c4 " c4 in - - let eo4 = o4 .&. µ4 in let !_ = traceW "eo4" eo4 in - let ec4 = ((c4 .&. µ4) .<. 16) .>. 16 in let !_ = traceW "ec4" ec4 in - let o5 = (((o4 .&. µ4) .<. 16) .>. 16) + kBitDiffPos 8 eo4 ec4 in let !_ = traceW "o5 " o5 in - let c5 = (c4 .&. µ4) + kBitDiffPos 8 ec4 eo4 in let !_ = traceW "c5 " c5 in - - let eo5 = o5 .&. µ5 in let !_ = traceW "eo5" eo5 in - let ec5 = ((c5 .&. µ5) .<. 32) .>. 32 in let !_ = traceW "ec5" ec5 in - let o6 = (((o5 .&. µ5) .<. 32) .>. 32) + kBitDiffPos 8 eo5 ec5 in let !_ = traceW "o6 " o6 in - let c6 = (c5 .&. µ5) + kBitDiffPos 8 ec5 eo5 in let !_ = traceW "c6 " c6 in - - (o6, c6) - --- µµ0 :: Word8 --- µµ0 = 0x55 - µµ1 :: Word8 µµ1 = 0x33 -µµ2 :: Word8 -µµ2 = 0x0F - hh :: Int -> Word8 hh 2 = 0xaa hh 4 = 0x88 @@ -142,58 +78,39 @@ showPadded :: Show a => Int -> a -> String showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..])) -traceWW :: String -> Word8 -> Word8 -traceWW s w = w -- trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ showPadded 3 w ++ ", " ++ showPadded 3 (fromIntegral w :: Int8)) w - (.>+.) :: Word8 -> Int -> Word8 (.>+.) w n = fromIntegral ((fromIntegral w :: Int8) `DB.shift` (-n)) --- import qualified Data.Vector.Storable as DVS --- import HaskellWorks.Data.Bits.FromBitTextByteString --- import Data.Word --- import HaskellWorks.Data.BalancedParens.Broadword - ocCalc8 :: Word8 -> Word8 -> Word8 ocCalc8 p x = - let b0 = x .&. 0x55 in let !_ = traceWW "b0 " b0 in - let b1 = (x .&. 0xAA) .>. 1 in let !_ = traceWW "b1 " b1 in - let ll = (b0 .^. b1) .&. b1 in let !_ = traceWW "ll " ll in - let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceWW "o1 " o1 in - let c1 = ((b0 .|. b1) .^. 0x55) .<. 1 .|. ll in let !_ = traceWW "c1 " c1 in + let b0 = x .&. 0x55 in + let b1 = (x .&. 0xAA) .>. 1 in + let ll = (b0 .^. b1) .&. b1 in + let o1 = (b0 .&. b1) .<. 1 .|. ll in + let c1 = ((b0 .|. b1) .^. 0x55) .<. 1 .|. ll in -- arithmetic operators come first, ordered in the standard way -- followed by shifts -- .&. -- .^. -- .|. - let eo1 = o1 .&. µµ1 in let !_ = traceWW "eo1" eo1 in - let ec1 = (c1 .&. (µµ1 .<. 2)) .>. 2 in let !_ = traceWW "ec1" ec1 in - let o2 = ((o1 .&. (µµ1 .<. 2)) .>. 2) + kkBitDiffPos 4 eo1 ec1 in let !_ = traceWW "o2 " o2 in -- <- Should this be 8 or 4? - let !_ = traceWW "xxx" (kkBitDiffPos 4 ec1 eo1) in - let !_ = traceWW "yyy" (c1 .&. µµ1) in - let c2 = (c1 .&. µµ1) + kkBitDiffPos 4 ec1 eo1 in let !_ = traceWW "c2 " c2 in - - let eo2 = o2 .&. µµ2 in let !_ = traceWW "eo2" eo2 in - let ec2 = (c2 .&. (µµ2 .<. 4)) .>. 4 in let !_ = traceWW "ec2" ec2 in - let o3 = ((o2 .&. (µµ2 .<. 4)) .>. 4) + kkBitDiffPos 8 eo2 ec2 in let !_ = traceWW "o3 " o3 in - let c3 = (c2 .&. µµ2) + kkBitDiffPos 8 ec2 eo2 in let !_ = traceWW "c3 " c3 in + let eo1 = o1 .&. µµ1 in + let ec1 = (c1 .&. (µµ1 .<. 2)) .>. 2 in + let o2 = ((o1 .&. (µµ1 .<. 2)) .>. 2) + kkBitDiffPos 4 eo1 ec1 in + let c2 = (c1 .&. µµ1) + kkBitDiffPos 4 ec1 eo1 in - let nnn = ((c2 .>. 0) .&. 15) in let !_ = traceWW "nnn" nnn in - let qqq = (((c2 .>. 0) .&. 15) - p) in let !_ = traceWW "qqq" qqq in - let bb2 = ((((c2 .>. 0) .&. 15) - p) .>+. 7) in let !_ = traceWW "bb2" bb2 in - let mm2 = bb2 .&. 15 in let !_ = traceWW "mm2" mm2 in - let pa2 = p - (c2 .&. mm2) in let !_ = traceWW "pa2" pa2 in - let pb2 = pa2 + (o2 .&. mm2) in let !_ = traceWW "pb2" pb2 in - let ss2 = 4 .&. bb2 in let !_ = traceWW "ss2" ss2 in + let bb2 = ((((c2 .>. 0) .&. 15) - p) .>+. 7) in + let mm2 = bb2 .&. 15 in + let pa2 = p - (c2 .&. mm2) in + let pb2 = pa2 + (o2 .&. mm2) in + let ss2 = 4 .&. bb2 in - -- let nnn = ((c1 .>. fromIntegral ss2) .&. 3) in let !_ = traceWW "nnn" nnn in - -- let qqq = (((c1 .>. fromIntegral ss2) .&. 3) - pb2) in let !_ = traceWW "qqq" qqq in - let bb1 = ((((c1 .>. fromIntegral ss2) .&. 3) - pb2) .>+. 7) in let !_ = traceWW "bb1" bb1 in - let mm1 = bb1 .&. 3 in let !_ = traceWW "mm1" mm1 in - let pa1 = pa2 - (c1 .&. mm1) in let !_ = traceWW "pa1" pa1 in - let pb1 = pa1 + (o1 .&. mm1) in let !_ = traceWW "pb1" pb1 in - let ss1 = ss2 + (2 .&. bb1) in let !_ = traceWW "ss1" ss1 in + let bb1 = ((((c1 .>. fromIntegral ss2) .&. 3) - pb2) .>+. 7) in + let mm1 = bb1 .&. 3 in + let pa1 = pa2 - (c1 .&. mm1) in + let pb1 = pa1 + (o1 .&. mm1) in + let ss1 = ss2 + (2 .&. bb1) in - let rrr = ss1 + pb1 + (((x .>. fromIntegral ss1) .&. ((pb1 .<. 1) .|. 1)) .<. 1) in let !_ = traceWW "rrr" rrr in + let rrr = ss1 + pb1 + (((x .>. fromIntegral ss1) .&. ((pb1 .<. 1) .|. 1)) .<. 1) in rrr diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs --- a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs +++ b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} @@ -68,6 +69,10 @@ instance Monoid Measure where mempty = Measure 0 0 0 +#if MIN_VERSION_GLASGOW_HASKELL(8, 4, 4, 0) +#else + mappend = (<>) +#endif instance FT.Measured Measure Elem where measure (Elem w size) = Measure { min, excess, size }