diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright John Ky (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,143 @@ +# succinct + +[![master](https://circleci.com/gh/haskell-works/succinct/tree/master.svg?style=svg)](https://circleci.com/gh/haskell-works/succinct/tree/master) + +`succinct` is a succinct JSON parsing library. + +It uses succinct data-structures to allow traversal of large JSON strings with minimal memory overhead. + +For an example, see [`app/Main.hs`](../master/app/Main.hs) + +## Prerequisites + +* `cabal` version `2.2` or later +* Depending on your use case you may need additional package dependencies. These can be found in the library dependencies of the examples + library component in the cabal file. + +## Memory benchmark + +If you need a repl to run any of the Haskell examples in this README, please run the command: + +```bash +cabal v2-repl lib:examples +``` + +For rexamples these examples are also found in Haskell modules under the `examples` directory. + +### Parsing large Json files in Scala with Argonaut + +```text + S0U EU OU MU CCSU CMD +--------- --------- ----------- -------- -------- --------------------------------------------------------------- + 0.0 80,526.3 76,163.6 72,338.6 13,058.6 sbt console + 0.0 536,660.4 76,163.6 72,338.6 13,058.6 import java.io._, argonaut._, Argonaut._ + 0.0 552,389.1 76,163.6 72,338.6 13,058.6 val file = new File("/Users/jky/Downloads/78mbs.json" + 0.0 634,066.5 76,163.6 72,338.6 13,058.6 val array = new Array[Byte](file.length.asInstanceOf[Int]) + 0.0 644,552.3 76,163.6 72,338.6 13,058.6 val is = new FileInputStream("/Users/jky/Downloads/78mbs.json") + 0.0 655,038.1 76,163.6 72,338.6 13,058.6 is.read(array) +294,976.0 160,159.7 1,100,365.0 79,310.8 13,748.1 val json = new String(array) +285,182.9 146,392.6 1,956,264.5 82,679.8 14,099.6 val data = Parse.parse(json) + *********** +``` + +### Parsing large Json files in Haskell with Aeson + +```haskell +-- CMD -- Mem (MB) +---------------------------------------------------------- -- -------- +import Control.DeepSeq -- 345 +import Data.Aeson -- 371 +import qualified Data.ByteString.Lazy as LBS -- 376 +!bs <- LBS.readFile "corpus/bench/hospitalisation.json" -- 380 +let !y = decode bs :: Maybe Value -- 928 +``` + +### Parsing large Json files in Haskell with succinct + +```haskell +-- CMD -- Mem (MB) +----------------------------------------------------------------- -- -------- +import qualified Data.Succinct.ByteString as BS -- 351 +import qualified Data.Succinct.Json.Standard.Cursor.Fast as JCF -- 353 + +!jsonBs <- BS.mmap "corpus/bench/hospitalisation.json" -- 355 +let !ibip = JCF.simdToIbBp jsonBs -- 358 +let !c = JCF.fromBsIbBp jsonBs ibip -- 495 +``` + +## Examples + +### Navigation example + +```haskell +import Control.Monad + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Fast as JCF +import qualified Data.Succinct.TreeCursor as TC + +let fc = TC.firstChild +let ns = TC.nextSibling +let pn = TC.parent +let ss = TC.subtreeSize +let jsonBs = "[null, {\"field\": 1}]" :: BS.ByteString +let ibip = JCF.simdToIbBp jsonBs +let cursor = JCF.fromBsIbBp jsonBs ibip +fc cursor +(fc >=> ns) cursor +``` + +### Querying example + +```haskell +import Control.Monad +import Data.Function +import Data.List +import Data.Succinct.Json.PartialValue +import Data.Succinct.Json.Standard.Cursor.Load.Cursor +import Data.Succinct.Json.Standard.Load.Partial +import Data.Succinct.MQuery +import Data.Succinct.MQuery.Micro + +import qualified Data.DList as DL + +!cursor <- loadPartial "corpus/bench/78mb.json" +!cursor <- loadCursorWithIndex "corpus/bench/78mb.json" +!cursor <- loadCursor "corpus/bench/78mb.json" +!cursor <- loadCursorWithCsPoppyIndex "corpus/bench/78mb.json" +let !json = jsonPartialJsonValueAt cursor +let q = MQuery (DL.singleton json) + +putPretty $ q >>= item & limit 10 +putPretty $ q >>= item & page 10 1 +putPretty $ q >>= item >>= hasKV "founded_year" (JsonPartialNumber 2005) & limit 10 +putPretty $ q >>= item >>= entry +putPretty $ q >>= item >>= entry >>= named "name" & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code") +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code") & onList (uniq . sort) +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount") & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & aggregate sum + +putPretty $ q >>= item & limit 10 +putPretty $ q >>= item & page 10 1 +putPretty $ q >>= item >>= entry +putPretty $ q >>= item >>= entry >>= named "name" & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) & onList (uniq . sort) +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount") & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & limit 10 +putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & aggregate sum +``` + +## References + +* [Semi-Indexing Semi-Structured Data in Tiny Space](http://www.di.unipi.it/~ottavian/files/semi_index_cikm.pdf) +* [Succinct Data Structures talk by Edward Kmett](https://www.youtube.com/watch?v=uA0Z7_4J7u8) +* [Typed Tagless Final Interpreters](http://okmij.org/ftp/tagless-final/course/lecture.pdf) + +## Special mentions + +* [Sydney Paper Club](http://www.meetup.com/Sydney-Paper-Club/) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/components/succinct-core-gen/src/Data/Succinct/BalancedParens/Gen.hs b/components/succinct-core-gen/src/Data/Succinct/BalancedParens/Gen.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core-gen/src/Data/Succinct/BalancedParens/Gen.hs @@ -0,0 +1,82 @@ +module Data.Succinct.BalancedParens.Gen + ( BP(..) + , count + , bpBools + , showBps + , storableVector + , vector + , vec2 + , randomRm + , randomRm2 + ) where + +import Data.Coerce +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Positioning +import Hedgehog + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.RangeMin as RM +import qualified Data.Succinct.BalancedParens.RangeMin2 as RM2 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Use guards" -} + +count :: MonadGen m => Range Count -> m Count +count r = coerce <$> G.word64 (coerce <$> r) + +data LR a = L a Int | R a Int deriving (Eq, Show) + +newtype BP = BP [Bool] deriving (Eq, Generic) + +showBps :: [Bool] -> String +showBps = fmap fromBool + where fromBool True = '(' + fromBool False = ')' + +bpBools' :: MonadGen m => Int -> (Int, [Bool], [Bool], Int) -> m [Bool] +bpBools' n (ln, lt, rt, rn) = if n <= 0 + then return (reverse lt <> rt) + else if ln - rn >= n + then return (reverse lt <> replicate n False <> rt) + else if rn - ln >= n + then return (reverse lt <> replicate n True <> rt) + else do + decision <- case (ln, rn) of + (0, 0) -> G.element [L '(' 1, R ')' 1] + (0, _) -> G.element [L '(' 1, R '(' (-1), R ')' 1] + (_, 0) -> G.element [L '(' 1, L ')' (-1), R ')' 1] + _ -> G.element [L '(' 1, R ')' 1] + + case decision of + L p d -> bpBools' (n - 1) (ln + d, toBool p:lt, rt, rn ) + R p d -> bpBools' (n - 1) (ln , lt, toBool p:rt, rn + d) + where toBool '(' = True + toBool _ = False + +bpBools :: MonadGen m => Range Int -> m [Bool] +bpBools r = do + n <- G.int r + bpBools' (n * 2) (0, [], [], 0) + +storableVector :: (MonadGen m, DVS.Storable a) => Range Int -> m a -> m (DVS.Vector a) +storableVector r g = DVS.fromList <$> G.list r g + +vector :: MonadGen m => Range Int -> m a -> m (DV.Vector a) +vector r g = DV.fromList <$> G.list r g + +vec2 :: MonadGen m => m a -> m (a, a) +vec2 g = (,) <$> g <*> g + +randomRm :: MonadGen m => Range Int -> m (RM.RangeMin (DVS.Vector Word64)) +randomRm r = do + v <- storableVector (fmap (64 *) r) (G.word64 R.constantBounded) + return (RM.mkRangeMin v) + +randomRm2 :: MonadGen m => Range Int -> m (RM2.RangeMin2 (DVS.Vector Word64)) +randomRm2 r = do + v <- storableVector (fmap (64 *) r) (G.word64 R.constantBounded) + return (RM2.mkRangeMin2 v) diff --git a/components/succinct-core-gen/src/Data/Succinct/BalancedParens/Internal/IO.hs b/components/succinct-core-gen/src/Data/Succinct/BalancedParens/Internal/IO.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core-gen/src/Data/Succinct/BalancedParens/Internal/IO.hs @@ -0,0 +1,12 @@ +module Data.Succinct.BalancedParens.Internal.IO + ( safeListDirectory + ) where + +import qualified System.Directory as IO + +safeListDirectory :: FilePath -> IO [FilePath] +safeListDirectory fp = do + exists <- IO.doesDirectoryExist fp + if exists + then IO.listDirectory fp + else return [] diff --git a/components/succinct-core/bench/Bench/BalancedParens.hs b/components/succinct-core/bench/Bench/BalancedParens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/bench/Bench/BalancedParens.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} + +module Bench.BalancedParens + ( mkBenchBalancedParens + ) where + +import Control.DeepSeq +import Control.Lens ((^.)) +import Control.Monad +import Criterion.Main +import Data.Generics.Product.Any +import Data.Maybe +import Data.Word +import GHC.Generics +import Data.Succinct.BalancedParens.FindClose +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Type +import HaskellWorks.Data.Bits.FromBitTextByteString +import HaskellWorks.Data.Naive + +import qualified Data.List as L +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.FindClose as CLS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64 as BWV64 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BW64 +import qualified Data.Succinct.BalancedParens.Internal.IO as IO +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64 as SW64 +import qualified Data.Succinct.BalancedParens.RangeMin as RM +import qualified Data.Succinct.BalancedParens.RangeMin2 as RM2 +import qualified HaskellWorks.Data.FromForeignRegion as IO +import qualified HaskellWorks.Data.Length as HW +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Monoid law, left identity" -} + +setupEnvVector :: Int -> IO (DVS.Vector Word64) +setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0])) + +setupEnvRmVector :: Int -> IO (RM.RangeMin (DVS.Vector Word64)) +setupEnvRmVector n = return $ RM.mkRangeMin $ DVS.fromList (take n (cycle [maxBound, 0])) + +setupEnvRm2Vector :: Int -> IO (RM2.RangeMin2 (DVS.Vector Word64)) +setupEnvRm2Vector n = return $ RM2.mkRangeMin2 $ DVS.fromList (take n (cycle [maxBound, 0])) + +setupEnvBP2 :: IO Word64 +setupEnvBP2 = return $ DVS.head (fromBitTextByteString "10") + +setupEnvBP4 :: IO Word64 +setupEnvBP4 = return $ DVS.head (fromBitTextByteString "1100") + +setupEnvBP8 :: IO Word64 +setupEnvBP8 = return $ DVS.head (fromBitTextByteString "11101000") + +setupEnvBP16 :: IO Word64 +setupEnvBP16 = return $ DVS.head (fromBitTextByteString "11111000 11100000") + +setupEnvBP32 :: IO Word64 +setupEnvBP32 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11100000") + +setupEnvBP64 :: IO Word64 +setupEnvBP64 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11101000 11101000 11101000 11101000 11100000") + +benchWord64 :: [Benchmark] +benchWord64 = foldMap mkBenchWord64Group [0 .. 64] + where mkBenchWord64Group :: Word64 -> [Benchmark] + mkBenchWord64Group r = let w = (1 .<. r) - 1 in + [ bgroup "Word64" + [ bench ("Broadword find close " <> bitShow w) (whnf (BW64.findUnmatchedCloseFar 0 0) w) + , bench ("Naive find close " <> bitShow w) (whnf (SW64.findUnmatchedCloseFar 0 0) w) + , bench ("Super naive find close " <> bitShow w) (whnf ((`findClose` 1) . Naive ) w) + ] + ] + +benchVector :: [Benchmark] +benchVector = + [ bgroup "Vector" + [ env setupEnvBP2 $ \w -> bgroup "FindClose 2-bit" + [ bench "Broadword" (whnf (findClose (Broadword w)) 1) + , bench "Naive" (whnf (findClose (Naive w)) 1) + ] + , env setupEnvBP4 $ \w -> bgroup "FindClose 4-bit" + [ bench "Broadword" (whnf (findClose (Broadword w)) 1) + , bench "Naive" (whnf (findClose (Naive w)) 1) + ] + , env setupEnvBP8 $ \w -> bgroup "FindClose 8-bit" + [ bench "Broadword" (whnf (findClose (Broadword w)) 1) + , bench "Naive" (whnf (findClose (Naive w)) 1) + ] + , env setupEnvBP16 $ \w -> bgroup "FindClose 16-bit" + [ bench "Broadword" (whnf (findClose (Broadword w)) 1) + , bench "Naive" (whnf (findClose (Naive w)) 1) + ] + , env setupEnvBP32 $ \w -> bgroup "FindClose 32-bit" + [ bench "Broadword" (whnf (findClose (Broadword w)) 1) + , bench "Naive" (whnf (findClose (Naive w)) 1) + ] + , env setupEnvBP64 $ \w -> bgroup "FindClose 64-bit" + [ bench "Broadword" (whnf (findClose (Broadword w)) 1) + , bench "Naive" (whnf (findClose (Naive w)) 1) + ] + , env (setupEnvVector 1000000) $ \bv -> bgroup "Vanilla" + [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000]) + ] + ] + ] + +benchRm :: [Benchmark] +benchRm = + [ bgroup "Rm" + [ env (G.sample (G.storableVector (R.singleton 1000) (G.word64 R.constantBounded))) $ \v -> bgroup "Vector64" + [ bench "mkRangeMin" (nf RM.mkRangeMin v) + ] + , env (setupEnvRmVector 1000000) $ \bv -> bgroup "RangeMin" + [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000]) + ] + ] + ] + +benchRm2 :: [Benchmark] +benchRm2 = + [ bgroup "Rm2" + [ env (G.sample (G.storableVector (R.singleton 1000) (G.word64 R.constantBounded))) $ \v -> bgroup "Vector64" + [ bench "mkRangeMin2" (nf RM2.mkRangeMin2 v) + ] + , env (setupEnvRm2Vector 1000000) $ \bv -> bgroup "RangeMin2" + [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000]) + ] + ] + ] + +data EnvCorpusVector = EnvCorpusVector + { vector :: DVS.Vector Word64 + , rmm2 :: RM2.RangeMin2 (DVS.Vector Word64) + } deriving (Generic, NFData) + +mkEnvCorpusVector :: FilePath -> IO EnvCorpusVector +mkEnvCorpusVector file = do + myVector <- IO.mmapFromForeignRegion file + let myRmm2 = RM2.mkRangeMin2 myVector + return EnvCorpusVector + { vector = myVector + , rmm2 = myRmm2 + } + +mkBenchCorpusVector :: IO [Benchmark] +mkBenchCorpusVector = do + entries <- IO.safeListDirectory "components/succinct-balancedparens/data/bench" + let files = L.sort (("components/succinct-balancedparens/data/bench/" ++) <$> (".ib.idx" `L.isSuffixOf`) `filter` entries) + benchmarks <- forM files $ \file -> return + [ env (mkEnvCorpusVector file) $ \e -> bgroup "Loading lazy byte string into Word64s" $ mempty + <> [bench ("BWV64.findClose with sum " <> file) (whnf (sum . mapMaybe (BWV64.findClose (e ^. the @"vector"))) [1 .. HW.length (e ^. the @"vector") * 64])] + <> [bench ("CLS.findClose with sum " <> file) (whnf (sum . mapMaybe (CLS.findClose (e ^. the @"rmm2" ))) [1 .. HW.length (e ^. the @"vector") * 64])] + ] + return (join benchmarks) + +mkBenchBalancedParens :: IO [Benchmark] +mkBenchBalancedParens = do + benchCorpusVectorBroadword <- mkBenchCorpusVector + + return $ mempty + <> benchWord64 + <> benchVector + <> benchRm + <> benchRm2 + <> benchCorpusVectorBroadword diff --git a/components/succinct-core/bench/Bench/Excess.hs b/components/succinct-core/bench/Bench/Excess.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/bench/Bench/Excess.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE BangPatterns #-} + +module Bench.Excess + ( makeBenchExcess + , runBenchExcess + ) where + +import Criterion.Main +import Data.Word +import Data.Succinct.Excess.MinMaxExcess0 +import Data.Succinct.Excess.MinMaxExcess1 +import Data.Succinct.Excess.PartialMinMaxExcess0 +import Data.Succinct.Excess.PartialMinMaxExcess1 +import Data.Succinct.Excess.Triplet +import HaskellWorks.Data.Vector.AsVector64 + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector.Storable as DVS + +setupEnvExcess :: Int -> IO (DVS.Vector Word64) +setupEnvExcess n = do + lbs <- LBS.readFile "/dev/random" + return (asVector64 (LBS.toStrict (LBS.take (fromIntegral n) lbs))) + +runPartialMinMaxExcess0Vector :: DVS.Vector Word64 -> IO () +runPartialMinMaxExcess0Vector v = do + let !_ = DVS.foldl go 0 v + + return () + where go :: Int -> Word64 -> Int + go a b = a + lo + ex + hi + where c = fromIntegral b :: Word64 + Triplet lo ex hi = partialMinMaxExcess0 64 c + +runPartialMinMaxExcess1Vector :: DVS.Vector Word64 -> IO () +runPartialMinMaxExcess1Vector v = do + let !_ = DVS.foldl go 0 v + + return () + where go :: Int -> Word64 -> Int + go a b = a + lo + ex + hi + where c = fromIntegral b :: Word64 + Triplet lo ex hi = partialMinMaxExcess1 64 c + +runMinMaxExcess0VectorElems :: DVS.Vector Word64 -> IO () +runMinMaxExcess0VectorElems v = do + let !_ = DVS.foldl go 0 v + + return () + where go :: Int -> Word64 -> Int + go a b = a + lo + ex + hi + where Triplet lo ex hi = minMaxExcess0 (b :: Word64) + +runMinMaxExcess1VectorElems :: DVS.Vector Word64 -> IO () +runMinMaxExcess1VectorElems v = do + let !_ = DVS.foldl go 0 v + + return () + where go :: Int -> Word64 -> Int + go a b = a + lo + ex + hi + where Triplet lo ex hi = minMaxExcess1 (b :: Word64) + +runMinMaxExcess0Vector :: DVS.Vector Word64 -> IO () +runMinMaxExcess0Vector v = do + let !_ = minMaxExcess1 v + + return () + +runMinMaxExcess1Vector :: DVS.Vector Word64 -> IO () +runMinMaxExcess1Vector v = do + let !_ = minMaxExcess1 v + + return () + +makeBenchExcess :: IO [Benchmark] +makeBenchExcess = return + [ env (setupEnvExcess (1024 * 1024)) $ \v -> bgroup "MinMaxExcess Vector" + [ bench "MinMaxExcess0" (whnfIO (runMinMaxExcess0VectorElems v)) + , bench "MinMaxExcess1" (whnfIO (runMinMaxExcess1VectorElems v)) + , bench "MinMaxExcess0" (whnfIO (runMinMaxExcess0Vector v)) + , bench "MinMaxExcess1" (whnfIO (runMinMaxExcess1Vector v)) + ] + , env (setupEnvExcess (1024 * 1024)) $ \v -> bgroup "PartialMinMaxExcess Vector" + [ bench "PartialMinMaxExcess0" (whnfIO (runPartialMinMaxExcess0Vector v)) + , bench "PartialMinMaxExcess1" (whnfIO (runPartialMinMaxExcess1Vector v)) + ] + ] + +runBenchExcess :: IO () +runBenchExcess = do + benchmarks <- mconcat <$> sequence + [ makeBenchExcess + ] + defaultMain benchmarks diff --git a/components/succinct-core/bench/Bench/RankSelect.hs b/components/succinct-core/bench/Bench/RankSelect.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/bench/Bench/RankSelect.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE BangPatterns #-} + +module Bench.RankSelect + ( mkBenchRankSelect + , runCsPoppyBuild + ) where + +import Control.Monad +import Criterion.Main +import Data.List +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy +import Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import Data.Succinct.RankSelect.CsPoppy.Internal.Reference +import Data.Succinct.RankSelect.CsPoppy.Internal.Vector +import Data.Succinct.RankSelect.Poppy512 +import Data.Word +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.FromForeignRegion +import System.Directory + +import qualified Data.Succinct.RankSelect.CsPoppy as CS +import qualified Data.Succinct.RankSelect.Poppy512 as P512 +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +benchCsPoppyBuild :: IO [Benchmark] +benchCsPoppyBuild = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \bitString -> bgroup filename + [ bench "CsPoppy Build" (whnf CS.makeCsPoppy bitString) + ] + +benchCsPoppyRank1 :: IO [Benchmark] +benchCsPoppyRank1 = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \(v :: CsPoppy) -> bgroup filename + [ bench "CsPoppy Rank1" (whnf (rank1 v) 100) + ] + +benchCsPoppySelect1 :: IO [Benchmark] +benchCsPoppySelect1 = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \(rsbs :: CsPoppy) -> bgroup filename + [ bench "CsPoppy Select1" (whnf (go rsbs 1 (popCount1 rsbs) ((popCount1 rsbs `div` 100) + 1)) 0) + ] + go rsbs a z step acc | a <= z = go rsbs (a + step) z step (select1 rsbs a + acc) + go _ _ _ _ acc = acc + {-# INLINE go #-} + +benchPoppy512Build :: IO [Benchmark] +benchPoppy512Build = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \bitString -> bgroup filename + [ bench "Poppy512 Build" (whnf P512.makePoppy512 bitString) + ] + +benchPoppy512Rank1 :: IO [Benchmark] +benchPoppy512Rank1 = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \(rsbs :: Poppy512) -> bgroup filename + [ bench "Poppy512 Rank1" (whnf (rank1 rsbs) 100) + ] + +benchPoppy512Select1 :: IO [Benchmark] +benchPoppy512Select1 = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \(rsbs :: Poppy512) -> bgroup filename + [ bench "Poppy512 Select1" (whnf (go rsbs 1 (popCount1 rsbs) ((popCount1 rsbs `div` 100) + 1)) 0) + ] + go rsbs a z step acc | a <= z = go rsbs (a + step) z step (select1 rsbs a + acc) + go _ _ _ _ acc = acc + {-# INLINE go #-} + +runCsPoppyBuild :: IO () +runCsPoppyBuild = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + forM_ files $ \file -> do + msbs :: CsPoppy <- mmapFromForeignRegion file + let !_ = select1 msbs 1 + return () + +benchMakeCsPoppyBlocks :: IO [Benchmark] +benchMakeCsPoppyBlocks = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \(v :: DVS.Vector Word64) -> bgroup filename + [ bench "makeCsPoppyBlocks" (whnf makeCsPoppyBlocks v) + ] + +benchMakeCsPoppyLayerM :: IO [Benchmark] +benchMakeCsPoppyLayerM = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mkEnv filename) $ \(v :: DVS.Vector Word64) -> bgroup filename + [ bench "makeCsPoppyLayerM" (whnf makeCsPoppyLayerM v) + , bench "makeCsPoppyLayerM2" (whnf makeCsPoppyLayerM2 v) + ] + mkEnv filename = do + !v <- mmapFromForeignRegion filename + return (makeCsPoppyBlocks v) + +benchGenCsSamples :: IO [Benchmark] +benchGenCsSamples = do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return (mkBenchmark <$> files) + where mkBenchmark filename = env (mkEnv filename) $ \ ~(pc, v :: DVS.Vector Word64) -> bgroup filename + [ bench "benchGenCsSamples" (whnf (genCsSamples pc) v) + ] + mkEnv filename = do + !v <- mmapFromForeignRegion filename + let !blocks = makeCsPoppyBlocks v + let !layerM = makeCsPoppyLayerM blocks + return (getCsiTotal (CsInterleaved (lastOrZero layerM)), v) + +mkBenchRankSelect :: IO [Benchmark] +mkBenchRankSelect = do + benchmarks <- (concat <$>) $ sequence $ [] + <> [benchCsPoppyBuild] + <> [benchCsPoppyRank1] + <> [benchCsPoppySelect1] + <> [benchPoppy512Build] + <> [benchPoppy512Rank1] + <> [benchPoppy512Select1] + <> [benchMakeCsPoppyBlocks] + <> [benchMakeCsPoppyLayerM] + <> [benchGenCsSamples] + when (null benchmarks) $ putStrLn "Warning: No benchmarks found" + pure benchmarks diff --git a/components/succinct-core/bench/Bench/RankSelectBase.hs b/components/succinct-core/bench/Bench/RankSelectBase.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/bench/Bench/RankSelectBase.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Bench.RankSelectBase + ( benchRankSelectBase + ) where + +import Criterion.Main +import Data.Word +import Data.Succinct.RankSelect.Base +import Data.Succinct.RankSelect.Base.Internal + +import qualified Data.Vector.Storable as DVS + +setupEnvVector :: Int -> IO (DVS.Vector Word64) +setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0])) + +benchRankSelectBase :: [Benchmark] +benchRankSelectBase = + [ env (return ()) $ \_ -> bgroup "8-bit" + [ bench "Rank - Once" (whnf (rank1 (0x55 :: Word8)) 8) + , bench "Select - Once" (whnf (select1 (0x55 :: Word8)) 8) + ] + , env (return ()) $ \_ -> bgroup "16-bit" + [ bench "Rank - Once" (whnf (rank1 (0x5555 :: Word16)) 16) + , bench "Select - Once" (whnf (select1 (0x5555 :: Word16)) 16) + ] + , env (return ()) $ \_ -> bgroup "32-bit" + [ bench "Rank - Once" (whnf (rank1 (0x55555555 :: Word32)) 32) + , bench "Select - Once" (whnf (select1 (0x55555555 :: Word32)) 32) + ] + , env (return ()) $ \_ -> bgroup "64-bit" + [ bench "Rank - Once" (whnf (rank1 (0x5555555555555555 :: Word64)) 64) + , bench "Select - Once" (whnf (select1 (0x5555555555555555 :: Word64)) 64) + ] + , env (setupEnvVector 1000000) $ \bv -> bgroup "64-bit vector" + [ bench "Rank - Once" (whnf (rank1 bv) 1) + , bench "Select - Once" (whnf (select1 bv) 1) + , bench "Rank - Many" (nf (map (rank1 bv)) [0, 1000..10000000]) + ] + , env (return ()) $ \_ -> bgroup "64-bit" + [ bench "Once: Rank1" (whnf (rank1 (0x5555555555555555 :: Word64)) 64) + , bench "Once: Select1 Class" (whnf (select1 (0x5555555555555555 :: Word64)) 64) + , bench "Once: Select1 Function" (whnf (select1Word64 (0x5555555555555555 :: Word64)) 64) + , bench "Once: Select1 Broadword" (whnf (select1Word64Broadword (0x5555555555555555 :: Word64)) 64) + , bench "Once: Select1 Bmi2" (whnf (select1Word64Bmi2 (0x5555555555555555 :: Word64)) 64) + , bench "Once: Select1 Bmi2Base0" (whnf (select1Word64Bmi2Base0 (0x5555555555555555 :: Word64)) 64) + ] + , env (return ()) $ \_ -> bgroup "32-bit" + [ bench "Once: Rank1" (whnf (rank1 (0x55555555 :: Word32)) 32) + , bench "Once: Select1 Class" (whnf (select1 (0x55555555 :: Word32)) 32) + , bench "Once: Select1 Function" (whnf (select1Word32 (0x55555555 :: Word32)) 32) + , bench "Once: Select1 Broadword" (whnf (select1Word32Broadword (0x55555555 :: Word32)) 32) + , bench "Once: Select1 Bmi2" (whnf (select1Word32Bmi2 (0x55555555 :: Word32)) 32) + ] + ] diff --git a/components/succinct-core/bench/Main.hs b/components/succinct-core/bench/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/bench/Main.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Bench.BalancedParens +import Bench.Excess +import Bench.RankSelect +import Bench.RankSelectBase +import Criterion.Main +import Data.Bits.Pdep + +main :: IO () +main = do + putStrLn $ "Fast pdep enabled: " <> show fastPdepEnabled + benchExcess <- mconcat <$> sequence + [ makeBenchExcess + ] + benchBalancedParens <- mkBenchBalancedParens + benchRankSelect <- mkBenchRankSelect + + defaultMain $ mconcat + [ benchRankSelect + , benchRankSelectBase + , benchExcess + , benchBalancedParens + ] diff --git a/components/succinct-core/doctest/DoctestDriver.hs b/components/succinct-core/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-core/doctest/config.json #-} +#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/components/succinct-core/src/Data/Succinct/BalancedParens.hs b/components/succinct-core/src/Data/Succinct/BalancedParens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens.hs @@ -0,0 +1,13 @@ +module Data.Succinct.BalancedParens + ( module X + ) where + +import Data.Succinct.BalancedParens.BalancedParens as X +import Data.Succinct.BalancedParens.CloseAt as X +import Data.Succinct.BalancedParens.Enclose as X +import Data.Succinct.BalancedParens.FindClose as X +import Data.Succinct.BalancedParens.FindCloseN as X +import Data.Succinct.BalancedParens.FindOpen as X +import Data.Succinct.BalancedParens.FindOpenN as X +import Data.Succinct.BalancedParens.OpenAt as X +import Data.Succinct.BalancedParens.Simple as X diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/BalancedParens.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/BalancedParens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/BalancedParens.hs @@ -0,0 +1,71 @@ +module Data.Succinct.BalancedParens.BalancedParens ( + BalancedParens (..), + depth, + subtreeSize, +) where + +import Control.Monad +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.OpenAt +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Vector.Storable qualified as DVS +import Data.Word +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +class (OpenAt v, CloseAt v, FindOpen v, FindClose v, Enclose v) => BalancedParens v where + -- TODO Second argument should be Int + firstChild :: v -> Count -> Maybe Count + firstChild v p = if openAt v p && openAt v (p + 1) then Just (p + 1) else Nothing + {-# INLINE firstChild #-} + + nextSibling :: v -> Count -> Maybe Count + nextSibling v p = + if closeAt v p + then Nothing + else + openAt v + `mfilter` ( findClose v p + >>= ( \q -> + if p /= q + then return (q + 1) + else Nothing + ) + ) + {-# INLINE nextSibling #-} + + parent :: v -> Count -> Maybe Count + parent v p = enclose v p >>= (\r -> if r >= 1 then return r else Nothing) + {-# INLINE parent #-} + +depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Maybe Count +depth v p = (\q -> rank1 v q - rank0 v q) <$> findOpen v p +{-# INLINE depth #-} + +subtreeSize :: (BalancedParens v) => v -> Count -> Maybe Count +subtreeSize v p = (\q -> (q - p + 1) `quot` 2) <$> findClose v p +{-# INLINE subtreeSize #-} + +instance BalancedParens [Bool] + +instance BalancedParens (DVS.Vector Word8) + +instance BalancedParens (DVS.Vector Word16) + +instance BalancedParens (DVS.Vector Word32) + +instance BalancedParens (DVS.Vector Word64) + +instance BalancedParens Word8 + +instance BalancedParens Word16 + +instance BalancedParens Word32 + +instance BalancedParens Word64 + +instance BalancedParens (Naive Word64) diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/CloseAt.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/CloseAt.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/CloseAt.hs @@ -0,0 +1,87 @@ +module Data.Succinct.BalancedParens.CloseAt + ( CloseAt(..) + ) where + +import Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Type +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +closeAt' :: (TestBit a, BitLength a) => a -> Count -> Bool +closeAt' v c = c > 0 && not (v .?. toPosition (c - 1)) || c > bitLength v +{-# INLINE closeAt' #-} + +class CloseAt v where + -- | Determine if the parenthesis at the give position (one-based) is a close. + -- + -- >>> :set -XTypeApplications + -- >>> import HaskellWorks.Data.Bits.BitRead + -- >>> import Data.Maybe + -- + -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 1 + -- False + -- + -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 2 + -- True + -- + -- If the parenthesis at the given position does not exist in the input, it is considered to be a close. + -- + -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 9 + -- True + closeAt :: v -> Count -> Bool + +instance (BitLength a, TestBit a) => CloseAt (BitShown a) where + closeAt = closeAt' . bitShown + {-# INLINE closeAt #-} + +instance CloseAt [Bool] where + closeAt = closeAt' + {-# INLINE closeAt #-} + +instance CloseAt (DVS.Vector Word8) where + closeAt = closeAt' + {-# INLINE closeAt #-} + + +instance CloseAt (DVS.Vector Word16) where + closeAt = closeAt' + {-# INLINE closeAt #-} + + +instance CloseAt (DVS.Vector Word32) where + closeAt = closeAt' + {-# INLINE closeAt #-} + + +instance CloseAt (DVS.Vector Word64) where + closeAt = closeAt' + {-# INLINE closeAt #-} + + +instance CloseAt Word8 where + closeAt = closeAt' + {-# INLINE closeAt #-} + +instance CloseAt Word16 where + closeAt = closeAt' + {-# INLINE closeAt #-} + +instance CloseAt Word32 where + closeAt = closeAt' + {-# INLINE closeAt #-} + +instance CloseAt Word64 where + closeAt = closeAt' + {-# INLINE closeAt #-} + +instance CloseAt (Naive Word64) where + closeAt = closeAt' + {-# INLINE closeAt #-} + +instance CloseAt (Broadword Word64) where + closeAt = closeAt . broadword + {-# INLINE closeAt #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Enclose.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Enclose.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Enclose.hs @@ -0,0 +1,58 @@ +module Data.Succinct.BalancedParens.Enclose + ( Enclose(..) + ) where + +import Data.Succinct.BalancedParens.FindOpenN +import Data.Word +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS + +class Enclose v where + enclose :: v -> Count -> Maybe Count + +instance (Enclose a) => Enclose (BitShown a) where + enclose = enclose . bitShown + {-# INLINE enclose #-} + +instance Enclose [Bool] where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose (DVS.Vector Word8) where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose (DVS.Vector Word16) where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose (DVS.Vector Word32) where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose (DVS.Vector Word64) where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose Word8 where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose Word16 where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose Word32 where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose Word64 where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance Enclose (Naive Word64) where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/FindClose.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/FindClose.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/FindClose.hs @@ -0,0 +1,113 @@ +module Data.Succinct.BalancedParens.FindClose + ( FindClose(..) + ) where + +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.FindCloseN +import Data.Word +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Type +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector16 as BWV16 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector32 as BWV32 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64 as BWV64 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector8 as BWV8 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.Word64 as W64 +import qualified Data.Vector.Storable as DVS + +class FindClose v where + -- | Find the closing parenthesis that machines the open parenthesis at the current position. + -- + -- If the parenthesis at the current position is an close parenthesis, then return the current position. + -- + -- Indexes are 1-based. 1 corresponds to open and 0 corresponds to close. + -- + -- If we run out of bits in the supplied bit-string, the implementation my either return Nothing, or + -- assume all the bits that follow are zeros. + -- + -- >>> :set -XTypeApplications + -- >>> import Data.Maybe + -- >>> import HaskellWorks.Data.Bits.BitRead + -- >>> findClose (fromJust (bitRead @Word64 "00000000")) 1 + -- Just 1 + -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 1 + -- Just 2 + -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 2 + -- Just 2 + -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 3 + -- Just 4 + -- >>> findClose (fromJust (bitRead @Word64 "11010010")) 1 + -- Just 6 + -- >>> findClose (fromJust (bitRead @Word64 "11110000")) 1 + -- Just 8 + findClose :: v -> Count -> Maybe Count + +instance (FindClose a) => FindClose (BitShown a) where + findClose = findClose . bitShown + {-# INLINE findClose #-} + +instance FindClose [Bool] where + findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose (DVS.Vector Word8) where + findClose = BWV8.findClose + {-# INLINE findClose #-} + +instance FindClose (DVS.Vector Word16) where + findClose = BWV16.findClose + {-# INLINE findClose #-} + +instance FindClose (DVS.Vector Word32) where + findClose = BWV32.findClose + {-# INLINE findClose #-} + +instance FindClose (DVS.Vector Word64) where + findClose = BWV64.findClose + {-# INLINE findClose #-} + +instance FindClose (Naive (DVS.Vector Word8)) where + findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose (Naive (DVS.Vector Word16)) where + findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose (Naive (DVS.Vector Word32)) where + findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose (Naive (DVS.Vector Word64)) where + findClose (Naive v) p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose Word8 where + findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose Word16 where + findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose Word32 where + findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose Word64 where + findClose = findClose . Broadword + {-# INLINE findClose #-} + +instance FindClose (Naive Word64) where + findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance FindClose (Broadword Word64) where + findClose (Broadword w) p = let x = w .>. (p - 1) in + case negate (x .&. 1) .&. W64.findUnmatchedClose x of + 127 -> Nothing + r -> let r' = fromIntegral r + p in if r' > 64 then Nothing else Just r' + {-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/FindCloseN.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/FindCloseN.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/FindCloseN.hs @@ -0,0 +1,66 @@ +module Data.Succinct.BalancedParens.FindCloseN + ( FindCloseN(..) + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic as G +import qualified Data.Vector.Storable as DVS + +class FindCloseN v where + -- | Find the position of the corresponding close parenthesis carrying in a number of open parentheses starting from a given position. + -- + -- All positions are one based. + -- + -- See the reference implementation 'G.findCloseN' for details + findCloseN :: v -> Count -> Count -> Maybe Count + +instance (CloseAt a, TestBit a, BitLength a) => FindCloseN (BitShown a) where + findCloseN = G.findCloseN . bitShown + {-# INLINE findCloseN #-} + +instance FindCloseN [Bool] where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN (DVS.Vector Word8) where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN (DVS.Vector Word16) where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN (DVS.Vector Word32) where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN (DVS.Vector Word64) where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN Word8 where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN Word16 where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN Word32 where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN Word64 where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} + +instance FindCloseN (Naive Word64) where + findCloseN = G.findCloseN + {-# INLINE findCloseN #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/FindOpen.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/FindOpen.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/FindOpen.hs @@ -0,0 +1,59 @@ +module Data.Succinct.BalancedParens.FindOpen + ( FindOpen(..) + ) where + +import Data.Word +import Data.Succinct.BalancedParens.FindOpenN +import Data.Succinct.BalancedParens.OpenAt +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS + +class FindOpen v where + findOpen :: v -> Count -> Maybe Count + +instance (FindOpen a) => FindOpen (BitShown a) where + findOpen = findOpen . bitShown + {-# INLINE findOpen #-} + +instance FindOpen [Bool] where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen (DVS.Vector Word8) where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen (DVS.Vector Word16) where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen (DVS.Vector Word32) where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen (DVS.Vector Word64) where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen Word8 where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen Word16 where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen Word32 where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen Word64 where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpen (Naive Word64) where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/FindOpenN.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/FindOpenN.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/FindOpenN.hs @@ -0,0 +1,70 @@ +module Data.Succinct.BalancedParens.FindOpenN + ( FindOpenN(..) + ) where + +import Data.Word +import Data.Succinct.BalancedParens.OpenAt +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS + +class FindOpenN v where + findOpenN :: v -> Count -> Count -> Maybe Count + +findOpen' :: (BitLength a, OpenAt a, TestBit a) => a -> Count -> Count -> Maybe Count +findOpen' v c p = if 0 < p && p <= bitLength v + then if v `openAt` p + then if c == 0 + then Just p + else findOpen' v (c - 1) (p - 1) + else findOpen' v (c + 1) (p - 1) + else Nothing +{-# INLINE findOpen' #-} + +instance (BitLength a, OpenAt a, TestBit a) => FindOpenN (BitShown a) where + findOpenN = findOpen' . bitShown + {-# INLINE findOpenN #-} + +instance FindOpenN [Bool] where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN (DVS.Vector Word8) where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN (DVS.Vector Word16) where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN (DVS.Vector Word32) where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN (DVS.Vector Word64) where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN Word8 where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN Word16 where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN Word32 where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN Word64 where + findOpenN = findOpen' + {-# INLINE findOpenN #-} + +instance FindOpenN (Naive Word64) where + findOpenN = findOpen' + {-# INLINE findOpenN #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector16.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector16.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector16.hs @@ -0,0 +1,54 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector16 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16 as BWV16 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: DVS.Vector Word16 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (BWV16.findUnmatchedCloseFar 0 p v + 1) + else Just (BWV16.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector32.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector32.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector32.hs @@ -0,0 +1,54 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector32 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32 as BWV32 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: DVS.Vector Word32 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (BWV32.findUnmatchedCloseFar 0 p v + 1) + else Just (BWV32.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector64.hs @@ -0,0 +1,54 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64 as BWV64 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: DVS.Vector Word64 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (BWV64.findUnmatchedCloseFar 0 p v + 1) + else Just (BWV64.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector8.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector8.hs @@ -0,0 +1,54 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector8 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8 as BWV8 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: DVS.Vector Word8 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (BWV8.findUnmatchedCloseFar 0 p v + 1) + else Just (BWV8.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word16.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word16.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word16.hs @@ -0,0 +1,53 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word16 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as W16 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: Word16 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (W16.findUnmatchedCloseFar 0 p v + 1) + else Just (W16.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word32.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word32.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word32.hs @@ -0,0 +1,53 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word32 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as W32 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: Word32 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (W32.findUnmatchedCloseFar 0 p v + 1) + else Just (W32.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word64.hs @@ -0,0 +1,53 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word64 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as W64 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: Word64 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (W64.findUnmatchedCloseFar 0 p v + 1) + else Just (W64.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word8.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Word8.hs @@ -0,0 +1,53 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word8 + ( findClose + ) where + +import Data.Word +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Positioning + +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 as W8 + +-- | Find the position of the matching close parenthesis. +-- +-- The position argument and return value is one-based. +-- +-- If the parenthesis at the input position is an a close, then that is considered the +-- matching close parenthesis. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 1: +-- +-- >>> findClose (fromJust $ bitRead "10000000") 1 +-- Just 2 +-- +-- >>> findClose (fromJust $ bitRead "11000000") 1 +-- Just 4 +-- +-- >>> findClose (fromJust $ bitRead "11010000") 1 +-- Just 6 +-- +-- The following scans for the matching close parenthesis for the open parenthesis at position 2: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 2 +-- Just 3 +-- +-- If the input position has a close parenthesis, then that position is returned: +-- +-- >>> findClose (fromJust $ bitRead "11010000") 3 +-- Just 3 +-- +-- The scan can continue past the end of the input word because every bit after then end of the +-- word is considered to be zero, which is a closing parenthesis: +-- +-- >>> findClose (fromJust $ bitRead "11111110") 1 +-- Just 14 +findClose :: Word8 -> Count -> Maybe Count +findClose v p = if p > 0 + then if closeAt v p + then Just p + else Just (W8.findUnmatchedCloseFar 0 p v + 1) + else Just (W8.findUnmatchedCloseFar 1 p v) +{-# INLINE findClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16.hs @@ -0,0 +1,42 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Int.Unsigned +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as BWW16 +import qualified HaskellWorks.Data.Drop as HW +import qualified HaskellWorks.Data.Length as HW + +findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word16 -> Count +findUnmatchedCloseCont i c v = if i < HW.end v + then case BWW16.findUnmatchedCloseFar c 0 w of + q -> if q >= bitLength w + then findUnmatchedCloseCont (i + 1) (q - bitLength w) v + else b + q + else b + c + where b = unsigned i * bitLength w -- base + w = v !!! fromIntegral i +{-# INLINE findUnmatchedCloseCont #-} + +findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word16 -> Count +findUnmatchedClose' c p v = if DVS.length v > 0 + then case BWW16.findUnmatchedCloseFar c p w of + q -> if q >= bitLength w + then findUnmatchedCloseCont 1 (q - bitLength w) v + else q + else p * 2 + c + where w = v !!! 0 +{-# INLINE findUnmatchedClose' #-} + +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word16 -> Count +findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd + where vi = p `div` elemBitLength v + vd = vi * elemBitLength v +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32.hs @@ -0,0 +1,42 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Int.Unsigned +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as BWW32 +import qualified HaskellWorks.Data.Drop as HW +import qualified HaskellWorks.Data.Length as HW + +findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word32 -> Count +findUnmatchedCloseCont i c v = if i < HW.end v + then case BWW32.findUnmatchedCloseFar c 0 w of + q -> if q >= bitLength w + then findUnmatchedCloseCont (i + 1) (q - bitLength w) v + else b + q + else b + c + where b = unsigned i * bitLength w -- base + w = v !!! fromIntegral i +{-# INLINE findUnmatchedCloseCont #-} + +findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word32 -> Count +findUnmatchedClose' c p v = if DVS.length v > 0 + then case BWW32.findUnmatchedCloseFar c p w of + q -> if q >= bitLength w + then findUnmatchedCloseCont 1 (q - bitLength w) v + else q + else p * 2 + c + where w = v !!! 0 +{-# INLINE findUnmatchedClose' #-} + +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word32 -> Count +findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd + where vi = p `div` elemBitLength v + vd = vi * elemBitLength v +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64.hs @@ -0,0 +1,42 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Int.Unsigned +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BWW64 +import qualified HaskellWorks.Data.Drop as HW +import qualified HaskellWorks.Data.Length as HW + +findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word64 -> Count +findUnmatchedCloseCont i c v = if i < HW.end v + then case BWW64.findUnmatchedCloseFar c 0 w of + q -> if q >= bitLength w + then findUnmatchedCloseCont (i + 1) (q - bitLength w) v + else b + q + else b + c + where b = unsigned i * bitLength w -- base + w = v !!! fromIntegral i +{-# INLINE findUnmatchedCloseCont #-} + +findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word64 -> Count +findUnmatchedClose' c p v = if DVS.length v > 0 + then case BWW64.findUnmatchedCloseFar c p w of + q -> if q >= bitLength w + then findUnmatchedCloseCont 1 (q - bitLength w) v + else q + else p * 2 + c + where w = v !!! 0 +{-# INLINE findUnmatchedClose' #-} + +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word64 -> Count +findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd + where vi = p `div` elemBitLength v + vd = vi * elemBitLength v +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8.hs @@ -0,0 +1,42 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Int.Unsigned +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 as BWW8 +import qualified HaskellWorks.Data.Drop as HW +import qualified HaskellWorks.Data.Length as HW + +findUnmatchedCloseCont :: Int64 -> Count -> DVS.Vector Word8 -> Count +findUnmatchedCloseCont i c v = if i < HW.end v + then case BWW8.findUnmatchedCloseFar c 0 w of + q -> if q >= bitLength w + then findUnmatchedCloseCont (i + 1) (q - bitLength w) v + else b + q + else b + c + where b = unsigned i * bitLength w -- base + w = v !!! fromIntegral i +{-# INLINE findUnmatchedCloseCont #-} + +findUnmatchedClose' :: Word64 -> Word64 -> DVS.Vector Word8 -> Count +findUnmatchedClose' c p v = if DVS.length v > 0 + then case BWW8.findUnmatchedCloseFar c p w of + q -> if q >= bitLength w + then findUnmatchedCloseCont 1 (q - bitLength w) v + else q + else p * 2 + c + where w = v !!! 0 +{-# INLINE findUnmatchedClose' #-} + +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word8 -> Count +findUnmatchedCloseFar c p v = findUnmatchedClose' c (p - vd) (HW.drop vi v) + vd + where vi = p `div` elemBitLength v + vd = vi * elemBitLength v +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16.hs @@ -0,0 +1,137 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Word16 +import HaskellWorks.Data.Int.Narrow +import HaskellWorks.Data.Int.Widen + +muk1 :: Word16 +muk1 = 0x3333 +{-# INLINE muk1 #-} + +muk2 :: Word16 +muk2 = 0x0f0f +{-# INLINE muk2 #-} + +muk3 :: Word16 +muk3 = 0x00ff +{-# INLINE muk3 #-} + +-- | Find the position of the first unmatch parenthesis. +-- +-- This is the broadword implementation of 'Data.Succinct.BalancedParens.Internal.Slow.Word16.findCloseFor'. +-- +-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word16 -> Word64 +findUnmatchedCloseFar c p w = + -- Keys: + -- * k1: Level of sub-words of size 2 = 1 .<. 1 + -- * k2: Level of sub-words of size 4 = 1 .<. 2 + -- * k3: Level of sub-words of size 8 = 1 .<. 3 + -- * o: Open count + -- * c: Close count + -- * e: Excess + -- * L: Left half of sub-word + -- * R: Right half of sub-word + -- * b: deficit at position whole-word mask + -- * m: deficit at position sub-word mask + -- * pa: position accumulator + -- * sa: shift accumulator + -- * f: far sub-block close parens count + let x = w .>. p in + let wsz = 16 :: Int16 in + let k1 = 1 in + let k2 = 2 in + let k3 = 3 in + let k4 = 4 in + let mask1 = (1 .<. (1 .<. k1)) - 1 in + let mask2 = (1 .<. (1 .<. k2)) - 1 in + let mask3 = (1 .<. (1 .<. k3)) - 1 in + let mask4 = (1 .<. (1 .<. k4)) - 1 in + let t64k1 = 1 .<. k1 :: Word64 in + let t64k2 = 1 .<. k2 :: Word64 in + let t64k3 = 1 .<. k3 :: Word64 in + let t8k1 = 1 .<. k1 :: Word16 in + let t8k2 = 1 .<. k2 :: Word16 in + let t8k3 = 1 .<. k3 :: Word16 in + let t8k4 = 1 .<. k4 :: Word16 in + + let b0 = x .&. 0x5555 in + let b1 = ( x .&. 0xaaaa) .>. 1 in + let ll = (b0 .^. b1 ) .&. b1 in + let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in + let ck1 = (((b0 .|. b1 ) .^. 0x5555) .<. 1) .|. ll in + + let eok1 = ok1 .&. muk1 in + let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2R = kBitDiffPos 4 eok1 eck1 in + let ok2 = ok2L + ok2R in + let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in + + let eok2 = ok2 .&. muk2 in + let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in + let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in + let ok3R = kBitDiffPos 8 eok2 eck2 in + let ok3 = ok3L + ok3R in + let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in + + let eok3 = ok3 .&. muk3 in + let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in + let ok4L = (ok3 .&. (muk3 .<. t64k3)) .>. t64k3 in + let ok4R = kBitDiffPos 16 eok3 eck3 in + let ok4 = ok4L + ok4R in + let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in + + let pak4 = c in + let sak4 = 0 in + + let hk4 = 0x0010 .&. comp (0xffff .>. fromIntegral sak4) in + let fk4 = ((ck4 .>. fromIntegral sak4) .|. hk4) .&. mask4 in + let bk4 = ((narrow pak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in + let mk4 = bk4 .&. mask4 in + let pbk4 = pak4 - widen ((ck4 .>. fromIntegral sak4) .&. mk4) in + let pck4 = pbk4 + widen ((ok4 .>. fromIntegral sak4) .&. mk4) in + let sbk4 = sak4 + widen (t8k4 .&. bk4) in + + let pak3 = pck4 in + let sak3 = sbk4 in + + let hk3 = 0x0808 .&. comp (0xffff .>. fromIntegral sak3) in + let fk3 = ((ck3 .>. fromIntegral sak3) .|. hk3) .&. mask3 in + let bk3 = ((narrow pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in + let mk3 = bk3 .&. mask3 in + let pbk3 = pak3 - widen (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in + let pck3 = pbk3 + widen ( (ok3 .>. fromIntegral sak3) .&. mk3) in + let sbk3 = sak3 + widen (t8k3 .&. bk3) in + + let pak2 = pck3 in + let sak2 = sbk3 in + + let hk2 = 0x4444 .&. comp (0xffff .>. fromIntegral sak2) in + let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in + let bk2 = ((narrow pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in + let mk2 = bk2 .&. mask2 in + let pbk2 = pak2 - widen (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in + let pck2 = pbk2 + widen ( (ok2 .>. fromIntegral sak2) .&. mk2) in + let sbk2 = sak2 + widen (t8k2 .&. bk2) in + + let pak1 = pck2 in + let sak1 = sbk2 in + + let hk1 = 0xaaaa .&. comp (0xffff .>. fromIntegral sak1) in + let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in + let bk1 = ((narrow pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in + let mk1 = bk1 .&. mask1 in + let pbk1 = pak1 - widen (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in + let pck1 = pbk1 + widen ( (ok1 .>. fromIntegral sak1) .&. mk1) in + let sbk1 = sak1 + widen (t8k1 .&. bk1) in + + let rrr = sbk1 + pck1 + (((widen x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in + + rrr + p +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32.hs @@ -0,0 +1,163 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Word32 +import HaskellWorks.Data.Int.Narrow +import HaskellWorks.Data.Int.Widen + +muk1 :: Word32 +muk1 = 0x33333333 +{-# INLINE muk1 #-} + +muk2 :: Word32 +muk2 = 0x0f0f0f0f +{-# INLINE muk2 #-} + +muk3 :: Word32 +muk3 = 0x00ff00ff +{-# INLINE muk3 #-} + +muk4 :: Word32 +muk4 = 0x0000ffff +{-# INLINE muk4 #-} + +-- | Find the position of the first unmatch parenthesis. +-- +-- This is the broadword implementation of 'Data.Succinct.BalancedParens.Internal.Slow.Word32.findCloseFor'. +-- +-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word32 -> Word64 +findUnmatchedCloseFar c p w = + -- Keys: + -- * k1: Level of sub-words of size 2 = 1 .<. 1 + -- * k2: Level of sub-words of size 4 = 1 .<. 2 + -- * k3: Level of sub-words of size 8 = 1 .<. 3 + -- * o: Open count + -- * c: Close count + -- * e: Excess + -- * L: Left half of sub-word + -- * R: Right half of sub-word + -- * b: deficit at position whole-word mask + -- * m: deficit at position sub-word mask + -- * pa: position accumulator + -- * sa: shift accumulator + -- * f: far sub-block close parens count + let x = w .>. p in + let wsz = 32 :: Int32 in + let k1 = 1 in + let k2 = 2 in + let k3 = 3 in + let k4 = 4 in + let k5 = 5 in + let mask1 = (1 .<. (1 .<. k1)) - 1 in + let mask2 = (1 .<. (1 .<. k2)) - 1 in + let mask3 = (1 .<. (1 .<. k3)) - 1 in + let mask4 = (1 .<. (1 .<. k4)) - 1 in + let mask5 = (1 .<. (1 .<. k5)) - 1 in + let t64k1 = 1 .<. k1 :: Word64 in + let t64k2 = 1 .<. k2 :: Word64 in + let t64k3 = 1 .<. k3 :: Word64 in + let t64k4 = 1 .<. k4 :: Word64 in + let t8k1 = 1 .<. k1 :: Word32 in + let t8k2 = 1 .<. k2 :: Word32 in + let t8k3 = 1 .<. k3 :: Word32 in + let t8k4 = 1 .<. k4 :: Word32 in + let t8k5 = 1 .<. k5 :: Word32 in + + let b0 = x .&. 0x55555555 in + let b1 = ( x .&. 0xaaaaaaaa) .>. 1 in + let ll = (b0 .^. b1 ) .&. b1 in + let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in + let ck1 = (((b0 .|. b1 ) .^. 0x55555555) .<. 1) .|. ll in + + let eok1 = ok1 .&. muk1 in + let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2R = kBitDiffPos 4 eok1 eck1 in + let ok2 = ok2L + ok2R in + let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in + + let eok2 = ok2 .&. muk2 in + let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in + let ok3L = ((ok2 .&. (muk2 .<. t64k2)) .>. t64k2) in + let ok3R = kBitDiffPos 8 eok2 eck2 in + let ok3 = ok3L + ok3R in + let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in + + let eok3 = ok3 .&. muk3 in + let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in + let ok4L = ((ok3 .&. (muk3 .<. t64k3)) .>. t64k3) in + let ok4R = kBitDiffPos 16 eok3 eck3 in + let ok4 = ok4L + ok4R in + let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in + + let eok4 = ok4 .&. muk4 in + let eck4 = (ck4 .&. (muk4 .<. t64k4)) .>. t64k4 in + let ok5L = ((ok4 .&. (muk4 .<. t64k4)) .>. t64k4) in + let ok5R = kBitDiffPos 32 eok4 eck4 in + let ok5 = ok5L + ok5R in + let ck5 = (ck4 .&. muk4) + kBitDiffPos 32 eck4 eok4 in + + let pak5 = c in + let sak5 = 0 in + + let hk5 = 0x00200020 .&. comp (0xffffffff .>. fromIntegral sak5) in + let fk5 = ((ck5 .>. fromIntegral sak5) .|. hk5) .&. mask5 in + let bk5 = ((narrow pak5 - fk5) .>. fromIntegral (wsz - 1)) - 1 in + let mk5 = bk5 .&. mask5 in + let pbk5 = pak5 - widen ((ck5 .>. fromIntegral sak5) .&. mk5) in + let pck5 = pbk5 + widen ((ok5 .>. fromIntegral sak5) .&. mk5) in + let sbk5 = sak5 + widen (t8k5 .&. bk5) in + + let pak4 = pck5 in + let sak4 = sbk5 in + + let hk4 = 0x00100010 .&. comp (0xffffffff .>. fromIntegral sak4) in + let fk4 = ((ck4 .>. fromIntegral sak4) .|. hk4) .&. mask4 in + let bk4 = ((narrow pak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in + let mk4 = bk4 .&. mask4 in + let pbk4 = pak4 - widen (((ck4 .>. fromIntegral sak4) .|. hk4) .&. mk4) in + let pck4 = pbk4 + widen ( (ok4 .>. fromIntegral sak4) .&. mk4) in + let sbk4 = sak4 + widen (t8k4 .&. bk4) in + + let pak3 = pck4 in + let sak3 = sbk4 in + + let hk3 = 0x08080808 .&. comp (0xffffffff .>. fromIntegral sak3) in + let fk3 = ((ck3 .>. fromIntegral sak3) .|. hk3) .&. mask3 in + let bk3 = ((narrow pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in + let mk3 = bk3 .&. mask3 in + let pbk3 = pak3 - widen (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in + let pck3 = pbk3 + widen ( (ok3 .>. fromIntegral sak3) .&. mk3) in + let sbk3 = sak3 + widen (t8k3 .&. bk3) in + + let pak2 = pck3 in + let sak2 = sbk3 in + + let hk2 = 0x44444444 .&. comp (0xffffffff .>. fromIntegral sak2) in + let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in + let bk2 = ((narrow pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in + let mk2 = bk2 .&. mask2 in + let pbk2 = pak2 - widen (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in + let pck2 = pbk2 + widen ( (ok2 .>. fromIntegral sak2) .&. mk2) in + let sbk2 = sak2 + widen (t8k2 .&. bk2) in + + let pak1 = pck2 in + let sak1 = sbk2 in + + let hk1 = 0xaaaaaaaa .&. comp (0xffffffff .>. fromIntegral sak1) in + let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in + let bk1 = ((narrow pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in + let mk1 = bk1 .&. mask1 in + let pbk1 = pak1 - widen (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in + let pck1 = pbk1 + widen ( (ok1 .>. fromIntegral sak1) .&. mk1) in + let sbk1 = sak1 + widen (t8k1 .&. bk1) in + + let rrr = sbk1 + pck1 + (((widen x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in + + rrr + p +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64.hs @@ -0,0 +1,187 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Word64 + +muk1 :: Word64 +muk1 = 0x3333333333333333 +{-# INLINE muk1 #-} + +muk2 :: Word64 +muk2 = 0x0f0f0f0f0f0f0f0f +{-# INLINE muk2 #-} + +muk3 :: Word64 +muk3 = 0x00ff00ff00ff00ff +{-# INLINE muk3 #-} + +muk4 :: Word64 +muk4 = 0x0000ffff0000ffff +{-# INLINE muk4 #-} + +muk5 :: Word64 +muk5 = 0x00000000ffffffff +{-# INLINE muk5 #-} + +-- | Find the position of the first unmatch parenthesis. +-- +-- This is the broadword implementation of 'Data.Succinct.BalancedParens.Internal.Slow.Word64.findCloseFor'. +-- +-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word64 -> Word64 +findUnmatchedCloseFar c p w = + -- Keys: + -- * k1: Level of sub-words of size 2 = 1 .<. 1 + -- * k2: Level of sub-words of size 4 = 1 .<. 2 + -- * k3: Level of sub-words of size 8 = 1 .<. 3 + -- * o: Open count + -- * c: Close count + -- * e: Excess + -- * L: Left half of sub-word + -- * R: Right half of sub-word + -- * b: deficit at position whole-word mask + -- * m: deficit at position sub-word mask + -- * pa: position accumulator + -- * sa: shift accumulator + -- * f: far sub-block close parens count + let x = w .>. p in + let wsz = 64 :: Int64 in + let k1 = 1 in + let k2 = 2 in + let k3 = 3 in + let k4 = 4 in + let k5 = 5 in + let k6 = 6 in + let mask1 = (1 .<. (1 .<. k1)) - 1 in + let mask2 = (1 .<. (1 .<. k2)) - 1 in + let mask3 = (1 .<. (1 .<. k3)) - 1 in + let mask4 = (1 .<. (1 .<. k4)) - 1 in + let mask5 = (1 .<. (1 .<. k5)) - 1 in + let mask6 = (1 .<. (1 .<. k6)) - 1 in + let t64k1 = 1 .<. k1 :: Word64 in + let t64k2 = 1 .<. k2 :: Word64 in + let t64k3 = 1 .<. k3 :: Word64 in + let t64k4 = 1 .<. k4 :: Word64 in + let t64k5 = 1 .<. k5 :: Word64 in + let t8k1 = 1 .<. k1 :: Word64 in + let t8k2 = 1 .<. k2 :: Word64 in + let t8k3 = 1 .<. k3 :: Word64 in + let t8k4 = 1 .<. k4 :: Word64 in + let t8k5 = 1 .<. k5 :: Word64 in + let t8k6 = 1 .<. k6 :: Word64 in + + let b0 = x .&. 0x5555555555555555 in + let b1 = ( x .&. 0xaaaaaaaaaaaaaaaa) .>. 1 in + let ll = (b0 .^. b1 ) .&. b1 in + let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in + let ck1 = (((b0 .|. b1 ) .^. 0x5555555555555555) .<. 1) .|. ll in + + let eok1 = ok1 .&. muk1 in + let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2R = kBitDiffPos 4 eok1 eck1 in + let ok2 = ok2L + ok2R in + let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in + + let eok2 = ok2 .&. muk2 in + let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in + let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in + let ok3R = kBitDiffPos 8 eok2 eck2 in + let ok3 = ok3L + ok3R in + let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in + + let eok3 = ok3 .&. muk3 in + let eck3 = (ck3 .&. (muk3 .<. t64k3)) .>. t64k3 in + let ok4L = (ok3 .&. (muk3 .<. t64k3)) .>. t64k3 in + let ok4R = kBitDiffPos 16 eok3 eck3 in + let ok4 = ok4L + ok4R in + let ck4 = (ck3 .&. muk3) + kBitDiffPos 16 eck3 eok3 in + + let eok4 = ok4 .&. muk4 in + let eck4 = (ck4 .&. (muk4 .<. t64k4)) .>. t64k4 in + let ok5L = (ok4 .&. (muk4 .<. t64k4)) .>. t64k4 in + let ok5R = kBitDiffPos 32 eok4 eck4 in + let ok5 = ok5L + ok5R in + let ck5 = (ck4 .&. muk4) + kBitDiffPos 32 eck4 eok4 in + + let eok5 = ok5 .&. muk5 in + let eck5 = (ck5 .&. (muk5 .<. t64k5)) .>. t64k5 in + let ok6L = (ok5 .&. (muk5 .<. t64k5)) .>. t64k5 in + let ok6R = kBitDiffPos 32 eok5 eck5 in + let ok6 = ok6L + ok6R in + let ck6 = (ck5 .&. muk5) + kBitDiffPos 32 eck5 eok5 in + + let qak6 = c in + let sak6 = 0 in + + let hk6 = 0x0000004000000040 .&. comp (0xffffffffffffffff .>. fromIntegral sak6) in + let fk6 = ((ck6 .>. fromIntegral sak6) .|. hk6) .&. mask6 in + let bk6 = ((qak6 - fk6) .>. fromIntegral (wsz - 1)) - 1 in + let mk6 = bk6 .&. mask6 in + let pbk6 = qak6 - ((ck6 .>. fromIntegral sak6) .&. mk6) in + let pck6 = pbk6 + ((ok6 .>. fromIntegral sak6) .&. mk6) in + let sbk6 = sak6 + (t8k6 .&. bk6) in + + let qak5 = pck6 in + let sak5 = sbk6 in + + let hk5 = 0x0000002000000020 .&. comp (0xffffffffffffffff .>. fromIntegral sak5) in + let fk5 = ((ck5 .>. fromIntegral sak5) .|. hk5) .&. mask5 in + let bk5 = ((qak5 - fk5) .>. fromIntegral (wsz - 1)) - 1 in + let mk5 = bk5 .&. mask5 in + let pbk5 = qak5 - (((ck5 .>. fromIntegral sak5) .|. hk5) .&. mk5) in + let pck5 = pbk5 + ( (ok5 .>. fromIntegral sak5) .&. mk5) in + let sbk5 = sak5 + (t8k5 .&. bk5) in + + let qak4 = pck5 in + let sak4 = sbk5 in + + let hk4 = 0x0010001000100010 .&. comp (0xffffffffffffffff .>. fromIntegral sak4) in + let fk4 = ((ck4 .>. fromIntegral sak4) .|. hk4) .&. mask4 in + let bk4 = ((qak4 - fk4) .>. fromIntegral (wsz - 1)) - 1 in + let mk4 = bk4 .&. mask4 in + let pbk4 = qak4 - (((ck4 .>. fromIntegral sak4) .|. hk4) .&. mk4) in + let pck4 = pbk4 + ( (ok4 .>. fromIntegral sak4) .&. mk4) in + let sbk4 = sak4 + (t8k4 .&. bk4) in + + let qak3 = pck4 in + let sak3 = sbk4 in + + let hk3 = 0x0808080808080808 .&. comp (0xffffffffffffffff .>. fromIntegral sak3) in + let fk3 = ((ck3 .>. fromIntegral sak3) .|. hk3) .&. mask3 in + let bk3 = ((qak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in + let mk3 = bk3 .&. mask3 in + let pbk3 = qak3 - (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in + let pck3 = pbk3 + ( (ok3 .>. fromIntegral sak3) .&. mk3) in + let sbk3 = sak3 + (t8k3 .&. bk3) in + + let qak2 = pck3 in + let sak2 = sbk3 in + + let hk2 = 0x4444444444444444 .&. comp (0xffffffffffffffff .>. fromIntegral sak2) in + let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in + let bk2 = ((qak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in + let mk2 = bk2 .&. mask2 in + let pbk2 = qak2 - (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in + let pck2 = pbk2 + ( (ok2 .>. fromIntegral sak2) .&. mk2) in + let sbk2 = sak2 + (t8k2 .&. bk2) in + + let qak1 = pck2 in + let sak1 = sbk2 in + + let hk1 = 0xaaaaaaaaaaaaaaaa .&. comp (0xffffffffffffffff .>. fromIntegral sak1) in + let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in + let bk1 = ((qak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in + let mk1 = bk1 .&. mask1 in + let pbk1 = qak1 - (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in + let pck1 = pbk1 + ( (ok1 .>. fromIntegral sak1) .&. mk1) in + let sbk1 = sak1 + (t8k1 .&. bk1) in + + let rrr = sbk1 + pck1 + (((x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in + + rrr + p +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8.hs @@ -0,0 +1,112 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 + ( findUnmatchedCloseFar + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Word8 +import HaskellWorks.Data.Int.Narrow +import HaskellWorks.Data.Int.Widen + +muk1 :: Word8 +muk1 = 0x33 +{-# INLINE muk1 #-} + +muk2 :: Word8 +muk2 = 0x0f +{-# INLINE muk2 #-} + +-- | Find the position of the first unmatch parenthesis. +-- +-- This is the broadword implementation of 'Data.Succinct.BalancedParens.Internal.Slow.Word8.findCloseFor'. +-- +-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word8 -> Word64 +findUnmatchedCloseFar c p w = + -- Keys: + -- * k1: Level of sub-words of size 2 = 1 .<. 1 + -- * k2: Level of sub-words of size 4 = 1 .<. 2 + -- * k3: Level of sub-words of size 8 = 1 .<. 3 + -- * o: Open count + -- * c: Close count + -- * e: Excess + -- * L: Left half of sub-word + -- * R: Right half of sub-word + -- * b: deficit at position whole-word mask + -- * m: deficit at position sub-word mask + -- * pa: position accumulator + -- * sa: shift accumulator + -- * h: high sub-block close parens count + -- * f: far sub-block close parens count + let x = w .>. p in + let wsz = 8 :: Int8 in + let k1 = 1 in + let k2 = 2 in + let k3 = 3 in + let mask3 = (1 .<. (1 .<. k3)) - 1 in + let mask2 = (1 .<. (1 .<. k2)) - 1 in + let mask1 = (1 .<. (1 .<. k1)) - 1 in + let t64k1 = 1 .<. k1 :: Word64 in + let t64k2 = 1 .<. k2 :: Word64 in + let t8k1 = 1 .<. k1 :: Word8 in + let t8k2 = 1 .<. k2 :: Word8 in + let t8k3 = 1 .<. k3 :: Word8 in + + let b0 = x .&. 0x55 in + let b1 = ( x .&. 0xaa) .>. 1 in + let ll = (b0 .^. b1 ) .&. b1 in + let ok1 = ( (b0 .&. b1 ) .<. 1) .|. ll in + let ck1 = (((b0 .|. b1 ) .^. 0x55) .<. 1) .|. ll in + + let eok1 = ok1 .&. muk1 in + let eck1 = (ck1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2L = (ok1 .&. (muk1 .<. t64k1)) .>. t64k1 in + let ok2R = kBitDiffPos 4 eok1 eck1 in + let ok2 = ok2L + ok2R in + let ck2 = (ck1 .&. muk1) + kBitDiffPos 4 eck1 eok1 in + + let eok2 = ok2 .&. muk2 in + let eck2 = (ck2 .&. (muk2 .<. t64k2)) .>. t64k2 in + let ok3L = (ok2 .&. (muk2 .<. t64k2)) .>. t64k2 in + let ok3R = kBitDiffPos 8 eok2 eck2 in + let ok3 = ok3L + ok3R in + let ck3 = (ck2 .&. muk2) + kBitDiffPos 8 eck2 eok2 in + + let pak3 = c in + let sak3 = 0 in + + let hk3 = 0x08 .&. comp (0xff .>. fromIntegral sak3) in + let fk3 = (ck3 .>. fromIntegral sak3 .|. hk3) .&. mask3 in + let bk3 = ((narrow pak3 - fk3) .>. fromIntegral (wsz - 1)) - 1 in + let mk3 = bk3 .&. mask3 in + let pbk3 = pak3 - widen (((ck3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in + let pck3 = pbk3 + widen (((ok3 .>. fromIntegral sak3) .|. hk3) .&. mk3) in + let sbk3 = sak3 + widen (t8k3 .&. bk3) in + + let pak2 = pck3 in + let sak2 = sbk3 in + + let hk2 = 0x44 .&. comp (0xff .>. fromIntegral sak2) in + let fk2 = ((ck2 .>. fromIntegral sak2) .|. hk2) .&. mask2 in + let bk2 = ((narrow pak2 - fk2) .>. fromIntegral (wsz - 1)) - 1 in + let mk2 = bk2 .&. mask2 in + let pbk2 = pak2 - widen (((ck2 .>. fromIntegral sak2) .|. hk2) .&. mk2) in + let pck2 = pbk2 + widen ( (ok2 .>. fromIntegral sak2) .&. mk2) in + let sbk2 = sak2 + widen (t8k2 .&. bk2) in + + let pak1 = pck2 in + let sak1 = sbk2 in + + let hk1 = 0xaa .&. comp (0xff .>. fromIntegral sak1) in + let fk1 = ((ck1 .>. fromIntegral sak1) .|. hk1) .&. mask1 in + let bk1 = ((narrow pak1 - fk1) .>. fromIntegral (wsz - 1)) - 1 in + let mk1 = bk1 .&. mask1 in + let pbk1 = pak1 - widen (((ck1 .>. fromIntegral sak1) .|. hk1) .&. mk1) in + let pck1 = pbk1 + widen ( (ok1 .>. fromIntegral sak1) .&. mk1) in + let sbk1 = sak1 + widen (t8k1 .&. bk1) in + + let rrr = sbk1 + pck1 + (((widen x .>. fromIntegral sbk1) .&. ((pck1 .<. 1) .|. 1)) .<. 1) in + + rrr + p +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/Word64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/Word64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Broadword/Word64.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.Word64 + ( findUnmatchedClose + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Word64 +import HaskellWorks.Data.Bits.Word64 + +-- | Find the position of the first unmatch parenthesis within a word. +-- +-- See [Broadword Implementation of Parenthesis Queries](https://arxiv.org/pdf/1301.5468.pdf), Sebastiano Vigna, 2013 +findUnmatchedClose :: Word64 -> Word64 +findUnmatchedClose x = + let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in + let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333) in + let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f in + let !b03 = (b02 * 0x0101010101010101) .<. 1 in + let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03 in + let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z00 = ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00 in + + let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1)))) in + let !b10 = b04 - d10 in + let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10) in + + let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1)))) in + let !b20 = b10 - d20 in + let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20) in + + let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1)))) in + let !b30 = b20 - d30 in + let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in + let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|. l 8 ) .&. u30) in + + let !p00 = lsb (z30 .>. 6 .&. l 8) in + let !r00 = ((p00 + ((z30 .>. fromIntegral (p00 .&. 0x3f)) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in + r00 +{-# INLINE findUnmatchedClose #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/List.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/List.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/List.hs @@ -0,0 +1,24 @@ +module Data.Succinct.BalancedParens.Internal.List + ( chunkBy + , toBools + , toBalancedParensString + ) where + +import Data.Word + +import qualified Data.Succinct.BalancedParens.Internal.Word as W + +chunkBy :: Int -> [a] -> [[a]] +chunkBy n bs = case splitAt n bs of + (as, zs) -> if null zs then [as] else as:chunkBy n zs + +toBoolsDiff :: [Word64] -> [Bool] -> [Bool] +toBoolsDiff = foldr ((.) . W.toBoolsDiff) id + +toBools :: [Word64] -> [Bool] +toBools ws = toBoolsDiff ws [] + +toBalancedParensString :: [Bool] -> String +toBalancedParensString (True:bs) = '(':toBalancedParensString bs +toBalancedParensString (False:bs) = ')':toBalancedParensString bs +toBalancedParensString [] = "" diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Show.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Show.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Show.hs @@ -0,0 +1,6 @@ +module Data.Succinct.BalancedParens.Internal.Show + ( showPadded + ) where + +showPadded :: Show a => Int -> a -> String +showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..])) diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindCloseC/Generic.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindCloseC/Generic.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindCloseC/Generic.hs @@ -0,0 +1,15 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindCloseC.Generic + ( findCloseC + ) where + +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning + +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic as G + +-- | Find position closing parenthesis from beginning of bit string, carrying a nesting level of 'c' +findCloseC :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Maybe Count +findCloseC v c = G.findCloseN v c 0 +{-# INLINE findCloseC #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindCloseN/Generic.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindCloseN/Generic.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindCloseN/Generic.hs @@ -0,0 +1,36 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic + ( findCloseN + ) where + +import Data.Succinct.BalancedParens.CloseAt +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning + +-- | Find the position of the corresponding close parenthesis carrying in a number of open parentheses starting from a given position. +-- +-- All positions are one based. +-- +-- This is a reference implementation. +-- +-- >>> :set -XTypeApplications +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- >>> import Data.Word +-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 0 1 +-- Just 4 +-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 0 2 +-- Just 3 +-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 1 1 +-- Just 5 +-- >>> findCloseN (fromJust (bitRead @Word64 "1100000")) 1 2 +-- Just 4 +findCloseN :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Count -> Maybe Count +findCloseN v c p = if 0 < p + then if v `closeAt` p + then if c <= 1 + then Just p + else findCloseN v (c - 1) (p + 1) + else findCloseN v (c + 1) (p + 1) + else Nothing +{-# INLINE findCloseN #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector16.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector16.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector16.hs @@ -0,0 +1,81 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector16 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Signed + +import qualified Data.Vector.Storable as DVS + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111" +-- 16 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000" +-- 8 +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word16 -> Word64 +findUnmatchedCloseFar d i v = if i < bitLength v + then if v .?. signed i + then findUnmatchedCloseFar (d + 1) (i + 1) v + else if d == 0 + then i + else findUnmatchedCloseFar (d - 1) (i + 1) v + else bitLength v + d +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector32.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector32.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector32.hs @@ -0,0 +1,81 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector32 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Signed + +import qualified Data.Vector.Storable as DVS + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111" +-- 16 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000" +-- 8 +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word32 -> Word64 +findUnmatchedCloseFar d i v = if i < bitLength v + then if v .?. signed i + then findUnmatchedCloseFar (d + 1) (i + 1) v + else if d == 0 + then i + else findUnmatchedCloseFar (d - 1) (i + 1) v + else bitLength v + d +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector64.hs @@ -0,0 +1,81 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector64 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Signed + +import qualified Data.Vector.Storable as DVS + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111" +-- 16 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000" +-- 8 +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word64 -> Word64 +findUnmatchedCloseFar d i v = if i < bitLength v + then if v .?. signed i + then findUnmatchedCloseFar (d + 1) (i + 1) v + else if d == 0 + then i + else findUnmatchedCloseFar (d - 1) (i + 1) v + else bitLength v + d +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector8.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Vector8.hs @@ -0,0 +1,81 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector8 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Signed + +import qualified Data.Vector.Storable as DVS + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111" +-- 16 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000" +-- 8 +findUnmatchedCloseFar :: Word64 -> Word64 -> DVS.Vector Word8 -> Word64 +findUnmatchedCloseFar d i v = if i < bitLength v + then if v .?. signed i + then findUnmatchedCloseFar (d + 1) (i + 1) v + else if d == 0 + then i + else findUnmatchedCloseFar (d - 1) (i + 1) v + else bitLength v + d +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word16.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word16.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word16.hs @@ -0,0 +1,77 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word16 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000 00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000 00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000 00000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 00000000" +-- 16 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111" +-- 32 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000 11110000" +-- 16 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000 11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000 11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000 11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000 11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000 11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000 11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000 11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000 11110000" +-- 16 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word16 -> Word64 +findUnmatchedCloseFar = go + where go :: Word64 -> Word64 -> Word16 -> Word64 + go d 16 _ = 16 + d + go d i w = case (w .>. i) .&. 1 of + 1 -> go (d + 1) (i + 1) w + _ -> if d == 0 + then i + else go (d - 1) (i + 1) w diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word32.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word32.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word32.hs @@ -0,0 +1,77 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word32 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 00000000 00000000" +-- 32 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111" +-- 64 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 32 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000" +-- 32 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word32 -> Word64 +findUnmatchedCloseFar = go + where go :: Word64 -> Word64 -> Word32 -> Word64 + go d 32 _ = 32 + d + go d i w = case (w .>. i) .&. 1 of + 1 -> go (d + 1) (i + 1) w + _ -> if d == 0 + then i + else go (d - 1) (i + 1) w diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word64.hs @@ -0,0 +1,78 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 00000000 00000000 00000000 00000000" +-- 64 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111" +-- 128 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 64 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000 11110000 11110000 11110000 11110000 11110000 11110000 11110000" +-- 64 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word64 -> Word64 +findUnmatchedCloseFar = go + where go :: Word64 -> Word64 -> Word64 -> Word64 + go d 64 _ = 64 + d + go d i w = case (w .>. fromIntegral i) .&. 1 of + 1 -> go (d + 1) (i + 1) w + _ -> if d == 0 + then i + else go (d - 1) (i + 1) w +{-# INLINE findUnmatchedCloseFar #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word8.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Slow/FindUnmatchedCloseFar/Word8.hs @@ -0,0 +1,77 @@ +module Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word8 + ( findUnmatchedCloseFar + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +-- | Find the position of the first unmatch parenthesis. +-- +-- The digits 1 and 0 are treated as an open parenthesis and closing parenthesis respectively. +-- +-- All positions are indexed from zero. If the search runs out of bits, then continue as if there remain an infinite +-- string of zeros. +-- +-- >>> import HaskellWorks.Data.Bits.BitRead +-- >>> import Data.Maybe +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "00000000" +-- 0 +-- +-- The following scans for the first unmatched closing parenthesis after skipping one bit from the beginning of the +-- bit string: +-- +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "00000000" +-- 1 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string. To find +-- unmatched parenthesis, the scan passes over the first parent of matching parentheses: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "10000000" +-- 2 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows, the first of which is at +-- position 64, which also happens to be the position of the unmatched parenthesis. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- +-- The following scans for the first unmatched closing parenthesis from the beginning of the bit string, but runs +-- out of bits. The scan continues as if there an inifinite string of zero bits follows and we don't get to the +-- unmatched parenthesis until position 128. +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11111111" +-- 16 +-- +-- Following are some more examples: +-- +-- >>> findUnmatchedCloseFar 0 0 $ fromJust $ bitRead "11110000" +-- 8 +-- >>> findUnmatchedCloseFar 0 1 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 2 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 3 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 4 $ fromJust $ bitRead "11110000" +-- 4 +-- >>> findUnmatchedCloseFar 0 5 $ fromJust $ bitRead "11110000" +-- 5 +-- >>> findUnmatchedCloseFar 0 6 $ fromJust $ bitRead "11110000" +-- 6 +-- >>> findUnmatchedCloseFar 0 7 $ fromJust $ bitRead "11110000" +-- 7 +-- >>> findUnmatchedCloseFar 0 8 $ fromJust $ bitRead "11110000" +-- 8 +findUnmatchedCloseFar :: Word64 -> Word64 -> Word8 -> Word64 +findUnmatchedCloseFar = go + where go :: Word64 -> Word64 -> Word8 -> Word64 + go d 8 _ = 8 + d + go d i w = case (w .>. i) .&. 1 of + 1 -> go (d + 1) (i + 1) w + _ -> if d == 0 + then i + else go (d - 1) (i + 1) w diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Trace.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Trace.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Trace.hs @@ -0,0 +1,8 @@ +module Data.Succinct.BalancedParens.Internal.Trace + ( traceW + ) where + +import Debug.Trace + +traceW :: Show a => String -> a -> a +traceW s a = trace (s <> " = " <> show a) a diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Vector/Storable.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Vector/Storable.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Vector/Storable.hs @@ -0,0 +1,39 @@ +module Data.Succinct.BalancedParens.Internal.Vector.Storable + ( lastOrZero + , reword + , dropTake + , dropTakeFill + , pageFill + ) where + +import qualified Data.Vector.Storable as DVS + +lastOrZero :: (DVS.Storable a, Integral a) => DVS.Vector a -> a +lastOrZero v = if not (DVS.null v) then DVS.last v else 0 +{-# INLINE lastOrZero #-} + +reword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b +reword v = DVS.generate (DVS.length v) (\i -> fromIntegral (v DVS.! i)) +{-# INLINE reword #-} + +dropTake :: DVS.Storable a => Int -> Int -> DVS.Vector a -> DVS.Vector a +dropTake n o = DVS.take o . DVS.drop n +{-# INLINE dropTake #-} + +dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a +dropTakeFill n o a v = let r = DVS.take o (DVS.drop n v) in + let len = DVS.length r in + if len == o then r else DVS.concat [r, DVS.fromList (replicate (o - len) a)] +{-# INLINE dropTakeFill #-} + +-- | Return the n-th page of size s from the input vector. In the case where there isn't +-- sufficient data to fill the page from the input vector, then the remainder of the page +-- is filled with a. +pageFill :: DVS.Storable a + => Int -- ^ The n-th page to retrieve + -> Int -- ^ The page size + -> a -- ^ The element value to fill the page when input vector has insufficient values + -> DVS.Vector a -- ^ The input vector + -> DVS.Vector a -- ^ The page +pageFill n s = dropTakeFill (n * s) s +{-# INLINE pageFill #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word.hs @@ -0,0 +1,30 @@ +module Data.Succinct.BalancedParens.Internal.Word + ( toBools + , toBoolsDiff + , partialToBoolsDiff + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning + +toBools :: Word64 -> [Bool] +toBools w = toBoolsDiff w [] + +partialToBoolsDiff :: Count -> Word64 -> [Bool] -> [Bool] +partialToBoolsDiff n w | n > 0 = partialToBoolsDiff (n - 1) w . ((w .?. fromIntegral (n - 1)):) +partialToBoolsDiff 0 _ = id +partialToBoolsDiff _ _ = error "Invalid size" + +toBoolsDiff :: Word64 -> [Bool] -> [Bool] +toBoolsDiff w = + go 0x00 . go 0x01 . go 0x02 . go 0x03 . go 0x04 . go 0x05 . go 0x06 . go 0x07 . + go 0x08 . go 0x09 . go 0x0a . go 0x0b . go 0x0c . go 0x0d . go 0x0e . go 0x0f . + go 0x10 . go 0x11 . go 0x12 . go 0x13 . go 0x14 . go 0x15 . go 0x16 . go 0x17 . + go 0x18 . go 0x19 . go 0x1a . go 0x1b . go 0x1c . go 0x1d . go 0x1e . go 0x1f . + go 0x20 . go 0x21 . go 0x22 . go 0x23 . go 0x24 . go 0x25 . go 0x26 . go 0x27 . + go 0x28 . go 0x29 . go 0x2a . go 0x2b . go 0x2c . go 0x2d . go 0x2e . go 0x2f . + go 0x30 . go 0x31 . go 0x32 . go 0x33 . go 0x34 . go 0x35 . go 0x36 . go 0x37 . + go 0x38 . go 0x39 . go 0x3a . go 0x3b . go 0x3c . go 0x3d . go 0x3e . go 0x3f + where go :: Position -> [Bool] -> [Bool] + go p = ((w .?. p):) diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word16.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word16.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word16.hs @@ -0,0 +1,34 @@ +module Data.Succinct.BalancedParens.Internal.Word16 + ( mu0 + , mu1 + , mu2 + , mu3 + , mu4 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word16 +mu0 = 0x5555 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word16 +mu1 = 0x3333 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word16 +mu2 = 0x0f0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word16 +mu3 = 0x00ff +{-# INLINE mu3 #-} + +-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits +mu4 :: Word16 +mu4 = 0xffff +{-# INLINE mu4 #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word32.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word32.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word32.hs @@ -0,0 +1,40 @@ +module Data.Succinct.BalancedParens.Internal.Word32 + ( mu0 + , mu1 + , mu2 + , mu3 + , mu4 + , mu5 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word32 +mu0 = 0x55555555 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word32 +mu1 = 0x33333333 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word32 +mu2 = 0x0f0f0f0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word32 +mu3 = 0x00ff00ff +{-# INLINE mu3 #-} + +-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits +mu4 :: Word32 +mu4 = 0x0000ffff +{-# INLINE mu4 #-} + +-- | Subwords of size 2 ^ 5 alternating between all bits cleared and all bits +mu5 :: Word32 +mu5 = 0xffffffff +{-# INLINE mu5 #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word64.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word64.hs @@ -0,0 +1,46 @@ +module Data.Succinct.BalancedParens.Internal.Word64 + ( mu0 + , mu1 + , mu2 + , mu3 + , mu4 + , mu5 + , mu6 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word64 +mu0 = 0x5555555555555555 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word64 +mu1 = 0x3333333333333333 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word64 +mu2 = 0x0f0f0f0f0f0f0f0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word64 +mu3 = 0x00ff00ff00ff00ff +{-# INLINE mu3 #-} + +-- | Subwords of size 2 ^ 4 alternating between all bits cleared and all bits +mu4 :: Word64 +mu4 = 0x0000ffff0000ffff +{-# INLINE mu4 #-} + +-- | Subwords of size 2 ^ 5 alternating between all bits cleared and all bits +mu5 :: Word64 +mu5 = 0x00000000ffffffff +{-# INLINE mu5 #-} + +-- | Subwords of size 2 ^ 6 alternating between all bits cleared and all bits +mu6 :: Word64 +mu6 = 0xffffffffffffffff +{-# INLINE mu6 #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word8.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Internal/Word8.hs @@ -0,0 +1,28 @@ +module Data.Succinct.BalancedParens.Internal.Word8 + ( mu0 + , mu1 + , mu2 + , mu3 + ) where + +import Data.Word + +-- | Subwords of size 2 ^ 0 alternating between all bits cleared and all bits +mu0 :: Word16 +mu0 = 0x55 +{-# INLINE mu0 #-} + +-- | Subwords of size 2 ^ 1 alternating between all bits cleared and all bits +mu1 :: Word16 +mu1 = 0x33 +{-# INLINE mu1 #-} + +-- | Subwords of size 2 ^ 2 alternating between all bits cleared and all bits +mu2 :: Word16 +mu2 = 0x0f +{-# INLINE mu2 #-} + +-- | Subwords of size 2 ^ 3 alternating between all bits cleared and all bits +mu3 :: Word16 +mu3 = 0xff +{-# INLINE mu3 #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/NewCloseAt.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/NewCloseAt.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/NewCloseAt.hs @@ -0,0 +1,59 @@ +module Data.Succinct.BalancedParens.NewCloseAt + ( NewCloseAt(..) + , newCloseAt' + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS + +class NewCloseAt v where + newCloseAt :: v -> Count -> Bool + +newCloseAt' :: TestBit a => a -> Count -> Bool +newCloseAt' v c = not (v .?. toPosition c) +{-# INLINE newCloseAt' #-} + +instance (BitLength a, TestBit a) => NewCloseAt (BitShown a) where + newCloseAt = newCloseAt' . bitShown + {-# INLINE newCloseAt #-} + +instance NewCloseAt [Bool] where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt (DVS.Vector Word8) where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt (DVS.Vector Word16) where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt (DVS.Vector Word32) where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt (DVS.Vector Word64) where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt Word8 where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt Word16 where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt Word32 where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} + +instance NewCloseAt Word64 where + newCloseAt = newCloseAt' + {-# INLINE newCloseAt #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/NewOpenAt.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/NewOpenAt.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/NewOpenAt.hs @@ -0,0 +1,58 @@ +module Data.Succinct.BalancedParens.NewOpenAt + ( NewOpenAt(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS + +class NewOpenAt v where + newOpenAt :: v -> Count -> Bool + +newOpenAt' :: (BitLength a, TestBit a) => a -> Count -> Bool +newOpenAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition c) +{-# INLINE newOpenAt' #-} + +instance (BitLength a, TestBit a) => NewOpenAt (BitShown a) where + newOpenAt = newOpenAt' . bitShown + {-# INLINE newOpenAt #-} + +instance NewOpenAt [Bool] where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt (DVS.Vector Word8) where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt (DVS.Vector Word16) where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt (DVS.Vector Word32) where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt (DVS.Vector Word64) where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt Word8 where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt Word16 where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt Word32 where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} + +instance NewOpenAt Word64 where + newOpenAt = newOpenAt' + {-# INLINE newOpenAt #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/OpenAt.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/OpenAt.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/OpenAt.hs @@ -0,0 +1,68 @@ +module Data.Succinct.BalancedParens.OpenAt + ( OpenAt(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.Broadword.Type +import HaskellWorks.Data.Naive +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS + +class OpenAt v where + openAt :: v -> Count -> Bool + +openAt' :: (BitLength a, TestBit a) => a -> Count -> Bool +openAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition (c - 1)) +{-# INLINE openAt' #-} + +instance (BitLength a, TestBit a) => OpenAt (BitShown a) where + openAt = openAt' . bitShown + {-# INLINE openAt #-} + +instance OpenAt [Bool] where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt (DVS.Vector Word8) where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt (DVS.Vector Word16) where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt (DVS.Vector Word32) where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt (DVS.Vector Word64) where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt Word8 where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt Word16 where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt Word32 where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt Word64 where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt (Naive Word64) where + openAt = openAt' + {-# INLINE openAt #-} + +instance OpenAt (Broadword Word64) where + openAt = openAt . broadword + {-# INLINE openAt #-} diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/RangeMin.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/RangeMin.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/RangeMin.hs @@ -0,0 +1,223 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Data.Succinct.BalancedParens.RangeMin ( + RangeMin (..), + mkRangeMin, +) where + +import Control.DeepSeq +import Data.Int +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindCloseN +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.FindOpenN +import Data.Succinct.BalancedParens.NewCloseAt +import Data.Succinct.BalancedParens.OpenAt +import Data.Succinct.Excess.MinExcess +import Data.Succinct.Excess.MinExcess1 +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import GHC.Generics +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.AllExcess.AllExcess1 +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (length) + +import qualified Data.Succinct.BalancedParens.Internal.Vector.Storable as DVS +import qualified Data.Vector.Storable as DVS + +data RangeMin a = RangeMin + { rangeMinBP :: !a + , rangeMinL0Min :: !(DVS.Vector Int8) + , rangeMinL0Excess :: !(DVS.Vector Int8) + , rangeMinL1Min :: !(DVS.Vector Int16) + , rangeMinL1Excess :: !(DVS.Vector Int16) + , rangeMinL2Min :: !(DVS.Vector Int16) + , rangeMinL2Excess :: !(DVS.Vector Int16) + } + deriving (Eq, Show, NFData, Generic) + +factorL0 :: (Integral a) => a +factorL0 = 1 +{-# INLINE factorL0 #-} + +factorL1 :: (Integral a) => a +factorL1 = 32 +{-# INLINE factorL1 #-} + +factorL2 :: (Integral a) => a +factorL2 = 32 +{-# INLINE factorL2 #-} + +pageSizeL0 :: (Integral a) => a +pageSizeL0 = factorL0 +{-# INLINE pageSizeL0 #-} + +pageSizeL1 :: (Integral a) => a +pageSizeL1 = pageSizeL0 * factorL1 +{-# INLINE pageSizeL1 #-} + +pageSizeL2 :: (Integral a) => a +pageSizeL2 = pageSizeL1 * factorL2 +{-# INLINE pageSizeL2 #-} + +mkRangeMin :: (AsVector64 a) => a -> RangeMin a +mkRangeMin bp = + RangeMin + { rangeMinBP = bp + , rangeMinL0Min = rmL0Min + , rangeMinL0Excess = DVS.reword rmL0Excess + , rangeMinL1Min = rmL1Min + , rangeMinL1Excess = DVS.reword rmL1Excess + , rangeMinL2Min = rmL2Min + , rangeMinL2Excess = rmL2Excess + } + where + bpv = asVector64 bp + lenBP = fromIntegral (length bpv) :: Int + lenL0 = lenBP + lenL1 = (DVS.length rmL0Min `div` pageSizeL1) + 1 :: Int + lenL2 = (DVS.length rmL0Min `div` pageSizeL2) + 1 :: Int + allMinL0 = DVS.generate lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i)) + allMinL1 = DVS.generate lenL1 (\i -> minExcess1 (DVS.dropTake (i * pageSizeL1) pageSizeL1 bpv)) + allMinL2 = DVS.generate lenL2 (\i -> minExcess1 (DVS.dropTake (i * pageSizeL2) pageSizeL2 bpv)) + -- Note: (0xffffffffffffffc0 :: Int64) = -64 + rmL0Excess = DVS.generate lenL0 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL1Excess = DVS.generate lenL1 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL2Excess = DVS.generate lenL2 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL0Min = DVS.generate lenL0 (\i -> let MinExcess minE _ = allMinL0 DVS.! i in fromIntegral minE) + rmL1Min = DVS.generate lenL1 (\i -> let MinExcess minE _ = allMinL1 DVS.! i in fromIntegral minE) + rmL2Min = DVS.generate lenL2 (\i -> let MinExcess minE _ = allMinL2 DVS.! i in fromIntegral minE) + +data FindState + = FindBP + | FindL0 + | FindFromL0 + | FindL1 + | FindFromL1 + | FindL2 + | FindFromL2 + +rm2FindClose :: (BitLength a, NewCloseAt a) => RangeMin a -> Int -> Count -> FindState -> Maybe Count +rm2FindClose v s p FindBP = + if v `newCloseAt` p + then + if s <= 1 + then Just p + else rm2FindClose v (s - 1) (p + 1) FindFromL0 + else rm2FindClose v (s + 1) (p + 1) FindFromL0 +rm2FindClose v s p FindL0 = + let i = p `div` 64 + in let mins = rangeMinL0Min v + in let minE = fromIntegral (mins !!! fromIntegral i) :: Int + in if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindBP + else + if v `newCloseAt` p && s <= 1 + then Just p + else + let excesses = rangeMinL0Excess v + in let excess = fromIntegral (excesses !!! fromIntegral i) :: Int + in rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0 +rm2FindClose v s p FindL1 = + let !i = p `div` (64 * pageSizeL1) + in let !mins = rangeMinL1Min v + in let !minE = fromIntegral (mins !!! fromIntegral i) :: Int + in if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindL0 + else + if 0 <= p && p < bitLength v + then + if v `newCloseAt` p && s <= 1 + then Just p + else + let excesses = rangeMinL1Excess v + in let excess = fromIntegral (excesses !!! fromIntegral i) :: Int + in rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1 + else Nothing +rm2FindClose v s p FindL2 = + let !i = p `div` (64 * pageSizeL2) + in let !mins = rangeMinL2Min v + in let !minE = fromIntegral (mins !!! fromIntegral i) :: Int + in if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindL1 + else + if 0 <= p && p < bitLength v + then + if v `newCloseAt` p && s <= 1 + then Just p + else + let excesses = rangeMinL2Excess v + in let excess = fromIntegral (excesses !!! fromIntegral i) :: Int + in rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2 + else Nothing +rm2FindClose v s p FindFromL0 + | p `mod` 64 == 0 = rm2FindClose v s p FindFromL1 + | 0 <= p && p < bitLength v = rm2FindClose v s p FindBP + | otherwise = Nothing +rm2FindClose v s p FindFromL1 + | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL2 else Nothing + | 0 <= p && p < bitLength v = rm2FindClose v s p FindL0 + | otherwise = Nothing +rm2FindClose v s p FindFromL2 + | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindL2 else Nothing + | 0 <= p && p < bitLength v = rm2FindClose v s p FindL1 + | otherwise = Nothing +{-# INLINE rm2FindClose #-} + +instance (TestBit a) => TestBit (RangeMin a) where + (.?.) = (.?.) . rangeMinBP + {-# INLINE (.?.) #-} + +instance (Rank1 a) => Rank1 (RangeMin a) where + rank1 = rank1 . rangeMinBP + {-# INLINE rank1 #-} + +instance (Rank0 a) => Rank0 (RangeMin a) where + rank0 = rank0 . rangeMinBP + {-# INLINE rank0 #-} + +instance (BitLength a) => BitLength (RangeMin a) where + bitLength = bitLength . rangeMinBP + {-# INLINE bitLength #-} + +instance (OpenAt a) => OpenAt (RangeMin a) where + openAt = openAt . rangeMinBP + {-# INLINE openAt #-} + +instance (CloseAt a) => CloseAt (RangeMin a) where + closeAt = closeAt . rangeMinBP + {-# INLINE closeAt #-} + +instance (NewCloseAt a) => NewCloseAt (RangeMin a) where + newCloseAt = newCloseAt . rangeMinBP + {-# INLINE newCloseAt #-} + +instance (FindOpenN a) => FindOpenN (RangeMin a) where + findOpenN = findOpenN . rangeMinBP + {-# INLINE findOpenN #-} + +instance (BitLength a, NewCloseAt a) => FindCloseN (RangeMin a) where + findCloseN v s p = (+ 1) `fmap` rm2FindClose v (fromIntegral s) (p - 1) FindFromL0 + {-# INLINE findCloseN #-} + +instance (BitLength a, CloseAt a, NewCloseAt a, FindCloseN a) => FindClose (RangeMin a) where + findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance (OpenAt a, FindOpenN a) => FindOpen (RangeMin a) where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance (FindOpenN a) => Enclose (RangeMin a) where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindOpenN a, FindCloseN a) => BalancedParens (RangeMin a) diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/RangeMin2.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/RangeMin2.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/RangeMin2.hs @@ -0,0 +1,276 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Data.Succinct.BalancedParens.RangeMin2 + ( RangeMin2(..) + , mkRangeMin2 + ) where + +import Control.DeepSeq +import Data.Int +import GHC.Generics +import HaskellWorks.Data.AtIndex +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindCloseN +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.FindOpenN +import Data.Succinct.BalancedParens.NewCloseAt +import Data.Succinct.BalancedParens.OpenAt +import HaskellWorks.Data.Bits.AllExcess.AllExcess1 +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Excess.MinExcess +import Data.Succinct.Excess.MinExcess1 +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (length) + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Vector.Storable as DVS + +data RangeMin2 a = RangeMin2 + { rangeMin2BP :: !a + , rangeMin2L0Min :: !(DVS.Vector Int8) + , rangeMin2L0Excess :: !(DVS.Vector Int8) + , rangeMin2L1Min :: !(DVS.Vector Int16) + , rangeMin2L1Excess :: !(DVS.Vector Int16) + , rangeMin2L2Min :: !(DVS.Vector Int16) + , rangeMin2L2Excess :: !(DVS.Vector Int16) + , rangeMin2L3Min :: !(DVS.Vector Int16) + , rangeMin2L3Excess :: !(DVS.Vector Int16) + , rangeMin2L4Min :: !(DVS.Vector Int16) + , rangeMin2L4Excess :: !(DVS.Vector Int16) + } deriving (NFData, Generic) + +factorL0 :: Integral a => a +factorL0 = 1 +{-# INLINE factorL0 #-} + +factorL1 :: Integral a => a +factorL1 = 32 +{-# INLINE factorL1 #-} + +factorL2 :: Integral a => a +factorL2 = 32 +{-# INLINE factorL2 #-} + +factorL3 :: Integral a => a +factorL3 = 32 +{-# INLINE factorL3 #-} + +factorL4 :: Integral a => a +factorL4 = 32 +{-# INLINE factorL4 #-} + +pageSizeL0 :: Integral a => a +pageSizeL0 = factorL0 +{-# INLINE pageSizeL0 #-} + +pageSizeL1 :: Integral a => a +pageSizeL1 = pageSizeL0 * factorL1 +{-# INLINE pageSizeL1 #-} + +pageSizeL2 :: Integral a => a +pageSizeL2 = pageSizeL1 * factorL2 +{-# INLINE pageSizeL2 #-} + +pageSizeL3 :: Integral a => a +pageSizeL3 = pageSizeL2 * factorL3 +{-# INLINE pageSizeL3 #-} + +pageSizeL4 :: Integral a => a +pageSizeL4 = pageSizeL3 * factorL4 +{-# INLINE pageSizeL4 #-} + +mkRangeMin2 :: AsVector64 a => a -> RangeMin2 a +mkRangeMin2 bp = RangeMin2 + { rangeMin2BP = bp + , rangeMin2L0Min = DVS.reword rmL0Min + , rangeMin2L0Excess = DVS.reword rmL0Excess + , rangeMin2L1Min = rmL1Min + , rangeMin2L1Excess = rmL1Excess + , rangeMin2L2Min = rmL2Min + , rangeMin2L2Excess = rmL2Excess + , rangeMin2L3Min = rmL3Min + , rangeMin2L3Excess = rmL3Excess + , rangeMin2L4Min = rmL4Min + , rangeMin2L4Excess = rmL4Excess + } + where bpv = asVector64 bp + lenBP = fromIntegral (length bpv) :: Int + lenL0 = lenBP + lenL1 = (DVS.length rmL0Min `div` pageSizeL1) + 1 :: Int + lenL2 = (DVS.length rmL0Min `div` pageSizeL2) + 1 :: Int + lenL3 = (DVS.length rmL0Min `div` pageSizeL3) + 1 :: Int + lenL4 = (DVS.length rmL0Min `div` pageSizeL4) + 1 :: Int + allMinL0 = DV.generate lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i)) + -- Note: (0xffffffffffffffc0 :: Int64) = -64 + rmL0Excess = DVS.generate lenL0 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL1Excess = DVS.generate lenL1 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL2Excess = DVS.generate lenL2 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL3Excess = DVS.generate lenL3 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL3 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL4Excess = DVS.generate lenL4 (\i -> fromIntegral (allExcess1 (DVS.pageFill i pageSizeL4 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 + rmL0Min = DVS.generate lenL0 (\i -> let MinExcess minE _ = allMinL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16 + rmL1Min = DVS.generate lenL1 (\i -> genMin 0 (DVS.pageFill i factorL1 0 rmL0Min) (DVS.pageFill i factorL1 0 rmL0Excess)) + rmL2Min = DVS.generate lenL2 (\i -> genMin 0 (DVS.pageFill i factorL2 0 rmL1Min) (DVS.pageFill i factorL2 0 rmL1Excess)) + rmL3Min = DVS.generate lenL3 (\i -> genMin 0 (DVS.pageFill i factorL3 0 rmL2Min) (DVS.pageFill i factorL3 0 rmL2Excess)) + rmL4Min = DVS.generate lenL4 (\i -> genMin 0 (DVS.pageFill i factorL4 0 rmL3Min) (DVS.pageFill i factorL4 0 rmL3Excess)) + +genMin :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a +genMin mL mins excesses = if not (DVS.null mins) || not (DVS.null excesses) + then genMin (DVS.lastOrZero mins `min` (mL + DVS.lastOrZero excesses)) (DVS.init mins) (DVS.init excesses) + else mL + +data FindState = FindBP + | FindL0 | FindFromL0 + | FindL1 | FindFromL1 + | FindL2 | FindFromL2 + | FindL3 | FindFromL3 + | FindL4 | FindFromL4 + +rm2FindClose :: (BitLength a, NewCloseAt a) => RangeMin2 a -> Int -> Count -> FindState -> Maybe Count +rm2FindClose v s p FindBP = if v `newCloseAt` p + then if s <= 1 + then Just p + else rm2FindClose v (s - 1) (p + 1) FindFromL0 + else rm2FindClose v (s + 1) (p + 1) FindFromL0 +rm2FindClose v s p FindL0 = + let i = p `div` 64 in + let mins = rangeMin2L0Min v in + let minE = fromIntegral (mins !!! fromIntegral i) :: Int in + if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindBP + else if v `newCloseAt` p && s <= 1 + then Just p + else let excesses = rangeMin2L0Excess v in + let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in + rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0 +rm2FindClose v s p FindL1 = + let !i = p `div` (64 * pageSizeL1) in + let !mins = rangeMin2L1Min v in + let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in + if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindL0 + else if 0 <= p && p < bitLength v + then if v `newCloseAt` p && s <= 1 + then Just p + else let excesses = rangeMin2L1Excess v in + let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in + rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1 + else Nothing +rm2FindClose v s p FindL2 = + let !i = p `div` (64 * pageSizeL2) in + let !mins = rangeMin2L2Min v in + let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in + if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindL1 + else if 0 <= p && p < bitLength v + then if v `newCloseAt` p && s <= 1 + then Just p + else let excesses = rangeMin2L2Excess v in + let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in + rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2 + else Nothing +rm2FindClose v s p FindL3 = + let !i = p `div` (64 * pageSizeL3) in + let !mins = rangeMin2L3Min v in + let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in + if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindL2 + else if 0 <= p && p < bitLength v + then if v `newCloseAt` p && s <= 1 + then Just p + else let excesses = rangeMin2L3Excess v in + let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in + rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL3)) FindFromL3 + else Nothing +rm2FindClose v s p FindL4 = + let !i = p `div` (64 * pageSizeL4) in + let !mins = rangeMin2L4Min v in + let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in + if fromIntegral s + minE <= 0 + then rm2FindClose v s p FindL3 + else if 0 <= p && p < bitLength v + then if v `newCloseAt` p && s <= 1 + then Just p + else let excesses = rangeMin2L4Excess v in + let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in + rm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL4)) FindFromL4 + else Nothing +rm2FindClose v s p FindFromL0 + | p `mod` 64 == 0 = rm2FindClose v s p FindFromL1 + | 0 <= p && p < bitLength v = rm2FindClose v s p FindBP + | otherwise = Nothing +rm2FindClose v s p FindFromL1 + | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL2 else Nothing + | 0 <= p && p < bitLength v = rm2FindClose v s p FindL0 + | otherwise = Nothing +rm2FindClose v s p FindFromL2 + | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL3 else Nothing + | 0 <= p && p < bitLength v = rm2FindClose v s p FindL1 + | otherwise = Nothing +rm2FindClose v s p FindFromL3 + | p `mod` (64 * pageSizeL3) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindFromL4 else Nothing + | 0 <= p && p < bitLength v = rm2FindClose v s p FindL2 + | otherwise = Nothing +rm2FindClose v s p FindFromL4 + | p `mod` (64 * pageSizeL4) == 0 = if 0 <= p && p < bitLength v then rm2FindClose v s p FindL4 else Nothing + | 0 <= p && p < bitLength v = rm2FindClose v s p FindL3 + | otherwise = Nothing +{-# INLINE rm2FindClose #-} + +instance TestBit a => TestBit (RangeMin2 a) where + (.?.) = (.?.) . rangeMin2BP + {-# INLINE (.?.) #-} + +instance Rank1 a => Rank1 (RangeMin2 a) where + rank1 = rank1 . rangeMin2BP + {-# INLINE rank1 #-} + +instance Rank0 a => Rank0 (RangeMin2 a) where + rank0 = rank0 . rangeMin2BP + {-# INLINE rank0 #-} + +instance BitLength a => BitLength (RangeMin2 a) where + bitLength = bitLength . rangeMin2BP + {-# INLINE bitLength #-} + +instance OpenAt a => OpenAt (RangeMin2 a) where + openAt = openAt . rangeMin2BP + {-# INLINE openAt #-} + +instance CloseAt a => CloseAt (RangeMin2 a) where + closeAt = closeAt . rangeMin2BP + {-# INLINE closeAt #-} + +instance NewCloseAt a => NewCloseAt (RangeMin2 a) where + newCloseAt = newCloseAt . rangeMin2BP + {-# INLINE newCloseAt #-} + +instance FindOpenN a => FindOpenN (RangeMin2 a) where + findOpenN = findOpenN . rangeMin2BP + {-# INLINE findOpenN #-} + +instance (BitLength a, FindCloseN a, NewCloseAt a) => FindCloseN (RangeMin2 a) where + findCloseN v s p = (+ 1) `fmap` rm2FindClose v (fromIntegral s) (p - 1) FindFromL0 + {-# INLINE findCloseN #-} + +instance (BitLength a, NewCloseAt a, CloseAt a, FindCloseN a) => FindClose (RangeMin2 a) where + findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) + {-# INLINE findClose #-} + +instance (OpenAt a, FindOpenN a) => FindOpen (RangeMin2 a) where + findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) + {-# INLINE findOpen #-} + +instance FindOpenN a => Enclose (RangeMin2 a) where + enclose v = findOpenN v 1 + {-# INLINE enclose #-} + +instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindOpenN a, FindCloseN a) => BalancedParens (RangeMin2 a) diff --git a/components/succinct-core/src/Data/Succinct/BalancedParens/Simple.hs b/components/succinct-core/src/Data/Succinct/BalancedParens/Simple.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/BalancedParens/Simple.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.BalancedParens.Simple + ( SimpleBalancedParens(..) + ) where + +import Control.Monad +import GHC.Generics +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.OpenAt +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.Base.Select1 +import Prelude as P + +newtype SimpleBalancedParens a = SimpleBalancedParens a + deriving (BalancedParens, FindOpen, FindClose, Enclose, OpenAt, CloseAt, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit, Generic) + +instance Functor SimpleBalancedParens where + fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a) + {-# INLINABLE fmap #-} + +instance BitShow a => Show (SimpleBalancedParens a) where + show = bitShow diff --git a/components/succinct-core/src/Data/Succinct/Excess.hs b/components/succinct-core/src/Data/Succinct/Excess.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess.hs @@ -0,0 +1,6 @@ +module Data.Succinct.Excess + ( module X + ) where + +import Data.Succinct.Excess.Excess0 as X +import Data.Succinct.Excess.Excess1 as X diff --git a/components/succinct-core/src/Data/Succinct/Excess/Excess0.hs b/components/succinct-core/src/Data/Succinct/Excess/Excess0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/Excess0.hs @@ -0,0 +1,45 @@ +module Data.Succinct.Excess.Excess0 + ( Excess0(..) + ) where + +import Data.Word +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 + +import qualified Data.Vector.Storable as DVS + +class Excess0 v where + excess0 :: v -> Count -> Int + +instance Excess0 Word8 where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} + +instance Excess0 Word16 where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} + +instance Excess0 Word32 where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} + +instance Excess0 Word64 where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} + +instance Excess0 (DVS.Vector Word8) where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} + +instance Excess0 (DVS.Vector Word16) where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} + +instance Excess0 (DVS.Vector Word32) where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} + +instance Excess0 (DVS.Vector Word64) where + excess0 v c = fromIntegral (rank0 v c) - fromIntegral (rank1 v c) + {-# INLINE excess0 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/Excess1.hs b/components/succinct-core/src/Data/Succinct/Excess/Excess1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/Excess1.hs @@ -0,0 +1,45 @@ +module Data.Succinct.Excess.Excess1 + ( Excess1(..) + ) where + +import Data.Word +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 + +import qualified Data.Vector.Storable as DVS + +class Excess1 v where + excess1 :: v -> Count -> Int + +instance Excess1 Word8 where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} + +instance Excess1 Word16 where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} + +instance Excess1 Word32 where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} + +instance Excess1 Word64 where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} + +instance Excess1 (DVS.Vector Word8) where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} + +instance Excess1 (DVS.Vector Word16) where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} + +instance Excess1 (DVS.Vector Word32) where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} + +instance Excess1 (DVS.Vector Word64) where + excess1 v c = fromIntegral (rank1 v c) - fromIntegral (rank0 v c) + {-# INLINE excess1 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/Internal/Branchless.hs b/components/succinct-core/src/Data/Succinct/Excess/Internal/Branchless.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/Internal/Branchless.hs @@ -0,0 +1,31 @@ +module Data.Succinct.Excess.Internal.Branchless + ( maxInt64 + , maxInt + , minInt64 + , minInt + ) where + +import Data.Int +import HaskellWorks.Data.Bits.BitWise + +import qualified HaskellWorks.Data.Branchless as BL + +minInt64 :: Int64 -> Int64 -> Int64 +minInt64 a b = fromIntegral ((m .&. fromIntegral a) .|. (comp m .&. fromIntegral b)) + where t = BL.ltWord64 (fromIntegral (a - minBound)) (fromIntegral (b - minBound)) + m = negate t +{-# INLINE minInt64 #-} + +minInt :: Int -> Int -> Int +minInt a b = fromIntegral (minInt64 (fromIntegral a) (fromIntegral b)) +{-# INLINE minInt #-} + +maxInt64 :: Int64 -> Int64 -> Int64 +maxInt64 a b = fromIntegral ((m .&. fromIntegral a) .|. (comp m .&. fromIntegral b)) + where t = BL.gtWord64 (fromIntegral (a - minBound)) (fromIntegral (b - minBound)) + m = negate t +{-# INLINE maxInt64 #-} + +maxInt :: Int -> Int -> Int +maxInt a b = fromIntegral (maxInt64 (fromIntegral a) (fromIntegral b)) +{-# INLINE maxInt #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/Internal/Partial/Table.hs b/components/succinct-core/src/Data/Succinct/Excess/Internal/Partial/Table.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/Internal/Partial/Table.hs @@ -0,0 +1,75 @@ +module Data.Succinct.Excess.Internal.Partial.Table + ( genWord8Excess0 + , genWord8Excess1 + + , tableWord8Excess0Lo + , tableWord8Excess0Ex + , tableWord8Excess0Hi + , tableWord8Excess1Lo + , tableWord8Excess1Ex + , tableWord8Excess1Hi + ) where + +import Data.Int +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Excess.Internal.Triplet8 (Triplet8 (Triplet8)) + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Triplet8 as T8 + +tableWord8Excess0Lo :: DVS.Vector Int8 +tableWord8Excess0Lo = DVS.generate (256 * 9) go + where go :: Int -> Int8 + go i = T8.triplet8Lo (genWord8Excess0 (i `div` 256) (fromIntegral i)) +{-# NOINLINE tableWord8Excess0Lo #-} + +tableWord8Excess0Ex :: DVS.Vector Int8 +tableWord8Excess0Ex = DVS.generate (256 * 9) go + where go :: Int -> Int8 + go i = T8.triplet8Ex (genWord8Excess0 (i `div` 256) (fromIntegral i)) +{-# NOINLINE tableWord8Excess0Ex #-} + +tableWord8Excess0Hi :: DVS.Vector Int8 +tableWord8Excess0Hi = DVS.generate (256 * 9) go + where go :: Int -> Int8 + go i = T8.triplet8Hi (genWord8Excess0 (i `div` 256) (fromIntegral i)) +{-# NOINLINE tableWord8Excess0Hi #-} + +tableWord8Excess1Lo :: DVS.Vector Int8 +tableWord8Excess1Lo = DVS.generate (256 * 9) go + where go :: Int -> Int8 + go i = T8.triplet8Lo (genWord8Excess1 (i `div` 256) (fromIntegral i)) +{-# NOINLINE tableWord8Excess1Lo #-} + +tableWord8Excess1Ex :: DVS.Vector Int8 +tableWord8Excess1Ex = DVS.generate (256 * 9) go + where go :: Int -> Int8 + go i = T8.triplet8Ex (genWord8Excess1 (i `div` 256) (fromIntegral i)) +{-# NOINLINE tableWord8Excess1Ex #-} + +tableWord8Excess1Hi :: DVS.Vector Int8 +tableWord8Excess1Hi = DVS.generate (256 * 9) go + where go :: Int -> Int8 + go i = T8.triplet8Hi (genWord8Excess1 (i `div` 256) (fromIntegral i)) +{-# NOINLINE tableWord8Excess1Hi #-} + +genWord8Excess0 :: Int -> Word8 -> Triplet8 +genWord8Excess0 = go 0 0 0 + where go :: Int8 -> Int8 -> Int8 -> Int -> Word8 -> Triplet8 + go lo ex hi n w = if n > 0 + then if w .&. 1 /= 1 + then let fx = ex + 1 in go lo fx (max hi fx) (n - 1) (w .>. 1) + else let fx = ex - 1 in go (min lo fx) fx hi (n - 1) (w .>. 1) + else Triplet8 lo ex hi +{-# INLINE genWord8Excess0 #-} + +genWord8Excess1 :: Int -> Word8 -> Triplet8 +genWord8Excess1 = go 0 0 0 + where go :: Int8 -> Int8 -> Int8 -> Int -> Word8 -> Triplet8 + go lo ex hi n w = if n > 0 + then if w .&. 1 /= 0 + then let fx = ex + 1 in go lo fx (max hi fx) (n - 1) (w .>. 1) + else let fx = ex - 1 in go (min lo fx) fx hi (n - 1) (w .>. 1) + else Triplet8 lo ex hi +{-# INLINE genWord8Excess1 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/Internal/Table.hs b/components/succinct-core/src/Data/Succinct/Excess/Internal/Table.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/Internal/Table.hs @@ -0,0 +1,136 @@ +module Data.Succinct.Excess.Internal.Table + ( word8Excess0 + , word8Excess0Max + , word8Excess0Min + , word8Excess1 + , word8Excess1Max + , word8Excess1Min + ) where + +import qualified Data.Vector.Storable as DVS + +word8Excess0Min :: DVS.Vector Int +word8Excess0Min = DVS.fromList + [ 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4 + , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5 + , 0, -1, -1, -3, -1, -3, -3, -5, -1, -3, -3, -5, -3, -5, -5, -7 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4 + , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4 + , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 0, -2, -2, -4, -2, -4, -4, -6, -2, -4, -4, -6, -4, -6, -6, -8 + ] +{-# NOINLINE word8Excess0Min #-} + +word8Excess0 :: DVS.Vector Int +word8Excess0 = DVS.fromList + [ 8, 6, 6, 4, 6, 4, 4, 2, 6, 4, 4, 2, 4, 2, 2, 0 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2 + , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2 + , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4 + , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4 + , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2 + , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4 + , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4 + , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4 + , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6 + , 0, -2, -2, -4, -2, -4, -4, -6, -2, -4, -4, -6, -4, -6, -6, -8 + ] +{-# NOINLINE word8Excess0 #-} + +word8Excess0Max :: DVS.Vector Int +word8Excess0Max = DVS.fromList + [ 8, 6, 6, 4, 6, 4, 4, 2, 6, 4, 4, 2, 4, 2, 2, 0 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0 + , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0 + , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 7, 5, 5, 3, 5, 3, 3, 1, 5, 3, 3, 1, 3, 1, 1, 0 + , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0 + , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0 + ] +{-# NOINLINE word8Excess0Max #-} + +word8Excess1Min :: DVS.Vector Int +word8Excess1Min = DVS.fromList + [ -8, -6, -6, -4, -6, -4, -4, -2, -6, -4, -4, -2, -4, -2, -2, 0 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0 + , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0 + , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -7, -5, -5, -3, -5, -3, -3, -1, -5, -3, -3, -1, -3, -1, -1, 0 + , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0 + , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0 + ] +{-# NOINLINE word8Excess1Min #-} + +word8Excess1 :: DVS.Vector Int +word8Excess1 = DVS.fromList + [ -8, -6, -6, -4, -6, -4, -4, -2, -6, -4, -4, -2, -4, -2, -2, 0 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2 + , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2 + , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4 + , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4 + , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2 + , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4 + , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4 + , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4 + , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , 0, 2, 2, 4, 2, 4, 4, 6, 2, 4, 4, 6, 4, 6, 6, 8 + ] +{-# NOINLINE word8Excess1 #-} + +word8Excess1Max :: DVS.Vector Int +word8Excess1Max = DVS.fromList + [ 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4 + , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5 + , 0, 1, 1, 3, 1, 3, 3, 5, 1, 3, 3, 5, 3, 5, 5, 7 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4 + , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4 + , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6 + , 0, 2, 2, 4, 2, 4, 4, 6, 2, 4, 4, 6, 4, 6, 6, 8 + ] +{-# NOINLINE word8Excess1Max #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/Internal/Triplet8.hs b/components/succinct-core/src/Data/Succinct/Excess/Internal/Triplet8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/Internal/Triplet8.hs @@ -0,0 +1,11 @@ +module Data.Succinct.Excess.Internal.Triplet8 + ( Triplet8(..) + ) where + +import Data.Int + +data Triplet8 = Triplet8 + { triplet8Lo :: {-# UNPACK #-} !Int8 + , triplet8Ex :: {-# UNPACK #-} !Int8 + , triplet8Hi :: {-# UNPACK #-} !Int8 + } deriving (Eq, Show) diff --git a/components/succinct-core/src/Data/Succinct/Excess/MinExcess.hs b/components/succinct-core/src/Data/Succinct/Excess/MinExcess.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/MinExcess.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC-funbox-strict-fields #-} + +module Data.Succinct.Excess.MinExcess + ( MinExcess(..) + ) where + +import Foreign.Ptr (castPtr) +import Foreign.Storable (Storable (..)) + +#if !MIN_VERSION_base(4,13,0) +import Control.Applicative (pure) +#endif + +data MinExcess = MinExcess + { minExcessMin :: !Int + , minExcessAll :: !Int + } deriving (Eq, Show) + +instance Storable MinExcess where + sizeOf _ = sizeOf (0 :: Int) * 3 + alignment _ = alignment (0 :: Int) + peek p = do let q = castPtr p + a <- peek q + b <- peekElemOff q 1 + pure (MinExcess a b) + poke p t = do let q = castPtr p + poke q (minExcessMin t) + pokeElemOff q 1 (minExcessAll t) diff --git a/components/succinct-core/src/Data/Succinct/Excess/MinExcess0.hs b/components/succinct-core/src/Data/Succinct/Excess/MinExcess0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/MinExcess0.hs @@ -0,0 +1,109 @@ +module Data.Succinct.Excess.MinExcess0 + ( MinExcess0(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.FixedBitSize +import Data.Succinct.Excess.Internal.Table +import Data.Succinct.Excess.MinExcess +import HaskellWorks.Data.Naive + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL + +class MinExcess0 a where + minExcess0 :: a -> MinExcess + +instance MinExcess0 [Bool] where + minExcess0 = go 0 0 + where go minE allE (x:xs) = let ne = if x then allE - 1 else allE + 1 in + go (BL.minInt minE ne) ne xs + go minE allE _ = MinExcess minE allE + {-# INLINE minExcess0 #-} + +instance MinExcess0 (Naive Word8) where + minExcess0 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess0 #-} + +instance MinExcess0 (Naive Word16) where + minExcess0 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess0 #-} + +instance MinExcess0 (Naive Word32) where + minExcess0 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess0 #-} + +instance MinExcess0 (Naive Word64) where + minExcess0 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess0 #-} + +instance MinExcess0 Word8 where + minExcess0 w = MinExcess (DVS.unsafeIndex word8Excess0Min (fromIntegral w)) + (DVS.unsafeIndex word8Excess0 (fromIntegral w)) + {-# INLINE minExcess0 #-} + +instance MinExcess0 Word16 where + minExcess0 w = MinExcess (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + where MinExcess minExcessA allExcessA = minExcess0 (fromIntegral w :: Word8) + MinExcess minExcessB allExcessB = minExcess0 (fromIntegral (w .>. 8) :: Word8) + {-# INLINE minExcess0 #-} + +instance MinExcess0 Word32 where + minExcess0 w = MinExcess (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + where MinExcess minExcessA allExcessA = minExcess0 (fromIntegral w :: Word16) + MinExcess minExcessB allExcessB = minExcess0 (fromIntegral (w .>. 16) :: Word16) + {-# INLINE minExcess0 #-} + +instance MinExcess0 Word64 where + minExcess0 w = MinExcess (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + where MinExcess minExcessA allExcessA = minExcess0 (fromIntegral w :: Word32) + MinExcess minExcessB allExcessB = minExcess0 (fromIntegral (w .>. 32) :: Word32) + {-# INLINE minExcess0 #-} + +instance MinExcess0 (DVS.Vector Word8) where + minExcess0 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word8 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess0 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess0 #-} + +instance MinExcess0 (DVS.Vector Word16) where + minExcess0 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word16 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess0 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess0 #-} + +instance MinExcess0 (DVS.Vector Word32) where + minExcess0 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word32 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess0 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess0 #-} + +instance MinExcess0 (DVS.Vector Word64) where + minExcess0 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word64 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess0 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess0 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/MinExcess1.hs b/components/succinct-core/src/Data/Succinct/Excess/MinExcess1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/MinExcess1.hs @@ -0,0 +1,109 @@ +module Data.Succinct.Excess.MinExcess1 + ( MinExcess1(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.FixedBitSize +import Data.Succinct.Excess.Internal.Table +import Data.Succinct.Excess.MinExcess +import HaskellWorks.Data.Naive + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL + +class MinExcess1 a where + minExcess1 :: a -> MinExcess + +instance MinExcess1 [Bool] where + minExcess1 = go 0 0 + where go minE allE (x:xs) = let ne = if x then allE + 1 else allE - 1 in + go (BL.minInt minE ne) ne xs + go minE allE _ = MinExcess minE allE + {-# INLINE minExcess1 #-} + +instance MinExcess1 (Naive Word8) where + minExcess1 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess1 #-} + +instance MinExcess1 (Naive Word16) where + minExcess1 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess1 #-} + +instance MinExcess1 (Naive Word32) where + minExcess1 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess1 #-} + +instance MinExcess1 (Naive Word64) where + minExcess1 = go 0 0 0 . naive + where go minE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) ne (n + 1) w + go minE allE _ _ = MinExcess minE allE + {-# INLINE minExcess1 #-} + +instance MinExcess1 Word8 where + minExcess1 w = MinExcess (DVS.unsafeIndex word8Excess1Min (fromIntegral w)) + (DVS.unsafeIndex word8Excess1 (fromIntegral w)) + {-# INLINE minExcess1 #-} + +instance MinExcess1 Word16 where + minExcess1 w = MinExcess (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + where MinExcess minExcessA allExcessA = minExcess1 (fromIntegral w :: Word8) + MinExcess minExcessB allExcessB = minExcess1 (fromIntegral (w .>. 8) :: Word8) + {-# INLINE minExcess1 #-} + +instance MinExcess1 Word32 where + minExcess1 w = MinExcess (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + where MinExcess minExcessA allExcessA = minExcess1 (fromIntegral w :: Word16) + MinExcess minExcessB allExcessB = minExcess1 (fromIntegral (w .>. 16) :: Word16) + {-# INLINE minExcess1 #-} + +instance MinExcess1 Word64 where + minExcess1 w = MinExcess (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + where MinExcess minExcessA allExcessA = minExcess1 (fromIntegral w :: Word32) + MinExcess minExcessB allExcessB = minExcess1 (fromIntegral (w .>. 32) :: Word32) + {-# INLINE minExcess1 #-} + +instance MinExcess1 (DVS.Vector Word8) where + minExcess1 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word8 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess1 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess1 #-} + +instance MinExcess1 (DVS.Vector Word16) where + minExcess1 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word16 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess1 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess1 #-} + +instance MinExcess1 (DVS.Vector Word32) where + minExcess1 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word32 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess1 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess1 #-} + +instance MinExcess1 (DVS.Vector Word64) where + minExcess1 = DVS.foldl' gen (MinExcess 0 0) + where gen :: MinExcess -> Word64 -> MinExcess + gen (MinExcess minE allE) w = let MinExcess wMinE wAllE = minExcess1 w in + MinExcess (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + {-# INLINE minExcess1 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/MinMaxExcess0.hs b/components/succinct-core/src/Data/Succinct/Excess/MinMaxExcess0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/MinMaxExcess0.hs @@ -0,0 +1,117 @@ +module Data.Succinct.Excess.MinMaxExcess0 + ( MinMaxExcess0(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.FixedBitSize +import Data.Succinct.Excess.Internal.Table +import Data.Succinct.Excess.Triplet +import HaskellWorks.Data.Naive + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL + +class MinMaxExcess0 a where + minMaxExcess0 :: a -> Triplet + +instance MinMaxExcess0 [Bool] where + minMaxExcess0 = go 0 0 0 + where go minE maxE allE (x:xs) = let ne = if x then allE - 1 else allE + 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne xs + go minE maxE allE _ = Triplet minE allE maxE + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (Naive Word8) where + minMaxExcess0 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (Naive Word16) where + minMaxExcess0 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (Naive Word32) where + minMaxExcess0 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (Naive Word64) where + minMaxExcess0 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE - 1 else allE + 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 Word8 where + minMaxExcess0 w = Triplet (DVS.unsafeIndex word8Excess0Min (fromIntegral w)) + (DVS.unsafeIndex word8Excess0 (fromIntegral w)) + (DVS.unsafeIndex word8Excess0Max (fromIntegral w)) + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 Word16 where + minMaxExcess0 w = Triplet (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + (BL.maxInt maxExcessA (maxExcessB + allExcessA)) + where Triplet minExcessA allExcessA maxExcessA = minMaxExcess0 (fromIntegral w :: Word8) + Triplet minExcessB allExcessB maxExcessB = minMaxExcess0 (fromIntegral (w .>. 8) :: Word8) + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 Word32 where + minMaxExcess0 w = Triplet (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + (BL.maxInt maxExcessA (maxExcessB + allExcessA)) + where Triplet minExcessA allExcessA maxExcessA = minMaxExcess0 (fromIntegral w :: Word16) + Triplet minExcessB allExcessB maxExcessB = minMaxExcess0 (fromIntegral (w .>. 16) :: Word16) + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 Word64 where + minMaxExcess0 w = Triplet (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + (BL.maxInt maxExcessA (maxExcessB + allExcessA)) + where Triplet minExcessA allExcessA maxExcessA = minMaxExcess0 (fromIntegral w :: Word32) + Triplet minExcessB allExcessB maxExcessB = minMaxExcess0 (fromIntegral (w .>. 32) :: Word32) + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (DVS.Vector Word8) where + minMaxExcess0 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word8 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess0 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (DVS.Vector Word16) where + minMaxExcess0 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word16 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess0 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (DVS.Vector Word32) where + minMaxExcess0 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word32 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess0 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess0 #-} + +instance MinMaxExcess0 (DVS.Vector Word64) where + minMaxExcess0 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word64 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess0 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess0 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/MinMaxExcess1.hs b/components/succinct-core/src/Data/Succinct/Excess/MinMaxExcess1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/MinMaxExcess1.hs @@ -0,0 +1,117 @@ +module Data.Succinct.Excess.MinMaxExcess1 + ( MinMaxExcess1(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.FixedBitSize +import Data.Succinct.Excess.Internal.Table +import Data.Succinct.Excess.Triplet +import HaskellWorks.Data.Naive + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL + +class MinMaxExcess1 a where + minMaxExcess1 :: a -> Triplet + +instance MinMaxExcess1 [Bool] where + minMaxExcess1 = go 0 0 0 + where go minE maxE allE (x:xs) = let ne = if x then allE + 1 else allE - 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne xs + go minE maxE allE _ = Triplet minE allE maxE + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (Naive Word8) where + minMaxExcess1 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (Naive Word16) where + minMaxExcess1 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (Naive Word32) where + minMaxExcess1 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (Naive Word64) where + minMaxExcess1 = go 0 0 0 0 . naive + where go minE maxE allE n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then allE + 1 else allE - 1 in + go (BL.minInt minE ne) (BL.maxInt maxE ne) ne (n + 1) w + go minE maxE allE _ _ = Triplet minE allE maxE + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 Word8 where + minMaxExcess1 w = Triplet (DVS.unsafeIndex word8Excess1Min (fromIntegral w)) + (DVS.unsafeIndex word8Excess1 (fromIntegral w)) + (DVS.unsafeIndex word8Excess1Max (fromIntegral w)) + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 Word16 where + minMaxExcess1 w = Triplet (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + (BL.maxInt maxExcessA (maxExcessB + allExcessA)) + where Triplet minExcessA allExcessA maxExcessA = minMaxExcess1 (fromIntegral w :: Word8) + Triplet minExcessB allExcessB maxExcessB = minMaxExcess1 (fromIntegral (w .>. 8) :: Word8) + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 Word32 where + minMaxExcess1 w = Triplet (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + (BL.maxInt maxExcessA (maxExcessB + allExcessA)) + where Triplet minExcessA allExcessA maxExcessA = minMaxExcess1 (fromIntegral w :: Word16) + Triplet minExcessB allExcessB maxExcessB = minMaxExcess1 (fromIntegral (w .>. 16) :: Word16) + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 Word64 where + minMaxExcess1 w = Triplet (BL.minInt minExcessA (minExcessB + allExcessA)) + (allExcessA + allExcessB) + (BL.maxInt maxExcessA (maxExcessB + allExcessA)) + where Triplet minExcessA allExcessA maxExcessA = minMaxExcess1 (fromIntegral w :: Word32) + Triplet minExcessB allExcessB maxExcessB = minMaxExcess1 (fromIntegral (w .>. 32) :: Word32) + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (DVS.Vector Word8) where + minMaxExcess1 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word8 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess1 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (DVS.Vector Word16) where + minMaxExcess1 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word16 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess1 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (DVS.Vector Word32) where + minMaxExcess1 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word32 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess1 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess1 #-} + +instance MinMaxExcess1 (DVS.Vector Word64) where + minMaxExcess1 = DVS.foldl' gen (Triplet 0 0 0) + where gen :: Triplet -> Word64 -> Triplet + gen (Triplet minE allE maxE) w = let Triplet wMinE wAllE wMaxE = minMaxExcess1 w in + Triplet (BL.minInt minE (wMinE + allE)) + ( wAllE + allE ) + (BL.maxInt maxE (wMaxE + allE)) + {-# INLINE minMaxExcess1 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/PartialMinExcess0.hs b/components/succinct-core/src/Data/Succinct/Excess/PartialMinExcess0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/PartialMinExcess0.hs @@ -0,0 +1,44 @@ +module Data.Succinct.Excess.PartialMinExcess0 + ( PartialMinExcess0(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Excess.MinExcess + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL +import qualified Data.Succinct.Excess.Internal.Partial.Table as T + +class PartialMinExcess0 a where + partialMinExcess0 :: Int -> a -> MinExcess + +instance PartialMinExcess0 Word8 where + partialMinExcess0 n w = MinExcess partialMinExcessMin partialMinExcessAll + where partialMinExcessMin = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess0Lo (n * 256 + fromIntegral w) + partialMinExcessAll = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess0Ex (n * 256 + fromIntegral w) + {-# INLINE partialMinExcess0 #-} + +instance PartialMinExcess0 Word16 where + partialMinExcess0 n w = MinExcess partialMinExcessMin partialMinExcessAll + where MinExcess aMin aAll = partialMinExcess0 8 (fromIntegral w :: Word8) + MinExcess bMin bAll = partialMinExcess0 (n - 8) (fromIntegral (w .>. 8) :: Word8) + partialMinExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinExcessAll = if n <= 8 then aAll else aAll + bAll + {-# INLINE partialMinExcess0 #-} + +instance PartialMinExcess0 Word32 where + partialMinExcess0 n w = MinExcess partialMinExcessMin partialMinExcessAll + where MinExcess aMin aAll = partialMinExcess0 16 (fromIntegral w :: Word16) + MinExcess bMin bAll = partialMinExcess0 (n - 16) (fromIntegral (w .>. 16) :: Word16) + partialMinExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinExcessAll = if n <= 8 then aAll else aAll + bAll + {-# INLINE partialMinExcess0 #-} + +instance PartialMinExcess0 Word64 where + partialMinExcess0 n w = MinExcess partialMinExcessMin partialMinExcessAll + where MinExcess aMin aAll = partialMinExcess0 32 (fromIntegral w :: Word32) + MinExcess bMin bAll = partialMinExcess0 (n - 32) (fromIntegral (w .>. 32) :: Word32) + partialMinExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinExcessAll = if n <= 8 then aAll else aAll + bAll + {-# INLINE partialMinExcess0 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/PartialMinExcess1.hs b/components/succinct-core/src/Data/Succinct/Excess/PartialMinExcess1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/PartialMinExcess1.hs @@ -0,0 +1,44 @@ +module Data.Succinct.Excess.PartialMinExcess1 + ( PartialMinExcess1(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Excess.MinExcess + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL +import qualified Data.Succinct.Excess.Internal.Partial.Table as T + +class PartialMinExcess1 a where + partialMinExcess1 :: Int -> a -> MinExcess + +instance PartialMinExcess1 Word8 where + partialMinExcess1 n w = MinExcess partialMinExcessMin partialMinExcessAll + where partialMinExcessMin = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess1Lo (n * 256 + fromIntegral w) + partialMinExcessAll = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess1Ex (n * 256 + fromIntegral w) + {-# INLINE partialMinExcess1 #-} + +instance PartialMinExcess1 Word16 where + partialMinExcess1 n w = MinExcess partialMinExcessMin partialMinExcessAll + where MinExcess aMin aAll = partialMinExcess1 8 (fromIntegral w :: Word8) + MinExcess bMin bAll = partialMinExcess1 (n - 8) (fromIntegral (w .>. 8) :: Word8) + partialMinExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinExcessAll = if n <= 8 then aAll else aAll + bAll + {-# INLINE partialMinExcess1 #-} + +instance PartialMinExcess1 Word32 where + partialMinExcess1 n w = MinExcess partialMinExcessMin partialMinExcessAll + where MinExcess aMin aAll = partialMinExcess1 16 (fromIntegral w :: Word16) + MinExcess bMin bAll = partialMinExcess1 (n - 16) (fromIntegral (w .>. 16) :: Word16) + partialMinExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinExcessAll = if n <= 8 then aAll else aAll + bAll + {-# INLINE partialMinExcess1 #-} + +instance PartialMinExcess1 Word64 where + partialMinExcess1 n w = MinExcess partialMinExcessMin partialMinExcessAll + where MinExcess aMin aAll = partialMinExcess1 32 (fromIntegral w :: Word32) + MinExcess bMin bAll = partialMinExcess1 (n - 32) (fromIntegral (w .>. 32) :: Word32) + partialMinExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinExcessAll = if n <= 8 then aAll else aAll + bAll + {-# INLINE partialMinExcess1 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/PartialMinMaxExcess0.hs b/components/succinct-core/src/Data/Succinct/Excess/PartialMinMaxExcess0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/PartialMinMaxExcess0.hs @@ -0,0 +1,50 @@ +module Data.Succinct.Excess.PartialMinMaxExcess0 + ( PartialMinMaxExcess0(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Excess.Triplet + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL +import qualified Data.Succinct.Excess.Internal.Partial.Table as T + +{- HLINT ignore "Reduce duplication" -} + +class PartialMinMaxExcess0 a where + partialMinMaxExcess0 :: Int -> a -> Triplet + +instance PartialMinMaxExcess0 Word8 where + partialMinMaxExcess0 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where partialMinMaxExcessMin = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess0Lo (n * 256 + fromIntegral w) + partialMinMaxExcessAll = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess0Ex (n * 256 + fromIntegral w) + partialMinMaxExcessMax = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess0Hi (n * 256 + fromIntegral w) + {-# INLINE partialMinMaxExcess0 #-} + +instance PartialMinMaxExcess0 Word16 where + partialMinMaxExcess0 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where Triplet aMin aAll aMax = partialMinMaxExcess0 8 (fromIntegral w :: Word8) + Triplet bMin bAll bMax = partialMinMaxExcess0 (n - 8) (fromIntegral (w .>. 8) :: Word8) + partialMinMaxExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinMaxExcessAll = if n <= 8 then aAll else aAll + bAll + partialMinMaxExcessMax = if n <= 8 then aMax else BL.maxInt aMax (aAll + bMax) + {-# INLINE partialMinMaxExcess0 #-} + +instance PartialMinMaxExcess0 Word32 where + partialMinMaxExcess0 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where Triplet aMin aAll aMax = partialMinMaxExcess0 16 (fromIntegral w :: Word16) + Triplet bMin bAll bMax = partialMinMaxExcess0 (n - 16) (fromIntegral (w .>. 16) :: Word16) + partialMinMaxExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinMaxExcessAll = if n <= 8 then aAll else aAll + bAll + partialMinMaxExcessMax = if n <= 8 then aMax else BL.maxInt aMax (aAll + bMax) + {-# INLINE partialMinMaxExcess0 #-} + +instance PartialMinMaxExcess0 Word64 where + partialMinMaxExcess0 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where Triplet aMin aAll aMax = partialMinMaxExcess0 32 (fromIntegral w :: Word32) + Triplet bMin bAll bMax = partialMinMaxExcess0 (n - 32) (fromIntegral (w .>. 32) :: Word32) + partialMinMaxExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinMaxExcessAll = if n <= 8 then aAll else aAll + bAll + partialMinMaxExcessMax = if n <= 8 then aMax else BL.maxInt aMax (aAll + bMax) + {-# INLINE partialMinMaxExcess0 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/PartialMinMaxExcess1.hs b/components/succinct-core/src/Data/Succinct/Excess/PartialMinMaxExcess1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/PartialMinMaxExcess1.hs @@ -0,0 +1,50 @@ +module Data.Succinct.Excess.PartialMinMaxExcess1 + ( PartialMinMaxExcess1(..) + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Excess.Triplet + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Branchless as BL +import qualified Data.Succinct.Excess.Internal.Partial.Table as T + +{- HLINT ignore "Reduce duplication" -} + +class PartialMinMaxExcess1 a where + partialMinMaxExcess1 :: Int -> a -> Triplet + +instance PartialMinMaxExcess1 Word8 where + partialMinMaxExcess1 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where partialMinMaxExcessMin = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess1Lo (n * 256 + fromIntegral w) + partialMinMaxExcessAll = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess1Ex (n * 256 + fromIntegral w) + partialMinMaxExcessMax = fromIntegral $ DVS.unsafeIndex T.tableWord8Excess1Hi (n * 256 + fromIntegral w) + {-# INLINE partialMinMaxExcess1 #-} + +instance PartialMinMaxExcess1 Word16 where + partialMinMaxExcess1 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where Triplet aMin aAll aMax = partialMinMaxExcess1 8 (fromIntegral w :: Word8) + Triplet bMin bAll bMax = partialMinMaxExcess1 (n - 8) (fromIntegral (w .>. 8) :: Word8) + partialMinMaxExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinMaxExcessAll = if n <= 8 then aAll else aAll + bAll + partialMinMaxExcessMax = if n <= 8 then aMax else BL.maxInt aMax (aAll + bMax) + {-# INLINE partialMinMaxExcess1 #-} + +instance PartialMinMaxExcess1 Word32 where + partialMinMaxExcess1 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where Triplet aMin aAll aMax = partialMinMaxExcess1 16 (fromIntegral w :: Word16) + Triplet bMin bAll bMax = partialMinMaxExcess1 (n - 16) (fromIntegral (w .>. 16) :: Word16) + partialMinMaxExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinMaxExcessAll = if n <= 8 then aAll else aAll + bAll + partialMinMaxExcessMax = if n <= 8 then aMax else BL.maxInt aMax (aAll + bMax) + {-# INLINE partialMinMaxExcess1 #-} + +instance PartialMinMaxExcess1 Word64 where + partialMinMaxExcess1 n w = Triplet partialMinMaxExcessMin partialMinMaxExcessAll partialMinMaxExcessMax + where Triplet aMin aAll aMax = partialMinMaxExcess1 32 (fromIntegral w :: Word32) + Triplet bMin bAll bMax = partialMinMaxExcess1 (n - 32) (fromIntegral (w .>. 32) :: Word32) + partialMinMaxExcessMin = if n <= 8 then aMin else BL.minInt aMin (aAll + bMin) + partialMinMaxExcessAll = if n <= 8 then aAll else aAll + bAll + partialMinMaxExcessMax = if n <= 8 then aMax else BL.maxInt aMax (aAll + bMax) + {-# INLINE partialMinMaxExcess1 #-} diff --git a/components/succinct-core/src/Data/Succinct/Excess/Triplet.hs b/components/succinct-core/src/Data/Succinct/Excess/Triplet.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Excess/Triplet.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC-funbox-strict-fields #-} + +module Data.Succinct.Excess.Triplet + ( Triplet(..) + ) where + +import Foreign.Ptr (castPtr) +import Foreign.Storable (Storable (..)) + +#if !MIN_VERSION_base(4,13,0) +import Control.Applicative (pure) +#endif + +data Triplet = Triplet + { tripletMinExcess :: !Int + , tripletAllExcess :: !Int + , tripletMaxExcess :: !Int + } deriving (Eq, Show) + +instance Storable Triplet where + sizeOf _ = sizeOf (0 :: Int) * 3 + alignment _ = alignment (0 :: Int) + peek p = do let q = castPtr p + a <- peek q + b <- peekElemOff q 1 + c <- peekElemOff q 2 + pure (Triplet a b c) + poke p t = do let q = castPtr p + poke q (tripletMinExcess t) + pokeElemOff q 1 (tripletAllExcess t) + pokeElemOff q 2 (tripletMaxExcess t) diff --git a/components/succinct-core/src/Data/Succinct/MQuery.hs b/components/succinct-core/src/Data/Succinct/MQuery.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.MQuery where + +import Control.Lens +import Control.Monad +import Data.List +import Data.Succinct.MQuery.Entry +import Data.Succinct.MQuery.Row +import Data.Succinct.MQuery.ToBool +import GHC.Base +import Prettyprinter + +import qualified Data.DList as DL + +newtype MQuery a = MQuery (DL.DList a) + +deriving instance Functor MQuery +deriving instance Applicative MQuery +deriving instance Monad MQuery +deriving instance Alternative MQuery +deriving instance MonadPlus MQuery +deriving instance Foldable MQuery + +class IsPredicate a where + type ArgOf a + toPredicate :: ArgOf a -> (a -> Bool) + +mQuery :: MQuery a -> DL.DList a +mQuery (MQuery a) = a + +instance ToBool (MQuery a) where + toBool = toBool . mQuery + +instance Pretty (MQuery String) where + pretty x = prettyRowOfString (Row 120 (mQuery x)) + +instance Pretty (MQuery Integer) where + pretty x = prettyRowOfString (Row 120 (mQuery x)) + +instance Pretty (MQuery Int) where + pretty x = prettyRowOfString (Row 120 (mQuery x)) + +satisfying :: (a -> Bool) -> a -> MQuery a +satisfying p a | p a = MQuery $ DL.singleton a +satisfying _ _ = MQuery DL.empty + +key :: Entry k v -> MQuery k +key (Entry k _) = MQuery $ DL.singleton k + +value :: Entry k v -> MQuery v +value (Entry _ v) = MQuery $ DL.singleton v + +dlTake :: Int -> DL.DList a -> DL.DList a +dlTake n = DL.fromList . take n . DL.toList + +select :: ToBool b => a -> (a -> b) -> MQuery a +select a f = if toBool (f a) then MQuery (DL.singleton a) else MQuery DL.empty + +having :: (a -> MQuery b) -> a -> MQuery a +having p a = case p a of + MQuery das -> case DL.toList das of + _:_ -> MQuery (DL.singleton a) + _ -> MQuery DL.empty + +valueOf :: Eq a => a -> a -> MQuery a +valueOf a b = if a == b then MQuery (DL.singleton b) else MQuery DL.empty + +limit :: Int -> MQuery a -> MQuery a +limit n (MQuery xs) = MQuery ((DL.fromList . take n . DL.toList) xs) + +skip :: Int -> MQuery a -> MQuery a +skip n (MQuery xs) = MQuery ((DL.fromList . drop n . DL.toList) xs) + +page :: Int -> Int -> MQuery a -> MQuery a +page size n (MQuery xs) = MQuery ((DL.fromList . take size . drop (size * n) . DL.toList) xs) + +sorted :: Ord a => MQuery a -> MQuery a +sorted (MQuery xs) = MQuery ((DL.fromList . sort . DL.toList) xs) + +onList :: ([a] -> [a]) -> MQuery a -> MQuery a +onList f (MQuery xs) = MQuery ((DL.fromList . f . DL.toList) xs) + +count :: MQuery a -> MQuery Int +count (MQuery xs) = MQuery (DL.singleton (length (DL.toList xs))) + +aggregate :: ([a] -> b) -> MQuery a -> MQuery b +aggregate f (MQuery xs) = MQuery (DL.fromList [f (DL.toList xs)]) + +uniq :: Eq a => [a] -> [a] +uniq (a:b:cs) | a == b = uniq (b:cs) +uniq (a:b:cs) = a:uniq (b:cs) +uniq cs = cs + +infixl 1 >>^. +infixl 1 >>^.. + +instance Semigroup (MQuery a) where + MQuery a <> MQuery b = MQuery (a `DL.append` b) + +instance Monoid (MQuery a) where + mempty = MQuery DL.empty + +(/^.) :: Monad m => s -> Getting a s a -> m a +(/^.) a g = return (a ^. g) + +(/^..) :: (Monad m, Foldable t, Monoid (m a)) => s -> Getting (t a) s (t a) -> m a +(/^..) a g = foldMap return (a ^. g) + +(>>^.) :: Monad m => m a -> Getting b a b -> m b +(>>^.) q g = q >>= (/^. g) + +(>>^..) :: (Monad m, Foldable t, Monoid (m a), Monoid (m b)) => m a -> Getting (t b) a (t b) -> m b +(>>^..) q g = q >>= (/^.. g) diff --git a/components/succinct-core/src/Data/Succinct/MQuery/AtLeastSize.hs b/components/succinct-core/src/Data/Succinct/MQuery/AtLeastSize.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery/AtLeastSize.hs @@ -0,0 +1,9 @@ +module Data.Succinct.MQuery.AtLeastSize where + +class AtLeastSize a where + atLeastSize :: a -> Int -> Bool + +instance AtLeastSize [a] where + atLeastSize _ 0 = True + atLeastSize (_:as) n | n > 0 = atLeastSize as (n - 1) + atLeastSize _ _ = False diff --git a/components/succinct-core/src/Data/Succinct/MQuery/Entry.hs b/components/succinct-core/src/Data/Succinct/MQuery/Entry.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery/Entry.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.MQuery.Entry where + +import Prettyprinter + +data Entry k v = Entry k v + +instance (Pretty k, Pretty v) => Pretty (Entry k v) where + pretty (Entry k v) = pretty k <> ": " <> pretty v diff --git a/components/succinct-core/src/Data/Succinct/MQuery/Micro.hs b/components/succinct-core/src/Data/Succinct/MQuery/Micro.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery/Micro.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.MQuery.Micro where + +import Prettyprinter +import Prettyprinter.Render.Text + + +import qualified Data.DList as DL + +newtype Micro a = Micro a + +prettyVs :: Pretty a => [a] -> Doc ann +prettyVs (kv:kvs) = pretty kv <> foldl (<>) mempty ((\jv -> ", " <> pretty jv) `map` kvs) +prettyVs [] = mempty + +putPretty :: Pretty a => a -> IO () +putPretty a = putDoc (pretty a <> hardline) + +prettyKvs :: Pretty (Micro a) => [a] -> Doc ann +prettyKvs (kv:kvs) = pretty (Micro kv) <> foldl (<>) mempty ((\jv -> ", " <> pretty (Micro jv)) `map` kvs) +prettyKvs [] = mempty + +instance Pretty a => Pretty (Micro [a]) where + pretty (Micro xs) = case length xs of + xsLen | xsLen == 0 -> "[]" + xsLen | xsLen <= 10 -> "[" <> prettyVs xs <> "]" + _ -> "[" <> prettyVs (take 10 xs) <> ", ..]" + +instance Pretty a => Pretty (Micro (DL.DList a)) where + pretty (Micro dxs) = case DL.toList dxs of + xs@(_:_:_:_:_:_:_:_:_:_:_:_:_) -> "[" <> prettyVs (take 50 xs) <> ", ..]" + [] -> "[]" + xs -> "[" <> prettyVs xs <> "]" diff --git a/components/succinct-core/src/Data/Succinct/MQuery/Mini.hs b/components/succinct-core/src/Data/Succinct/MQuery/Mini.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery/Mini.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.MQuery.Mini where + +import Data.Succinct.MQuery.AtLeastSize +import Data.Succinct.MQuery.Micro +import Prettyprinter + +import qualified Data.DList as DL + +newtype Mini a = Mini a + +instance Pretty (Micro a) => Pretty (Mini [a]) where + pretty (Mini xs) | xs `atLeastSize` 11 = "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> ", ..]" + pretty (Mini xs) | xs `atLeastSize` 1 = "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> "]" + pretty (Mini _ ) = "[]" + +instance Pretty (Mini a) => Pretty (Mini (DL.DList a)) where + pretty (Mini xs) = vcat (punctuate "," ((pretty . Mini) `map` take 10 (DL.toList xs))) diff --git a/components/succinct-core/src/Data/Succinct/MQuery/Row.hs b/components/succinct-core/src/Data/Succinct/MQuery/Row.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery/Row.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.MQuery.Row where + +import Prettyprinter + +import qualified Data.DList as DL + +type MaxChars = Int + +data Row a = Row MaxChars a + +instance Pretty a => Pretty (Row (DL.DList a)) where + -- TODO implement max chars for Row + pretty (Row _ xs) = vcat (("==> " <>) `map` prettyRows) + where prettyRows :: [Doc ann] + prettyRows = fmap pretty $ DL.toList xs + +prettyRowOfString :: Show a => Row (DL.DList a) -> Doc ann +prettyRowOfString (Row _ xs) = vcat (("==> " <>) `map` prettyRows) + where prettyRows :: [Doc ann] + prettyRows = (pretty . show) `map` DL.toList xs diff --git a/components/succinct-core/src/Data/Succinct/MQuery/Shows.hs b/components/succinct-core/src/Data/Succinct/MQuery/Shows.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery/Shows.hs @@ -0,0 +1,11 @@ +module Data.Succinct.MQuery.Shows where + +import Data.Succinct.MQuery.Micro + +showsVs :: Show a => [a] -> String -> String +showsVs (kv:kvs) = shows kv . foldl (.) id ((\jv -> (", " ++) . shows jv) `map` kvs) +showsVs [] = id + +showKvs :: Show (Micro a) => [a] -> String -> String +showKvs (kv:kvs) = shows (Micro kv) . foldl (.) id ((\jv -> (", " ++) . shows (Micro jv)) `map` kvs) +showKvs [] = id diff --git a/components/succinct-core/src/Data/Succinct/MQuery/ToBool.hs b/components/succinct-core/src/Data/Succinct/MQuery/ToBool.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/MQuery/ToBool.hs @@ -0,0 +1,16 @@ +module Data.Succinct.MQuery.ToBool where + +import qualified Data.DList as DL + +class ToBool a where + toBool :: a -> Bool + +instance ToBool Bool where + toBool = id + +instance ToBool [a] where + toBool (_:_) = True + toBool _ = False + +instance ToBool (DL.DList a) where + toBool = toBool . DL.toList diff --git a/components/succinct-core/src/Data/Succinct/Parser.hs b/components/succinct-core/src/Data/Succinct/Parser.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/Parser.hs @@ -0,0 +1,59 @@ +module Data.Succinct.Parser + ( Parser(..) + ) where + +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Word +import HaskellWorks.Data.Char.IsChar + +import qualified Data.Attoparsec.ByteString as ABS +import qualified Data.Attoparsec.ByteString.Char8 as BC +import qualified Data.Attoparsec.Text as AT +import qualified Data.Attoparsec.Types as T + +class Parser t e | t -> e where + satisfy :: (e -> Bool) -> T.Parser t e + satisfyWith :: (e -> a) -> (a -> Bool) -> T.Parser t a + satisfyChar :: (Char -> Bool) -> T.Parser t Char + string :: t -> T.Parser t t + try :: T.Parser t a -> T.Parser t a + char :: Char -> T.Parser t Char + () :: T.Parser t Char -> String -> T.Parser t Char + rational :: Fractional f => T.Parser t f + +instance Parser ByteString Word8 where + satisfy = ABS.satisfy + satisfyWith = ABS.satisfyWith + satisfyChar = ABS.satisfyWith toChar + string = ABS.string + try = ABS.try + char = BC.char + () = (BC.) + rational = BC.rational + {-# INLINE satisfy #-} + {-# INLINE satisfyWith #-} + {-# INLINE satisfyChar #-} + {-# INLINE string #-} + {-# INLINE try #-} + {-# INLINE char #-} + {-# INLINE () #-} + {-# INLINE rational #-} + +instance Parser Text Char where + satisfy = AT.satisfy + satisfyWith = AT.satisfyWith + satisfyChar = AT.satisfyWith toChar + string = AT.string + try = AT.try + char = AT.char + () = (AT.) + rational = AT.rational + {-# INLINE satisfy #-} + {-# INLINE satisfyWith #-} + {-# INLINE satisfyChar #-} + {-# INLINE string #-} + {-# INLINE try #-} + {-# INLINE char #-} + {-# INLINE () #-} + {-# INLINE rational #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base.hs @@ -0,0 +1,8 @@ +module Data.Succinct.RankSelect.Base + ( module X + ) where + +import Data.Succinct.RankSelect.Base.Rank0 as X +import Data.Succinct.RankSelect.Base.Rank1 as X +import Data.Succinct.RankSelect.Base.Select0 as X +import Data.Succinct.RankSelect.Base.Select1 as X diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base/Internal.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Internal.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Internal.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE CPP #-} + +module Data.Succinct.RankSelect.Base.Internal + ( select1Word64Broadword + , select1Word64Bmi2 + , select1Word64Bmi2Base0 + , select1Word64 + , select1Word32Broadword + , select1Word32Bmi2 + , select1Word32 + ) where + +import Data.Bits (countTrailingZeros, shiftR) +import Data.Bits.Pdep +import Data.Int +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Narrow + +select1Word64Bmi2Base0 :: Word64 -> Word64 -> Word64 +select1Word64Bmi2Base0 w r = fromIntegral (countTrailingZeros (pdep (1 .<. r) w)) +{-# INLINE select1Word64Bmi2Base0 #-} + +select1Word64Bmi2 :: Word64 -> Word64 -> Word64 +select1Word64Bmi2 w r = + let zeros = countTrailingZeros (pdep (1 .<. ((r - 1) .&. 0x7f)) w) :: Int + mask = fromIntegral ((fromIntegral (zeros .<. 57) :: Int64) `shiftR` 63) :: Word64 + in (fromIntegral zeros .|. mask) + 1 +{-# INLINE select1Word64Bmi2 #-} + +select1Word32Bmi2 :: Word32 -> Word64 -> Word64 +select1Word32Bmi2 w r = + let zeros = countTrailingZeros (pdep (1 .<. ((r - 1) .&. 0x7f)) w) :: Int + mask = fromIntegral ((fromIntegral (zeros .<. 58) :: Int64) `shiftR` 63) :: Word64 + in (fromIntegral zeros .|. mask) + 1 +{-# INLINE select1Word32Bmi2 #-} + +select1Word64Broadword :: Word64 -> Word64 -> Word64 +select1Word64Broadword _ 0 = 0 +select1Word64Broadword v rn = + -- Do a normal parallel bit count for a 64-bit integer, + -- but store all intermediate steps. + let a = (v .&. 0x5555555555555555) + ((v .>. 1) .&. 0x5555555555555555) in + let b = (a .&. 0x3333333333333333) + ((a .>. 2) .&. 0x3333333333333333) in + let c = (b .&. 0x0f0f0f0f0f0f0f0f) + ((b .>. 4) .&. 0x0f0f0f0f0f0f0f0f) in + let d = (c .&. 0x00ff00ff00ff00ff) + ((c .>. 8) .&. 0x00ff00ff00ff00ff) in + let e = (d .&. 0x0000ffff0000ffff) + ((d .>. 16) .&. 0x0000ffff0000ffff) in + let f = (e .&. 0x00000000ffffffff) + ((e .>. 32) .&. 0x00000000ffffffff) in + -- Now do branchless select! + let r0 = f + 1 - narrow64 rn in + let s0 = 64 :: Word64 in + let t0 = (d .>. 32) + (d .>. 48) in + let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in + let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in + let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in + let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in + let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in + let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in + let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in + let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in + let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in + let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in + let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in + let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in + let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in + let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in + let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in + let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in + fromIntegral s6 +{-# INLINE select1Word64Broadword #-} + +select1Word32Broadword :: Word32 -> Word64 -> Word64 +select1Word32Broadword _ 0 = 0 +select1Word32Broadword v rn = + -- Do a normal parallel bit count for a 64-bit integer, + -- but store all intermediate steps. + let a = (v .&. 0x55555555) + ((v .>. 1) .&. 0x55555555) in + let b = (a .&. 0x33333333) + ((a .>. 2) .&. 0x33333333) in + let c = (b .&. 0x0f0f0f0f) + ((b .>. 4) .&. 0x0f0f0f0f) in + let d = (c .&. 0x00ff00ff) + ((c .>. 8) .&. 0x00ff00ff) in + let e = (d .&. 0x000000ff) + ((d .>. 16) .&. 0x000000ff) in + -- Now do branchless select! + let r0 = e + 1 - narrow32 rn in + let s0 = 64 :: Word32 in + let t0 = (d .>. 32) + (d .>. 48) in + let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in + let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in + let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in + let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in + let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in + let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in + let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in + let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in + let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in + let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in + let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in + let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in + let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in + let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in + let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in + let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in + fromIntegral s6 +{-# INLINE select1Word32Broadword #-} + +select1Word64 :: Word64 -> Word64 -> Word64 +#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED) +select1Word64 = select1Word64Bmi2 +#else +select1Word64 = select1Word64Broadword +#endif +{-# INLINE select1Word64 #-} + +select1Word32 :: Word32 -> Word64 -> Word64 +#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED) +select1Word32 = select1Word32Bmi2 +#else +select1Word32 = select1Word32Broadword +#endif +{-# INLINE select1Word32 #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank.hs @@ -0,0 +1,20 @@ +module Data.Succinct.RankSelect.Base.Rank + ( -- * Rank & Select + Rank(..) + ) where + +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import HaskellWorks.Data.Positioning + +class Eq a => Rank v a where + -- | Find the number of occurences of the given symbol in the prefix of the supplied bitstring of the given length + rank + :: a -- ^ The symbol + -> v -- ^ The bitstring + -> Count -- ^ The prefix length + -> Count + +instance Rank [Bool] Bool where + rank a = if a then rank1 else rank0 + {-# INLINABLE rank #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank0.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank0.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.RankSelect.Base.Rank0 + ( Rank0(..) + ) where + +import Data.Succinct.RankSelect.Base.Rank1 as X +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.ElemFixedBitSize +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Positioning +import Prelude as P + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Reduce duplication" -} + +class Rank0 v where + -- | Find the number of occurences of the bit @0@ in the prefix of the supplied bitstring of the given length + -- + -- >>> import HaskellWorks.Data.Bits.BitRead + -- >>> :set -XTypeApplications + -- + -- >>> rank0 (unsafeBitRead @Word8 "11111111") 4 + -- 0 + -- >>> rank0 (unsafeBitRead @Word8 "00111111") 4 + -- 2 + -- >>> rank0 (unsafeBitRead @Word8 "10011111") 4 + -- 2 + -- >>> rank0 (unsafeBitRead @Word8 "10011001") 4 + -- 2 + -- >>> rank0 (unsafeBitRead @Word8 "10011001") 6 + -- 3 + rank0 + :: v -- ^ The bitstring + -> Count -- ^ The prefix length + -> Count + +deriving instance Rank0 a => Rank0 (BitShown a) + +instance Rank0 Word8 where + rank0 v s0 = s0 - rank1 v s0 + {-# INLINE rank0 #-} + +instance Rank0 Word16 where + rank0 v s0 = s0 - rank1 v s0 + {-# INLINE rank0 #-} + +instance Rank0 Word32 where + rank0 v s0 = s0 - rank1 v s0 + {-# INLINE rank0 #-} + +instance Rank0 Word64 where + rank0 v s0 = s0 - rank1 v s0 + {-# INLINE rank0 #-} + +instance Rank0 [Bool] where + rank0 = go 0 + where go r _ 0 = r + go r (False:bs) p = go (r + 1) bs (p - 1) + go r (True:bs) p = go r bs (p - 1) + go _ [] _ = error "Out of range" + {-# INLINE rank0 #-} + +instance Rank0 [Word8] where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = take (fromIntegral q) v + maybeElem = v !! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 [Word16] where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = take (fromIntegral q) v + maybeElem = v !! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 [Word32] where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = take (fromIntegral q) v + maybeElem = v !! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 [Word64] where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = take (fromIntegral q) v + maybeElem = v !! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DV.Vector Word8) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DV.Vector Word16) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DV.Vector Word32) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DV.Vector Word64) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DVS.Vector Word8) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DVS.Vector Word16) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DVS.Vector Word32) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} + +instance Rank0 (DVS.Vector Word64) where + rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINE rank0 #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank1.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Rank1.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.RankSelect.Base.Rank1 + ( Rank1(..) + ) where + +import Data.Bits.BitSize +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.ElemFixedBitSize +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Positioning + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Reduce duplication" -} + +class Rank1 v where + -- | Find the number of occurences of the bit @1@ in the prefix of the supplied bitstring of the given length + -- + -- >>> import HaskellWorks.Data.Bits.BitRead + -- >>> :set -XTypeApplications + -- + -- >>> rank1 (unsafeBitRead @Word8 "00000000") 4 + -- 0 + -- >>> rank1 (unsafeBitRead @Word8 "11000000") 4 + -- 2 + -- >>> rank1 (unsafeBitRead @Word8 "01100000") 4 + -- 2 + -- >>> rank1 (unsafeBitRead @Word8 "01100110") 4 + -- 2 + -- >>> rank1 (unsafeBitRead @Word8 "01100110") 6 + -- 3 + rank1 + :: v -- ^ The bitstring + -> Count -- ^ The prefix length + -> Count + +deriving instance Rank1 a => Rank1 (BitShown a) + +instance Rank1 Word8 where + rank1 _ 0 = 0 + rank1 v i = popCount1 (v .&. ((1 .<. fromIntegral i) - 1)) + {-# INLINABLE rank1 #-} + +instance Rank1 Word16 where + rank1 _ 0 = 0 + rank1 v i = popCount1 (v .&. ((1 .<. fromIntegral i) - 1)) + {-# INLINABLE rank1 #-} + +instance Rank1 Word32 where + rank1 _ 0 = 0 + rank1 v i = popCount1 (v .&. ((1 .<. fromIntegral i) - 1)) + {-# INLINABLE rank1 #-} + +instance Rank1 Word64 where + rank1 _ 0 = 0 + rank1 v i = popCount1 (v .&. ((1 .<. fromIntegral i) - 1)) + {-# INLINABLE rank1 #-} + +instance Rank1 Bool where + rank1 True 0 = 0 + rank1 True 1 = 1 + rank1 False 0 = 0 + rank1 False 1 = 0 + rank1 _ _ = error "Invalid position for rank1" + +instance (PopCount1 w, Rank1 w, BitSize w) => Rank1 [w] where + rank1 = go 0 + where go c (w:ws) p = if p <= bitCount w + then c + rank1 w p + else go (c + popCount1 w) ws (p - bitCount w) + go c [] _ = c + + {-# INLINABLE rank1 #-} + +instance Rank1 (DV.Vector Word8) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} + +instance Rank1 (DV.Vector Word16) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} + +instance Rank1 (DV.Vector Word32) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} + +instance Rank1 (DV.Vector Word64) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DV.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} + +instance Rank1 (DVS.Vector Word8) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} + +instance Rank1 (DVS.Vector Word16) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} + +instance Rank1 (DVS.Vector Word32) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} + +instance Rank1 (DVS.Vector Word64) where + rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem + where (q, r) = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1) + prefix = DVS.take (fromIntegral q) v + maybeElem = v !!! fromIntegral q + {-# INLINABLE rank1 #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select.hs @@ -0,0 +1,20 @@ +module Data.Succinct.RankSelect.Base.Select + ( -- * Rank & Select + Select(..) + ) where + +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Data.Positioning + +class Eq a => Select v a where + -- | Find length of the shortest prefix of the given prefix that contains specified number of occurences of the given symbol + select + :: a -- ^ The symbol + -> v -- ^ The bitstring + -> Count -- ^ The number of occurences + -> Count + +instance Select [Bool] Bool where + select a = if a then select1 else select0 + {-# INLINABLE select #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select0.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select0.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.RankSelect.Base.Select0 + ( Select0(..) + ) where + +import Data.Succinct.RankSelect.Base.Select1 +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.ElemFixedBitSize +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Positioning + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Reduce duplication" -} + +class Select0 v where + -- | Find length of the shortest prefix of the given prefix that contains specified number of occurences of the bit @1@ + -- + -- If the bitstring does not have enough occurences of bit @0@ is insufficient to satisfy the query the result is undefined. + -- + -- >>> import HaskellWorks.Data.Bits.BitRead + -- >>> :set -XTypeApplications + -- + -- >>> select0 (unsafeBitRead @Word8 "11111111") 0 + -- 0 + -- >>> select0 (unsafeBitRead @Word8 "11110111") 1 + -- 5 + -- >>> select0 (unsafeBitRead @Word8 "00000000") 4 + -- 4 + -- >>> select0 (unsafeBitRead @Word8 "11000000") 4 + -- 6 + -- >>> select0 (unsafeBitRead @Word8 "01100000") 4 + -- 6 + select0 + :: v -- ^ The bitstring + -> Count -- ^ The number of zeros + -> Count + +deriving instance Select0 a => Select0 (BitShown a) + +-- TODO: Implement NOT in terms of select for word-16 +instance Select0 Word8 where + select0 v = select1 (comp v) + {-# INLINABLE select0 #-} + +instance Select0 Word16 where + select0 v = select1 (comp v) + {-# INLINABLE select0 #-} + +instance Select0 Word32 where + select0 v = select1 (comp v) + {-# INLINABLE select0 #-} + +instance Select0 Word64 where + select0 v = select1 (comp v) + {-# INLINABLE select0 #-} + +instance Select0 [Bool] where + select0 = go 0 + where go r _ 0 = r + go r (False:bs) c = go (r + 1) bs (c - 1) + go r (True:bs) c = go (r + 1) bs c + go _ [] _ = error "Out of range" + {-# INLINABLE select0 #-} + +instance Select0 [Word8] where + select0 v c = go v c 0 + where go :: [Word8] -> Count -> Count -> Count + go _ 0 acc = acc + go u d acc = let w = head u in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u) + {-# INLINABLE select0 #-} + +instance Select0 [Word16] where + select0 v c = go v c 0 + where go :: [Word16] -> Count -> Count -> Count + go _ 0 acc = acc + go u d acc = let w = head u in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u) + {-# INLINABLE select0 #-} + +instance Select0 [Word32] where + select0 v c = go v c 0 + where go :: [Word32] -> Count -> Count -> Count + go _ 0 acc = acc + go u d acc = let w = head u in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u) + {-# INLINABLE select0 #-} + +instance Select0 [Word64] where + select0 v c = go v c 0 + where go :: [Word64] -> Count -> Count -> Count + go _ 0 acc = acc + go u d acc = let w = head u in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u) + {-# INLINABLE select0 #-} + +instance Select0 (DV.Vector Word8) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} + +instance Select0 (DV.Vector Word16) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} + +instance Select0 (DV.Vector Word32) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} + +instance Select0 (DV.Vector Word64) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} + +instance Select0 (DVS.Vector Word8) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} + +instance Select0 (DVS.Vector Word16) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} + +instance Select0 (DVS.Vector Word32) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} + +instance Select0 (DVS.Vector Word64) where + select0 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount0 w of + pc | d <= pc -> select0 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINABLE select0 #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select1.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Base/Select1.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.RankSelect.Base.Select1 + ( Select1(..) + ) where + +import Data.Bits.BitSize +import Data.Succinct.RankSelect.Base.Internal +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.ElemFixedBitSize +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Int.Narrow +import HaskellWorks.Data.Positioning +import Prelude + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS + +class Select1 v where + -- | Find length of the shortest prefix of the given prefix that contains specified number of occurences of the bit @1@ + -- + -- If the bitstring does not have enough occurences of bit @1@ is insufficient to satisfy the query the result is undefined. + -- + -- >>> import HaskellWorks.Data.Bits.BitRead + -- >>> :set -XTypeApplications + -- + -- >>> select1 (unsafeBitRead @Word8 "00000000") 0 + -- 0 + -- >>> select1 (unsafeBitRead @Word8 "00001000") 1 + -- 5 + -- >>> select1 (unsafeBitRead @Word8 "11111111") 4 + -- 4 + -- >>> select1 (unsafeBitRead @Word8 "00111111") 4 + -- 6 + -- >>> select1 (unsafeBitRead @Word8 "10011111") 4 + -- 6 + select1 + :: v -- ^ The bitstring + -> Count -- ^ The number of ones + -> Count + +deriving instance Select1 a => Select1 (BitShown a) + +-- TODO: Implement NOT interms of select for word-16 +instance Select1 Word8 where + select1 _ 0 = 0 + select1 v p = select1 (fromIntegral v :: Word16) p + {-# INLINE select1 #-} + +-- TODO: Remove redundant code to optimise +instance Select1 Word16 where + select1 _ 0 = 0 + select1 v rn = + -- Do a normal parallel bit count for a 64-bit integer, + -- but store all intermediate steps. + let a = (v .&. 0x5555) + ((v .>. 1) .&. 0x5555) in + let b = (a .&. 0x3333) + ((a .>. 2) .&. 0x3333) in + let c = (b .&. 0x0f0f) + ((b .>. 4) .&. 0x0f0f) in + let d = (c .&. 0x00ff) + ((c .>. 8) .&. 0x00ff) in + -- Now do branchless select! + let r0 = d + 1 - narrow16 rn in + let s0 = 64 :: Word16 in + let t0 = (d .>. 32) + (d .>. 48) in + let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in + let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in + let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in + let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in + let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in + let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in + let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in + let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in + let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in + let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in + let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in + let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in + let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in + let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in + let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in + let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in + fromIntegral s6 + {-# INLINE select1 #-} + +instance Select1 Word32 where + select1 = select1Word32 + {-# INLINE select1 #-} + +instance Select1 Word64 where + select1 = select1Word64 + {-# INLINE select1 #-} + +instance Select1 Bool where + select1 b c = if c == 1 && b then 1 else 0 + +instance Select1 (DVS.Vector Word8) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance Select1 (DVS.Vector Word16) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance Select1 (DVS.Vector Word32) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance Select1 (DVS.Vector Word64) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance Select1 (DV.Vector Word8) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance Select1 (DV.Vector Word16) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance Select1 (DV.Vector Word32) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance Select1 (DV.Vector Word64) where + select1 v c = go 0 c 0 + where go _ 0 acc = acc + go n d acc = let w = (v !!! n) in + case popCount1 w of + pc | d <= pc -> select1 w d + acc + pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v) + {-# INLINE select1 #-} + +instance (PopCount1 w, Select1 w, BitSize w) => Select1 [w] where + select1 v c = go v c 0 + where go _ 0 acc = acc + go u d acc = case u of + w:ws -> let pc = popCount1 w in + if d <= pc + then select1 w d + acc + else go ws (d - pc) (acc + bitCount w) + [] -> acc + {-# INLINE select1 #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy.hs @@ -0,0 +1,136 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE Rank2Types #-} + +module Data.Succinct.RankSelect.CsPoppy + ( CsPoppy(..) + , makeCsPoppy + ) where + +import Control.DeepSeq +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindCloseN +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.FindOpenN +import Data.Succinct.BalancedParens.NewCloseAt +import Data.Succinct.BalancedParens.OpenAt +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import Data.Succinct.RankSelect.CsPoppy.Internal.Vector +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (drop, length, pi, take) + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha0 as A0 +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 as A1 + +data CsPoppy = CsPoppy + { csPoppyBits :: !(DVS.Vector Word64) + , csPoppyIndex0 :: !A0.CsPoppyIndex + , csPoppyIndex1 :: !A1.CsPoppyIndex + } deriving (Eq, Show, NFData, Generic) + +instance FromForeignRegion CsPoppy where + fromForeignRegion = makeCsPoppy . fromForeignRegion + +instance AsVector64 CsPoppy where + asVector64 = asVector64 . csPoppyBits + {-# INLINE asVector64 #-} + +instance BitLength CsPoppy where + bitLength = bitLength . csPoppyBits + {-# INLINE bitLength #-} + +instance PopCount0 CsPoppy where + popCount0 v = getCsiTotal (CsInterleaved (lastOrZero (A0.csPoppyLayerM (csPoppyIndex0 v)))) + {-# INLINE popCount0 #-} + +instance PopCount1 CsPoppy where + popCount1 v = getCsiTotal (CsInterleaved (lastOrZero (A1.csPoppyLayerM (csPoppyIndex1 v)))) + {-# INLINE popCount1 #-} + +makeCsPoppy :: DVS.Vector Word64 -> CsPoppy +makeCsPoppy v = CsPoppy + { csPoppyBits = v + , csPoppyIndex0 = A0.makeCsPoppyIndex v + , csPoppyIndex1 = A1.makeCsPoppyIndex v + } + +instance TestBit CsPoppy where + (.?.) = (.?.) . csPoppyBits + {-# INLINE (.?.) #-} + +instance BitRead CsPoppy where + bitRead = fmap makeCsPoppy . bitRead + +instance Rank0 CsPoppy where + rank0 (CsPoppy !v i _) = A0.rank0On v i + {-# INLINE rank0 #-} + +instance Rank1 CsPoppy where + rank1 (CsPoppy !v _ i) = A1.rank1On v i + {-# INLINE rank1 #-} + +instance Select0 CsPoppy where + select0 (CsPoppy !v i _) = A0.select0On v i + {-# INLINE select0 #-} + +instance Select1 CsPoppy where + select1 (CsPoppy !v _ i) = A1.select1On v i + {-# INLINE select1 #-} + +instance OpenAt CsPoppy where + openAt = openAt . csPoppyBits + {-# INLINE openAt #-} + +instance CloseAt CsPoppy where + closeAt = closeAt . csPoppyBits + {-# INLINE closeAt #-} + +instance NewCloseAt CsPoppy where + newCloseAt = newCloseAt . csPoppyBits + {-# INLINE newCloseAt #-} + +instance FindOpenN CsPoppy where + findOpenN = findOpenN . csPoppyBits + {-# INLINE findOpenN #-} + +instance FindOpen CsPoppy where + findOpen = findOpen . csPoppyBits + {-# INLINE findOpen #-} + +instance FindClose CsPoppy where + findClose = findClose . csPoppyBits + {-# INLINE findClose #-} + +instance FindCloseN CsPoppy where + findCloseN = findCloseN . csPoppyBits + {-# INLINE findCloseN #-} + +instance Enclose CsPoppy where + enclose = enclose . csPoppyBits + {-# INLINE enclose #-} + +instance BalancedParens CsPoppy where + firstChild = firstChild . csPoppyBits + nextSibling = nextSibling . csPoppyBits + parent = parent . csPoppyBits + {-# INLINE firstChild #-} + {-# INLINE nextSibling #-} + {-# INLINE parent #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Alpha0.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Alpha0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Alpha0.hs @@ -0,0 +1,170 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE Rank2Types #-} + +module Data.Succinct.RankSelect.CsPoppy.Internal.Alpha0 + ( CsPoppyIndex(..) + , makeCsPoppyIndex + , makeCsPoppyBlocks + , makeCsPoppyLayerM2 + , genCsSamples + , rank0On + , select0On + ) where + +import Control.DeepSeq +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import Data.Succinct.RankSelect.CsPoppy.Internal.Lookup +import Data.Succinct.RankSelect.CsPoppy.Internal.Vector +import Data.Word +import GHC.Generics +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Positioning + +import Prelude hiding (drop) + +import qualified Control.Monad.ST as ST +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Storable.Mutable as DVSM + +data CsPoppyIndex = CsPoppyIndex + { csPoppyLayerM :: !(DVS.Vector Word64) + , csPoppyLayerS :: !(DVS.Vector Word64) -- Sampling lookup of each 8192 1-bit + } deriving (Eq, Show, NFData, Generic) + +makeCsPoppyIndex :: DVS.Vector Word64 -> CsPoppyIndex +makeCsPoppyIndex vv = CsPoppyIndex + { csPoppyLayerM = layerM + , csPoppyLayerS = layerS + } + where blocks = makeCsPoppyBlocks vv + layerM = makeCsPoppyLayerM2 blocks + layerMPopCount = getCsiTotal (CsInterleaved (lastOrZero layerM)) + layerS = genCsSamples layerMPopCount vv + +makeCsPoppyBlocks :: DVS.Vector Word64 -> DVS.Vector Word64 +makeCsPoppyBlocks vv = DVS.generate (((DVS.length vv + 8 - 1) `div` 8) + 1) genBlocks + where e = DVS.length vv + genBlocks :: Int -> Word64 + genBlocks u = let i = fromIntegral u in if + | (i + 1) * 8 <= e -> let j = i * 8 in + popCount0 (DVS.unsafeIndex vv (j + 0)) + + popCount0 (DVS.unsafeIndex vv (j + 1)) + + popCount0 (DVS.unsafeIndex vv (j + 2)) + + popCount0 (DVS.unsafeIndex vv (j + 3)) + + popCount0 (DVS.unsafeIndex vv (j + 4)) + + popCount0 (DVS.unsafeIndex vv (j + 5)) + + popCount0 (DVS.unsafeIndex vv (j + 6)) + + popCount0 (DVS.unsafeIndex vv (j + 7)) + | otherwise -> popCount0 (DVS.take 8 (DVS.drop (i * 8) vv)) + +makeCsPoppyLayerM2 :: DVS.Vector Word64 -> DVS.Vector Word64 +makeCsPoppyLayerM2 blocksv = DVS.constructN (((DVS.length blocksv + 4 - 1) `div` 4) + 1) genLayer1 + where genLayer1 :: DVS.Vector Word64 -> Word64 + genLayer1 u = let ui = end u in if ui > 0 && ui * 4 + 4 < end blocksv + then let lx = DVS.unsafeIndex u (fromIntegral (ui - 1)) in + let la = DVS.unsafeIndex blocksv (fromIntegral (ui * 4 - 4)) in + let lb = DVS.unsafeIndex blocksv (fromIntegral (ui * 4 - 3)) in + let lc = DVS.unsafeIndex blocksv (fromIntegral (ui * 4 - 2)) in + let ld = DVS.unsafeIndex blocksv (fromIntegral (ui * 4 - 1)) in + let nx = lx + (la + lb + lc + ld) in + let na = DVS.unsafeIndex blocksv (fromIntegral (ui * 4 + 0)) in + let nb = DVS.unsafeIndex blocksv (fromIntegral (ui * 4 + 1)) in + let nc = DVS.unsafeIndex blocksv (fromIntegral (ui * 4 + 2)) in + ( ( nx .&. 0x00000000ffffffff) + .|. ((na .<. 32) .&. 0x000003ff00000000) + .|. ((nb .<. 42) .&. 0x000ffc0000000000) + .|. ((nc .<. 52) .&. 0x3ff0000000000000)) + else let lx = lastOrZero u in + let la = indexOrZero blocksv (ui * 4 - 4) in + let lb = indexOrZero blocksv (ui * 4 - 3) in + let lc = indexOrZero blocksv (ui * 4 - 2) in + let ld = indexOrZero blocksv (ui * 4 - 1) in + let nx = lx + (la + lb + lc + ld) in + let na = indexOrZero blocksv (ui * 4 + 0) in + let nb = indexOrZero blocksv (ui * 4 + 1) in + let nc = indexOrZero blocksv (ui * 4 + 2) in + ( ( nx .&. 0x00000000ffffffff) + .|. ((na .<. 32) .&. 0x000003ff00000000) + .|. ((nb .<. 42) .&. 0x000ffc0000000000) + .|. ((nc .<. 52) .&. 0x3ff0000000000000)) + +sampleWidth :: Count +sampleWidth = 8192 +{-# INLINE sampleWidth #-} + +genCsSamples :: Count -> DVS.Vector Word64 -> DVS.Vector Word64 +genCsSamples pc v = DVS.create (genCsSamplesST pc v) + +genCsSamplesST :: Count -> DVS.Vector Word64 -> (forall s . ST.ST s (DVS.MVector s Word64)) +genCsSamplesST pc vv = do + u :: DVSM.MVector s Word64 <- DVSM.unsafeNew maxSize + + go u 0 0 (DVS.length vv) 0 1 + where maxSize :: Int + maxSize = fromIntegral $ (pc `div` 8192) + 1 + go :: DVS.MVector s Word64 -> Int -> Int -> Int -> Count -> Count -> ST.ST s (DVS.MVector s Word64) + go u ui vi vie lpc epc | vi < vie = do + -- u: Target vector + -- ui: Target vector index + -- uim: Target vector end index + -- v: Source vector + -- vi: Target vector index + -- lpc: Last pop count + -- epc: Expectant pop count + + -- uw <- DVSM.read u ui + let vw = comp (DVS.unsafeIndex vv vi) -- Source word + let vwpc = popCount1 vw -- Source word pop count + let npc = vwpc + lpc -- Next pop count + + if npc >= epc + then do -- Emit a position + let dpc = epc - lpc + let ewp = select0 vw dpc + fromIntegral vi * 64 -- Expectant word position + DVSM.unsafeWrite u ui ewp + go u (ui + 1) (vi + 1) vie npc (epc + sampleWidth) + else go u ui (vi + 1) vie npc epc -- Don't emit a position this time + go u ui _ _ _ _ = return (DVSM.take ui u) + +rank0On :: DVS.Vector Word64 -> CsPoppyIndex -> Count -> Count +rank0On v (CsPoppyIndex layerM _) p = rankPrior + rankInBasicBlock + where mw = layerM !!! toPosition (p `div` 2048) + mx = mw .&. 0x00000000ffffffff + ma = (mw .&. 0x000003ff00000000) .>. 32 + mb = (mw .&. 0x000ffc0000000000) .>. 42 + mc = (mw .&. 0x3ff0000000000000) .>. 52 + q = (p `div` 512) `mod` 4 -- quarter + mi | q == 0 = mx + | q == 1 = mx + ma + | q == 2 = mx + ma + mb + | q == 3 = mx + ma + mb + mc + | otherwise = error "Invalid interleaved entry index" + rankPrior = mi :: Count + rankInBasicBlock = rank0 (DVS.drop (fromIntegral (p `div` 512) * 8) v) (p `mod` 512) +{-# INLINE rank0On #-} + +select0On :: DVS.Vector Word64 -> CsPoppyIndex -> Count -> Count +select0On _ _ r | r == 0 = 0 +select0On v (CsPoppyIndex !layerM !layerS) r = + let !si = (r - 1) `div` 8192 in + let !spi = layerS !!! fromIntegral si in + let vBitSize = fromIntegral (DVS.length v) * 64 in + let !spj = atIndexOr vBitSize layerS (fromIntegral si + 1) in + let !mi = spi `div` (512 * 4) in + let !mj = spj `div` (512 * 4) in + let !(!bbr, !bbi) = lookupLayerMFrom2 mi (mj + 1) r layerM in + let !block = DVS.take 8 (drop (bbi * 8) v) in + let !q = r - bbr in + + select0 block q + bbi * 512 +{-# INLINE select0On #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Alpha1.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Alpha1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Alpha1.hs @@ -0,0 +1,171 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE Rank2Types #-} + +{- HLINT ignore "Redundant multi-way if" -} + +module Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 + ( CsPoppyIndex(..) + , makeCsPoppyIndex + , makeCsPoppyBlocks + , makeCsPoppyLayerM2 + , genCsSamples + , rank1On + , select1On + ) where + +import Control.DeepSeq +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import Data.Succinct.RankSelect.CsPoppy.Internal.Lookup +import Data.Succinct.RankSelect.CsPoppy.Internal.Vector +import Data.Word +import GHC.Generics +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Positioning + +import Prelude hiding (drop) + +import qualified Control.Monad.ST as ST +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Storable.Mutable as DVSM + +data CsPoppyIndex = CsPoppyIndex + { csPoppyLayerM :: !(DVS.Vector Word64) + , csPoppyLayerS :: !(DVS.Vector Word64) -- Sampling lookup of each 8192 1-bit + } deriving (Eq, Show, NFData, Generic) + +makeCsPoppyIndex :: DVS.Vector Word64 -> CsPoppyIndex +makeCsPoppyIndex v = CsPoppyIndex + { csPoppyLayerM = layerM + , csPoppyLayerS = layerS + } + where blocks = makeCsPoppyBlocks v + layerM = makeCsPoppyLayerM2 blocks + layerMPopCount = getCsiTotal (CsInterleaved (lastOrZero layerM)) + layerS = genCsSamples layerMPopCount v + +makeCsPoppyBlocks :: DVS.Vector Word64 -> DVS.Vector Word64 +makeCsPoppyBlocks v = DVS.generate (((DVS.length v + 8 - 1) `div` 8) + 1) genBlocks + where e = DVS.length v + genBlocks :: Int -> Word64 + genBlocks u = let i = fromIntegral u in if + | (i + 1) * 8 <= e -> let j = i * 8 in + popCount1 (DVS.unsafeIndex v (j + 0)) + + popCount1 (DVS.unsafeIndex v (j + 1)) + + popCount1 (DVS.unsafeIndex v (j + 2)) + + popCount1 (DVS.unsafeIndex v (j + 3)) + + popCount1 (DVS.unsafeIndex v (j + 4)) + + popCount1 (DVS.unsafeIndex v (j + 5)) + + popCount1 (DVS.unsafeIndex v (j + 6)) + + popCount1 (DVS.unsafeIndex v (j + 7)) + | otherwise -> popCount1 (DVS.take 8 (DVS.drop (i * 8) v)) + +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 + genLayer1 u = let ui = end u in if ui > 0 && ui * 4 + 4 < end blocks + then let lx = DVS.unsafeIndex u (fromIntegral (ui - 1)) in + let la = DVS.unsafeIndex blocks (fromIntegral (ui * 4 - 4)) in + let lb = DVS.unsafeIndex blocks (fromIntegral (ui * 4 - 3)) in + let lc = DVS.unsafeIndex blocks (fromIntegral (ui * 4 - 2)) in + let ld = DVS.unsafeIndex blocks (fromIntegral (ui * 4 - 1)) in + let nx = lx + (la + lb + lc + ld) in + let na = DVS.unsafeIndex blocks (fromIntegral (ui * 4 + 0)) in + let nb = DVS.unsafeIndex blocks (fromIntegral (ui * 4 + 1)) in + let nc = DVS.unsafeIndex blocks (fromIntegral (ui * 4 + 2)) in + ( ( nx .&. 0x00000000ffffffff) + .|. ((na .<. 32) .&. 0x000003ff00000000) + .|. ((nb .<. 42) .&. 0x000ffc0000000000) + .|. ((nc .<. 52) .&. 0x3ff0000000000000)) + else let lx = lastOrZero u in + let la = indexOrZero blocks (ui * 4 - 4) in + let lb = indexOrZero blocks (ui * 4 - 3) in + let lc = indexOrZero blocks (ui * 4 - 2) in + let ld = indexOrZero blocks (ui * 4 - 1) in + let nx = lx + (la + lb + lc + ld) in + let na = indexOrZero blocks (ui * 4 + 0) in + let nb = indexOrZero blocks (ui * 4 + 1) in + let nc = indexOrZero blocks (ui * 4 + 2) in + ( ( nx .&. 0x00000000ffffffff) + .|. ((na .<. 32) .&. 0x000003ff00000000) + .|. ((nb .<. 42) .&. 0x000ffc0000000000) + .|. ((nc .<. 52) .&. 0x3ff0000000000000)) + +sampleWidth :: Count +sampleWidth = 8192 +{-# INLINE sampleWidth #-} + +genCsSamples :: Count -> DVS.Vector Word64 -> DVS.Vector Word64 +genCsSamples pc v = DVS.create (genCsSamplesST pc v) + +genCsSamplesST :: Count -> DVS.Vector Word64 -> (forall s . ST.ST s (DVS.MVector s Word64)) +genCsSamplesST pc v = do + u :: DVSM.MVector s Word64 <- DVSM.unsafeNew maxSize + + go u 0 0 (DVS.length v) 0 1 + where maxSize :: Int + maxSize = fromIntegral $ (pc `div` 8192) + 1 + go :: DVS.MVector s Word64 -> Int -> Int -> Int -> Count -> Count -> ST.ST s (DVS.MVector s Word64) + go u ui vi vie lpc epc | vi < vie = do + -- u: Target vector + -- ui: Target vector index + -- uim: Target vector end index + -- v: Source vector + -- vi: Target vector index + -- lpc: Last pop count + -- epc: Expectant pop count + + -- uw <- DVSM.read u ui + let vw = DVS.unsafeIndex v vi -- Source word + let vwpc = popCount1 vw -- Source word pop count + let npc = vwpc + lpc -- Next pop count + + if npc >= epc + then do -- Emit a position + let dpc = epc - lpc + let ewp = select1 vw dpc + fromIntegral vi * 64 -- Expectant word position + DVSM.unsafeWrite u ui ewp + go u (ui + 1) (vi + 1) vie npc (epc + sampleWidth) + else go u ui (vi + 1) vie npc epc -- Don't emit a position this time + go u ui _ _ _ _ = return (DVSM.take ui u) + +rank1On :: DVS.Vector Word64 -> CsPoppyIndex -> Count -> Count +rank1On v (CsPoppyIndex layerM _) p = rankPrior + rankInBasicBlock + where mw = layerM !!! toPosition (p `div` 2048) + mx = mw .&. 0x00000000ffffffff + ma = (mw .&. 0x000003ff00000000) .>. 32 + mb = (mw .&. 0x000ffc0000000000) .>. 42 + mc = (mw .&. 0x3ff0000000000000) .>. 52 + q = (p `div` 512) `mod` 4 -- quarter + mi | q == 0 = mx + | q == 1 = mx + ma + | q == 2 = mx + ma + mb + | q == 3 = mx + ma + mb + mc + | otherwise = error "Invalid interleaved entry index" + rankPrior = mi :: Count + rankInBasicBlock = rank1 (DVS.drop (fromIntegral (p `div` 512) * 8) v) (p `mod` 512) +{-# INLINE rank1On #-} + +select1On :: DVS.Vector Word64 -> CsPoppyIndex -> Count -> Count +select1On _ _ r | r == 0 = 0 +select1On v (CsPoppyIndex !layerM !layerS) r = + let !si = (r - 1) `div` 8192 in + let !spi = layerS !!! fromIntegral si in + let vBitSize = fromIntegral (DVS.length v) * 64 in + let !spj = atIndexOr vBitSize layerS (fromIntegral si + 1) in + let !mi = spi `div` (512 * 4) in + let !mj = spj `div` (512 * 4) in + let !(!bbr, !bbi) = lookupLayerMFrom2 mi (mj + 1) r layerM in + let !block = DVS.take 8 (drop (bbi * 8) v) in + let !q = r - bbr in + + select1 block q + bbi * 512 +{-# INLINE select1On #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/CsInterleaved.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/CsInterleaved.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/CsInterleaved.hs @@ -0,0 +1,71 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE Rank2Types #-} + +module Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved + ( CsInterleaved(..) + , getCsiX + , getCsiA + , getCsiB + , getCsiC + , getCsiTotal + , mkCsi + , putCsiX + , putCsiA + , putCsiB + , putCsiC + ) where + +import Data.Word +import Foreign.Ptr +import Foreign.Storable +import HaskellWorks.Data.Bits.BitWise + +newtype CsInterleaved = CsInterleaved { unCsInterleaved :: Word64 } deriving Eq + +instance Storable CsInterleaved where + sizeOf = sizeOf . unCsInterleaved + {-# INLINE sizeOf #-} + alignment = alignment . unCsInterleaved + {-# INLINE alignment #-} + peekElemOff ptr i = CsInterleaved <$> peekElemOff (castPtr ptr) i + {-# INLINE peekElemOff #-} + pokeElemOff ptr i = pokeElemOff (castPtr ptr) i . unCsInterleaved + {-# INLINE pokeElemOff #-} + +mkCsi :: Word64 -> Word64 -> Word64 -> Word64 -> CsInterleaved +mkCsi x a b c = CsInterleaved + $ ((x .&. 0xffffffff) .<. 0) + .|. ((a .&. 0x3ff) .<. 32) + .|. ((b .&. 0x3ff) .<. 42) + .|. ((c .&. 0x3ff) .<. 52) + +getCsiX :: CsInterleaved -> Word64 +getCsiX (CsInterleaved i) = i .&. 0xffffffff + +getCsiA :: CsInterleaved -> Word64 +getCsiA (CsInterleaved i) = (i .>. 32) .&. 0x3ff + +getCsiB :: CsInterleaved -> Word64 +getCsiB (CsInterleaved i) = (i .>. 42) .&. 0x3ff + +getCsiC :: CsInterleaved -> Word64 +getCsiC (CsInterleaved i) = (i .>. 52) .&. 0x3ff + +getCsiTotal :: CsInterleaved -> Word64 +getCsiTotal csi = getCsiX csi + getCsiA csi + getCsiB csi + getCsiC csi + +putCsiX :: Word64 -> CsInterleaved -> CsInterleaved +putCsiX v (CsInterleaved i) = CsInterleaved (((v .&. 0xffffffff) .<. 0) .|. (i .&. 0xffffffff00000000)) + +putCsiA :: Word64 -> CsInterleaved -> CsInterleaved +putCsiA v (CsInterleaved i) = CsInterleaved (((v .&. 0x3ff) .<. 32) .|. (i .&. 0xfffffc00ffffffff)) + +putCsiB :: Word64 -> CsInterleaved -> CsInterleaved +putCsiB v (CsInterleaved i) = CsInterleaved (((v .&. 0x3ff) .<. 42) .|. (i .&. 0xfff003ffffffffff)) + +putCsiC :: Word64 -> CsInterleaved -> CsInterleaved +putCsiC v (CsInterleaved i) = CsInterleaved (((v .&. 0x3ff) .<. 52) .|. (i .&. 0xc00fffffffffffff)) + +instance Show CsInterleaved where + showsPrec _ i = shows (getCsiX i, getCsiA i, getCsiB i, getCsiC i) diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Lookup.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Lookup.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Lookup.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiWayIf #-} + +module Data.Succinct.RankSelect.CsPoppy.Internal.Lookup where + +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise +import Prelude hiding (drop, length, pi, take) + +import qualified Data.Vector.Storable as DVS + +binarySearchPBounds :: (Word64 -> Bool) -> DVS.Vector Word64 -> Word64 -> Word64 -> Word64 +binarySearchPBounds p v = loop + where loop :: Word64 -> Word64 -> Word64 + loop !l !u + | u <= l = l + | otherwise = let e = v !!! fromIntegral k in if p e then loop l k else loop (k + 1) u + where k = (u + l) .>. 1 +{-# INLINE binarySearchPBounds #-} + +lookupLayerMXFrom :: Word64 -> Word64 -> Word64 -> DVS.Vector Word64 -> Word64 +lookupLayerMXFrom prev i r v | i < length v = + let mw = v !!! fromIntegral i :: Word64 + mx = ( mw .&. 0x00000000ffffffff ) :: Word64 + in if r <= mx + then prev + else lookupLayerMXFrom i (i + 1) r v +lookupLayerMXFrom prev _ _ _ = prev +{-# INLINE lookupLayerMXFrom #-} + +lookupLayerMFrom1 :: Word64 -> Word64 -> Word64 -> DVS.Vector Word64 -> (Word64, Word64) +lookupLayerMFrom1 i _ r v + | r <= mx = error "This shouldn't happen" + | r <= ma = (mx, j * 4 ) + | r <= mb = (ma, j * 4 + 1) + | r <= mc = (mb, j * 4 + 2) + | otherwise = (mc, j * 4 + 3) + where j = lookupLayerMXFrom 0 i r v + mw = v !!! fromIntegral j :: Word64 + mx = ( mw .&. 0x00000000ffffffff ) :: Word64 + ma = mx + ((mw .&. 0x000003ff00000000) .>. 32) :: Word64 + mb = ma + ((mw .&. 0x000ffc0000000000) .>. 42) :: Word64 + mc = mb + ((mw .&. 0x3ff0000000000000) .>. 52) :: Word64 +{-# INLINE lookupLayerMFrom1 #-} + +lookupLayerMFrom2 :: Word64 -> Word64 -> Word64 -> DVS.Vector Word64 -> (Word64, Word64) +lookupLayerMFrom2 i j r v = + let cmp w = (r - 1) < (w .&. 0xffffffff) + !k = (binarySearchPBounds cmp v i j - 1) `max` 0 + !mw = v !!! fromIntegral k :: Word64 + !mx = ( mw .&. 0x00000000ffffffff ) :: Word64 + !ma = mx + ((mw .&. 0x000003ff00000000) .>. 32) :: Word64 + !mb = ma + ((mw .&. 0x000ffc0000000000) .>. 42) :: Word64 + !mc = mb + ((mw .&. 0x3ff0000000000000) .>. 52) :: Word64 + in if + | r <= mx -> (0 , 0 ) + | r <= ma -> (mx, k * 4 ) + | r <= mb -> (ma, k * 4 + 1) + | r <= mc -> (mb, k * 4 + 2) + | otherwise -> (mc, k * 4 + 3) +{-# INLINE lookupLayerMFrom2 #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Nice.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Nice.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Nice.hs @@ -0,0 +1,24 @@ +module Data.Succinct.RankSelect.CsPoppy.Internal.Nice where + +import Data.Succinct.RankSelect.CsPoppy +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import HaskellWorks.Data.Bits.BitShow + +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha0 as A0 +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 as A1 +import qualified Data.Vector.Storable as DVS + +newtype Nice a = Nice a deriving Eq + +instance Show (Nice CsPoppy) where + showsPrec _ (Nice rsbs) = showString "CsPoppy " + <> showString "{ csPoppyBits = " <> shows (bitShow <$> DVS.toList (csPoppyBits rsbs)) + <> showString ", csPoppyIndex0 = CsPoppyIndex" + <> showString "{ csPoppyLayerM = " <> shows (CsInterleaved <$> DVS.toList (A0.csPoppyLayerM (csPoppyIndex0 rsbs))) + <> showString ", csPoppyLayerS = " <> shows (A0.csPoppyLayerS (csPoppyIndex0 rsbs)) + <> showString " }" + <> showString ", csPoppyIndex1 = CsPoppyIndex" + <> showString "{ csPoppyLayerM = " <> shows (CsInterleaved <$> DVS.toList (A1.csPoppyLayerM (csPoppyIndex1 rsbs))) + <> showString ", csPoppyLayerS = " <> shows (A1.csPoppyLayerS (csPoppyIndex1 rsbs)) + <> showString " }" + <> showString " }" diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Reference.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Reference.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Reference.hs @@ -0,0 +1,34 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE Rank2Types #-} + +module Data.Succinct.RankSelect.CsPoppy.Internal.Reference + ( makeCsPoppyLayerM + ) where + +import Data.Succinct.RankSelect.CsPoppy.Internal.Vector +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Length + +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)) + diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Vector.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Vector.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy/Internal/Vector.hs @@ -0,0 +1,21 @@ +module Data.Succinct.RankSelect.CsPoppy.Internal.Vector + ( indexOrZero + , lastOrZero + ) where + +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS + +indexOrZero :: DVS.Vector Word64 -> Position -> Word64 +indexOrZero _ i | i < 0 = 0 +indexOrZero v i | i < end v = v !!! i +indexOrZero _ _ = 0 +{-# INLINE indexOrZero #-} + +lastOrZero :: DVS.Vector Word64 -> Word64 +lastOrZero v | 0 < end v = DVS.last v +lastOrZero _ = 0 +{-# INLINE lastOrZero #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy0.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy0.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy0.hs @@ -0,0 +1,123 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE Rank2Types #-} + +module Data.Succinct.RankSelect.CsPoppy0 + ( CsPoppy0(..) + , makeCsPoppy0 + ) where + +import Control.DeepSeq +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindCloseN +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.FindOpenN +import Data.Succinct.BalancedParens.NewCloseAt +import Data.Succinct.BalancedParens.OpenAt +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import Data.Succinct.RankSelect.CsPoppy.Internal.Vector +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (drop, length, pi, take) + +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha0 as A0 +import qualified Data.Vector.Storable as DVS + +data CsPoppy0 = CsPoppy0 + { csPoppy0Bits :: !(DVS.Vector Word64) + , csPoppy0Index0 :: !A0.CsPoppyIndex + } deriving (Eq, Show, NFData, Generic) + +instance FromForeignRegion CsPoppy0 where + fromForeignRegion = makeCsPoppy0 . fromForeignRegion + +instance AsVector64 CsPoppy0 where + asVector64 = asVector64 . csPoppy0Bits + {-# INLINE asVector64 #-} + +instance BitLength CsPoppy0 where + bitLength = bitLength . csPoppy0Bits + {-# INLINE bitLength #-} + +instance PopCount0 CsPoppy0 where + popCount0 v = getCsiTotal (CsInterleaved (lastOrZero (A0.csPoppyLayerM (csPoppy0Index0 v)))) + {-# INLINE popCount0 #-} + +makeCsPoppy0 :: DVS.Vector Word64 -> CsPoppy0 +makeCsPoppy0 v = CsPoppy0 + { csPoppy0Bits = v + , csPoppy0Index0 = A0.makeCsPoppyIndex v + } + +instance TestBit CsPoppy0 where + (.?.) = (.?.) . csPoppy0Bits + {-# INLINE (.?.) #-} + +instance BitRead CsPoppy0 where + bitRead = fmap makeCsPoppy0 . bitRead + +instance Rank1 CsPoppy0 where + rank1 rsbs p = p - rank0 rsbs p + {-# INLINE rank1 #-} + +instance Rank0 CsPoppy0 where + rank0 (CsPoppy0 !v i) = A0.rank0On v i + {-# INLINE rank0 #-} + +instance Select0 CsPoppy0 where + select0 (CsPoppy0 !v i) = A0.select0On v i + {-# INLINE select0 #-} + +instance OpenAt CsPoppy0 where + openAt = openAt . csPoppy0Bits + {-# INLINE openAt #-} + +instance CloseAt CsPoppy0 where + closeAt = closeAt . csPoppy0Bits + {-# INLINE closeAt #-} + +instance NewCloseAt CsPoppy0 where + newCloseAt = newCloseAt . csPoppy0Bits + {-# INLINE newCloseAt #-} + +instance FindOpenN CsPoppy0 where + findOpenN = findOpenN . csPoppy0Bits + {-# INLINE findOpenN #-} + +instance FindOpen CsPoppy0 where + findOpen = findOpen . csPoppy0Bits + {-# INLINE findOpen #-} + +instance FindClose CsPoppy0 where + findClose = findClose . csPoppy0Bits + {-# INLINE findClose #-} + +instance FindCloseN CsPoppy0 where + findCloseN = findCloseN . csPoppy0Bits + {-# INLINE findCloseN #-} + +instance Enclose CsPoppy0 where + enclose = enclose . csPoppy0Bits + {-# INLINE enclose #-} + +instance BalancedParens CsPoppy0 where + firstChild = firstChild . csPoppy0Bits + nextSibling = nextSibling . csPoppy0Bits + parent = parent . csPoppy0Bits + {-# INLINE firstChild #-} + {-# INLINE nextSibling #-} + {-# INLINE parent #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy1.hs b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/CsPoppy1.hs @@ -0,0 +1,123 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE Rank2Types #-} + +module Data.Succinct.RankSelect.CsPoppy1 + ( CsPoppy1(..) + , makeCsPoppy + ) where + +import Control.DeepSeq +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindCloseN +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.FindOpenN +import Data.Succinct.BalancedParens.NewCloseAt +import Data.Succinct.BalancedParens.OpenAt +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import Data.Succinct.RankSelect.CsPoppy.Internal.Vector +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (drop, length, pi, take) + +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 as A1 +import qualified Data.Vector.Storable as DVS + +data CsPoppy1 = CsPoppy1 + { csPoppy1Bits :: !(DVS.Vector Word64) + , csPoppy1Index1 :: !A1.CsPoppyIndex + } deriving (Eq, Show, NFData, Generic) + +instance FromForeignRegion CsPoppy1 where + fromForeignRegion = makeCsPoppy . fromForeignRegion + +instance AsVector64 CsPoppy1 where + asVector64 = asVector64 . csPoppy1Bits + {-# INLINE asVector64 #-} + +instance BitLength CsPoppy1 where + bitLength = bitLength . csPoppy1Bits + {-# INLINE bitLength #-} + +instance PopCount1 CsPoppy1 where + popCount1 v = getCsiTotal (CsInterleaved (lastOrZero (A1.csPoppyLayerM (csPoppy1Index1 v)))) + {-# INLINE popCount1 #-} + +makeCsPoppy :: DVS.Vector Word64 -> CsPoppy1 +makeCsPoppy v = CsPoppy1 + { csPoppy1Bits = v + , csPoppy1Index1 = A1.makeCsPoppyIndex v + } + +instance TestBit CsPoppy1 where + (.?.) = (.?.) . csPoppy1Bits + {-# INLINE (.?.) #-} + +instance BitRead CsPoppy1 where + bitRead = fmap makeCsPoppy . bitRead + +instance Rank0 CsPoppy1 where + rank0 rsbs p = p - rank1 rsbs p + {-# INLINE rank0 #-} + +instance Rank1 CsPoppy1 where + rank1 (CsPoppy1 !v i) = A1.rank1On v i + {-# INLINE rank1 #-} + +instance Select1 CsPoppy1 where + select1 (CsPoppy1 !v i) = A1.select1On v i + {-# INLINE select1 #-} + +instance OpenAt CsPoppy1 where + openAt = openAt . csPoppy1Bits + {-# INLINE openAt #-} + +instance CloseAt CsPoppy1 where + closeAt = closeAt . csPoppy1Bits + {-# INLINE closeAt #-} + +instance NewCloseAt CsPoppy1 where + newCloseAt = newCloseAt . csPoppy1Bits + {-# INLINE newCloseAt #-} + +instance FindOpenN CsPoppy1 where + findOpenN = findOpenN . csPoppy1Bits + {-# INLINE findOpenN #-} + +instance FindOpen CsPoppy1 where + findOpen = findOpen . csPoppy1Bits + {-# INLINE findOpen #-} + +instance FindClose CsPoppy1 where + findClose = findClose . csPoppy1Bits + {-# INLINE findClose #-} + +instance FindCloseN CsPoppy1 where + findCloseN = findCloseN . csPoppy1Bits + {-# INLINE findCloseN #-} + +instance Enclose CsPoppy1 where + enclose = enclose . csPoppy1Bits + {-# INLINE enclose #-} + +instance BalancedParens CsPoppy1 where + firstChild = firstChild . csPoppy1Bits + nextSibling = nextSibling . csPoppy1Bits + parent = parent . csPoppy1Bits + {-# INLINE firstChild #-} + {-# INLINE nextSibling #-} + {-# INLINE parent #-} diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Internal/List.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Internal/List.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Internal/List.hs @@ -0,0 +1,18 @@ +module Data.Succinct.RankSelect.Internal.List + ( chunkBy + , toBools + ) where + +import Data.Word + +import qualified Data.Succinct.BalancedParens.Internal.Word as W + +chunkBy :: Int -> [a] -> [[a]] +chunkBy n bs = case (take n bs, drop n bs) of + (as, zs) -> if null zs then [as] else as:chunkBy n zs + +toBoolsDiff :: [Word64] -> [Bool] -> [Bool] +toBoolsDiff = foldr ((.) . W.toBoolsDiff) id + +toBools :: [Word64] -> [Bool] +toBools ws = toBoolsDiff ws [] diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Internal/Word.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Internal/Word.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Internal/Word.hs @@ -0,0 +1,30 @@ +module Data.Succinct.RankSelect.Internal.Word + ( toBools + , toBoolsDiff + , partialToBoolsDiff + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning + +toBools :: Word64 -> [Bool] +toBools w = toBoolsDiff w [] + +partialToBoolsDiff :: Count -> Word64 -> [Bool] -> [Bool] +partialToBoolsDiff n w | n > 0 = partialToBoolsDiff (n - 1) w . ((w .?. fromIntegral (n - 1)):) +partialToBoolsDiff 0 _ = id +partialToBoolsDiff _ _ = error "Invalid size" + +toBoolsDiff :: Word64 -> [Bool] -> [Bool] +toBoolsDiff w = + go 0x00 . go 0x01 . go 0x02 . go 0x03 . go 0x04 . go 0x05 . go 0x06 . go 0x07 . + go 0x08 . go 0x09 . go 0x0a . go 0x0b . go 0x0c . go 0x0d . go 0x0e . go 0x0f . + go 0x10 . go 0x11 . go 0x12 . go 0x13 . go 0x14 . go 0x15 . go 0x16 . go 0x17 . + go 0x18 . go 0x19 . go 0x1a . go 0x1b . go 0x1c . go 0x1d . go 0x1e . go 0x1f . + go 0x20 . go 0x21 . go 0x22 . go 0x23 . go 0x24 . go 0x25 . go 0x26 . go 0x27 . + go 0x28 . go 0x29 . go 0x2a . go 0x2b . go 0x2c . go 0x2d . go 0x2e . go 0x2f . + go 0x30 . go 0x31 . go 0x32 . go 0x33 . go 0x34 . go 0x35 . go 0x36 . go 0x37 . + go 0x38 . go 0x39 . go 0x3a . go 0x3b . go 0x3c . go 0x3d . go 0x3e . go 0x3f + where go :: Position -> [Bool] -> [Bool] + go p = ((w .?. p):) diff --git a/components/succinct-core/src/Data/Succinct/RankSelect/Poppy512.hs b/components/succinct-core/src/Data/Succinct/RankSelect/Poppy512.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/RankSelect/Poppy512.hs @@ -0,0 +1,141 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE DeriveAnyClass #-} + +module Data.Succinct.RankSelect.Poppy512 + ( Poppy512(..) + , Rank1(..) + , makePoppy512 + ) where + +import Control.DeepSeq +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.CloseAt +import Data.Succinct.BalancedParens.Enclose +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.FindCloseN +import Data.Succinct.BalancedParens.FindOpen +import Data.Succinct.BalancedParens.FindOpenN +import Data.Succinct.BalancedParens.NewCloseAt +import Data.Succinct.BalancedParens.OpenAt +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Word +import GHC.Generics +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.Search +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (length) + +import qualified Data.Vector.Storable as DVS + +data Poppy512 = Poppy512 + { poppy512Bits :: !(DVS.Vector Word64) + , poppy512Index :: !(DVS.Vector Word64) + } deriving (Eq, Show, NFData, Generic) + +instance FromForeignRegion Poppy512 where + fromForeignRegion = makePoppy512 . fromForeignRegion + +instance PopCount0 Poppy512 where + popCount0 = popCount0 . poppy512Bits + {-# INLINE popCount0 #-} + +instance PopCount1 Poppy512 where + popCount1 = popCount1 . poppy512Bits + {-# INLINE popCount1 #-} + +instance AsVector64 Poppy512 where + asVector64 = asVector64 . poppy512Bits + {-# INLINE asVector64 #-} + +makePoppy512 :: DVS.Vector Word64 -> Poppy512 +makePoppy512 v = Poppy512 + { poppy512Bits = v + , poppy512Index = DVS.constructN (((DVS.length v + 7) `div` 8) + 1) gen512Index + } + where gen512Index :: DVS.Vector Word64 -> Word64 + gen512Index u = let indexN = DVS.length u - 1 in + if indexN == -1 + then 0 + else popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v)) + DVS.last u + +instance BitLength Poppy512 where + bitLength v = length (poppy512Bits v) * bitLength (poppy512Bits v !!! 0) + {-# INLINE bitLength #-} + +instance TestBit Poppy512 where + (.?.) = (.?.) . poppy512Bits + {-# INLINE (.?.) #-} + +instance BitRead Poppy512 where + bitRead = fmap makePoppy512 . bitRead + +instance Rank1 Poppy512 where + rank1 (Poppy512 v i) p = + (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512) + +instance Rank0 Poppy512 where + rank0 (Poppy512 v i) p = + p `div` 512 * 512 - (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512) + +instance Select1 Poppy512 where + select1 (Poppy512 v i) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s) + where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1) + s = (i !!! q) :: Count + wordAt = (i !!!) + +instance Select0 Poppy512 where + select0 (Poppy512 v i) p = toCount q * 512 + select0 (DVS.drop (fromIntegral q * 8) v) (p - s) + where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1) + s = (fromIntegral q * 512 - (i !!! q)) :: Count + wordAt o = fromIntegral o * 512 - (i !!! o) + +instance OpenAt Poppy512 where + openAt = openAt . poppy512Bits + {-# INLINE openAt #-} + +instance CloseAt Poppy512 where + closeAt = closeAt . poppy512Bits + {-# INLINE closeAt #-} + +instance FindOpenN Poppy512 where + findOpenN = findOpenN . poppy512Bits + {-# INLINE findOpenN #-} + +instance FindCloseN Poppy512 where + findCloseN = findCloseN . poppy512Bits + {-# INLINE findCloseN #-} + +instance FindOpen Poppy512 where + findOpen = findOpen . poppy512Bits + {-# INLINE findOpen #-} + +instance FindClose Poppy512 where + findClose = findClose . poppy512Bits + {-# INLINE findClose #-} + +instance NewCloseAt Poppy512 where + newCloseAt = newCloseAt . poppy512Bits + {-# INLINE newCloseAt #-} + +instance Enclose Poppy512 where + enclose = enclose . poppy512Bits + {-# INLINE enclose #-} + +instance BalancedParens Poppy512 where + firstChild = firstChild . poppy512Bits + nextSibling = nextSibling . poppy512Bits + parent = parent . poppy512Bits + {-# INLINE firstChild #-} + {-# INLINE nextSibling #-} + {-# INLINE parent #-} diff --git a/components/succinct-core/src/Data/Succinct/String/Parse.hs b/components/succinct-core/src/Data/Succinct/String/Parse.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/src/Data/Succinct/String/Parse.hs @@ -0,0 +1,60 @@ +module Data.Succinct.String.Parse where + +import Control.Monad +import Control.Applicative + +newtype Parser a = Parser { parse :: String -> [(a, String)] } + +runParser :: Parser a -> String -> a +runParser m s = + case parse m s of + [(res, [])] -> res + [(_, _)] -> error "Parser did not consume entire stream." + _ -> error "Parser error." + +item :: Parser Char +item = Parser $ \s -> + case s of + [] -> [] + (c:cs) -> [(c,cs)] + +bind :: Parser a -> (a -> Parser b) -> Parser b +bind p f = Parser $ \s -> concatMap (\(a, s') -> parse (f a) s') $ parse p s + +unit :: a -> Parser a +unit a = Parser (\s -> [(a,s)]) + +instance Functor Parser where + fmap f (Parser cs) = Parser (\s -> [(f a, b) | (a, b) <- cs s]) + +instance Applicative Parser where + pure = unit + (Parser cs1) <*> (Parser cs2) = Parser (\s -> [(f a, s2) | (f, s1) <- cs1 s, (a, s2) <- cs2 s1]) + +instance Monad Parser where + (>>=) = bind + +instance MonadPlus Parser where + mzero = failure + mplus = combine + +instance Alternative Parser where + empty = mzero + (<|>) = option + +combine :: Parser a -> Parser a -> Parser a +combine p q = Parser (\s -> parse p s ++ parse q s) + +failure :: Parser a +failure = Parser (const []) + +option :: Parser a -> Parser a -> Parser a +option p q = Parser $ \s -> + case parse p s of + [] -> parse q s + res -> res + +char :: Char -> Parser Char +char c = do + d <- item + if c == d then return c else failure diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/FindCloseNSpec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/FindCloseNSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/FindCloseNSpec.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.FindCloseNSpec where + +import Data.Succinct.BalancedParens +import HaskellWorks.Data.Bits.Broadword.Type +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.FindCloseNSpec" $ do + it "returns same result as broadword" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 64) + findClose w p === findClose (Broadword w) p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector16Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector16Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector16Spec.hs @@ -0,0 +1,64 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector16Spec + ( spec + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Widen +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector16 as V16 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector16Spec" $ do + describe "findClose" $ do + it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do + w <- forAll $ G.word16 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w, 0] + V16.findClose v p === G.findCloseN w 0 p + it "Two element vector up to position 16" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + w <- forAll $ pure $ id @Word32 $ + (widen w1 .<. (bitLength w0 * 1)) .|. + (widen w0 .<. (bitLength w0 * 0)) + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w0, w1] + V16.findClose v p === G.findCloseN w 0 p + it "Four element vector up to position 32" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + w2 <- forAll $ G.word16 R.constantBounded + w3 <- forAll $ G.word16 R.constantBounded + w <- forAll $ pure $ id @Word64 $ + (widen w3 .<. (bitLength w0 * 3)) .|. + (widen w2 .<. (bitLength w0 * 2)) .|. + (widen w1 .<. (bitLength w0 * 1)) .|. + (widen w0 .<. (bitLength w0 * 0)) + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w0, w1, w2, w3] + V16.findClose v p === G.findCloseN w 0 p + it "Two element vector" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2)) + v <- forAll $ pure $ DVS.fromList [w0, w1] + _ <- forAll $ pure $ bitShow v + V16.findClose v p === G.findCloseN v 0 p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector32Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector32Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector32Spec.hs @@ -0,0 +1,50 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector32Spec + ( spec + ) where + +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Widen +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector32 as V32 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector32Spec" $ do + describe "findClose" $ do + it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do + w <- forAll $ G.word32 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w, 0] + V32.findClose v p === G.findCloseN w 0 p + it "Two element vector up to position 32" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + w <- forAll $ pure $ id @Word64 $ + (widen w1 .<. (bitLength w0 * 1)) .|. + (widen w0 .<. (bitLength w0 * 0)) + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w0, w1] + V32.findClose v p === G.findCloseN w 0 p + it "Two element vector" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2)) + v <- forAll $ pure $ DVS.fromList [w0, w1] + _ <- forAll $ pure $ bitShow v + V32.findClose v p === G.findCloseN v 0 p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector64Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector64Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector64Spec.hs @@ -0,0 +1,37 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64Spec + ( spec + ) where + +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64 as V64 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64Spec" $ do + describe "findClose" $ do + it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do + w <- forAll $ G.word64 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w, 0] + V64.findClose v p === G.findCloseN w 0 p + it "Two element vector" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word64 R.constantBounded + w1 <- forAll $ G.word64 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2)) + v <- forAll $ pure $ DVS.fromList [w0, w1] + _ <- forAll $ pure $ bitShow v + V64.findClose v p === G.findCloseN v 0 p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector8Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector8Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindClose/Vector8Spec.hs @@ -0,0 +1,109 @@ +module Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector8Spec + ( spec + ) where + +import Control.Monad +import Data.Word +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Widen +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.List as L +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.FindClose as CLS +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector8 as V8 +import qualified Data.Succinct.BalancedParens.Internal.IO as IO +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic as G +import qualified Data.Succinct.BalancedParens.RangeMin2 as RM2 +import qualified HaskellWorks.Data.FromForeignRegion as IO +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R +import qualified System.IO.Unsafe as IO + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +testFiles :: [FilePath] +testFiles = IO.unsafePerformIO $ do + files <- IO.safeListDirectory "components/succinct-balancedparens/data/test" + return $ L.sort (("components/succinct-balancedparens/data/test/" ++) <$> (".ib.idx" `L.isSuffixOf`) `filter` files) +{-# NOINLINE testFiles #-} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector8Spec" $ do + describe "findClose" $ do + it "Two element vector zero as second word" $ require $ withTests 1000 $ property $ do + w <- forAll $ G.word8 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 8) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w, 0] + V8.findClose v p === G.findCloseN w 0 p + it "Two element vector up to position 16" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + w <- forAll $ pure $ id @Word16 $ + (widen w1 .<. (bitLength w0 * 1)) .|. + (widen w0 .<. (bitLength w0 * 0)) + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w0, w1] + V8.findClose v p === G.findCloseN w 0 p + it "Four element vector up to position 32" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + w2 <- forAll $ G.word8 R.constantBounded + w3 <- forAll $ G.word8 R.constantBounded + w <- forAll $ pure $ id @Word32 $ + (widen w3 .<. (bitLength w0 * 3)) .|. + (widen w2 .<. (bitLength w0 * 2)) .|. + (widen w1 .<. (bitLength w0 * 1)) .|. + (widen w0 .<. (bitLength w0 * 0)) + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w0, w1, w2, w3] + V8.findClose v p === G.findCloseN w 0 p + it "Eight element vector up to position 64" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + w2 <- forAll $ G.word8 R.constantBounded + w3 <- forAll $ G.word8 R.constantBounded + w4 <- forAll $ G.word8 R.constantBounded + w5 <- forAll $ G.word8 R.constantBounded + w6 <- forAll $ G.word8 R.constantBounded + w7 <- forAll $ G.word8 R.constantBounded + w <- forAll $ pure $ id @Word64 $ + (widen w7 .<. (bitLength w0 * 7)) .|. + (widen w6 .<. (bitLength w0 * 6)) .|. + (widen w5 .<. (bitLength w0 * 5)) .|. + (widen w4 .<. (bitLength w0 * 4)) .|. + (widen w3 .<. (bitLength w0 * 3)) .|. + (widen w2 .<. (bitLength w0 * 2)) .|. + (widen w1 .<. (bitLength w0 * 1)) .|. + (widen w0 .<. (bitLength w0 * 0)) + p <- forAll $ G.word64 (R.linear 1 (bitLength w)) + _ <- forAll $ pure $ bitShow w + v <- forAll $ pure $ DVS.fromList [w0, w1, w2, w3, w4, w5, w6, w7] + V8.findClose v p === G.findCloseN w 0 p + it "Two element vector" $ require $ withTests 1000 $ property $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + p <- forAll $ G.word64 (R.linear 1 (bitLength w0 * 2)) + v <- forAll $ pure $ DVS.fromList [w0, w1] + _ <- forAll $ pure $ bitShow v + V8.findClose v p === G.findCloseN v 0 p + describe "Corpus tests" $ do + forM_ testFiles $ \file -> do + it ("File " <> file) $ do + v <- IO.mmapFromForeignRegion file + let rmm2 = RM2.mkRangeMin2 (v :: DVS.Vector Word64) + require $ withTests 100000 $ property $ do + _ <- forAll $ pure file + p <- forAll $ G.word64 (R.linear 1 (bitLength v)) + _ <- forAll $ pure $ bitShow v + mfilter (<= bitLength v) (CLS.findClose v p) === CLS.findClose rmm2 p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector16Spec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16Spec where + +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Widen +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16 as BWV16 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as BWW32 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector16 as SV16 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16Spec" $ do + it "findUnmatchedCloseFar against two words" $ require $ withTests 1000 $ property $ do + c <- forAll $ G.word64 (R.linear 0 64) + p <- forAll $ G.word64 (R.linear 0 16) + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + w <- forAll $ pure $ (widen w1 .<. bitLength w0) .|. widen w0 + v <- forAll $ pure $ DVS.fromList [w0, w1] + annotateShow $ bitShow w + actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ BWW32.findUnmatchedCloseFar c p w + actual === expected + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure DVS.empty + c <- forAll $ pure 0 + p <- forAll $ pure 0 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV16.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure $ DVS.fromList [0] + c <- forAll $ pure 1 + p <- forAll $ pure 8 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV16.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do + v <- forAll $ G.storableVector (R.linear 0 4) (G.word16 R.constantBounded) + c <- forAll $ G.word64 (R.linear 0 (bitLength v)) + p <- forAll $ G.word64 (R.linear 0 (bitLength v)) + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV16.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV16.findUnmatchedCloseFar c p v + actual === expected diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector32Spec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32Spec where + +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Widen +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32 as BWV32 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BWW64 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector32 as SV32 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32Spec" $ do + it "findUnmatchedCloseFar against two words" $ require $ withTests 1000 $ property $ do + c <- forAll $ G.word64 (R.linear 0 64) + p <- forAll $ G.word64 (R.linear 0 16) + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + w <- forAll $ pure $ (widen w1 .<. bitLength w0) .|. widen w0 + v <- forAll $ pure $ DVS.fromList [w0, w1] + annotateShow $ bitShow w + actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ BWW64.findUnmatchedCloseFar c p w + actual === expected + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure DVS.empty + c <- forAll $ pure 0 + p <- forAll $ pure 0 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV32.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure $ DVS.fromList [0] + c <- forAll $ pure 1 + p <- forAll $ pure 8 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV32.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do + v <- forAll $ G.storableVector (R.linear 0 4) (G.word32 R.constantBounded) + c <- forAll $ G.word64 (R.linear 0 (bitLength v)) + p <- forAll $ G.word64 (R.linear 0 (bitLength v)) + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV32.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV32.findUnmatchedCloseFar c p v + actual === expected diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector64Spec.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64Spec where + +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64 as BWV64 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector64 as SV64 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64Spec" $ do + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure DVS.empty + c <- forAll $ pure 0 + p <- forAll $ pure 0 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV64.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV64.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure $ DVS.fromList [0] + c <- forAll $ pure 1 + p <- forAll $ pure 8 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV64.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV64.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do + v <- forAll $ G.storableVector (R.linear 0 4) (G.word64 R.constantBounded) + c <- forAll $ G.word64 (R.linear 0 (bitLength v)) + p <- forAll $ G.word64 (R.linear 0 (bitLength v)) + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV64.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV64.findUnmatchedCloseFar c p v + actual === expected diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Vector8Spec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8Spec where + +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Int.Widen +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8 as BWV8 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as BWW16 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector8 as SV8 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8Spec" $ do + it "findUnmatchedCloseFar against two words" $ require $ withTests 1000 $ property $ do + c <- forAll $ G.word64 (R.linear 0 64) + p <- forAll $ G.word64 (R.linear 0 8) + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + w <- forAll $ pure $ (widen w1 .<. bitLength w0) .|. widen w0 + v <- forAll $ pure $ DVS.fromList [w0, w1] + annotateShow $ bitShow w + actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ BWW16.findUnmatchedCloseFar c p w + actual === expected + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure DVS.empty + c <- forAll $ pure 0 + p <- forAll $ pure 0 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV8.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ requireTest $ do + v <- forAll $ pure $ DVS.fromList [0] + c <- forAll $ pure 1 + p <- forAll $ pure 8 + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV8.findUnmatchedCloseFar c p v + actual === expected + it "findUnmatchedCloseFar against slow" $ require $ withTests 10000 $ property $ do + v <- forAll $ G.storableVector (R.linear 0 4) (G.word8 R.constantBounded) + c <- forAll $ G.word64 (R.linear 0 (bitLength v)) + p <- forAll $ G.word64 (R.linear 0 (bitLength v)) + annotateShow $ bitShow v + actual <- forAll $ pure $ BWV8.findUnmatchedCloseFar c p v + expected <- forAll $ pure $ SV8.findUnmatchedCloseFar c p v + actual === expected diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word16Spec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16Spec where + +import Data.Maybe +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Numeric +import Test.Hspec + +import qualified Data.Succinct.BalancedParens.FindClose as C +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word16 as BW16 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 as BW16 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word16 as SW16 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Broadword.Word16Spec" $ do + it "findUnmatchedCloseFar 0 [11111111 11110100]" $ requireTest $ do + p <- forAll $ pure 0 + w <- forAll $ pure $ fromJust $ bitRead "11111111 11110100" + annotateShow $ bitShow w + annotateShow $ showHex w "" + BW16.findUnmatchedCloseFar 0 p w === SW16.findUnmatchedCloseFar 0 p w + it "findUnmatchedCloseFar" $ require $ withTests 2000 $ property $ do + c <- forAll $ G.word64 (R.linear 0 64) + p <- forAll $ G.word64 (R.linear 0 16) + w <- forAll $ G.word16 R.constantBounded + annotateShow $ bitShow w + BW16.findUnmatchedCloseFar c p w === SW16.findUnmatchedCloseFar c p w + it "findClose" $ require $ withTests 1000 $ property $ do + p <- forAll $ G.word64 (R.linear 1 128) + w <- forAll $ G.word16 R.constantBounded + annotateShow $ bitShow w + BW16.findClose w p === C.findClose w p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word32Spec.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32Spec where + +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.BalancedParens.FindClose as C +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word32 as BW32 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 as BW32 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word32 as SW32 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Broadword.Word32Spec" $ do + it "findUnmatchedCloseFar" $ requireTest $ do + p <- forAll $ pure 0 + w <- forAll $ pure 0xe9f6e7ff + annotateShow $ bitShow w + BW32.findUnmatchedCloseFar 0 p w === SW32.findUnmatchedCloseFar 0 p w + it "findUnmatchedCloseFar" $ require $ withTests 40000 $ property $ do + c <- forAll $ G.word64 (R.linear 0 64) + p <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + annotateShow $ bitShow w + BW32.findUnmatchedCloseFar c p w === SW32.findUnmatchedCloseFar c p w + it "findClose" $ require $ withTests 1000 $ property $ do + p <- forAll $ G.word64 (R.linear 1 128) + w <- forAll $ G.word32 R.constantBounded + annotateShow $ bitShow w + BW32.findClose w p === C.findClose w p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word64Spec.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64Spec where + +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Naive +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.BalancedParens.FindClose as C +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word64 as BW64 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 as BW64 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64 as SW64 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Broadword.Word64Spec" $ do + it "findUnmatchedCloseFar" $ require $ withTests 100000 $ property $ do + c <- forAll $ G.word64 (R.linear 0 128) + p <- forAll $ G.word64 (R.linear 0 128) + w <- forAll $ G.word64 R.constantBounded + annotateShow $ bitShow w + BW64.findUnmatchedCloseFar c p w === SW64.findUnmatchedCloseFar c p w + it "findClose" $ require $ withTests 1000 $ property $ do + p <- forAll $ G.word64 (R.linear 1 128) + w <- forAll $ G.word64 R.constantBounded + annotateShow $ bitShow w + BW64.findClose w p === C.findClose (Naive w) p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/Broadword/FindUnmatchedCloseFar/Word8Spec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8Spec where + +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.BalancedParens.FindClose as C +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word8 as BW8 +import qualified Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 as BW8 +import qualified Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word8 as SW8 +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Evaluate" -} +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.Broadword.Word8Spec" $ do + it "findUnmatchedCloseFar" $ require $ withTests 1000 $ property $ do + c <- forAll $ G.word64 (R.linear 0 64) + p <- forAll $ G.word64 (R.linear 0 8) + w <- forAll $ G.word8 R.constantBounded + annotateShow $ bitShow w + BW8.findUnmatchedCloseFar c p w === SW8.findUnmatchedCloseFar c p w + it "findClose" $ require $ withTests 1000 $ property $ do + p <- forAll $ G.word64 (R.linear 1 128) + w <- forAll $ G.word8 R.constantBounded + annotateShow $ bitShow w + BW8.findClose w p === C.findClose w p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/BroadwordSpec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/BroadwordSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/Internal/BroadwordSpec.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.Internal.BroadwordSpec where + +import Data.Word +import GHC.Generics +import Data.Succinct.BalancedParens.FindClose +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.Broadword.Type +import HaskellWorks.Data.Bits.FromBitTextByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +newtype ShowVector a = ShowVector a deriving (Eq, BitShow, Generic) + +instance BitShow a => Show (ShowVector a) where + show = bitShow + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.BroadwordSpec" $ do + describe "For (()(()())) 1101101000" $ do + let bs = Broadword (91 :: Word64) + it "Test 1a" $ requireTest $ findClose bs 1 === Just 10 + it "Test 1b" $ requireTest $ findClose bs 2 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 3 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 4 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 5 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 6 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 7 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 8 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 9 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 10 === Just 10 + -- it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1 + -- it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2 + -- it "Test 3a" $ requireTest $ enclose bs 2 === Just 1 + -- it "Test 3b" $ requireTest $ enclose bs 7 === Just 4 + describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do + let bs = Broadword (DVS.head (fromBitTextByteString "11011010 00000000") :: Word64) + it "Test 1a" $ requireTest $ findClose bs 1 === Just 10 + it "Test 1b" $ requireTest $ findClose bs 2 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 3 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 4 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 5 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 6 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 7 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 8 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 9 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 10 === Just 10 + -- it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1 + -- it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2 + -- it "Test 3a" $ requireTest $ enclose bs 2 === Just 1 + -- it "Test 3b" $ requireTest $ enclose bs 7 === Just 4 + -- it "firstChild 1" $ requireTest $ firstChild bs 1 === Just 2 + -- it "firstChild 4" $ requireTest $ firstChild bs 4 === Just 5 + -- it "nextSibling 2" $ requireTest $ nextSibling bs 2 === Just 4 + -- it "nextSibling 5" $ requireTest $ nextSibling bs 5 === Just 7 + -- it "parent 2" $ requireTest $ parent bs 2 === Just 1 + -- it "parent 5" $ requireTest $ parent bs 5 === Just 4 + -- it "depth 1" $ requireTest $ depth bs 1 === Just 1 + -- it "depth 2" $ requireTest $ depth bs 2 === Just 2 + -- it "depth 3" $ requireTest $ depth bs 3 === Just 2 + -- it "depth 4" $ requireTest $ depth bs 4 === Just 2 + -- it "depth 5" $ requireTest $ depth bs 5 === Just 3 + -- it "depth 6" $ requireTest $ depth bs 6 === Just 3 + -- it "depth 7" $ requireTest $ depth bs 7 === Just 3 + -- it "depth 8" $ requireTest $ depth bs 8 === Just 3 + -- it "depth 9" $ requireTest $ depth bs 9 === Just 2 + -- it "depth 10" $ requireTest $ depth bs 10 === Just 1 + -- it "subtreeSize 1" $ requireTest $ subtreeSize bs 1 === Just 5 + -- it "subtreeSize 2" $ requireTest $ subtreeSize bs 2 === Just 1 + -- it "subtreeSize 3" $ requireTest $ subtreeSize bs 3 === Just 0 + -- it "subtreeSize 4" $ requireTest $ subtreeSize bs 4 === Just 3 + -- it "subtreeSize 5" $ requireTest $ subtreeSize bs 5 === Just 1 + -- it "subtreeSize 6" $ requireTest $ subtreeSize bs 6 === Just 0 + -- it "subtreeSize 7" $ requireTest $ subtreeSize bs 7 === Just 1 + -- it "subtreeSize 8" $ requireTest $ subtreeSize bs 8 === Just 0 + -- it "subtreeSize 9" $ requireTest $ subtreeSize bs 9 === Just 0 + -- it "subtreeSize 10" $ requireTest $ subtreeSize bs 10 === Just 0 + -- describe "Does not suffer exceptions" $ do + -- it "when calling nextSibling from valid locations" $ do + -- forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do + -- [nextSibling v p | p <- [1..bitLength v]] === [nextSibling v p | p <- [1..bitLength v]] + it "Broadword findClose should behave the same as Naive findClose" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + p <- forAll $ G.count (R.linear 1 64) + findClose w p === findClose (Broadword w) p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/RangeMin2Spec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/RangeMin2Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/RangeMin2Spec.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + + +module Data.Succinct.BalancedParens.RangeMin2Spec where + +import Control.Monad (mfilter) +import Data.Word +import Data.Succinct.BalancedParens +import Data.Succinct.BalancedParens.RangeMin2 +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.FromBitTextByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +factor :: Int +factor = 16384 +{-# INLINE factor #-} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.RangeMinSpec2" $ do + it "For a simple bit string can find close" $ requireTest $ do + let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64 + let !rm = mkRangeMin2 v + findClose rm 61 === findClose v 61 + it "findClose should return the same result" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded) + let !rm = mkRangeMin2 v + let len = bitLength v + [mfilter (<= bitLength v) (findClose rm i) | i <- [1..len]] === [mfilter (<= bitLength v) (findClose v i) | i <- [1..len]] + it "findClose should return the same result over all counts" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) + p <- forAll $ G.count (R.linear 1 (bitLength v)) + let !rm = mkRangeMin2 v + mfilter (<= bitLength v) (findClose rm p) === mfilter (<= bitLength v) (findClose v p) + it "nextSibling should return the same result over all counts" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) + p <- forAll $ G.count (R.linear 1 (bitLength v)) + let !rm = mkRangeMin2 v + nextSibling rm p === nextSibling v p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/RangeMinSpec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/RangeMinSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/RangeMinSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.BalancedParens.RangeMinSpec where + +import Control.Monad (mfilter) +import Data.Word +import GHC.Generics +import Data.Succinct.BalancedParens +import Data.Succinct.BalancedParens.RangeMin +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.FromBitTextByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +newtype ShowVector a = ShowVector a deriving (Eq, BitShow, Generic) + +instance BitShow a => Show (ShowVector a) where + show = bitShow + +factor :: Int +factor = 16384 +{-# INLINE factor #-} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.RangeMinSpec" $ do + it "For a simple bit string can find close" $ requireTest $ do + let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64 + let !rm = mkRangeMin v + findClose rm 61 === findClose v 61 + it "findClose should return the same result" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded) + let !rm = mkRangeMin v + let len = bitLength v + [mfilter (<= bitLength v) (findClose rm i) | i <- [1..len]] === [mfilter (<= bitLength v) (findClose v i) | i <- [1..len]] + it "findClose should return the same result over all counts" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) + p <- forAll $ G.count (R.linear 1 (bitLength v)) + let !rm = mkRangeMin v + mfilter (<= bitLength v) (findClose rm p) === mfilter (<= bitLength v) (findClose v p) + it "nextSibling should return the same result over all counts" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded) + p <- forAll $ G.count (R.linear 1 (bitLength v)) + let !rm = mkRangeMin v + nextSibling rm p === nextSibling v p diff --git a/components/succinct-core/test/Data/Succinct/BalancedParens/SimpleSpec.hs b/components/succinct-core/test/Data/Succinct/BalancedParens/SimpleSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/BalancedParens/SimpleSpec.hs @@ -0,0 +1,126 @@ +module Data.Succinct.BalancedParens.SimpleSpec where + +import Data.Maybe +import Data.Word +import Data.Succinct.BalancedParens +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.BalancedParens.SimpleSpec" $ do + describe "For (()(()())) 1101101000" $ do + let bs = SimpleBalancedParens (91 :: Word64) + it "Test 1a" $ requireTest $ findClose bs 1 === Just 10 + it "Test 1b" $ requireTest $ findClose bs 2 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 3 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 4 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 5 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 6 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 7 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 8 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 9 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 10 === Just 10 + it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1 + it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2 + it "Test 3a" $ requireTest $ enclose bs 2 === Just 1 + it "Test 3b" $ requireTest $ enclose bs 7 === Just 4 + describe "For (()(()())) 1101101000" $ do + let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool]) + it "Test 1a" $ requireTest $ findClose bs 1 === Just 10 + it "Test 1b" $ requireTest $ findClose bs 2 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 3 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 4 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 5 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 6 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 7 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 8 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 9 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 10 === Just 10 + it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1 + it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2 + it "Test 3a" $ requireTest $ enclose bs 2 === Just 1 + it "Test 3b" $ requireTest $ enclose bs 7 === Just 4 + it "firstChild 1" $ requireTest $ firstChild bs 1 === Just 2 + it "firstChild 4" $ requireTest $ firstChild bs 4 === Just 5 + it "nextSibling 2" $ requireTest $ nextSibling bs 2 === Just 4 + it "nextSibling 5" $ requireTest $ nextSibling bs 5 === Just 7 + it "parent 2" $ requireTest $ parent bs 2 === Just 1 + it "parent 5" $ requireTest $ parent bs 5 === Just 4 + it "depth 1" $ requireTest $ depth bs 1 === Just 1 + it "depth 2" $ requireTest $ depth bs 2 === Just 2 + it "depth 3" $ requireTest $ depth bs 3 === Just 2 + it "depth 4" $ requireTest $ depth bs 4 === Just 2 + it "depth 5" $ requireTest $ depth bs 5 === Just 3 + it "depth 6" $ requireTest $ depth bs 6 === Just 3 + it "depth 7" $ requireTest $ depth bs 7 === Just 3 + it "depth 8" $ requireTest $ depth bs 8 === Just 3 + it "depth 9" $ requireTest $ depth bs 9 === Just 2 + it "depth 10" $ requireTest $ depth bs 10 === Just 1 + it "subtreeSize 1" $ requireTest $ subtreeSize bs 1 === Just 5 + it "subtreeSize 2" $ requireTest $ subtreeSize bs 2 === Just 1 + it "subtreeSize 3" $ requireTest $ subtreeSize bs 3 === Just 0 + it "subtreeSize 4" $ requireTest $ subtreeSize bs 4 === Just 3 + it "subtreeSize 5" $ requireTest $ subtreeSize bs 5 === Just 1 + it "subtreeSize 6" $ requireTest $ subtreeSize bs 6 === Just 0 + it "subtreeSize 7" $ requireTest $ subtreeSize bs 7 === Just 1 + it "subtreeSize 8" $ requireTest $ subtreeSize bs 8 === Just 0 + it "subtreeSize 9" $ requireTest $ subtreeSize bs 9 === Just 0 + it "subtreeSize 10" $ requireTest $ subtreeSize bs 10 === Just 0 + describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do + let bs = SimpleBalancedParens (fromJust (bitRead "11011010 00000000") :: DVS.Vector Word8) + it "Test 1a" $ requireTest $ findClose bs 1 === Just 10 + it "Test 1b" $ requireTest $ findClose bs 2 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 3 === Just 3 + it "Test 1b" $ requireTest $ findClose bs 4 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 5 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 6 === Just 6 + it "Test 1b" $ requireTest $ findClose bs 7 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 8 === Just 8 + it "Test 1b" $ requireTest $ findClose bs 9 === Just 9 + it "Test 1b" $ requireTest $ findClose bs 10 === Just 10 + it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1 + it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2 + it "Test 3a" $ requireTest $ enclose bs 2 === Just 1 + it "Test 3b" $ requireTest $ enclose bs 7 === Just 4 + it "firstChild 1" $ requireTest $ firstChild bs 1 === Just 2 + it "firstChild 4" $ requireTest $ firstChild bs 4 === Just 5 + it "nextSibling 2" $ requireTest $ nextSibling bs 2 === Just 4 + it "nextSibling 5" $ requireTest $ nextSibling bs 5 === Just 7 + it "parent 2" $ requireTest $ parent bs 2 === Just 1 + it "parent 5" $ requireTest $ parent bs 5 === Just 4 + it "depth 1" $ requireTest $ depth bs 1 === Just 1 + it "depth 2" $ requireTest $ depth bs 2 === Just 2 + it "depth 3" $ requireTest $ depth bs 3 === Just 2 + it "depth 4" $ requireTest $ depth bs 4 === Just 2 + it "depth 5" $ requireTest $ depth bs 5 === Just 3 + it "depth 6" $ requireTest $ depth bs 6 === Just 3 + it "depth 7" $ requireTest $ depth bs 7 === Just 3 + it "depth 8" $ requireTest $ depth bs 8 === Just 3 + it "depth 9" $ requireTest $ depth bs 9 === Just 2 + it "depth 10" $ requireTest $ depth bs 10 === Just 1 + it "subtreeSize 1" $ requireTest $ subtreeSize bs 1 === Just 5 + it "subtreeSize 2" $ requireTest $ subtreeSize bs 2 === Just 1 + it "subtreeSize 3" $ requireTest $ subtreeSize bs 3 === Just 0 + it "subtreeSize 4" $ requireTest $ subtreeSize bs 4 === Just 3 + it "subtreeSize 5" $ requireTest $ subtreeSize bs 5 === Just 1 + it "subtreeSize 6" $ requireTest $ subtreeSize bs 6 === Just 0 + it "subtreeSize 7" $ requireTest $ subtreeSize bs 7 === Just 1 + it "subtreeSize 8" $ requireTest $ subtreeSize bs 8 === Just 0 + it "subtreeSize 9" $ requireTest $ subtreeSize bs 9 === Just 0 + it "subtreeSize 10" $ requireTest $ subtreeSize bs 10 === Just 0 + describe "Does not suffer exceptions" $ do + it "when calling nextSibling from valid locations" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 64) (G.word64 R.constantBounded) + [nextSibling v p | p <- [1..bitLength v]] === [nextSibling v p | p <- [1..bitLength v]] diff --git a/components/succinct-core/test/Data/Succinct/Excess/Internal/BranchlessSpec.hs b/components/succinct-core/test/Data/Succinct/Excess/Internal/BranchlessSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/Internal/BranchlessSpec.hs @@ -0,0 +1,36 @@ +module Data.Succinct.Excess.Internal.BranchlessSpec (spec) where + +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.Excess.Internal.Branchless as BL +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.Internal.Branchless" $ do + describe "For Int64" $ do + it "minInt64 behaves like min" $ requireProperty $ do + a <- forAll $ G.int64 R.constantBounded + b <- forAll $ G.int64 R.constantBounded + + min a b === BL.minInt64 a b + it "minInt behaves like min" $ requireProperty $ do + a <- forAll $ G.int R.constantBounded + b <- forAll $ G.int R.constantBounded + + min a b === BL.minInt a b + it "maxInt64 behaves like max" $ requireProperty $ do + a <- forAll $ G.int64 R.constantBounded + b <- forAll $ G.int64 R.constantBounded + + max a b === BL.maxInt64 a b + it "maxInt behaves like max" $ requireProperty $ do + a <- forAll $ G.int R.constantBounded + b <- forAll $ G.int R.constantBounded + + max a b === BL.maxInt a b diff --git a/components/succinct-core/test/Data/Succinct/Excess/MinExcess0Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/MinExcess0Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/MinExcess0Spec.hs @@ -0,0 +1,121 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.MinExcess0Spec (spec) where + +import HaskellWorks.Data.Bits.Word +import Data.Succinct.Excess.Internal.Triplet8 (Triplet8 (Triplet8)) +import Data.Succinct.Excess.MinExcess +import Data.Succinct.Excess.MinExcess0 +import HaskellWorks.Data.Naive +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Partial.Table as T +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.MinExcess0Spec" $ do + describe "For Word8" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let MinExcess minE e = minExcess0 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + let w2 = leConcat w0 w1 + let MinExcess minE0 e0 = minExcess0 w0 + let MinExcess minE1 _ = minExcess0 w1 + let MinExcess minE2 _ = minExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess0 w0 + let MinExcess minE1 _ = minExcess0 w1 + let MinExcess minE2 _ = minExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "For Word16" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + let MinExcess minE e = minExcess0 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = leConcat w0 w1 + let MinExcess minE0 e0 = minExcess0 w0 + let MinExcess minE1 _ = minExcess0 w1 + let MinExcess minE2 _ = minExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess0 w0 + let MinExcess minE1 _ = minExcess0 w1 + let MinExcess minE2 _ = minExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "For Word32" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + let MinExcess minE e = minExcess0 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + + let w2 = leConcat w0 w1 + let MinExcess minE0 e0 = minExcess0 w0 + let MinExcess minE1 _ = minExcess0 w1 + let MinExcess minE2 _ = minExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess0 w0 + let MinExcess minE1 _ = minExcess0 w1 + let MinExcess minE2 _ = minExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "For Word64" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + let MinExcess minE e = minExcess0 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word64 R.constantBounded + w1 <- forAll $ G.word64 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess0 w0 + let MinExcess minE1 _ = minExcess0 w1 + let MinExcess minE2 _ = minExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "Equivalent to native implementation" $ do + it "For Word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minExcess0 w === minExcess0 (Naive w) + it "For Word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minExcess0 w === minExcess0 (Naive w) + it "For Word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minExcess0 w === minExcess0 (Naive w) + it "For Word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minExcess0 w === minExcess0 (Naive w) + describe "Equivalent to word8Excess0' implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let MinExcess lo0 ex0 = minExcess0 w + let Triplet8 lo1 ex1 _ = T.genWord8Excess0 8 w + lo0 === fromIntegral lo1 + ex0 === fromIntegral ex1 diff --git a/components/succinct-core/test/Data/Succinct/Excess/MinExcess1Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/MinExcess1Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/MinExcess1Spec.hs @@ -0,0 +1,121 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.MinExcess1Spec (spec) where + +import HaskellWorks.Data.Bits.Word +import Data.Succinct.Excess.Internal.Triplet8 (Triplet8 (Triplet8)) +import Data.Succinct.Excess.MinExcess +import Data.Succinct.Excess.MinExcess1 +import HaskellWorks.Data.Naive +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Partial.Table as T +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.MinExcess1Spec" $ do + describe "For Word8" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let MinExcess minE e = minExcess1 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + + let w2 = leConcat w0 w1 + let MinExcess minE0 e0 = minExcess1 w0 + let MinExcess minE1 _ = minExcess1 w1 + let MinExcess minE2 _ = minExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess1 w0 + let MinExcess minE1 _ = minExcess1 w1 + let MinExcess minE2 _ = minExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "For Word16" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + let MinExcess minE e = minExcess1 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = leConcat w0 w1 + let MinExcess minE0 e0 = minExcess1 w0 + let MinExcess minE1 _ = minExcess1 w1 + let MinExcess minE2 _ = minExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess1 w0 + let MinExcess minE1 _ = minExcess1 w1 + let MinExcess minE2 _ = minExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "For Word32" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + let MinExcess minE e = minExcess1 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + let w2 = leConcat w0 w1 + let MinExcess minE0 e0 = minExcess1 w0 + let MinExcess minE1 _ = minExcess1 w1 + let MinExcess minE2 _ = minExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess1 w0 + let MinExcess minE1 _ = minExcess1 w1 + let MinExcess minE2 _ = minExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "For Word64" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + let MinExcess minE e = minExcess1 w + assert $ minE <= e + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word64 R.constantBounded + w1 <- forAll $ G.word64 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let MinExcess minE0 e0 = minExcess1 w0 + let MinExcess minE1 _ = minExcess1 w1 + let MinExcess minE2 _ = minExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + describe "Equivalent to native implementation" $ do + it "For Word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minExcess1 w === minExcess1 (Naive w) + it "For Word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minExcess1 w === minExcess1 (Naive w) + it "For Word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minExcess1 w === minExcess1 (Naive w) + it "For Word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minExcess1 w === minExcess1 (Naive w) + describe "Equivalent to word8Excess1' implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let MinExcess lo0 ex0 = minExcess1 w + let Triplet8 lo1 ex1 _ = T.genWord8Excess1 8 w + lo0 === fromIntegral lo1 + ex0 === fromIntegral ex1 diff --git a/components/succinct-core/test/Data/Succinct/Excess/MinMaxExcess0Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/MinMaxExcess0Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/MinMaxExcess0Spec.hs @@ -0,0 +1,180 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.MinMaxExcess0Spec (spec) where + +import HaskellWorks.Data.Bits.Word +import Data.Succinct.Excess.Internal.Triplet8 (Triplet8 (Triplet8)) +import Data.Succinct.Excess.MinMaxExcess0 +import Data.Succinct.Excess.Triplet +import HaskellWorks.Data.Naive +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Partial.Table as T +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.MinMaxExcess0Spec" $ do + describe "For Word8" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let Triplet minE e maxE = minMaxExcess0 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet minE0 e0 _ = minMaxExcess0 w0 + let Triplet minE1 _ _ = minMaxExcess0 w1 + let Triplet minE2 _ _ = minMaxExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet _ e0 maxE0 = minMaxExcess0 w0 + let Triplet _ _ maxE1 = minMaxExcess0 w1 + let Triplet _ _ maxE2 = minMaxExcess0 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess0 w0 + let Triplet minE1 _ _ = minMaxExcess0 w1 + let Triplet minE2 _ _ = minMaxExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess0 w0 + let Triplet _ _ maxE1 = minMaxExcess0 w1 + let Triplet _ _ maxE2 = minMaxExcess0 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "For Word16" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + let Triplet minE e maxE = minMaxExcess0 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet minE0 e0 _ = minMaxExcess0 w0 + let Triplet minE1 _ _ = minMaxExcess0 w1 + let Triplet minE2 _ _ = minMaxExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet _ e0 maxE0 = minMaxExcess0 w0 + let Triplet _ _ maxE1 = minMaxExcess0 w1 + let Triplet _ _ maxE2 = minMaxExcess0 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess0 w0 + let Triplet minE1 _ _ = minMaxExcess0 w1 + let Triplet minE2 _ _ = minMaxExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess0 w0 + let Triplet _ _ maxE1 = minMaxExcess0 w1 + let Triplet _ _ maxE2 = minMaxExcess0 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "For Word32" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + let Triplet minE e maxE = minMaxExcess0 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + + let w2 = leConcat w0 w1 + let Triplet minE0 e0 _ = minMaxExcess0 w0 + let Triplet minE1 _ _ = minMaxExcess0 w1 + let Triplet minE2 _ _ = minMaxExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + + let w2 = leConcat w0 w1 + let Triplet _ e0 maxE0 = minMaxExcess0 w0 + let Triplet _ _ maxE1 = minMaxExcess0 w1 + let Triplet _ _ maxE2 = minMaxExcess0 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess0 w0 + let Triplet minE1 _ _ = minMaxExcess0 w1 + let Triplet minE2 _ _ = minMaxExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess0 w0 + let Triplet _ _ maxE1 = minMaxExcess0 w1 + let Triplet _ _ maxE2 = minMaxExcess0 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "For Word64" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + let Triplet minE e maxE = minMaxExcess0 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word64 R.constantBounded + w1 <- forAll $ G.word64 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess0 w0 + let Triplet minE1 _ _ = minMaxExcess0 w1 + let Triplet minE2 _ _ = minMaxExcess0 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word64 R.constantBounded + w1 <- forAll $ G.word64 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess0 w0 + let Triplet _ _ maxE1 = minMaxExcess0 w1 + let Triplet _ _ maxE2 = minMaxExcess0 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "Equivalent to native implementation" $ do + it "For Word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minMaxExcess0 w === minMaxExcess0 (Naive w) + it "For Word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minMaxExcess0 w === minMaxExcess0 (Naive w) + it "For Word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minMaxExcess0 w === minMaxExcess0 (Naive w) + it "For Word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minMaxExcess0 w === minMaxExcess0 (Naive w) + describe "Equivalent to word8Excess0' implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let Triplet lo0 ex0 hi0 = minMaxExcess0 w + let Triplet8 lo1 ex1 hi1 = T.genWord8Excess0 8 w + lo0 === fromIntegral lo1 + ex0 === fromIntegral ex1 + hi0 === fromIntegral hi1 diff --git a/components/succinct-core/test/Data/Succinct/Excess/MinMaxExcess1Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/MinMaxExcess1Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/MinMaxExcess1Spec.hs @@ -0,0 +1,180 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.MinMaxExcess1Spec (spec) where + +import HaskellWorks.Data.Bits.Word +import Data.Succinct.Excess.Internal.Triplet8 (Triplet8 (Triplet8)) +import Data.Succinct.Excess.MinMaxExcess1 +import Data.Succinct.Excess.Triplet +import HaskellWorks.Data.Naive +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Excess.Internal.Partial.Table as T +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.MinMaxExcess1Spec" $ do + describe "For Word8" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let Triplet minE e maxE = minMaxExcess1 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + + let w2 = leConcat w0 w1 + let Triplet minE0 e0 _ = minMaxExcess1 w0 + let Triplet minE1 _ _ = minMaxExcess1 w1 + let Triplet minE2 _ _ = minMaxExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + + let w2 = leConcat w0 w1 + let Triplet _ e0 maxE0 = minMaxExcess1 w0 + let Triplet _ _ maxE1 = minMaxExcess1 w1 + let Triplet _ _ maxE2 = minMaxExcess1 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess1 w0 + let Triplet minE1 _ _ = minMaxExcess1 w1 + let Triplet minE2 _ _ = minMaxExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess1 w0 + let Triplet _ _ maxE1 = minMaxExcess1 w1 + let Triplet _ _ maxE2 = minMaxExcess1 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "For Word16" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + let Triplet minE e maxE = minMaxExcess1 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet minE0 e0 _ = minMaxExcess1 w0 + let Triplet minE1 _ _ = minMaxExcess1 w1 + let Triplet minE2 _ _ = minMaxExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet _ e0 maxE0 = minMaxExcess1 w0 + let Triplet _ _ maxE1 = minMaxExcess1 w1 + let Triplet _ _ maxE2 = minMaxExcess1 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess1 w0 + let Triplet minE1 _ _ = minMaxExcess1 w1 + let Triplet minE2 _ _ = minMaxExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word16 R.constantBounded + w1 <- forAll $ G.word16 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess1 w0 + let Triplet _ _ maxE1 = minMaxExcess1 w1 + let Triplet _ _ maxE2 = minMaxExcess1 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "For Word32" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + let Triplet minE e maxE = minMaxExcess1 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet minE0 e0 _ = minMaxExcess1 w0 + let Triplet minE1 _ _ = minMaxExcess1 w1 + let Triplet minE2 _ _ = minMaxExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0)" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + let w2 = leConcat w0 w1 + let Triplet _ e0 maxE0 = minMaxExcess1 w0 + let Triplet _ _ maxE1 = minMaxExcess1 w1 + let Triplet _ _ maxE2 = minMaxExcess1 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess1 w0 + let Triplet minE1 _ _ = minMaxExcess1 w1 + let Triplet minE2 _ _ = minMaxExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word32 R.constantBounded + w1 <- forAll $ G.word32 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess1 w0 + let Triplet _ _ maxE1 = minMaxExcess1 w1 + let Triplet _ _ maxE2 = minMaxExcess1 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "For Word64" $ do + it "Excess should be between min excess and max excess" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + let Triplet minE e maxE = minMaxExcess1 w + assert $ minE <= e && e <= maxE + it "minE2 == minE0 `min` (minE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word64 R.constantBounded + w1 <- forAll $ G.word64 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet minE0 e0 _ = minMaxExcess1 w0 + let Triplet minE1 _ _ = minMaxExcess1 w1 + let Triplet minE2 _ _ = minMaxExcess1 w2 + minE2 === minE0 `min` (minE1 + e0) + it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $ requireProperty $ do + w0 <- forAll $ G.word64 R.constantBounded + w1 <- forAll $ G.word64 R.constantBounded + let w2 = DVS.fromList [w0, w1] + let Triplet _ e0 maxE0 = minMaxExcess1 w0 + let Triplet _ _ maxE1 = minMaxExcess1 w1 + let Triplet _ _ maxE2 = minMaxExcess1 w2 + maxE2 === maxE0 `max` (maxE1 + e0) + describe "Equivalent to native implementation" $ do + it "For Word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minMaxExcess1 w === minMaxExcess1 (Naive w) + it "For Word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minMaxExcess1 w === minMaxExcess1 (Naive w) + it "For Word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minMaxExcess1 w === minMaxExcess1 (Naive w) + it "For Word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minMaxExcess1 w === minMaxExcess1 (Naive w) + describe "Equivalent to word8Excess1' implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + let Triplet lo0 ex0 hi0 = minMaxExcess1 w + let Triplet8 lo1 ex1 hi1 = T.genWord8Excess1 8 w + lo0 === fromIntegral lo1 + ex0 === fromIntegral ex1 + hi0 === fromIntegral hi1 diff --git a/components/succinct-core/test/Data/Succinct/Excess/PartialMinExcess0Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/PartialMinExcess0Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/PartialMinExcess0Spec.hs @@ -0,0 +1,31 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.PartialMinExcess0Spec (spec) where + +import Data.Succinct.Excess.MinExcess0 +import Data.Succinct.Excess.PartialMinExcess0 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.PartialMinExcess0Spec" $ do + describe "Equivalent to partialMinExcess1 implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minExcess0 w === partialMinExcess0 8 w + it "For word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minExcess0 w === partialMinExcess0 16 w + it "For word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minExcess0 w === partialMinExcess0 32 w + it "For word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minExcess0 w === partialMinExcess0 64 w diff --git a/components/succinct-core/test/Data/Succinct/Excess/PartialMinExcess1Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/PartialMinExcess1Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/PartialMinExcess1Spec.hs @@ -0,0 +1,31 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.PartialMinExcess1Spec (spec) where + +import Data.Succinct.Excess.MinExcess1 +import Data.Succinct.Excess.PartialMinExcess1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.PartialMinExcess1Spec" $ do + describe "Equivalent to partialMinExcess1 implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minExcess1 w === partialMinExcess1 8 w + it "For word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minExcess1 w === partialMinExcess1 16 w + it "For word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minExcess1 w === partialMinExcess1 32 w + it "For word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minExcess1 w === partialMinExcess1 64 w diff --git a/components/succinct-core/test/Data/Succinct/Excess/PartialMinMaxExcess0Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/PartialMinMaxExcess0Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/PartialMinMaxExcess0Spec.hs @@ -0,0 +1,31 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.PartialMinMaxExcess0Spec (spec) where + +import Data.Succinct.Excess.MinMaxExcess0 +import Data.Succinct.Excess.PartialMinMaxExcess0 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.PartialMinMaxExcess0Spec" $ do + describe "Equivalent to partialMinMaxExcess1 implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minMaxExcess0 w === partialMinMaxExcess0 8 w + it "For word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minMaxExcess0 w === partialMinMaxExcess0 16 w + it "For word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minMaxExcess0 w === partialMinMaxExcess0 32 w + it "For word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minMaxExcess0 w === partialMinMaxExcess0 64 w diff --git a/components/succinct-core/test/Data/Succinct/Excess/PartialMinMaxExcess1Spec.hs b/components/succinct-core/test/Data/Succinct/Excess/PartialMinMaxExcess1Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Excess/PartialMinMaxExcess1Spec.hs @@ -0,0 +1,31 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.Excess.PartialMinMaxExcess1Spec (spec) where + +import Data.Succinct.Excess.MinMaxExcess1 +import Data.Succinct.Excess.PartialMinMaxExcess1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Excess.PartialMinMaxExcess1Spec" $ do + describe "Equivalent to partialMinMaxExcess1 implementation" $ do + it "For word8" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + minMaxExcess1 w === partialMinMaxExcess1 8 w + it "For word16" $ requireProperty $ do + w <- forAll $ G.word16 R.constantBounded + minMaxExcess1 w === partialMinMaxExcess1 16 w + it "For word32" $ requireProperty $ do + w <- forAll $ G.word32 R.constantBounded + minMaxExcess1 w === partialMinMaxExcess1 32 w + it "For word64" $ requireProperty $ do + w <- forAll $ G.word64 R.constantBounded + minMaxExcess1 w === partialMinMaxExcess1 64 w diff --git a/components/succinct-core/test/Data/Succinct/MQuerySpec.hs b/components/succinct-core/test/Data/Succinct/MQuerySpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/MQuerySpec.hs @@ -0,0 +1,36 @@ +module Data.Succinct.MQuerySpec (spec) where + +import Control.Lens +import Data.Succinct.Model.Example +import Data.Succinct.MQuery +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.DList as DL +import qualified Data.Foldable as F +import qualified Data.Succinct.Model.Lens as L + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +spec :: Spec +spec = describe "Data.Succinct.MQuerySpec" $ do + it "Select into simple lens to boolean field" $ requireProperty $ do + let q = MQuery $ DL.fromList exampleMounts + let actual = F.toList $ q >>^. L.readOnly + actual === [True, False, False, False] + it "Select into simple lens to list" $ requireProperty $ do + let q = MQuery $ DL.fromList exampleMounts + let actual = F.toList $ q >>^. L.options + actual === [[], ["nosuid" , "noauto"], [], ["noexec"]] + it "Select into lens to a foldable" $ requireProperty $ do + let q = MQuery $ DL.fromList exampleMounts + let actual = F.toList $ q >>^.. L.options + actual === ["nosuid" , "noauto" , "noexec"] + it "Select into lens to a foldable" $ requireProperty $ do + let q = MQuery $ DL.fromList exampleMounts + let actual = F.toList $ q <&> view L.options + actual === [[] , ["nosuid" , "noauto"] , [] , ["noexec"]] + diff --git a/components/succinct-core/test/Data/Succinct/Model/Example.hs b/components/succinct-core/test/Data/Succinct/Model/Example.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Model/Example.hs @@ -0,0 +1,46 @@ +module Data.Succinct.Model.Example where + +import Data.Succinct.Model.Type + +exampleMounts :: [Mount] +exampleMounts = + [ Mount + { mountPoint = "/" + , mountStorage = StorageDisk + { storageDevice = Just "/dev/sda1" + , storageLabel = Nothing + } + , mountFsType = "btrfs" + , mountReadOnly = True + , mountOptions = [] + } + , Mount + { mountPoint = "/var" + , mountStorage = StorageDisk + { storageLabel = Just "8f3ba6f4-5c70-46ec-83af-0d5434953e5f" + , storageDevice = Nothing + } + , mountFsType = "ext4" + , mountReadOnly = False + , mountOptions = ["nosuid", "noauto"] + } + , Mount + { mountPoint = "" + , mountStorage = StorageTmpFs + { storageSizeMB = 64 + } + , mountFsType = "" + , mountReadOnly = False + , mountOptions = [] + } + , Mount + { mountPoint = "/mypath" + , mountStorage = StorageNfs + { storageServer = "my.nfs.server" + , storageRemotePath = "/exports/mypath" + } + , mountFsType = "" + , mountReadOnly = False + , mountOptions = ["noexec"] + } + ] diff --git a/components/succinct-core/test/Data/Succinct/Model/Lens.hs b/components/succinct-core/test/Data/Succinct/Model/Lens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Model/Lens.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Succinct.Model.Lens where + +import Control.Lens +import Data.Succinct.Model.Type + +makeFields ''Storage +makeFields ''Mount diff --git a/components/succinct-core/test/Data/Succinct/Model/Type.hs b/components/succinct-core/test/Data/Succinct/Model/Type.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/Model/Type.hs @@ -0,0 +1,46 @@ +module Data.Succinct.Model.Type where + +data Storage + = StorageDisk + { storageDevice :: Maybe String + , storageLabel :: Maybe String + } + | StorageTmpFs + { storageSizeMB :: Int + } + | StorageNfs + { storageServer :: String + , storageRemotePath :: String + } deriving (Eq, Show) + +-- storageDisk :: Storage +-- storageDisk = Storage +-- { storageDevice = Nothing +-- , storageLabel = Nothing +-- } + +-- storageTmpFs :: Int -> StorageTmpFs +-- storageTmpFs = StorageTmpFs + +-- storageNfs :: String -> String -> Storage +-- storageNfs server remotePath = StorageNfs +-- { storageServer = server +-- , storageRemotePath = remotePath +-- } + +data Mount = Mount + { mountPoint :: String + , mountStorage :: Storage + , mountFsType :: String + , mountReadOnly :: Bool + , mountOptions :: [String] + } deriving (Eq, Show) + +-- mount :: String -> Storage -> String -> Mount +-- mount point storage fsType = MountPoint +-- { mountPoint = point +-- , mountStorage = storage +-- , mountFsType = fsType +-- , mountReadOnly = False +-- , mountOptions = [] +-- } diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/Base/InternalSpec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/Base/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/Base/InternalSpec.hs @@ -0,0 +1,28 @@ +module Data.Succinct.RankSelect.Base.InternalSpec + ( spec + ) where + +import Control.Monad (mfilter) +import Data.Bits (popCount) +import Data.Succinct.RankSelect.Base.Internal +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.Base.InternalSpec" $ do + describe "Bmi2 and broadword implementations match" $ do + it "64-bit" $ requireProperty $ do + s <- forAll $ mfilter (/= 0) (G.word64 R.constantBounded) + r <- forAll $ G.word64 (R.linear 0 (fromIntegral (popCount s))) + select1Word64Broadword s r === select1Word64Bmi2 s r + it "32-bit" $ requireProperty $ do + s <- forAll $ mfilter (/= 0) (G.word32 R.constantBounded) + r <- forAll $ G.word64 (R.linear 0 (fromIntegral (popCount s))) + select1Word32Broadword s r === select1Word32Bmi2 s r diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/Base/Rank0Spec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Rank0Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Rank0Spec.hs @@ -0,0 +1,100 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.Base.Rank0Spec + ( genRank0UpTo8Spec + , genRank0UpTo16Spec + , spec + ) where + +import Control.Monad +import Data.Maybe +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Typeable +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +genRank0UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec +genRank0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "rank0 10010010 over [0..8] should be 001223445" $ requireProperty $ do + let bs = fromJust (bitRead "10010010") :: s + fmap (rank0 bs) [0..8] === [0, 0, 1, 2, 2, 3, 4, 4, 5] + +genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec +genRank0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "rank0 11011010 00000000 over [0..16]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: s + fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + it "rank0 11011010 10000000 over [0..16]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 10000000" :: s + fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9, 10] + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.InternalSpec" $ do + genRank0UpTo8Spec (undefined :: Word8) + genRank0UpTo8Spec (undefined :: Word16) + genRank0UpTo8Spec (undefined :: Word32) + genRank0UpTo8Spec (undefined :: Word64) + genRank0UpTo8Spec (undefined :: [Word8]) + genRank0UpTo16Spec (undefined :: [Word8]) + genRank0UpTo8Spec (undefined :: [Word16]) + genRank0UpTo16Spec (undefined :: [Word16]) + genRank0UpTo8Spec (undefined :: [Word32]) + genRank0UpTo16Spec (undefined :: [Word32]) + genRank0UpTo8Spec (undefined :: [Word64]) + genRank0UpTo16Spec (undefined :: [Word64]) + genRank0UpTo8Spec (undefined :: DV.Vector Word8) + genRank0UpTo16Spec (undefined :: DV.Vector Word8) + genRank0UpTo8Spec (undefined :: DV.Vector Word16) + genRank0UpTo16Spec (undefined :: DV.Vector Word16) + genRank0UpTo8Spec (undefined :: DV.Vector Word32) + genRank0UpTo16Spec (undefined :: DV.Vector Word32) + genRank0UpTo8Spec (undefined :: DV.Vector Word64) + genRank0UpTo16Spec (undefined :: DV.Vector Word64) + genRank0UpTo8Spec (undefined :: DVS.Vector Word8) + genRank0UpTo16Spec (undefined :: DVS.Vector Word8) + genRank0UpTo8Spec (undefined :: DVS.Vector Word16) + genRank0UpTo16Spec (undefined :: DVS.Vector Word16) + genRank0UpTo8Spec (undefined :: DVS.Vector Word32) + genRank0UpTo16Spec (undefined :: DVS.Vector Word32) + genRank0UpTo8Spec (undefined :: DVS.Vector Word64) + genRank0UpTo16Spec (undefined :: DVS.Vector Word64) + describe "Different word sizes give the same rank0" $ do + it "when comparing Word16 and Word64 over bits 0-7" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 8) + w <- forAll $ G.word8 R.constantBounded + rank0 w i === rank0 (fromIntegral w :: Word64) i + it "when comparing Word16 and Word64 over bits 0-15" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 16) + w <- forAll $ G.word16 R.constantBounded + rank0 w i === rank0 (fromIntegral w :: Word64) i + it "when comparing Word32 and Word64 over bits 0-31" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + rank0 w i === rank0 (fromIntegral w :: Word64) i + it "when comparing Word32 and Word64 over bits 32-64" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + v <- forAll $ G.word32 R.constantBounded + w <- forAll $ G.word32 R.constantBounded + let v64 = fromIntegral v :: Word64 + let w64 = fromIntegral w :: Word64 + rank0 v i + popCount0 w === rank0 ((v64 .<. 32) .|. w64) (i + 32) + it "when comparing select1 for Word64 form a galois connection" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + when (1 <= i && i <= popCount0 w) $ do + rank0 w (select0 w i) === i + (select0 w (rank0 w (fromIntegral i)) <= fromIntegral i) === True diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/Base/Rank1Spec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Rank1Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Rank1Spec.hs @@ -0,0 +1,92 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.Base.Rank1Spec + ( genRank1UpTo8Spec + , genRank1UpTo16Spec + , spec + ) where + +import Control.Monad +import Data.Maybe +import Data.Typeable +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec +genRank1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "rank1 10010010 over [0..8] should be 011122233" $ requireProperty $ do + let bs = fromJust (bitRead "10010010") :: s + fmap (rank1 bs) [0..8] === [0, 1, 1, 1, 2, 2, 2, 3, 3] + +genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec +genRank1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "rank1 11011010 00000000 over [0..9]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: s + fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5] + it "rank1 11011010 10000000 over [0..9]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 10000000" :: s + fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6] + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.InternalSpec" $ do + genRank1UpTo8Spec (undefined :: Word8) + genRank1UpTo8Spec (undefined :: Word16) + genRank1UpTo8Spec (undefined :: Word32) + genRank1UpTo8Spec (undefined :: Word64) + genRank1UpTo8Spec (undefined :: DV.Vector Word8) + genRank1UpTo16Spec (undefined :: DV.Vector Word8) + genRank1UpTo8Spec (undefined :: DV.Vector Word16) + genRank1UpTo16Spec (undefined :: DV.Vector Word16) + genRank1UpTo8Spec (undefined :: DV.Vector Word32) + genRank1UpTo16Spec (undefined :: DV.Vector Word32) + genRank1UpTo8Spec (undefined :: DV.Vector Word64) + genRank1UpTo16Spec (undefined :: DV.Vector Word64) + genRank1UpTo8Spec (undefined :: DVS.Vector Word8) + genRank1UpTo16Spec (undefined :: DVS.Vector Word8) + genRank1UpTo8Spec (undefined :: DVS.Vector Word16) + genRank1UpTo16Spec (undefined :: DVS.Vector Word16) + genRank1UpTo8Spec (undefined :: DVS.Vector Word32) + genRank1UpTo16Spec (undefined :: DVS.Vector Word32) + genRank1UpTo8Spec (undefined :: DVS.Vector Word64) + genRank1UpTo16Spec (undefined :: DVS.Vector Word64) + describe "For Word8-Word64" $ do + it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 8) + w <- forAll $ G.word8 R.constantBounded + rank1 w i === rank1 (fromIntegral w :: Word64) i + it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 16) + w <- forAll $ G.word16 R.constantBounded + rank1 w i === rank1 (fromIntegral w :: Word64) i + it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + rank1 w i === rank1 (fromIntegral w :: Word64) i + it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + v <- forAll $ G.word32 R.constantBounded + w <- forAll $ G.word32 R.constantBounded + let v64 = fromIntegral v :: Word64 + let w64 = fromIntegral w :: Word64 + rank1 v i + popCount1 w === rank1 ((v64 .<. 32) .|. w64) (i + 32) + it "rank1 and select1 for Word64 form a galois connection" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + when (1 <= i && i <= popCount1 w) $ do + rank1 w (select1 w i) === i + (select1 w (rank1 w (fromIntegral i)) <= fromIntegral i) === True diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/Base/Select0Spec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Select0Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Select0Spec.hs @@ -0,0 +1,127 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.Base.Select0Spec + ( genSelect0UpTo8Spec + , genSelect0UpTo16Spec + , genSelect0UpTo32Spec + , spec + ) where + +import Control.Monad +import Data.Maybe +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Typeable +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec +genSelect0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "select0 10010010 over [0..5] should be 023568" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: Word8 + fmap (select0 bs) [0..5] === [0, 2, 3, 5, 6, 8] + +genSelect0UpTo16Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec +genSelect0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "select0 11011010 00 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "1101101 000" :: [Bool] + fmap (select0 bs) [0..5] === [0, 3, 6, 8, 9, 10] + it "select0 11011010 00000000 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: Word32 + fmap (select0 bs) [0..11] === [0, 3, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16] + +genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec +genSelect0UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "select0 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do + let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s + fmap (select0 bs) [0..19] === [0, 3, 4, 5, 6, 7, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24] + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.InternalSpec" $ do + genSelect0UpTo8Spec (undefined :: Word8) + genSelect0UpTo8Spec (undefined :: Word16) + genSelect0UpTo8Spec (undefined :: Word32) + genSelect0UpTo8Spec (undefined :: Word64) + genSelect0UpTo16Spec (undefined :: Word16) + genSelect0UpTo16Spec (undefined :: Word32) + genSelect0UpTo16Spec (undefined :: Word64) + genSelect0UpTo32Spec (undefined :: Word32) + genSelect0UpTo32Spec (undefined :: Word64) + genSelect0UpTo8Spec (undefined :: [Bool]) + genSelect0UpTo16Spec (undefined :: [Bool]) + genSelect0UpTo32Spec (undefined :: [Bool]) + genSelect0UpTo8Spec (undefined :: [Word8]) + genSelect0UpTo16Spec (undefined :: [Word8]) + genSelect0UpTo32Spec (undefined :: [Word8]) + genSelect0UpTo8Spec (undefined :: [Word16]) + genSelect0UpTo16Spec (undefined :: [Word16]) + genSelect0UpTo32Spec (undefined :: [Word16]) + genSelect0UpTo8Spec (undefined :: [Word32]) + genSelect0UpTo16Spec (undefined :: [Word32]) + genSelect0UpTo32Spec (undefined :: [Word32]) + genSelect0UpTo8Spec (undefined :: [Word64]) + genSelect0UpTo16Spec (undefined :: [Word64]) + genSelect0UpTo32Spec (undefined :: [Word64]) + genSelect0UpTo8Spec (undefined :: DV.Vector Word8) + genSelect0UpTo16Spec (undefined :: DV.Vector Word8) + genSelect0UpTo32Spec (undefined :: DV.Vector Word8) + genSelect0UpTo8Spec (undefined :: DV.Vector Word16) + genSelect0UpTo16Spec (undefined :: DV.Vector Word16) + genSelect0UpTo32Spec (undefined :: DV.Vector Word16) + genSelect0UpTo8Spec (undefined :: DV.Vector Word32) + genSelect0UpTo16Spec (undefined :: DV.Vector Word32) + genSelect0UpTo32Spec (undefined :: DV.Vector Word32) + genSelect0UpTo8Spec (undefined :: DV.Vector Word64) + genSelect0UpTo16Spec (undefined :: DV.Vector Word64) + genSelect0UpTo32Spec (undefined :: DV.Vector Word64) + genSelect0UpTo8Spec (undefined :: DVS.Vector Word8) + genSelect0UpTo16Spec (undefined :: DVS.Vector Word8) + genSelect0UpTo32Spec (undefined :: DVS.Vector Word8) + genSelect0UpTo8Spec (undefined :: DVS.Vector Word16) + genSelect0UpTo16Spec (undefined :: DVS.Vector Word16) + genSelect0UpTo32Spec (undefined :: DVS.Vector Word16) + genSelect0UpTo8Spec (undefined :: DVS.Vector Word32) + genSelect0UpTo16Spec (undefined :: DVS.Vector Word32) + genSelect0UpTo32Spec (undefined :: DVS.Vector Word32) + genSelect0UpTo8Spec (undefined :: DVS.Vector Word64) + genSelect0UpTo16Spec (undefined :: DVS.Vector Word64) + genSelect0UpTo32Spec (undefined :: DVS.Vector Word64) + describe "For Word8-Word64" $ do + it "rank0 for Word16 and Word64 should give same answer for bits 0-7" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 8) + w <- forAll $ G.word8 R.constantBounded + rank0 w i === rank0 (fromIntegral w :: Word64) i + it "rank0 for Word16 and Word64 should give same answer for bits 0-15" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 16) + w <- forAll $ G.word16 R.constantBounded + rank0 w i === rank0 (fromIntegral w :: Word64) i + it "rank0 for Word32 and Word64 should give same answer for bits 0-31" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + rank0 w i === rank0 (fromIntegral w :: Word64) i + it "rank0 for Word32 and Word64 should give same answer for bits 32-64" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + v <- forAll $ G.word32 R.constantBounded + w <- forAll $ G.word32 R.constantBounded + let v64 = fromIntegral v :: Word64 + let w64 = fromIntegral w :: Word64 + rank0 v i + popCount0 w === rank0 ((v64 .<. 32) .|. w64) (i + 32) + it "rank0 and select0 for Word64 form a galois connection" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + when (1 <= i && i <= popCount0 w) $ do + rank0 w (select0 w i) === i + (select0 w (rank0 w (fromIntegral i)) <= fromIntegral i) === True diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/Base/Select1Spec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Select1Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/Base/Select1Spec.hs @@ -0,0 +1,118 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.Base.Select1Spec + ( genSelect1UpTo8Spec + , genSelect1UpTo16Spec + , genSelect1UpTo32Spec + , spec + ) where + +import Control.Monad +import Data.Maybe +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Typeable +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec +genSelect1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "select1 10010010 over [0..3] should be 0147" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: s + fmap (select1 bs) [0..3] === [0, 1, 4, 7] + +genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec +genSelect1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "select1 11011010 00 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00" :: s + fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7] + it "select1 11011010 00000000 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: s + fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7] + it "select 01000000 00000100 over [0..2]" $ requireProperty $ do + let bs = fromJust $ bitRead "01000000 00000100" :: s + fmap (select1 bs) [0..2] === [0, 2, 14] + +genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec +genSelect1UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeRep (Proxy :: Proxy s))) $ do + it "select1 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do + let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s + fmap (select1 bs) [0..5] === [0, 1, 2, 8, 9, 18] + it "select 10000010 00000000 00100000 00010000 over [0..4]" $ requireProperty $ do + let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s + fmap (select1 bs) [0..4] === [0, 1, 7, 19, 28] + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.InternalSpec" $ do + genSelect1UpTo8Spec (undefined :: Word8) + genSelect1UpTo8Spec (undefined :: Word16) + genSelect1UpTo8Spec (undefined :: Word32) + genSelect1UpTo8Spec (undefined :: Word64) + genSelect1UpTo16Spec (undefined :: Word16) + genSelect1UpTo16Spec (undefined :: Word32) + genSelect1UpTo16Spec (undefined :: Word64) + genSelect1UpTo32Spec (undefined :: Word32) + genSelect1UpTo32Spec (undefined :: Word64) + genSelect1UpTo8Spec (undefined :: DV.Vector Word8) + genSelect1UpTo16Spec (undefined :: DV.Vector Word8) + genSelect1UpTo32Spec (undefined :: DV.Vector Word8) + genSelect1UpTo8Spec (undefined :: DV.Vector Word16) + genSelect1UpTo16Spec (undefined :: DV.Vector Word16) + genSelect1UpTo32Spec (undefined :: DV.Vector Word16) + genSelect1UpTo8Spec (undefined :: DV.Vector Word32) + genSelect1UpTo16Spec (undefined :: DV.Vector Word32) + genSelect1UpTo32Spec (undefined :: DV.Vector Word32) + genSelect1UpTo8Spec (undefined :: DV.Vector Word64) + genSelect1UpTo16Spec (undefined :: DV.Vector Word64) + genSelect1UpTo32Spec (undefined :: DV.Vector Word64) + genSelect1UpTo8Spec (undefined :: DVS.Vector Word8) + genSelect1UpTo16Spec (undefined :: DVS.Vector Word8) + genSelect1UpTo32Spec (undefined :: DVS.Vector Word8) + genSelect1UpTo8Spec (undefined :: DVS.Vector Word16) + genSelect1UpTo16Spec (undefined :: DVS.Vector Word16) + genSelect1UpTo32Spec (undefined :: DVS.Vector Word16) + genSelect1UpTo8Spec (undefined :: DVS.Vector Word32) + genSelect1UpTo16Spec (undefined :: DVS.Vector Word32) + genSelect1UpTo32Spec (undefined :: DVS.Vector Word32) + genSelect1UpTo8Spec (undefined :: DVS.Vector Word64) + genSelect1UpTo16Spec (undefined :: DVS.Vector Word64) + genSelect1UpTo32Spec (undefined :: DVS.Vector Word64) + describe "For Word64" $ do + it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 8) + w <- forAll $ G.word8 R.constantBounded + rank1 w i === rank1 (fromIntegral w :: Word64) i + it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 16) + w <- forAll $ G.word16 R.constantBounded + rank1 w i === rank1 (fromIntegral w :: Word64) i + it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + rank1 w i === rank1 (fromIntegral w :: Word64) i + it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + v <- forAll $ G.word32 R.constantBounded + w <- forAll $ G.word32 R.constantBounded + let v64 = fromIntegral v :: Word64 + let w64 = fromIntegral w :: Word64 + rank1 v i + popCount1 w === rank1 ((v64 .<. 32) .|. w64) (i + 32) + it "rank1 and select1 for Word64 form a galois connection" $ requireProperty $ do + i <- forAll $ G.word64 (R.linear 0 32) + w <- forAll $ G.word32 R.constantBounded + when (1 <= i && i <= popCount1 w) $ do + rank1 w (select1 w i) === i + (select1 w (rank1 w (fromIntegral i)) <= fromIntegral i) === True diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/BasicGen.hs b/components/succinct-core/test/Data/Succinct/RankSelect/BasicGen.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/BasicGen.hs @@ -0,0 +1,137 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.BasicGen + ( genRankSelectSpec + , genRank0Select0Spec + , genRank1Select1Spec + ) where + +import Data.Maybe +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Typeable +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +genRank0UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Show s) => s -> Spec +genRank0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do + it "rank0 10010010 over [0..8] should be 001223445" $ requireProperty $ do + let bs = fromJust (bitRead "10010010") :: s + _ <- forAll $ pure bs + fmap (rank0 bs) [0..8] === [0, 0, 1, 2, 2, 3, 4, 4, 5] + +genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Show s) => s -> Spec +genRank0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do + it "rank0 11011010 00000000 over [0..16]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: s + _ <- forAll $ pure bs + fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + it "rank0 11011010 10000000 over [0..16]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 10000000" :: s + _ <- forAll $ pure bs + fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9, 10] + +genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Show s) => s -> Spec +genRank1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do + it "rank1 10010010 over [0..8] should be 011122233" $ requireProperty $ do + let bs = fromJust (bitRead "10010010") :: s + _ <- forAll $ pure bs + fmap (rank1 bs) [0..8] === [0, 1, 1, 1, 2, 2, 2, 3, 3] + +genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Show s) => s -> Spec +genRank1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do + it "rank1 11011010 00000000 over [0..9]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: s + _ <- forAll $ pure bs + fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5] + it "rank1 11011010 10000000 over [0..9]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 10000000" :: s + _ <- forAll $ pure bs + fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6] + +genSelect0UpTo8Spec :: forall s. Typeable s => s -> Spec +genSelect0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do + it "select0 10010010 over [0..5] should be 023568" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: Word8 + _ <- forAll $ pure bs + fmap (select0 bs) [0..5] === [0, 2, 3, 5, 6, 8] + +genSelect0UpTo16Spec :: forall s. Typeable s => s -> Spec +genSelect0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do + it "select0 11011010 00 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "1101101 000" :: [Bool] + _ <- forAll $ pure bs + fmap (select0 bs) [0..5] === [0, 3, 6, 8, 9, 10] + it "select0 11011010 00000000 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: Word32 + _ <- forAll $ pure bs + fmap (select0 bs) [0..11] === [0, 3, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16] + +genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 s, Show s) => s -> Spec +genSelect0UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do + it "select0 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do + let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s + _ <- forAll $ pure bs + fmap (select0 bs) [0..19] === [0, 3, 4, 5, 6, 7, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24] + +genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 s, Show s) => s -> Spec +genSelect1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do + it "select1 10010010 over [0..3] should be 0147" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: s + _ <- forAll $ pure $ bs + fmap (select1 bs) [0..3] === [0, 1, 4, 7] + +genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 s, Show s) => s -> Spec +genSelect1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do + it "select1 11011010 00 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00" :: s + _ <- forAll $ pure bs + fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7] + it "select1 11011010 00000000 over [0..5]" $ requireProperty $ do + let bs = fromJust $ bitRead "11011010 00000000" :: s + _ <- forAll $ pure bs + fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7] + it "select 01000000 00000100 over [0..2]" $ requireProperty $ do + let bs = fromJust $ bitRead "01000000 00000100" :: s + _ <- forAll $ pure bs + fmap (select1 bs) [0..2] === [0, 2, 14] + +genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 s, Show s) => s -> Spec +genSelect1UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do + it "select1 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do + let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s + _ <- forAll $ pure bs + fmap (select1 bs) [0..5] === [0, 1, 2, 8, 9, 18] + it "select 10000010 00000000 00100000 00010000 over [0..4]" $ requireProperty $ do + let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s + _ <- forAll $ pure bs + fmap (select1 bs) [0..4] === [0, 1, 7, 19, 28] + +genRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s, Show s) => s -> Spec +genRank1Select1Spec s = describe "For Rank 1" $ do + genRank1UpTo8Spec s + genRank1UpTo16Spec s + genSelect1UpTo8Spec s + genSelect1UpTo16Spec s + genSelect1UpTo32Spec s + +genRank0Select0Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Select0 s, Show s) => s -> Spec +genRank0Select0Spec s = describe "For Rank 0" $ do + genRank0UpTo8Spec s + genRank0UpTo16Spec s + genSelect0UpTo8Spec s + genSelect0UpTo16Spec s + genSelect0UpTo32Spec s + +genRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s, Show s) => s -> Spec +genRankSelectSpec s = describe "Generically" $ do + genRank1Select1Spec s + genRank0Select0Spec s diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/BinarySearchSpec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/BinarySearchSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/BinarySearchSpec.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.RankSelect.BinarySearchSpec (spec) where + +import Control.Monad +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.BinarySearchSpec" $ do + it "example 1" $ requireTest $ do + !v <- forAll $ pure $ DVS.fromList + [ 0, 19, 80, 129, 161, 179, 237, 281, 302, 350, 394, 438, 438, 458, 470, 524 + , 546, 592, 634, 648, 688, 713, 774, 795, 852, 861, 884, 936, 992, 992, 1001, 1036 + , 1068, 1087, 1109, 1145, 1161, 1179, 1182, 1211, 1234, 1295, 1309, 1335, 1359, 1359, 1361, 1383 + ] + !vpc <- forAll $ pure (popCount1 v) + !r <- forAll $ pure 144 + let !rsbs = makeCsPoppy v + + when (vpc > 0 && r > 0) $ do + let !p = select1 v r + + select1 rsbs r === p + + return () diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/CsPoppy/InternalSpec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/CsPoppy/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/CsPoppy/InternalSpec.hs @@ -0,0 +1,58 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.CsPoppy.InternalSpec (spec) where + +import Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 +import Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Prelude hiding (length) +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +makeCsPoppyBlocksRef :: DVS.Vector Word64 -> DVS.Vector Word64 +makeCsPoppyBlocksRef v = DVS.generate (((DVS.length v + 8 - 1) `div` 8) + 1) genBlocks + where genBlocks :: Int -> Word64 + genBlocks u = let i = fromIntegral u in popCount1 (DVS.take 8 (DVS.drop (i * 8) v)) + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.CsInterleavedSpec" $ do + describe "Interleaved Level 1 & 2" $ do + it "have all its fields isolated" $ requireProperty $ do + vx <- forAll $ G.word64 R.constantBounded + va <- forAll $ G.word64 R.constantBounded + vb <- forAll $ G.word64 R.constantBounded + vc <- forAll $ G.word64 R.constantBounded + let actual = putCsiX vx . + putCsiA va . + putCsiB vb . + putCsiC vc $ CsInterleaved 0 + getCsiX (putCsiX vx actual) === (vx .&. 0xffffffff) + getCsiA (putCsiA va actual) === (va .&. 0x3ff) + getCsiB (putCsiB vb actual) === (vb .&. 0x3ff) + getCsiC (putCsiC vc actual) === (vc .&. 0x3ff) + it "have all its fields isolated" $ requireProperty $ do + vx <- forAll $ G.word64 R.constantBounded + va <- forAll $ G.word64 R.constantBounded + vb <- forAll $ G.word64 R.constantBounded + vc <- forAll $ G.word64 R.constantBounded + getCsiX (putCsiX vx (CsInterleaved 0)) === (vx .&. 0xffffffff) + getCsiA (putCsiA va (CsInterleaved 0)) === (va .&. 0x3ff) + getCsiB (putCsiB vb (CsInterleaved 0)) === (vb .&. 0x3ff) + getCsiC (putCsiC vc (CsInterleaved 0)) === (vc .&. 0x3ff) + describe "makeCsPoppyBlocks" $ do + it "must behave like makeCsPoppyBlocks1" $ requireProperty $ do + xs <- forAll $ G.list (R.linear 0 1000) (G.word64 R.constantBounded) + v <- forAll $ pure $ DVS.fromList xs + a <- forAll $ pure $ makeCsPoppyBlocks v + e <- forAll $ pure $ makeCsPoppyBlocksRef v + a === e diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/CsPoppySpec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/CsPoppySpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/CsPoppySpec.hs @@ -0,0 +1,253 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.RankSelect.CsPoppySpec (spec) where + +import Control.Monad +import Control.Monad.IO.Class +import Data.Function +import Data.Maybe +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.BasicGen +import Data.Succinct.RankSelect.CsPoppy +import Data.Succinct.RankSelect.CsPoppy.Internal.Nice +import Data.Succinct.RankSelect.Poppy512 +import Data.Word +import GHC.Exts +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitLength +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Product +import HaskellWorks.Data.Take +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Prelude hiding (length, take) +import Test.Common +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 as A1 +import qualified HaskellWorks.Hedgehog.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +newtype ShowVector a = ShowVector a deriving (Eq, BitShow) + +instance BitShow a => Show (ShowVector a) where + show = bitShow + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.CsPoppySpec" $ do + genRank1Select1Spec (undefined :: CsPoppy) + describe "rank1 for Vector Word64 is equivalent to rank1 for CsPoppy" $ do + it "on empty bitvector" $ require $ withTests 1 $ property $ do + let v = DVS.empty + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + let i = 0 + rank1 v i === rank1 w i + it "on one basic block" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + rank1 v i === rank1 w i + it "on two basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + rank1 v i === rank1 w i + it "on three basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + rank1 v i === rank1 w i + describe "rank0 for Vector Word64 is equivalent to rank0 for CsPoppy" $ do + it "on empty bitvector" $ require $ withTests 1 $ property $ do + let v = DVS.empty + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + let i = 0 + rank0 v i === rank0 w i + it "on one basic block" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + rank0 v i === rank0 w i + it "on two basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + rank0 v i === rank0 w i + it "on three basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + rank0 v i === rank0 w i + describe "select1 for Vector Word64 is equivalent to select1 for CsPoppy" $ do + it "on empty bitvector" $ require $ withTests 1 $ property $ do + let v = DVS.empty + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + let i = 0 + select1 w i === select1 v i + it "on one full zero basic block" $ require $ withTests 1 $ property $ do + let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select1 w 0 === select1 v 0 + it "on one basic block" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount1 v)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select1 w i === select1 v i + it "on two basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount1 v)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select1 w i === select1 v i + it "on three basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount1 v)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select1 w i === select1 v i + describe "select0 for Vector Word64 is equivalent to select0 for CsPoppy" $ do + it "on empty bitvector" $ require $ withTests 1 $ property $ do + let v = DVS.empty + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + let i = 0 + select0 w i === select0 v i + it "on one full zero basic block" $ require $ withTests 1 $ property $ do + let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select0 w 0 === select0 v 0 + it "on one basic block" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount0 v)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select0 w i === select0 v i + it "on two basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount0 v)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select0 w i === select0 v i + it "on three basic blocks" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount0 v)) + Nice w <- forAll $ pure $ Nice $ makeCsPoppy v + select0 w i === select0 v i + describe "Rank select over large buffer" $ do + it "Rank works" $ requireProperty $ do + let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64 + let ps = makeCsPoppy cs + (rank1 ps `map` [1 .. 4096]) === [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]] + it "Rank is consistent with pop count" $ requireProperty $ do + v <- forAll $ G.storableVector (R.linear 0 1024) (G.word64 R.constantBounded) + Nice rsbs <- forAll $ pure $ Nice (makeCsPoppy v) + rank1 rsbs (bitLength rsbs) === popCount1 rsbs + it "Select works" $ do + let v = DVS.fromList [0x1101001000100001, 0x2202002000200002, 0x3303003000300003] :: DVS.Vector Word64 + let pc = popCount1 v + requireProperty $ do + Nice csPoppy <- forAll $ pure $ Nice (makeCsPoppy v) + s <- forAll $ G.word64 (R.linear 1 pc) + select1 csPoppy s === select1 v s + it "Rank select should match that of un-indexed implementation" $ requireProperty $ do + !xs <- forAll $ G.list (R.linear 1 100) (G.word64 (R.linear 0 100)) + !v <- forAll $ pure (DVS.fromList (scanl (+) 0 xs)) + !vpc <- forAll $ pure (popCount1 v) + !r <- forAll $ G.word64 (R.linear 0 (popCount1 v)) + let !rsbs = makeCsPoppy v + + when (vpc > 0 && r > 0) $ do + annotate $ "v : " <> show v + annotate $ "vpc: " <> show vpc + annotate $ "r : " <> show r + + let !p = select1 v r + + select1 rsbs r === p + describe "Corpus generic" $ do + describe "Shrunk Rank" $ do + forM_ corpusFiles $ \corpusFile -> do + it corpusFile $ do + fileV <- liftIO $ mmapFromForeignRegion corpusFile + requireProperty $ do + let v = DVS.take 768 fileV + Nice csPoppy <- forAll $ pure $ Nice $ makeCsPoppy v + maxPos <- forAll $ pure $ fromIntegral $ DVS.length (csPoppyBits csPoppy) + r <- forAll $ G.word64 (R.linear 1 maxPos) + rank1 csPoppy r === rank1 v r + describe "Rank" $ do + forM_ corpusFiles $ \corpusFile -> do + it corpusFile $ do + v <- liftIO $ mmapFromForeignRegion corpusFile + let csPoppy = makeCsPoppy v + let maxPos = fromIntegral $ DVS.length (csPoppyBits csPoppy) + requireProperty $ do + r <- forAll $ G.word64 (R.linear 1 maxPos) + rank1 csPoppy r === rank1 v r + describe "Select" $ do + forM_ corpusFiles $ \corpusFile -> do + it corpusFile $ do + fileV <- liftIO $ mmapFromForeignRegion corpusFile + let csPoppy = makeCsPoppy fileV + let pc = popCount1 (csPoppyBits csPoppy) + requireProperty $ do + _ <- forAll $ pure $ Nice csPoppy + s <- forAll $ G.word64 (R.linear 1 pc) + select1 csPoppy s === select1 fileV s + describe "Select straw man" $ do + forM_ corpusFiles $ \corpusFile -> do + it corpusFile $ do + fileV <- liftIO $ mmapFromForeignRegion corpusFile + let csPoppy = makeCsPoppy fileV + let pc = popCount1 (csPoppyBits csPoppy) + requireProperty $ do + _ <- forAll $ pure $ corpusFile + _ <- forAll $ pure $ A1.csPoppyLayerS (csPoppyIndex1 csPoppy) + s <- forAll $ G.word64 (R.linear 1 pc) + select1 csPoppy s === select1 fileV s + + describe "Corpus specific" $ + describe "components/succinct-core/data/sample-000.idx" $ do + it "A popCount0" $ requireTest $ do + (va :: CsPoppy) :*: (vr :: Poppy512) <- liftIO $ mmapFromForeignRegion "components/succinct-core/data/sample-000.idx" + + actual <- safely $ popCount0 va + + actual === popCount0 vr + it "A popCount1" $ requireTest $ do + (va :: CsPoppy) :*: (vr :: Poppy512) <- liftIO $ mmapFromForeignRegion "components/succinct-core/data/sample-000.idx" + + actual <- safely $ popCount1 va + + actual === popCount1 vr + it "A select1" $ requireTest $ do + (va :: CsPoppy) :*: (vr :: Poppy512) <- liftIO $ mmapFromForeignRegion "components/succinct-core/data/sample-000.idx" + + actual <- safely $ select1 va 176670 + + actual === select1 vr 176670 + it "A select0" $ requireTest $ do + (va :: CsPoppy) :*: (vr :: Poppy512) <- liftIO $ mmapFromForeignRegion "components/succinct-core/data/sample-000.idx" + + actual <- safely $ select0 va 1302306 + + actual === select0 vr 1302306 + it "Check new samples" $ requireTest $ do + vr :: Poppy512 <- liftIO $ mmapFromForeignRegion "components/succinct-core/data/sample-000.idx" + + let v = poppy512Bits vr + let pcv = popCount1 v + let samples = A1.genCsSamples pcv v + + forM_ (zip (DVS.toList samples) [1,8193..]) $ \(sample, i) -> do + select1 vr i === sample diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/Gen.hs b/components/succinct-core/test/Data/Succinct/RankSelect/Gen.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/Gen.hs @@ -0,0 +1,14 @@ +module Data.Succinct.RankSelect.Gen where + +import Data.Succinct.RankSelect.SpecCommon +import HaskellWorks.Data.Positioning +import Hedgehog + +import qualified Data.Vector.Storable as DVS +import qualified Hedgehog.Gen as G + +count :: MonadGen m => Range Count -> m Count +count = G.word64 + +vector :: (MonadGen m, DVS.Storable a) => Range Int -> m a -> m (ShowVector (DVS.Vector a)) +vector r g = ShowVector . DVS.fromList <$> G.list r g diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/InternalSpec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/InternalSpec.hs @@ -0,0 +1,39 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.InternalSpec (spec) where + +import Data.Maybe +import Data.Succinct.RankSelect.Base.Rank +import Data.Succinct.RankSelect.Base.Select +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Prelude hiding (length) +import Test.Hspec + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.InternalSpec" $ do + describe "For [Bool]" $ do + it "rank True 10010010 over [0..8] should be 011122233" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: [Bool] + fmap (rank True bs) [0..8] === [0, 1, 1, 1, 2, 2, 2, 3, 3] + it "rank True 10010010 over [0..8] should be 001223445" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: [Bool] + fmap (rank False bs) [0..8] === [0, 0, 1, 2, 2, 3, 4, 4, 5] + it "select True 10010010 over [0..3] should be 0147" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: [Bool] + fmap (select True bs) [0..3] === [0, 1, 4, 7] + it "select False 10010010 over [0..5] should be 023568" $ requireProperty $ do + let bs = fromJust $ bitRead "10010010" :: [Bool] + fmap (select False bs) [0..5] === [0, 2, 3, 5, 6, 8] + it "Rank and select form a galois connection" $ requireProperty $ do + bs <- forAll $ G.list (R.linear 0 70) G.bool + c <- forAll $ G.word64 (R.linear 0 (popCount1 bs)) + rank True bs (select True bs c) === c diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/Poppy512Spec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/Poppy512Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/Poppy512Spec.hs @@ -0,0 +1,135 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.Poppy512Spec (spec) where + +import Data.Maybe +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select0 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.BasicGen +import Data.Succinct.RankSelect.Poppy512 +import Data.Succinct.RankSelect.SpecCommon +import Data.Word +import GHC.Exts +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Prelude hiding (length) +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.RankSelect.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.Poppy512.Rank1Spec" $ do + genRankSelectSpec (undefined :: Poppy512) + describe "rank1 for Vector Word64 is equivalent to rank1 for Poppy512" $ do + it "on empty bitvector" $ requireProperty $ do + let v = DVS.empty + let w = makePoppy512 v + let i = 0 + rank1 v i === rank1 w i + it "on one basic block" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + let w = makePoppy512 v + rank1 v i === rank1 w i + it "on two basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + let w = makePoppy512 v + rank1 v i === rank1 w i + it "on three basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + let w = makePoppy512 v + rank1 v i === rank1 w i + describe "rank0 for Vector Word64 is equivalent to rank0 for Poppy512" $ do + it "on empty bitvector" $ requireProperty $ do + let v = DVS.empty + let w = makePoppy512 v + let i = 0 + rank0 v i === rank0 w i + it "on one basic block" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + let w = makePoppy512 v + rank0 v i === rank0 w i + it "on two basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + let w = makePoppy512 v + rank0 v i === rank0 w i + it "on three basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (length v * 8)) + let w = makePoppy512 v + rank0 v i === rank0 w i + describe "select0 for Vector Word64 is equivalent to select0 for Poppy512" $ do + it "on empty bitvector" $ requireProperty $ do + let v = DVS.empty + let w = makePoppy512 v + let i = 0 + select0 v i === select0 w i + it "on one full zero basic block" $ requireProperty $ do + let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 + let w = makePoppy512 v + select0 v 0 === select0 w 0 + it "on one basic block" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount0 v)) + let w = makePoppy512 v + select0 v i === select0 w i + it "on two basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount0 v)) + let w = makePoppy512 v + select0 v i === select0 w i + it "on three basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount0 v)) + let w = makePoppy512 v + select0 v i === select0 w i + describe "select1 for Vector Word64 is equivalent to select1 for Poppy512" $ do + it "on empty bitvector" $ requireProperty $ do + let v = DVS.empty + let w = makePoppy512 v + let i = 0 + select1 v i === select1 w i + it "on one full zero basic block" $ requireProperty $ do + let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 + let w = makePoppy512 v + select1 v 0 === select1 w 0 + it "on one basic block" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount1 v)) + let w = makePoppy512 v + select1 v i === select1 w i + it "on two basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount1 v)) + let w = makePoppy512 v + select1 v i === select1 w i + it "on three basic blocks" $ requireProperty $ do + ShowVector v <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded) + i <- forAll $ G.word64 (R.linear 0 (popCount1 v)) + let w = makePoppy512 v + select1 v i === select1 w i + describe "Rank select over large buffer" $ do + it "Rank works" $ requireProperty $ do + let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64 + let ps = makePoppy512 cs + (rank1 ps `map` [1 .. 4096]) === [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]] + it "Select works" $ requireProperty $ do + let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64 + let ps = makePoppy512 cs + (select1 ps `map` [1 .. 2048]) === [1, 3 .. 4096] diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/SimpleSpec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/SimpleSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/SimpleSpec.hs @@ -0,0 +1,68 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Data.Succinct.RankSelect.SimpleSpec (spec) where + +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Vector +import Data.Word +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.RankSelect.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} + +spec :: Spec +spec = describe "Data.Succinct.SuccinctSpec" $ do + it "rank1 for BitShown (Vector Word8) and BitShown (Vector Word64) should give same answer" $ require $ withTests 1 $ property $ do + i <- forAll $ G.count $ R.linear 0 64 + a <- forAll $ G.word8 $ R.constantBounded + b <- forAll $ G.word8 $ R.constantBounded + c <- forAll $ G.word8 $ R.constantBounded + d <- forAll $ G.word8 $ R.constantBounded + e <- forAll $ G.word8 $ R.constantBounded + f <- forAll $ G.word8 $ R.constantBounded + g <- forAll $ G.word8 $ R.constantBounded + h <- forAll $ G.word8 $ R.constantBounded + let a64 = fromIntegral a :: Word64 + let b64 = fromIntegral b :: Word64 + let c64 = fromIntegral c :: Word64 + let d64 = fromIntegral d :: Word64 + let e64 = fromIntegral e :: Word64 + let f64 = fromIntegral f :: Word64 + let g64 = fromIntegral g :: Word64 + let h64 = fromIntegral h :: Word64 + let abcdefgh64 = (h64 .<. 56) .|. (g64 .<. 48) .|. (f64 .<. 40) .|. (e64 .<. 32) .|. + (d64 .<. 24) .|. (c64 .<. 16) .|. (b64 .<. 8 ) .|. a64 + let vec16 = BitShown (fromList [a, b, c, d, e, f, g, h] :: Vector Word8 ) + let vec64 = BitShown (fromList [abcdefgh64] :: Vector Word64) + rank1 vec16 i === rank1 vec64 i + it "rank1 for BitShown (Vector Word16) and BitShown (Vector Word64) should give same answer" $ require $ withTests 1 $ property $ do + i <- forAll $ G.count $ R.linear 0 64 + a <- forAll $ G.word16 $ R.constantBounded + b <- forAll $ G.word16 $ R.constantBounded + c <- forAll $ G.word16 $ R.constantBounded + d <- forAll $ G.word16 $ R.constantBounded + let a64 = fromIntegral a :: Word64 + let b64 = fromIntegral b :: Word64 + let c64 = fromIntegral c :: Word64 + let d64 = fromIntegral d :: Word64 + let abcd64 = (d64 .<. 48) .|. (c64 .<. 32) .|. (b64 .<. 16) .|. a64 + let vec16 = BitShown (fromList [a, b, c, d] :: Vector Word16) + let vec64 = BitShown (fromList [abcd64] :: Vector Word64) + rank1 vec16 i === rank1 vec64 i + it "rank1 for BitShown (Vector Word32) and BitShown (Vector Word64) should give same answer" $ require $ withTests 1 $ property $ do + i <- forAll $ G.count $ R.linear 0 64 + a <- forAll $ G.word32 $ R.constantBounded + b <- forAll $ G.word32 $ R.constantBounded + let a64 = fromIntegral a :: Word64 + let b64 = fromIntegral b :: Word64 + let ab64 = (b64 .<. 32) .|. a64 + let vec32 = BitShown (fromList [a, b] :: Vector Word32) + let vec64 = BitShown (fromList [ab64] :: Vector Word64) + rank1 vec32 i === rank1 vec64 i diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/SpecCommon.hs b/components/succinct-core/test/Data/Succinct/RankSelect/SpecCommon.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/SpecCommon.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.RankSelect.SpecCommon where + +import HaskellWorks.Data.Bits.BitShow + +newtype ShowVector a = ShowVector a deriving (Eq, BitShow) + +instance BitShow a => Show (ShowVector a) where + show = bitShow diff --git a/components/succinct-core/test/Data/Succinct/RankSelect/ValidateSpec.hs b/components/succinct-core/test/Data/Succinct/RankSelect/ValidateSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Data/Succinct/RankSelect/ValidateSpec.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.RankSelect.ValidateSpec (spec) where + +import Control.Monad +import Control.Monad.IO.Class +import Data.List (isSuffixOf) +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import System.IO.Unsafe +import Test.Hspec + +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Hedgehog.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R +import qualified System.Directory as IO + +{- HLINT ignore "Reduce duplication" -} + +entries :: [FilePath] +entries = mfilter (".idx" `isSuffixOf`) <$> unsafePerformIO $ IO.getDirectoryContents "components/succinct-core/data" + +spec :: Spec +spec = describe "Data.Succinct.RankSelect.ValidateSpec" $ do + it "Validate generated" $ requireProperty $ do + !v <- forAll $ G.storableVector (R.linear 5 100) (G.word64 R.constantBounded) + + let !popCounts = DVS.fromList (scanl (+) 0 (popCount1 <$> DVS.toList v)) + let !bitIndex = makeCsPoppy v + + forM_ [0 .. fromIntegral (DVS.length v - 1)] $ \i -> do + let !w = v !!! i + let !lastPopCount = popCounts !!! i + + forM_ [0 .. 63] $ \pw -> do + let !r0 = rank1 w pw + lastPopCount + let !r1 = rank1 w (pw + 1) + lastPopCount + let !p = fromIntegral (i * 64) + pw + + when (r0 == r1) $ do + let !actualP = select1 bitIndex r0 + when (actualP > p) $ do + annotate $ "actualP[" <> show actualP <> "] > p[" <> show p <> "]" + failure + + True === True + describe "Validate components/succinct-core/data/*.idx" $ + forM_ entries $ \entry -> + it entry $ requireTest $ do + !(v :: DVS.Vector Word64) <- liftIO $ mmapFromForeignRegion ("components/succinct-core/data/" <> entry) + let !popCounts = DVS.fromList (scanl (+) 0 (popCount1 <$> DVS.toList v)) + let !bitIndex = makeCsPoppy v + + forM_ [0 .. fromIntegral (DVS.length v - 1)] $ \i -> do + let !w = v !!! i + let !lastPopCount = popCounts !!! i + + forM_ [0 .. 63] $ \pw -> do + let !r0 = rank1 w pw + lastPopCount + let !r1 = rank1 w (pw + 1) + lastPopCount + let !p = fromIntegral (i * 64) + pw + + when (r0 == r1) $ do + let !actualP = select1 bitIndex r0 + when (actualP > p) $ do + annotate $ "select1 " <> show r0 <> " == " <> "actualP[" <> show actualP <> "] > p[" <> show p <> "]" + failure diff --git a/components/succinct-core/test/Spec.hs b/components/succinct-core/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/succinct-core/test/Test/Common.hs b/components/succinct-core/test/Test/Common.hs new file mode 100644 --- /dev/null +++ b/components/succinct-core/test/Test/Common.hs @@ -0,0 +1,30 @@ +module Test.Common where + +import Control.Exception +import Control.Monad.IO.Class +import Data.List (isSuffixOf) +import Hedgehog + +import qualified System.Directory as IO +import qualified System.IO.Unsafe as IO + +corpusFiles :: [FilePath] +corpusFiles = IO.unsafePerformIO $ do + entries <- IO.getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries + return files +{-# NOINLINE corpusFiles #-} + +ioFailOnException :: a -> IO (Either String a) +ioFailOnException a = do + catch (Right <$> evaluate a) handler + where handler (e :: SomeException) = return (Left (show e)) + +safely :: a -> PropertyT IO a +safely a = do + result <- liftIO $ ioFailOnException a + case result of + Right b -> return b + Left msg -> do + annotate msg + failure diff --git a/components/succinct-dsv/app/App/Char.hs b/components/succinct-dsv/app/App/Char.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Char.hs @@ -0,0 +1,25 @@ +module App.Char where + +import Data.Char +import Data.Word +import Options.Applicative (ReadM, eitherReader) + +doubleQuote :: Word8 +doubleQuote = fromIntegral (ord '"') + +comma :: Word8 +comma = fromIntegral (ord ',') + +pipe :: Word8 +pipe = fromIntegral (ord '|') + +newline :: Word8 +newline = fromIntegral (ord '\n') + +readChar :: ReadM Char +readChar = eitherReader $ \xs -> case xs of + [a] -> return a + _ -> Left $ "Invalid delimeter " <> show xs + +readWord8 :: ReadM Word8 +readWord8 = fromIntegral . ord <$> readChar diff --git a/components/succinct-dsv/app/App/Commands.hs b/components/succinct-dsv/app/App/Commands.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands.hs @@ -0,0 +1,29 @@ +module App.Commands where + +import App.Commands.CreateIndex +import App.Commands.Generate +import App.Commands.IndexWord8s +import App.Commands.QueryLazy +import App.Commands.QueryStrict +import App.Commands.RangeJoin +import Options.Applicative + +{- HLINT ignore "Monoid law, left identity" -} + +commands :: Parser (IO ()) +commands = commandsGeneral <|> commandsDebugging + +commandsGeneral :: Parser (IO ()) +commandsGeneral = subparser $ mempty + <> commandGroup "Commands:" + <> cmdCreateIndex + <> cmdQueryLazy + <> cmdQueryStrict + <> cmdRangeJoin + +commandsDebugging :: Parser (IO ()) +commandsDebugging = subparser $ mempty + <> commandGroup "Debugging commands:" + <> cmdIndexWord8s + <> cmdGenerate + <> hidden diff --git a/components/succinct-dsv/app/App/Commands/CreateIndex.hs b/components/succinct-dsv/app/App/Commands/CreateIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/CreateIndex.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE BangPatterns #-} + +module App.Commands.CreateIndex + ( cmdCreateIndex + ) where + +import App.Char +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import HaskellWorks.Data.ByteString.Lazy +import Options.Applicative hiding (columns) + +import qualified App.Commands.Options.Type as Z +import qualified App.IO as IO +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Succinct.Dsv.Lazy.Cursor as SVL +import qualified System.IO as IO + +runCreateIndex :: Z.CreateIndexOptions -> IO () +runCreateIndex opts = do + let !filePath = opts ^. the @"filePath" + let !delimiter = opts ^. the @"delimiter" + + !bs <- IO.readInputFile filePath + + let !cursor = SVL.makeCursor delimiter bs + let !markers = cursor & SVL.dsvCursorMarkers + let !newlines = cursor & SVL.dsvCursorNewlines + let !filePathNoDash = if filePath == "-" then "stdin" else filePath + + hOutMarkers <- IO.openFile (filePathNoDash ++ ".markers.idx") IO.WriteMode + hOutNewlines <- IO.openFile (filePathNoDash ++ ".newlines.idx") IO.WriteMode + + forM_ (zip markers newlines) $ \(markerV, newlineV) -> do + LBS.hPut hOutMarkers (toLazyByteString markerV) + LBS.hPut hOutNewlines (toLazyByteString newlineV) + + B.hPutBuilder hOutMarkers (B.word8 0xff) -- Telomere byte + IO.hClose hOutMarkers + + B.hPutBuilder hOutNewlines (B.word8 0xff) -- Telomere byte + IO.hClose hOutNewlines + + return () + +optsCreateIndex :: Parser Z.CreateIndexOptions +optsCreateIndex = Z.CreateIndexOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input DSV file" + <> metavar "STRING" + ) + <*> option readWord8 + ( long "input-delimiter" + <> short 'd' + <> help "DSV delimiter" + <> metavar "CHAR" + ) + +cmdCreateIndex :: Mod CommandFields (IO ()) +cmdCreateIndex = command "create-index" $ flip info idm $ runCreateIndex <$> optsCreateIndex diff --git a/components/succinct-dsv/app/App/Commands/Generate.hs b/components/succinct-dsv/app/App/Commands/Generate.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/Generate.hs @@ -0,0 +1,47 @@ +module App.Commands.Generate + ( cmdGenerate + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Options.Applicative hiding (columns) + +import qualified App.Commands.Options.Type as Z +import qualified App.Gen as G +import qualified Data.List as L +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +printField :: String -> String +printField cs = if any invalid cs + then escape cs + else cs + where invalid c = c == ',' || c == '\r' || c == '\n' || c == '"' + escape = ("\"" <>) . (<> "\"") . concatMap (\c -> if c == '"' then "\"\"" else [c]) + +runGenerate :: Z.GenerateOptions -> IO () +runGenerate opts = do + let fields = opts ^. the @"fields" + let rows = opts ^. the @"rows" + + csv <- G.sample (G.list (R.singleton rows) (G.list (R.singleton fields) G.field)) :: IO [[String]] + + putStr $ unlines $ map (L.intercalate "," . map printField) csv + + return () + +optsGenerate :: Parser Z.GenerateOptions +optsGenerate = Z.GenerateOptions + <$> option auto + ( long "fields" + <> help "Number of fields" + <> metavar "INT" + ) + <*> option auto + ( long "rows" + <> help "Number of rows" + <> metavar "INT" + ) + +cmdGenerate :: Mod CommandFields (IO ()) +cmdGenerate = command "generate" $ flip info idm $ runGenerate <$> optsGenerate diff --git a/components/succinct-dsv/app/App/Commands/IndexWord8s.hs b/components/succinct-dsv/app/App/Commands/IndexWord8s.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/IndexWord8s.hs @@ -0,0 +1,65 @@ +module App.Commands.IndexWord8s + ( cmdIndexWord8s + ) where + +import Control.Lens +import Data.Generics.Product.Any +import HaskellWorks.Data.Vector.AsVector64 +import Options.Applicative + +import qualified App.Commands.Options.Type as Z +import qualified App.IO as IO +import qualified Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +import qualified Data.Succinct.Simd.Comparison.Avx2 as AVX2 +import qualified Data.Succinct.Simd.Comparison.Stock as STOCK + +runIndexWord8sNormal :: Z.IndexWord8sOptions -> IO () +runIndexWord8sNormal opts = do + contents <- IO.readInputFile (opts ^. the @"source") + + IO.writeOutputFile (opts ^. the @"target") $ contents + & LBS.toLazyByteString + . fmap (STOCK.cmpEqWord8s 44 . asVector64) + . BS.resegmentPadded 64 + . LBS.toChunks + +runIndexWord8sSimd :: Z.IndexWord8sOptions -> IO () +runIndexWord8sSimd opts = do + contents <- IO.readInputFile (opts ^. the @"source") + + IO.writeOutputFile (opts ^. the @"target") $ contents + & LBS.toLazyByteString + . fmap (AVX2.cmpEqWord8s 44 . asVector64) + . BS.resegmentPadded 64 + . LBS.toChunks + +runIndexWord8s :: Z.IndexWord8sOptions -> IO () +runIndexWord8s opts + | opts ^. the @"simd" = runIndexWord8sSimd opts + | otherwise = runIndexWord8sNormal opts + +optsIndexWord8s :: Parser Z.IndexWord8sOptions +optsIndexWord8s = Z.IndexWord8sOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + <> showDefault + <> value "-" + ) + <*> strOption + ( long "output" + <> help "Output file" + <> metavar "FILE" + <> showDefault + <> value "-" + ) + <*> switch + ( long "simd" + <> help "Use simd method" + ) + +cmdIndexWord8s :: Mod CommandFields (IO ()) +cmdIndexWord8s = command "index-word8s" $ flip info idm $ runIndexWord8s <$> optsIndexWord8s diff --git a/components/succinct-dsv/app/App/Commands/Options/Parse.hs b/components/succinct-dsv/app/App/Commands/Options/Parse.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/Options/Parse.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.Options.Parse + ( nonZeroOneBased + , columnDesc + , rangeJoinColumn + ) where + +import Data.Text +import Options.Applicative +import Text.Read (readEither) + +import qualified App.Data.ColumnDesc as Z +import qualified App.Data.List as L +import qualified App.Data.RangeJoinColumn as Z +import qualified Data.Text as T + +nonZeroOneBased :: Mod OptionFields Int -> Parser Int +nonZeroOneBased = option $ eitherReader $ \s -> do + a <- readEither s + if a == 0 + then Left "cannot index column 0" + else Right (a - 1) + +columnDesc :: Mod OptionFields (Z.ColumnDesc Text) -> Parser (Z.ColumnDesc Text) +columnDesc = option $ eitherReader $ \s -> do + case L.splitOn ':' s of + [iString, f] -> do + i <- readEither iString + if i == 0 + then Left "cannot index column 0" + else Right (Z.ColumnDesc (i - 1) (T.pack f)) + [iString] -> do + i <- readEither iString + if i == 0 + then Left "cannot index column 0" + else Right (Z.ColumnDesc (i - 1) "id") + _ -> Left $ "invalid column description " <> show s + +rangeJoinColumn :: Mod OptionFields Z.RangeJoinColumn -> Parser Z.RangeJoinColumn +rangeJoinColumn = option $ eitherReader $ \s -> case s of + ('L':rs) -> do + i <- readEither rs + if i == 0 + then Left "cannot index column 0" + else Right (Z.LtColumn (i - 1)) + ('R':rs) -> do + i <- readEither rs + if i == 0 + then Left "cannot index column 0" + else Right (Z.RtColumn (i - 1)) + _ -> Left $ "invalid range-join column: " <> show s diff --git a/components/succinct-dsv/app/App/Commands/Options/Type.hs b/components/succinct-dsv/app/App/Commands/Options/Type.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/Options/Type.hs @@ -0,0 +1,62 @@ +module App.Commands.Options.Type where + +import App.Data.ColumnDesc +import App.Data.RangeJoinColumn +import Data.Text (Text) +import GHC.Generics +import GHC.Word (Word8) + +data CreateIndexOptions = CreateIndexOptions + { filePath :: FilePath + , delimiter :: Word8 + } deriving (Eq, Show, Generic) + +data QueryStrictOptions = QueryStrictOptions + { columns :: [Int] + , filePath :: FilePath + , outputFilePath :: FilePath + , delimiter :: Word8 + , outDelimiter :: Word8 + , useIndex :: Bool + } deriving (Eq, Show, Generic) + +data GenerateOptions = GenerateOptions + { fields :: Int + , rows :: Int + } deriving (Eq, Show, Generic) + +data CatOptions = CatOptions + { source :: FilePath + , target :: FilePath + , simd :: Bool + } deriving (Eq, Show, Generic) + +data IndexWord8sOptions = IndexWord8sOptions + { source :: FilePath + , target :: FilePath + , simd :: Bool + } deriving (Eq, Show, Generic) + +data QueryLazyOptions = QueryLazyOptions + { columns :: [ColumnDesc Text] + , filePath :: FilePath + , outputFilePath :: FilePath + , delimiter :: Word8 + , outDelimiter :: Word8 + , method :: String + } deriving (Eq, Show, Generic) + +data RangeJoinOptions = RangeJoinOptions + { input1FilePath :: FilePath + , input1Delimiter :: Word8 + , input1StartColumn :: Int + , input1StopColumn :: Int + , input2FilePath :: FilePath + , input2Delimiter :: Word8 + , input2StartColumn :: Int + , input2StopColumn :: Int + , columns :: [RangeJoinColumn] + , rangeType :: Text + , outputFilePath :: FilePath + , outputDelimiter :: Word8 + } deriving (Eq, Show, Generic) diff --git a/components/succinct-dsv/app/App/Commands/QueryLazy.hs b/components/succinct-dsv/app/App/Commands/QueryLazy.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/QueryLazy.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.QueryLazy + ( cmdQueryLazy + ) where + +import App.Char +import App.Commands.Options.Parse +import Control.Applicative +import Control.Lens +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Resource +import Data.Generics.Product.Any +import Options.Applicative hiding (columns) + +import qualified App.Commands.Options.Type as Z +import qualified App.Data.ColumnDesc as Z +import qualified App.IO as IO +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as L +import qualified Data.Vector as DV +import qualified Data.Succinct.Dsv.Lazy.Cursor as SVL +import qualified Data.Succinct.Dsv.Lazy.Cursor.Lazy as SVLL +import qualified Data.Succinct.Dsv.Lazy.Cursor.Strict as SVLS +import qualified System.Exit as IO +import qualified System.IO as IO + +{- HLINT ignore "Reduce duplication" -} + +defaultMethod :: String +defaultMethod = "lazy-traverse" + +runQueryLazy :: Z.QueryLazyOptions -> IO () +runQueryLazy opts = case opts ^. the @"method" of + "lazy-traverse" -> runQueryLazyFast opts + "strict-traverse" -> runQueryLazySlow opts + "strict-bytestring" -> runQueryLazyStrict opts + method -> do + IO.hPutStrLn IO.stderr $ "Unknown method: " <> method + IO.exitFailure + +runQueryLazySlow :: Z.QueryLazyOptions -> IO () +runQueryLazySlow opts = do + !bs <- IO.readInputFile (opts ^. the @"filePath") + + let !c = SVL.makeCursor (opts ^. the @"delimiter") bs + let !rows = SVLL.toListVector c + let !outDelimiterBuilder = B.word8 (opts ^. the @"outDelimiter") + + runResourceT $ do + (_, hOut) <- IO.openOutputFile (opts ^. the @"outputFilePath") Nothing + forM_ rows $ \row -> do + let fieldStrings = columnToFieldString row <$> (opts ^.. the @"columns" . each . the @"number") + + liftIO $ B.hPutBuilder hOut $ mconcat (L.intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 + + return () + return () + where columnToFieldString :: DV.Vector LBS.ByteString -> Int -> B.Builder + columnToFieldString fields i = if i >= 0 && i < DV.length fields + then B.lazyByteString (DV.unsafeIndex fields i) + else B.lazyByteString LBS.empty + +runQueryLazyStrict :: Z.QueryLazyOptions -> IO () +runQueryLazyStrict opts = do + !bs <- IO.readInputFile (opts ^. the @"filePath") + + let !c = SVL.makeCursor (opts ^. the @"delimiter") bs + let !rows = SVLS.toListVector c + let !outDelimiterBuilder = B.word8 (opts ^. the @"outDelimiter") + + runResourceT $ do + (_, hOut) <- IO.openOutputFile (opts ^. the @"outputFilePath") Nothing + forM_ rows $ \row -> do + let fieldStrings = columnToFieldString row <$> (opts ^.. the @"columns" . each . the @"number") + + liftIO $ B.hPutBuilder hOut $ mconcat (L.intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 + + return () + return () + where columnToFieldString :: DV.Vector BS.ByteString -> Int -> B.Builder + columnToFieldString fields i = if i >= 0 && i < DV.length fields + then B.byteString (DV.unsafeIndex fields i) + else B.byteString BS.empty + +runQueryLazyFast :: Z.QueryLazyOptions -> IO () +runQueryLazyFast opts = do + !bs <- IO.readInputFile (opts ^. the @"filePath") + + let !c = SVL.makeCursor (opts ^. the @"delimiter") bs + let !sel = opts ^. the @"columns" <&> Z.realiseColumnDescLazy <&> Z.columnDescToTuple + let !rows = SVLL.mapSelectListList sel c + let !outDelimiterBuilder = B.word8 (opts ^. the @"outDelimiter") + + runResourceT $ do + (_, hOut) <- IO.openOutputFile (opts ^. the @"outputFilePath") Nothing + forM_ rows $ \row -> do + let fieldStrings = fmap B.lazyByteString row + + liftIO $ B.hPutBuilder hOut $ mconcat (L.intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 + + return () + return () + +cmdQueryLazy :: Mod CommandFields (IO ()) +cmdQueryLazy = command "query-lazy" $ flip info idm $ runQueryLazy <$> optsQueryLazy + +optsQueryLazy :: Parser Z.QueryLazyOptions +optsQueryLazy = Z.QueryLazyOptions + <$> many + ( columnDesc + ( long "column" + <> short 'k' + <> help "Column to select" + <> metavar "COLUMN INDEX" )) + <*> strOption + ( long "input" + <> short 'i' + <> help "Input DSV file" + <> metavar "FILE" + <> showDefault + <> value "-" + ) + <*> strOption + ( long "output" + <> short 'o' + <> help "Output DSV file" + <> metavar "FILE" + <> showDefault + <> value "-" + ) + <*> option readWord8 + ( long "input-delimiter" + <> short 'd' + <> help "Input DSV delimiter" + <> metavar "CHAR" + ) + <*> option readWord8 + ( long "output-delimiter" + <> short 'e' + <> help "Output DSV delimiter" + <> metavar "CHAR" + ) + <*> strOption + ( long "method" + <> short 'm' + <> help "Method" + <> metavar "METHOD" + <> showDefault + <> value defaultMethod + ) diff --git a/components/succinct-dsv/app/App/Commands/QueryStrict.hs b/components/succinct-dsv/app/App/Commands/QueryStrict.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/QueryStrict.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.QueryStrict + ( cmdQueryStrict + ) where + +import App.Char +import App.Commands.Options.Parse +import Control.Applicative +import Control.Lens +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Resource +import Data.Generics.Product.Any +import Options.Applicative + +import qualified App.Commands.Options.Type as Z +import qualified App.IO as IO +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.List as L +import qualified Data.Vector as DV +import qualified Data.Succinct.Dsv.Strict.Cursor as SVS + +runQueryStrict :: Z.QueryStrictOptions -> IO () +runQueryStrict opts = do + let delimiter = opts ^. the @"delimiter" + let inputFilePath = opts ^. the @"filePath" + let useIndex = opts ^. the @"useIndex" + c <- SVS.mmapCursor delimiter useIndex inputFilePath + + let !rows = SVS.toListVector c + let !outDelimiterBuilder = B.word8 (opts ^. the @"outDelimiter") + + runResourceT $ do + (_, hOut) <- IO.openOutputFile (opts ^. the @"outputFilePath") Nothing + forM_ rows $ \row -> do + let fieldStrings = columnToFieldString row <$> (opts ^. the @"columns") + + liftIO $ B.hPutBuilder hOut $ mconcat (L.intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 + + return () + return () + + where columnToFieldString :: DV.Vector BS.ByteString -> Int -> B.Builder + columnToFieldString fields i = if i >= 0 && i < DV.length fields + then B.byteString (DV.unsafeIndex fields i) + else B.byteString BS.empty + +cmdQueryStrict :: Mod CommandFields (IO ()) +cmdQueryStrict = command "query-strict" $ flip info idm $ runQueryStrict <$> optsQueryStrict + +optsQueryStrict :: Parser Z.QueryStrictOptions +optsQueryStrict = Z.QueryStrictOptions + <$> many + ( nonZeroOneBased + ( long "column" + <> short 'k' + <> help "Column to select" + <> metavar "COLUMN INDEX" )) + <*> strOption + ( long "input" + <> short 'i' + <> help "Input DSV file" + <> metavar "FILE" + ) + <*> strOption + ( long "output" + <> short 'o' + <> help "Output DSV file" + <> metavar "FILE" + ) + <*> option readWord8 + ( long "input-delimiter" + <> short 'd' + <> help "DSV delimiter to read in the input" + <> metavar "CHAR" + ) + <*> option readWord8 + ( long "output-delimiter" + <> short 'e' + <> help "DSV delimiter to write in the output" + <> metavar "CHAR" + ) + <*> switch (long "use-index") diff --git a/components/succinct-dsv/app/App/Commands/RangeJoin.hs b/components/succinct-dsv/app/App/Commands/RangeJoin.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Commands/RangeJoin.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.RangeJoin + ( cmdRangeJoin + ) where + +import App.Char +import App.Commands.Options.Parse +import Control.Lens +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Resource +import Data.Generics.Product.Any +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Word +import Options.Applicative hiding (columns) +import Text.Read (readMaybe) + +import qualified App.Commands.Options.Type as Z +import qualified App.Data.RangeJoinColumn as Z +import qualified App.IO as IO +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Vector as DV +import qualified Data.Succinct.Dsv.Lazy.Cursor as SVL +import qualified Data.Succinct.Dsv.Lazy.Cursor.Lazy as SVLL + +rangeJoin :: (DV.Vector LBS.ByteString -> DV.Vector LBS.ByteString -> [LBS.ByteString]) + -> Int -> Int -> [DV.Vector LBS.ByteString] -> Int -> Int -> [DV.Vector LBS.ByteString] -> [[LBS.ByteString]] +rangeJoin f aa az as ba bz bs = rangeJoin' f (mapMaybe (mkEntry aa az) as) (mapMaybe (mkEntry ba bz) bs) + +mkEntry :: Int -> Int -> DV.Vector LBS.ByteString -> Maybe (Word32, Word32, DV.Vector LBS.ByteString) +mkEntry a z v = (,, v) <$> lookupWord32 a v <*> lookupWord32 z v + +lookupWord32 :: Int -> DV.Vector LBS.ByteString -> Maybe Word32 +lookupWord32 i v = do + lbs <- v DV.!? i + let s = T.unpack (T.decodeUtf8 (LBS.toStrict lbs)) + readMaybe s + +rangeJoin' :: (DV.Vector LBS.ByteString -> DV.Vector LBS.ByteString -> [LBS.ByteString]) + -> [(Word32, Word32, DV.Vector LBS.ByteString)] -> [(Word32, Word32, DV.Vector LBS.ByteString)] -> [[LBS.ByteString]] +rangeJoin' f ((ua, uz, u):us) ((va, vz, v):vs) = if + | uz < va -> ("L":encodeWord32 ua:encodeWord32 uz :f u e):rangeJoin' f us ((va , vz, v):vs) + | vz < ua -> ("R":encodeWord32 va:encodeWord32 vz :f e v):rangeJoin' f ((ua , uz, u):us) vs + | ua < va -> ("L":encodeWord32 ua:encodeWord32 (va - 1):f u e):rangeJoin' f ((va , uz, u):us) ((va , vz, v):vs) + | va < ua -> ("R":encodeWord32 va:encodeWord32 (ua - 1):f e v):rangeJoin' f ((ua , uz, u):us) ((ua , vz, v):vs) + | uz < vz -> ("B":encodeWord32 ua:encodeWord32 uz :f u v):rangeJoin' f us ((uz + 1, vz, v):vs) + | vz < uz -> ("B":encodeWord32 va:encodeWord32 vz :f u v):rangeJoin' f ((vz + 1, uz, u):us) vs + | otherwise -> ("B":encodeWord32 va:encodeWord32 vz :f u v):rangeJoin' f us vs + where e = DV.empty +rangeJoin' f ((ua, uz, _):us) [] = ["L", encodeWord32 ua, encodeWord32 uz]:rangeJoin' f us [] +rangeJoin' f [] ((va, vz, _):vs) = ["R", encodeWord32 va, encodeWord32 vz]:rangeJoin' f [] vs +rangeJoin' _ [] [] = [] + +encodeWord32 :: Word32 -> LBS.ByteString +encodeWord32 = LBS.fromStrict . T.encodeUtf8 . T.pack . show + +mkColumnSelector :: [Z.RangeJoinColumn] -> DV.Vector LBS.ByteString -> DV.Vector LBS.ByteString -> [LBS.ByteString] +mkColumnSelector [] _ _ = [] +mkColumnSelector (c:cs) u v = case c of + Z.LtColumn n -> fromMaybe "" (u DV.!? n):mkColumnSelector cs u v + Z.RtColumn n -> fromMaybe "" (v DV.!? n):mkColumnSelector cs u v + +runRangeJoin :: Z.RangeJoinOptions -> IO () +runRangeJoin opts = do + let input1Delimiter = opts ^. the @"input1Delimiter" + let input1FilePath = opts ^. the @"input1FilePath" + let input1StartColumn = opts ^. the @"input1StartColumn" + let input1StopColumn = opts ^. the @"input1StopColumn" + let input2Delimiter = opts ^. the @"input2Delimiter" + let input2FilePath = opts ^. the @"input2FilePath" + let input2StartColumn = opts ^. the @"input2StartColumn" + let input2StopColumn = opts ^. the @"input2StopColumn" + let columns = opts ^. the @"columns" + let outputFilePath = opts ^. the @"outputFilePath" + let outputDelimiter = opts ^. the @"outputDelimiter" + + !rows1 <- SVLL.toListVector . SVL.makeCursor input1Delimiter <$> IO.readInputFile input1FilePath + !rows2 <- SVLL.toListVector . SVL.makeCursor input2Delimiter <$> IO.readInputFile input2FilePath + + let !outDelimiterBuilder = B.word8 outputDelimiter + let !outNewlineBuilder = B.word8 10 + let !columnSelector = mkColumnSelector columns + + runResourceT $ do + (_, hOut) <- IO.openOutputFile outputFilePath Nothing + let outLbsss = rangeJoin columnSelector input1StartColumn input1StopColumn rows1 input2StartColumn input2StopColumn rows2 + let outBss = fmap (fmap B.lazyByteString) outLbsss + let outB = mconcat (L.intersperse outNewlineBuilder (fmap (mconcat . L.intersperse outDelimiterBuilder) outBss)) + liftIO $ B.hPutBuilder hOut outB + return () + +cmdRangeJoin :: Mod CommandFields (IO ()) +cmdRangeJoin = command "range-join" $ flip info idm $ runRangeJoin <$> optsRangeJoin + +optsRangeJoin :: Parser Z.RangeJoinOptions +optsRangeJoin = Z.RangeJoinOptions + <$> strOption + ( long "input1" + <> help "Input DSV file 1" + <> metavar "FILE" + ) + <*> option readWord8 + ( long "input1-delimiter" + <> help "DSV delimiter to use for input1" + <> metavar "CHAR" + ) + <*> nonZeroOneBased + ( long "input1-start-column" + <> short 'k' + <> help "Column to use as start column from 1" + <> metavar "COLUMN INDEX" + ) + <*> nonZeroOneBased + ( long "input1-stop-column" + <> short 'k' + <> help "Column to use as stop column from 1" + <> metavar "COLUMN INDEX" + ) + <*> strOption + ( long "input2" + <> help "Input DSV file 2" + <> metavar "FILE" + ) + <*> option readWord8 + ( long "input2-delimiter" + <> help "DSV delimiter to use for input2" + <> metavar "CHAR" + ) + <*> nonZeroOneBased + ( long "input2-start-column" + <> short 'k' + <> help "Column to use as start column from 2" + <> metavar "COLUMN INDEX" + ) + <*> nonZeroOneBased + ( long "input2-stop-column" + <> short 'k' + <> help "Column to use as stop column from 2" + <> metavar "COLUMN INDEX" + ) + <*> many + ( rangeJoinColumn + ( long "column" + <> short 'k' + <> help "Range join colum" + <> metavar "RANGE_JOIN_COLUMN" + ) + ) + <*> strOption + ( long "range-type" + <> short 'r' + <> help "Range type" + <> metavar "RANGE_TYPE" + ) + <*> strOption + ( long "output" + <> short 'o' + <> help "Output DSV file" + <> metavar "FILE" + ) + <*> option readWord8 + ( long "output-delimiter" + <> short 'e' + <> help "DSV delimiter to write in the output" + <> metavar "CHAR" + ) diff --git a/components/succinct-dsv/app/App/Data/ColumnDesc.hs b/components/succinct-dsv/app/App/Data/ColumnDesc.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Data/ColumnDesc.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Data.ColumnDesc + ( ColumnDesc(..) + , realiseColumnDescLazy + , realiseColumnDescStrict + , columnDescToTuple + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Text +import GHC.Generics + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IPv4 +import qualified Text.Appar.String as TAS + +data ColumnDesc a = ColumnDesc + { number :: Int + , conversion :: a + } deriving (Eq, Show, Generic, Functor) + +ipv4ToWord32 :: LBS.ByteString -> LBS.ByteString +ipv4ToWord32 lbs = case TAS.parse IPv4.parseIpAddress (T.unpack (T.decodeUtf8 (LBS.toStrict lbs))) of + Just ipv4Address -> LBS.fromStrict (T.encodeUtf8 (T.pack (show (ipv4Address ^. the @"word")))) + Nothing -> lbs + +realiseColumnDescLazy :: ColumnDesc Text -> ColumnDesc (LBS.ByteString -> LBS.ByteString) +realiseColumnDescLazy = fmap realise + where realise :: Text -> LBS.ByteString -> LBS.ByteString + realise t = case t of + "id" -> id + "ipv4-to-word32" -> ipv4ToWord32 + _ -> const "BAD" + +realiseColumnDescStrict :: ColumnDesc Text -> ColumnDesc (BS.ByteString -> BS.ByteString) +realiseColumnDescStrict cd = fmap (\f -> LBS.toStrict . f . LBS.fromStrict) (realiseColumnDescLazy cd) + +columnDescToTuple :: ColumnDesc a -> (Int, a) +columnDescToTuple cd = (cd ^. the @1, cd ^. the @2) diff --git a/components/succinct-dsv/app/App/Data/List.hs b/components/succinct-dsv/app/App/Data/List.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Data/List.hs @@ -0,0 +1,11 @@ +module App.Data.List + ( splitOn + ) where + +splitOn :: Eq a => a -> [a] -> [[a]] +splitOn _ [] = [] +splitOn a xs = cons $ case break (== a) xs of + (l, ys) -> (l, ) $ case ys of + [] -> [] + _:zs -> splitOn a zs + where cons ~(h, t) = h : t diff --git a/components/succinct-dsv/app/App/Data/RangeJoinColumn.hs b/components/succinct-dsv/app/App/Data/RangeJoinColumn.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Data/RangeJoinColumn.hs @@ -0,0 +1,8 @@ +module App.Data.RangeJoinColumn + ( RangeJoinColumn(..) + ) where + +import GHC.Generics + +data RangeJoinColumn = LtColumn Int | RtColumn Int + deriving (Eq, Show, Generic) diff --git a/components/succinct-dsv/app/App/Gen.hs b/components/succinct-dsv/app/App/Gen.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/Gen.hs @@ -0,0 +1,9 @@ +module App.Gen where + +import Hedgehog + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +field :: MonadGen m => m String +field = G.string (R.linear 0 20) (G.choice [G.alphaNum, G.element "\r\n,\" \t"]) diff --git a/components/succinct-dsv/app/App/IO.hs b/components/succinct-dsv/app/App/IO.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/App/IO.hs @@ -0,0 +1,27 @@ +module App.IO where + +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import System.IO (Handle) + +import qualified Data.ByteString.Lazy as LBS +import qualified System.IO as IO + +openOutputFile :: MonadResource m => FilePath -> Maybe Int -> m (ReleaseKey, Handle) +openOutputFile "-" _ = allocate (return IO.stdout) (const (return ())) +openOutputFile filePath maybeBufferSize = allocate open close + where open = do + handle <- IO.openFile filePath IO.WriteMode + forM_ maybeBufferSize $ \bufferSize -> + liftIO $ IO.hSetBuffering handle (IO.BlockBuffering (Just bufferSize)) + return handle + close = IO.hClose + +readInputFile :: FilePath -> IO LBS.ByteString +readInputFile "-" = LBS.hGetContents IO.stdin +readInputFile filePath = LBS.readFile filePath + +writeOutputFile :: FilePath -> LBS.ByteString -> IO () +writeOutputFile "-" bs = LBS.hPut IO.stdout bs +writeOutputFile filePath bs = LBS.writeFile filePath bs diff --git a/components/succinct-dsv/app/Main.hs b/components/succinct-dsv/app/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/app/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import App.Commands +import Control.Monad +import Options.Applicative + +main :: IO () +main = join $ customExecParser + (prefs $ showHelpOnEmpty <> showHelpOnError) + (info (commands <**> helper) idm) diff --git a/components/succinct-dsv/bench/Main.hs b/components/succinct-dsv/bench/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/bench/Main.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +import Control.Monad +import Criterion.Main +import Data.ByteString (ByteString) +import Data.Vector (Vector) +import Data.Word +import Data.Succinct.Dsv.Internal.Char (comma, pipe) +import System.Directory + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Csv as CSV +import qualified Data.Csv.Streaming as CSS +import qualified Data.List as L +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Dsv.Lazy.Cursor as SVL +import qualified Data.Succinct.Dsv.Lazy.Cursor.Lazy as SVLL +import qualified Data.Succinct.Dsv.Strict.Cursor as SVS +import qualified Data.Succinct.Dsv.Strict.Cursor.Internal as SVS +import qualified Data.Succinct.Dsv.Strict.Cursor.Internal.Reference as SVS +import qualified HaskellWorks.Data.FromForeignRegion as IO +import qualified Data.Succinct.RankSelect.CsPoppy as RS + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Monoid law, left identity" -} + +loadCassavaStrict :: FilePath -> IO (Vector (Vector ByteString)) +loadCassavaStrict filePath = do + !bs <- LBS.readFile filePath + let r = CSV.decode CSS.HasHeader bs :: Either String (Vector (Vector ByteString)) + case r of + Left _ -> error "Unexpected parse error" + Right v -> pure v + +loadCassavaStreaming :: FilePath -> IO (CSS.Records (Vector ByteString)) +loadCassavaStreaming filePath = do + !bs <- LBS.readFile filePath + let r = CSS.decode CSV.HasHeader bs :: CSS.Records (Vector ByteString) + pure r + +loadHwsvStrictIndex :: FilePath -> IO (SVS.DsvCursor ByteString RS.CsPoppy) +loadHwsvStrictIndex = SVS.mmapCursor comma True + +loadHwsvStrict :: FilePath -> IO (Vector (Vector ByteString)) +loadHwsvStrict filePath = SVS.toVectorVector <$> SVS.mmapCursor comma True filePath + +loadHwsvLazyIndex :: FilePath -> IO [(DVS.Vector Word64, DVS.Vector Word64)] +loadHwsvLazyIndex filePath = do + !bs <- LBS.readFile filePath + + let c = SVL.makeCursor comma bs + pure (zip (SVL.dsvCursorMarkers c) (SVL.dsvCursorNewlines c)) + +loadHwsvLazy :: FilePath -> IO [Vector LBS.ByteString] +loadHwsvLazy filePath = do + !bs <- LBS.readFile filePath + + let c = SVL.makeCursor comma bs + + pure (SVLL.toListVector c) + +makeBenchCsv :: IO [Benchmark] +makeBenchCsv = do + entries <- listDirectory "components/succinct-dsv/data/bench" + let files = ("components/succinct-dsv/data/bench/" ++) <$> (".csv" `L.isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return $ mempty + <> [bench ("cassava/decode/via-strict/" <> file) (nfIO (loadCassavaStrict file))] + <> [bench ("cassava/decode/via-streaming/" <> file) (nfIO (loadCassavaStreaming file))] + <> [bench ("hw-dsv/decode/via-strict/" <> file) (nfIO (loadHwsvStrict file))] + <> [bench ("hw-dsv/decode/via-lazy/" <> file) (nfIO (loadHwsvLazy file))] + <> [bench ("hw-dsv/decode/via-strict/index/" <> file) (nfIO (loadHwsvStrictIndex file))] + <> [bench ("hw-dsv/decode/via-lazy/index/" <> file) (nfIO (loadHwsvLazyIndex file))] + return (join benchmarks) + +makeBenchW64s :: IO [Benchmark] +makeBenchW64s = do + entries <- listDirectory "components/succinct-dsv/data/bench" + let files = ("components/succinct-dsv/data/bench/" ++) <$> (".csv" `L.isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return + [ env (IO.mmapFromForeignRegion file) $ \v -> bgroup "Creating bit index from mmaped file" $ mempty + <> [bench ("mkIbVector with sum" <> file) (whnf (DVS.foldl (+) 0 . SVS.mkIbVector comma) v)] + ] + return (join benchmarks) + +makeBenchMkInterestBits :: IO [Benchmark] +makeBenchMkInterestBits = do + entries <- listDirectory "components/succinct-dsv/data/bench" + let files = ("components/succinct-dsv/data/bench/" ++) <$> (".csv" `L.isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return + [ env (IO.mmapFromForeignRegion file) $ \(v :: DVS.Vector Word64) -> bgroup "Loading lazy byte string into Word64s" $ mempty + <> [bench ("mkIbVector with sum" <> file) (whnf (DVS.foldr (+) 0 . SVS.mkIbVector pipe) v)] + <> [bench ("makeIndexes with sum" <> file) (whnf (DVS.foldr (+) 0 . fst . SVS.makeIndexes pipe) v)] + ] + return (join benchmarks) + +main :: IO () +main = do + benchmarks <- (mconcat <$>) $ sequence $ mempty + <> [makeBenchCsv] + -- <> [makeBenchW64s] + -- <> [makeBenchMkInterestBits] + defaultMain benchmarks diff --git a/components/succinct-dsv/data/bench/data-0001000.csv b/components/succinct-dsv/data/bench/data-0001000.csv new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/data/bench/data-0001000.csv @@ -0,0 +1,1911 @@ +aaHaaaba6aaaaaetaR,JaaUaagaaJwaaaaaaDaayaa6aa,XGaZa1a3aaA,P8aaaaarala6,aaHaaaba6aaaaaetaR,JaaUaagaaJwaaaaaaDaayaa6aa,XGaZa1a3aaA,P8aaaaarala6,aaHaaaba6aaaaaetaR,JaaUaagaaJwaaaaaaDaayaa6aa +aaZaaIac MmsajUa,T4yaaaaaaa4tCa9aa,GaaaaTa8aaf,"aaaaZ +aa",aaZaaIac MmsajUa,T4yaaaaaaa4tCa9aa,GaaaaTa8aaf,"aaaaZ +aa",aaZaaIac MmsajUa,T4yaaaaaaa4tCa9aa +mdaWaaaCDaWnaaa,aaaaaaaapaaaaaEaaaaaa,aaaf7gaKad,aa1JaKaa8ucaaaaaa,mdaWaaaCDaWnaaa,aaaaaaaapaaaaaEaaaaaa,aaaf7gaKad,aa1JaKaa8ucaaaaaa,mdaWaaaCDaWnaaa,aaaaaaaapaaaaaEaaaaaa +aaaFH,sDJaF4aaLaaaGaag,J3aa0a3aaa,akaRaaLa7aaaeaWaaaa,aaaFH,sDJaF4aaLaaaGaag,J3aa0a3aaa,akaRaaLa7aaaeaWaaaa,aaaFH,sDJaF4aaLaaaGaag +"aakae rNaafvwaaa","h6aaaaa +aa",aaazaFaGXaaEs,"aajaa5uaaaaaAaa""a","aakae rNaafvwaaa","h6aaaaa +aa",aaazaFaGXaaEs,"aajaa5uaaaaaAaa""a","aakae rNaafvwaaa","h6aaaaa +aa" + ,aaaoabw,"qaaabaQVGbeaaaa4a""aaaaaaaUaa",g4aaaaaIaGa, ,aaaoabw,"qaaabaQVGbeaaaa4a""aaaaaaaUaa",g4aaaaaIaGa, ,aaaoabw +axaa,aGaia3agaaaSCS,"T,a",00,axaa,aGaia3agaaaSCS,"T,a",00,axaa,aGaia3agaaaSCS +aaaa7paaB,"a7 6akaahaaa oav",a2aaaaaalataha08avaaba A,ara54aaaTVnca 0aaaa,aaaa7paaB,"a7 6akaahaaa oav",a2aaaaaalataha08avaaba A,ara54aaaTVnca 0aaaa,aaaa7paaB,"a7 6akaahaaa oav" +hvydaaaaafaaaaHaHaC,QaWaaaaaeoCxaHaya7aaaa2va,raaaaa6aaaaaaaaaaRBaTaPFaMaZaY,aapaaaRaEa7aaIaaaa,hvydaaaaafaaaaHaHaC,QaWaaaaaeoCxaHaya7aaaa2va,raaaaa6aaaaaaaaaaRBaTaPFaMaZaY,aapaaaRaEa7aaIaaaa,hvydaaaaafaaaaHaHaC,QaWaaaaaeoCxaHaya7aaaa2va +aaaqamUaa1 aaaaaaaaamaaaaz3d,waacPaP7EaaaaaEyaasGaaJa,aaJdaaaGYnaa5aaNqaa,,aaaqamUaa1 aaaaaaaaamaaaaz3d,waacPaP7EaaaaaEyaasGaaJa,aaJdaaaGYnaa5aaNqaa,,aaaqamUaa1 aaaaaaaaamaaaaz3d,waacPaP7EaaaaaEyaasGaaJa +aUaaacaaaaaaaW,0ZOaxaTt5F3HVghHaapazB,aaawDaaaaa1ka2aaa1,aaIaadSbaaaaMm6FaGaiaaaaa,aUaaacaaaaaaaW,0ZOaxaTt5F3HVghHaapazB,aaawDaaaaa1ka2aaa1,aaIaadSbaaaaMm6FaGaiaaaaa,aUaaacaaaaaaaW,0ZOaxaTt5F3HVghHaapazB +a,maaaaaYaaa,a,aaaaRzaW,a,maaaaaYaaa,a,aaaaRzaW,a,maaaaaYaaa +acD,"aa +aaa","aa,9l0axyaabmaaOaaaab","Loaa,f5aaa1aaaaaaaaaqaaaaaIw",acD,"aa +aaa","aa,9l0axyaabmaaOaaaab","Loaa,f5aaa1aaaaaaaaaqaaaaaIw",acD,"aa +aaa" +aIraaYZaaC9aamaaaPm4N,angaa,aa,aaiaJaaa,aIraaYZaaC9aamaaaPm4N,angaa,aa,aaiaJaaa,aIraaYZaaC9aamaaaPm4N,angaa +"a,Jaa"," aaa7aTa9aa1aaYpYaalaa""",aaaa4,Salaaaaaaaa,"a,Jaa"," aaa7aTa9aa1aaYpYaalaa""",aaaa4,Salaaaaaaaa,"a,Jaa"," aaa7aTa9aa1aaYpYaalaa""" +aaaafaLaaaaaaaaZ,aaaPaaaa9aLaaaaaZ6a,aaa,"aaaa apaJYsaakH ",aaaafaLaaaaaaaaZ,aaaPaaaa9aLaaaaaZ6a,aaa,"aaaa apaJYsaakH ",aaaafaLaaaaaaaaZ,aaaPaaaa9aLaaaaaZ6a +WaaaBaQaaaaa9p ac,"aaaaECVaayaaDs ,aataowaaaaa",a6aaaF,KuaUPYaa lama,WaaaBaQaaaaa9p ac,"aaaaECVaayaaDs ,aataowaaaaa",a6aaaF,KuaUPYaa lama,WaaaBaQaaaaa9p ac,"aaaaECVaayaaDs ,aataowaaaaa" +,,o0aanaHm2aslNaa,Da9a,,,o0aanaHm2aslNaa,Da9a,, +" +aaaaaHaaahaBaaaaaIaa8Ua7",aJaa,"paSQaapa0Za +axaaaaa2aaaJ +",aMaZaaasaaa," +aaaaaHaaahaBaaaaaIaa8Ua7",aJaa,"paSQaapa0Za +axaaaaa2aaaJ +",aMaZaaasaaa," +aaaaaHaaahaBaaaaaIaa8Ua7",aJaa +aaaaaaEaawqaaaRasaaaaa,a,4ZaeaaaaaD7NaaaaZaqaaaaa,"aXaoaaaa4aaaaaavaoAGa9,waasK",aaaaaaEaawqaaaRasaaaaa,a,4ZaeaaaaaD7NaaaaZaqaaaaa,"aXaoaaaa4aaaaaavaoAGa9,waasK",aaaaaaEaawqaaaRasaaaaa,a +aaa,aa5aaOaWJvaaaM,Y,aaaaaaME3baaaaaaawaaa6aaaaG,aaa,aa5aaOaWJvaaaM,Y,aaaaaaME3baaaaaaawaaa6aaaaG,aaa,aa5aaOaWJvaaaM +",Baa6vaaB a5aaDfaoaaamaaa +adF",daamaxa,aaa6aaaaava5jaaaifaVaaz ,"aaaaaaaHaaRaMUa +iaanaaa",",Baa6vaaB a5aaDfaoaaamaaa +adF",daamaxa,aaa6aaaaava5jaaaifaVaaz ,"aaaaaaaHaaRaMUa +iaanaaa",",Baa6vaaB a5aaDfaoaaamaaa +adF",daamaxa +FaCaa7aaGacX0uaaYaaBatJaFfaaa,aaaaSaaTa,a,aqa,FaCaa7aaGacX0uaaYaaBatJaFfaaa,aaaaSaaTa,a,aqa,FaCaa7aaGacX0uaaYaaBatJaFfaaa,aaaaSaaTa +aY6f7O,aaaa0IWaaaaaazaaWaaa,FaaacaaMaTNaaaZaa,aaa aVsaaaBadaa9taa1aHaa,aY6f7O,aaaa0IWaaaaaazaaWaaa,FaaacaaMaTNaaaZaa,aaa aVsaaaBadaa9taa1aHaa,aY6f7O,aaaa0IWaaaaaazaaWaaa +"a1jaaaxaayaabZaaaa8aa +aai7IfL",aFha0aaaaama9a,"aXaDzaDwyZaaaauaaWBchaaaaa,M","abP6aRaaaWaZ ","a1jaaaxaayaabZaaaa8aa +aai7IfL",aFha0aaaaama9a,"aXaDzaDwyZaaaauaaWBchaaaaa,M","abP6aRaaaWaZ ","a1jaaaxaayaabZaaaa8aa +aai7IfL",aFha0aaaaama9a +"akahaaa XRFaaaawaai7aaanaa0aHa","aaaaaaaf3aaas,IaMG",CkCaaaCavaaVafa aa,aVa laFraaaaagj6aawo24aaaaa,"akahaaa XRFaaaawaai7aaanaa0aHa","aaaaaaaf3aaas,IaMG",CkCaaaCavaaVafa aa,aVa laFraaaaagj6aawo24aaaaa,"akahaaa XRFaaaawaai7aaanaa0aHa","aaaaaaaf3aaas,IaMG" +aaWla,KLaaavSBaEFaadaHamSH," ,Laaa aaa5vaaaaaaja",aa7aaa3Waaaaabaaaa,aaWla,KLaaavSBaEFaadaHamSH," ,Laaa aaa5vaaaaaaja",aa7aaa3Waaaaabaaaa,aaWla,KLaaavSBaEFaadaHamSH +V9aTaaRRaaaaaaaAosaaaaiaa,aa,"3a 0faaaaaBaDaaOa",ataaawaa,V9aTaaRRaaaaaaaAosaaaaiaa,aa,"3a 0faaaaaBaDaaOa",ataaawaa,V9aTaaRRaaaaaaaAosaaaaiaa,aa +kagaaad,KJaa,"aJJ""aaeS,aa",av,kagaaad,KJaa,"aJJ""aaeS,aa",av,kagaaad,KJaa +aaaaa,aaXaaKaahaaHVaQaaah,7aeaGaaaaaaa0Haqa,8kaaaaaaaaaRaaaa,aaaaa,aaXaaKaahaaHVaQaaah,7aeaGaaaaaaa0Haqa,8kaaaaaaaaaRaaaa,aaaaa,aaXaaKaahaaHVaQaaah +yaaasWaaaOapaTaaPn,4aaaaaaakaaTaLam5faaaDKRacQaJ,aaaaaaaaJ,"a a",yaaasWaaaOapaTaaPn,4aaaaaaakaaTaLam5faaaDKRacQaJ,aaaaaaaaJ,"a a",yaaasWaaaOapaTaaPn,4aaaaaaakaaTaLam5faaaDKRacQaJ +aavaaaa2aaH9aaaaz48Vkraaaaaq,"aaaAa +raaGaaaaaNaaaMaa","q0chakaaalaaaaizaRwaaZ""sahDay","XaaaaNBjVaaDUM agaa",aavaaaa2aaH9aaaaz48Vkraaaaaq,"aaaAa +raaGaaaaaNaaaMaa","q0chakaaalaaaaizaRwaaZ""sahDay","XaaaaNBjVaaDUM agaa",aavaaaa2aaH9aaaaz48Vkraaaaaq,"aaaAa +raaGaaaaaNaaaMaa" +aaaacaNaadaaIaa,pwa7aYaaaX8wowaaaaaaaAaaa0,"aaa,aa +aaBhqaaagaaaAka""WIaaga",aatawVaagaaPa ,aaaacaNaadaaIaa,pwa7aYaaaX8wowaaaaaaaAaaa0,"aaa,aa +aaBhqaaagaaaAka""WIaaga",aatawVaagaaPa ,aaaacaNaadaaIaa,pwa7aYaaaX8wowaaaaaaaAaaa0 +Aaaaaaaaaaac,auaaaaaaa83Usaa,,aaFanaaaaaaaDaLQMaaaaGxana,Aaaaaaaaaaac,auaaaaaaa83Usaa,,aaFanaaaaaaaDaLQMaaaaGxana,Aaaaaaaaaaac,auaaaaaaa83Usaa +aaaH25aaaaaaaalaaa a9aaaazc,aaa6,aeaaaaa,"akvaaa +j5kaaaaE SaPa",aaaH25aaaaaaaalaaa a9aaaazc,aaa6,aeaaaaa,"akvaaa +j5kaaaaE SaPa",aaaH25aaaaaaaalaaa a9aaaazc,aaa6 +KaaaOaaab5aalk,,"aCaaXaacMPaaixaaf9aa""aaaa",a2anJaaapaxya,KaaaOaaab5aalk,,"aCaaXaacMPaaixaaf9aa""aaaa",a2anJaaapaxya,KaaaOaaab5aalk, +ajaaaaaaaK JQaUga8EyCVaaZa,aaaaataaaqaakaaaaaaUD,ynaZaanaaIaaaaaaFUayatZ,Z,ajaaaaaaaK JQaUga8EyCVaaZa,aaaaataaaqaakaaaaaaUD,ynaZaanaaIaaaaaaFUayatZ,Z,ajaaaaaaaK JQaUga8EyCVaaZa,aaaaataaaqaakaaaaaaUD +aaaaaaaafauQaaaIaaa," +akaaaVma,a2aKaaaaawaaa",aaadaaSaLaa,"Caaa 9aaapaamaaa",aaaaaaaafauQaaaIaaa," +akaaaVma,a2aKaaaaawaaa",aaadaaSaLaa,"Caaa 9aaapaamaaa",aaaaaaaafauQaaaIaaa," +akaaaVma,a2aKaaaaawaaa" +"a0iaSLmGaaaatHaa Raayaagaaaa","65bFKad8aLaraaa""aaaaaaGa",aaa,afOaaaqaSanaaaku8bAa,"a0iaSLmGaaaatHaa Raayaagaaaa","65bFKad8aLaraaa""aaaaaaGa",aaa,afOaaaqaSanaaaku8bAa,"a0iaSLmGaaaatHaa Raayaagaaaa","65bFKad8aLaraaa""aaaaaaGa" +"aaaGfaaMa aar a a,,atpwa",aaaSK3gaaaM6Ha,aByaauaaaaaaa," +aa","aaaGfaaMa aar a a,,atpwa",aaaSK3gaaaM6Ha,aByaauaaaaaaa," +aa","aaaGfaaMa aar a a,,atpwa",aaaSK3gaaaM6Ha +NCaaaaa,a8aaTaaUSaa aahaaaaZaaaiaa a,aVa,"Naaa +aXaaap",NCaaaaa,a8aaTaaUSaa aahaaaaZaaaiaa a,aVa,"Naaa +aXaaap",NCaaaaa,a8aaTaaUSaa aahaaaaZaaaiaa a +"uala""aaavasaaPZat""T""aa",aaasMKa 9,aaaaaa,axa,"uala""aaavasaaPZat""T""aa",aaasMKa 9,aaaaaa,axa,"uala""aaavasaaPZat""T""aa",aaasMKa 9 +"aaXaaaaataOaaZa3laja +aamaCaa",gsgzaaerjaayaaaazaaaaaa6N,aaaSa7a,puaaaaaahaaaDaaaaa,"aaXaaaaataOaaZa3laja +aamaCaa",gsgzaaerjaayaaaazaaaaaa6N,aaaSa7a,puaaaaaahaaaDaaaaa,"aaXaaaaataOaaZa3laja +aamaCaa",gsgzaaerjaayaaaazaaaaaa6N +Xa0a,,naaadaaaaaLaavxaawaaoa,"aaaa +aaf",Xa0a,,naaadaaaaaLaavxaawaaoa,"aaaa +aaf",Xa0a, +jUaZadaNal,aaaaaayaaaaRaDaaak,agzaafpepaNaraaaaSBTaaT,"DaaaaaaaVaa4, +a",jUaZadaNal,aaaaaayaaaaRaDaaak,agzaafpepaNaraaaaSBTaaT,"DaaaaaaaVaa4, +a",jUaZadaNal,aaaaaayaaaaRaDaaak +4RvaSaaaamaaaaaaaaaa8aaV,aaaaasaaua6aakagakzaaOaaa,aaaawa36Zaaa2aaaARVua,aaSxaavaaVaBaa ag,4RvaSaaaamaaaaaaaaaa8aaV,aaaaasaaua6aakagakzaaOaaa,aaaawa36Zaaa2aaaARVua,aaSxaavaaVaBaa ag,4RvaSaaaamaaaaaaaaaa8aaV,aaaaasaaua6aakagakzaaOaaa +LXaZTaaaCaaaFaaaa6aa0aazaaaa,79,"arOdxzu aHaa3 aaaanaaaa aaXa",aaaaaaaaaaVaaaaazMaab,LXaZTaaaCaaaFaaaa6aa0aazaaaa,79,"arOdxzu aHaa3 aaaanaaaa aaXa",aaaaaaaaaaVaaaaazMaab,LXaZTaaaCaaaFaaaa6aa0aazaaaa,79 +agaaaaaWaa,C4a,,aaaaxaaQaAaaaaBaaaBaaanaa,agaaaaaWaa,C4a,,aaaaxaaQaAaaaaBaaaBaaanaa,agaaaaaWaa,C4a +aaaa,"NRaaata""ratbCj"," a",aaaaaala,aaaa,"NRaaata""ratbCj"," a",aaaaaala,aaaa,"NRaaata""ratbCj" +,"asaakaaaaalaaaaa aIaaas9",aaValaaaanaQaaaaaaaaaaakaJcF,aaaaGaaamua,,"asaakaaaaalaaaaa aIaaas9",aaValaaaanaQaaaaaaaaaaakaJcF,aaaaGaaamua,,"asaakaaaaalaaaaa aIaaas9" +" ALaath,aqak6FaaQaaaCaaaV",YaKgKaaaafSaaSafa,aaaaFaa aaaVfL8aZaaaa5aXaaXa,"a81uY6aaaEcaaaa4aaraa"" a"," ALaath,aqak6FaaQaaaCaaaV",YaKgKaaaafSaaSafa,aaaaFaa aaaVfL8aZaaaa5aXaaXa,"a81uY6aaaEcaaaa4aaraa"" a"," ALaath,aqak6FaaQaaaCaaaV",YaKgKaaaafSaaSafa +"acaaaDaa +aaQ",aaaajTaat4uah,ZaaZGaaaaILa,a8aLQKaaaaaaL Ea,"acaaaDaa +aaQ",aaaajTaat4uah,ZaaZGaaaaILa,a8aLQKaaaaaaL Ea,"acaaaDaa +aaQ",aaaajTaat4uah +aa,waaaaaataFa4JaLamaaa,a,aaa waaaaaaaayIwaaaa,aa,waaaaaataFa4JaLamaaa,a,aaa waaaaaaaayIwaaaa,aa,waaaaaataFa4JaLamaaa +axaaaaa4asYxaaanaaaaaXYa,taaaaCaaa,"k,","a""aal2baa aakaauaal",axaaaaa4asYxaaanaaaaaXYa,taaaaCaaa,"k,","a""aal2baa aakaauaal",axaaaaa4asYxaaanaaaaaXYa,taaaaCaaa +4aaFaaaaaaasaaapa7,a,aaaxafaaZa964aHOaeE4ata,"aaaaaCafaaaqaPnaaBaaa0ag Ra",4aaFaaaaaaasaaapa7,a,aaaxafaaZa964aHOaeE4ata,"aaaaaCafaaaqaPnaaBaaa0ag Ra",4aaFaaaaaaasaaapa7,a +aarPaaSaaaaaAcAaagaa,"aa0aa waaa","aLaaaa +aaa5Fa9aAaaA62aX 2","4xaaa aa aa9Faaatmqaaaaa",aarPaaSaaaaaAcAaagaa,"aa0aa waaa","aLaaaa +aaa5Fa9aAaaA62aX 2","4xaaa aa aa9Faaatmqaaaaa",aarPaaSaaaaaAcAaagaa,"aa0aa waaa" +av8aaaaaaaaaS aMLKaqzaanaL,"a BuWaaUoa +aIaTaaaaaaPwwa,Kah","""a58qaE0Naaxaaaamao aaaaKZa ",aaacaiaaaaaaaXaaFaaa ,av8aaaaaaaaaS aMLKaqzaanaL,"a BuWaaUoa +aIaTaaaaaaPwwa,Kah","""a58qaE0Naaxaaaamao aaaaKZa ",aaacaiaaaaaaaXaaFaaa ,av8aaaaaaaaaS aMLKaqzaanaL,"a BuWaaUoa +aIaTaaaaaaPwwa,Kah" +m,"b4aaYb""D",faaaaava aah3w aaaaaaa,"a7aaaM""ayaa",m,"b4aaYb""D",faaaaava aah3w aaaaaaa,"a7aaaM""ayaa",m,"b4aaYb""D" +cqZgaaaaaaLahAaaaaa,"ZaCa2aEaFrraSaiaa6""aa",Ea9IsPax,"Sa,afiF a",cqZgaaaaaaLahAaaaaa,"ZaCa2aEaFrraSaiaa6""aa",Ea9IsPax,"Sa,afiF a",cqZgaaaaaaLahAaaaaa,"ZaCa2aEaFrraSaiaa6""aa" +"aaxaOoawaa +a"," +aDa",aFa ayaaFa2aaaaaaaaaaaa,JaNafa aba,"aaxaOoawaa +a"," +aDa",aFa ayaaFa2aaaaaaaaaaaa,JaNafa aba,"aaxaOoawaa +a"," +aDa" +,aaa 7aa aanvO,7aaaaaaZxa,"aeaaaaaiDaxaUaacaaC0a,a",,aaa 7aa aanvO,7aaaaaaZxa,"aeaaaaaiDaxaUaacaaC0a,a",,aaa 7aa aanvO +"aIaaaaaaSaaAaaNaaaaaa9paa,xaaa","aa8akaaaax7daaMaRpD +5aa","aaaaaL,k,aaao r HG BiaaaaKaaa","aaFaaa6unY a7aaSaa8wmaEaa y8a","aIaaaaaaSaaAaaNaaaaaa9paa,xaaa","aa8akaaaax7daaMaRpD +5aa","aaaaaL,k,aaao r HG BiaaaaKaaa","aaFaaa6unY a7aaSaa8wmaEaa y8a","aIaaaaaaSaaAaaNaaaaaa9paa,xaaa","aa8akaaaax7daaMaRpD +5aa" +4aqranAaaaasaaa9akam,naa,aaaa67xaa9,aSa6ab6jnMb2aoa,4aqranAaaaasaaa9akam,naa,aaaa67xaa9,aSa6ab6jnMb2aoa,4aqranAaaaasaaa9akam,naa +a,aaaaqnaaaa,",0aaaaZaaaaga2qaXaaZaaa",aaaaapaYhNaetaaaaOaaaad,a,aaaaqnaaaa,",0aaaaZaaaaga2qaXaaZaaa",aaaaapaYhNaetaaaaOaaaad,a,aaaaqnaaaa +aaapaaaaaEazMaZghaaaIx,a54aga,aaaaoaaaho,"gaaaaa7airPaaaaaaaaa""aaa",aaapaaaaaEazMaZghaaaIx,a54aga,aaaaoaaaho,"gaaaaa7airPaaaaaaaaa""aaa",aaapaaaaaEazMaZghaaaIx,a54aga +Taa,aNaa,am,aEBaaaaX,Taa,aNaa,am,aEBaaaaX,Taa,aNaa + aaqaaaaaVbaHS6aaaa,7aQaaaaraajaa3aaaaga5aaao6,5aXa,aUa, aaqaaaaaVbaHS6aaaa,7aQaaaaraajaa3aaaaga5aaao6,5aXa,aUa, aaqaaaaaVbaHS6aaaa,7aQaaaaraajaa3aaaaga5aaao6 +"jaaaaaaaa1aaunafhaapa +Za","aa,aasPaayaa5aCa",rJaaajaaHamaaaaaWvj,aaThaaQaJaL,"jaaaaaaaa1aaunafhaapa +Za","aa,aasPaayaa5aCa",rJaaajaaHamaaaaaWvj,aaThaaQaJaL,"jaaaaaaaa1aaunafhaapa +Za","aa,aasPaayaa5aCa" +" +maaaawaaa",ap,aadaaaae b3uaa,ae4WQHaBgC," +maaaawaaa",ap,aadaaaae b3uaa,ae4WQHaBgC," +maaaawaaa",ap +"ruaJ auaaVaaaaaaaazaa","ayaaZZa,aaa6 eagq",araaagaaaaqaCdaaaOa aVlaaa7b,9aOaaaa2Uav,"ruaJ auaaVaaaaaaaazaa","ayaaZZa,aaa6 eagq",araaagaaaaqaCdaaaOa aVlaaa7b,9aOaaaa2Uav,"ruaJ auaaVaaaaaaaazaa","ayaaZZa,aaa6 eagq" +aaaQCaaaaabJxaaaea,saZdaay,"Ja7a aaaaa,alyaaS",aRaaaz3aaaJTraNaaaaafa,aaaQCaaaaabJxaaaea,saZdaay,"Ja7a aaaaa,alyaaS",aRaaaz3aaaJTraNaaaaafa,aaaQCaaaaabJxaaaea,saZdaay +"qaaHaaaWQ9J""aNaa2 aaaaaaca",aZ,iaeNaVaSFa6aaDaaaaaXaHaa,w a,"qaaHaaaWQ9J""aNaa2 aaaaaaca",aZ,iaeNaVaSFa6aaDaaaaaXaHaa,w a,"qaaHaaaWQ9J""aNaa2 aaaaaaca",aZ +aaaa0naazakaaaaoazalqIasaGapaB,"avab,aPa28aaaI",aaaaaaaaaeaaaaBikaaaaa," +aa",aaaa0naazakaaaaoazalqIasaGapaB,"avab,aPa28aaaI",aaaaaaaaaeaaaaBikaaaaa," +aa",aaaa0naazakaaaaoazalqIasaGapaB,"avab,aPa28aaaI" +"a +iwrCaaIaaaaa4deHaX",aa,oaeaaaa3avaaaaa,Ma,"a +iwrCaaIaaaaa4deHaX",aa,oaeaaaa3avaaaaa,Ma,"a +iwrCaaIaaaaa4deHaX",aa +aap6a," +aaw RnaaaCZaaaM7a","Xaasaaaiak13nRMaaaa +aav","95Sa +baaaa aa ",aap6a," +aaw RnaaaCZaaaM7a","Xaasaaaiak13nRMaaaa +aav","95Sa +baaaa aa ",aap6a," +aaw RnaaaCZaaaM7a" +aaDaa,XWaja,"Waaaaa,aoaa",4aaazaa6aa,aaDaa,XWaja,"Waaaaa,aoaa",4aaazaa6aa,aaDaa,XWaja +" ,RxNa6Aaa",XaahFWaaaakaqaQa,a4saa6aazaaaagaa8aAq8aa,"YaYataKaraXaSaaaaaa hCaaaPaaaE"," ,RxNa6Aaa",XaahFWaaaakaqaQa,a4saa6aazaaaagaa8aAq8aa,"YaYataKaraXaSaaaaaa hCaaaPaaaE"," ,RxNa6Aaa",XaahFWaaaakaqaQa +"a""",aQa aa4jaaaaaaaagaab9aa,ZuaaAsa,afasaaa2N,"a""",aQa aa4jaaaaaaaagaab9aa,ZuaaAsa,afasaaa2N,"a""",aQa aa4jaaaaaaaagaab9aa +aada3awaaaaaaak6aa,"laaiaaaa +aal +aaaaQaaaa,",vaaaaa0aaaaaawaaaaTaCaaaaa,"aaaaU8 ,aaK",aada3awaaaaaaak6aa,"laaiaaaa +aal +aaaaQaaaa,",vaaaaa0aaaaaawaaaaTaCaaaaa,"aaaaU8 ,aaK",aada3awaaaaaaak6aa,"laaiaaaa +aal +aaaaQaaaa," +,abaaaaaBs9afaaaa,a,aa,,abaaaaaBs9afaaaa,a,aa,,abaaaaaBs9afaaaa +aa2a faa1aa, aaa,aNAQaaa,"agXNG + Na +",aa2a faa1aa, aaa,aNAQaaa,"agXNG + Na +",aa2a faa1aa, aaa +,aEa0,a,aaaaaaa9aaaY,,aEa0,a,aaaaaaa9aaaY,,aEa0 +ava,"FaalaaaOaadaaaaaADa,a6jPaaaa",,naaa0aaacavaXaaaaIadydQa,ava,"FaalaaaOaadaaaaaADa,a6jPaaaa",,naaa0aaacavaXaaaaIadydQa,ava,"FaalaaaOaadaaaaaADa,a6jPaaaa" +5aavaaaa," +aaaaaaaa",aEoa7aaayaaaaz7b4aalaaaoq,uaaaaaaaL,5aavaaaa," +aaaaaaaa",aEoa7aaayaaaaz7b4aalaaaoq,uaaaaaaaL,5aavaaaa," +aaaaaaaa" +"aaXaaaa +aaaaaaaa8aaaaa","aubaagaaaaaaaaaaaaKQjaZKaa4a""",aaaaa,"zEaxa 47aa5aDaJ""ag""aa,aaam","aaXaaaa +aaaaaaaa8aaaaa","aubaagaaaaaaaaaaaaKQjaZKaa4a""",aaaaa,"zEaxa 47aa5aDaJ""ag""aa,aaam","aaXaaaa +aaaaaaaa8aaaaa","aubaagaaaaaaaaaaaaKQjaZKaa4a""" +aajaaaF4aZDaagaaGa1a5aaaaa,aasaalaUzm,aaaaeaaaa,aa1aaaakcaP,aajaaaF4aZDaagaaGa1a5aaaaa,aasaalaUzm,aaaaeaaaa,aa1aaaakcaP,aajaaaF4aZDaagaaGa1a5aaaaa,aasaalaUzm +aaa5Daaaaab,aVaaaabaavOaayFkJ3a,nIGaaR3TpZaKaaI,"jyaRJR,8aacp",aaa5Daaaaab,aVaaaabaavOaayFkJ3a,nIGaaR3TpZaKaaI,"jyaRJR,8aacp",aaa5Daaaaab,aVaaaabaavOaayFkJ3a +auaaMaoaea,snga 4a,JaaaajwaaaaCaaaaaacbaht,FaaaaaMaaOaZaaaaaMacaaa,auaaMaoaea,snga 4a,JaaaajwaaaaCaaaaaacbaht,FaaaaaMaaOaZaaaaaMacaaa,auaaMaoaea,snga 4a +aaaa4,6Zaaaavapa,saOaaa26aaaaaWkaoYwaaaaa,aaaaAaaaaa,aaaa4,6Zaaaavapa,saOaaa26aaaaaWkaoYwaaaaa,aaaaAaaaaa,aaaa4,6Zaaaavapa +1daaaaaXlP,aaAaaaMalaa7avyaaaa6a, anataa9ga v Faalagba ,lar9aUazSa,1daaaaaXlP,aaAaaaMalaa7avyaaaa6a, anataa9ga v Faalagba ,lar9aUazSa,1daaaaaXlP,aaAaaaMalaa7avyaaaa6a +0yUaa6a,GagaaCiaabaa,va,aaPamlOaaav2apG,0yUaa6a,GagaaCiaabaa,va,aaPamlOaaav2apG,0yUaa6a,GagaaCiaabaa +Taaaaaaa1aDa,,Zaa7YA4a2Waaa, aaaataiaV,Taaaaaaa1aDa,,Zaa7YA4a2Waaa, aaaataiaV,Taaaaaaa1aDa, +aZwayaaaaaaaaaaaaaa4 aaTaa,aaayaa,7aauTRyaaaeaTatSaaJaaaaOaaaaaa,aNac4aBwobxa ,aZwayaaaaaaaaaaaaaa4 aaTaa,aaayaa,7aauTRyaaaeaTatSaaJaaaaOaaaaaa,aNac4aBwobxa ,aZwayaaaaaaaaaaaaaa4 aaTaa,aaayaa +"aPaOaaaG4janMaaWaawaMFaab ama","Kaa xa",Aabaaaaa6DaaaviaaaOaaZaa4aaa,aaa aaaaaa,"aPaOaaaG4janMaaWaawaMFaab ama","Kaa xa",Aabaaaaa6DaaaviaaaOaaZaa4aaa,aaa aaaaaa,"aPaOaaaG4janMaaWaawaMFaab ama","Kaa xa" +"YaQaag caaaaa","aamala +afaaaALjaaa9a",ISaaaasaaaaa,abad7,"YaQaag caaaaa","aamala +afaaaALjaaa9a",ISaaaasaaaaa,abad7,"YaQaag caaaaa","aamala +afaaaALjaaa9a" +"uX Paa7aaKa9IbaaCa5",Fajaaqiaaaaaaaaaa,aak GaarT,"aaAaaaaaZaaws,aaaa","uX Paa7aaKa9IbaaCa5",Fajaaqiaaaaaaaaaa,aak GaarT,"aaAaaaaaZaaws,aaaa","uX Paa7aaKa9IbaaCa5",Fajaaqiaaaaaaaaaa +oaaaa9a0afaam,"U ",aa8uaaaaaM2a3GaaPaaaDf2nRaaa,asKvaEaaUParnHtaHEa,oaaaa9a0afaam,"U ",aa8uaaaaaM2a3GaaPaaaDf2nRaaa,asKvaEaaUParnHtaHEa,oaaaa9a0afaam,"U " +,aaeaaa71uf5aajaa a4a3t8a,"a +a aaaaaaaaaaa",vaaaaaaaaeaapaaayaaa,,aaeaaa71uf5aajaa a4a3t8a,"a +a aaaaaaaaaaa",vaaaaaaaaeaapaaayaaa,,aaeaaa71uf5aajaa a4a3t8a +5a8aAaaaxdaaa aZa,"Baa a8aaaasraaaa +taaa",aMaadFaaaaaaaaa,aab1aaaaaVNaaataaCaaaaa,5a8aAaaaxdaaa aZa,"Baa a8aaaasraaaa +taaa",aMaadFaaaaaaaaa,aab1aaaaaVNaaataaCaaaaa,5a8aAaaaxdaaa aZa,"Baa a8aaaasraaaa +taaa" +aaaaWaaaaan,2aaaaaZaaaaovaaaq,caaaUdawjab,t,aaaaWaaaaan,2aaaaaZaaaaovaaaq,caaaUdawjab,t,aaaaWaaaaan,2aaaaaZaaaaovaaaq +aa94avaaa3XaaaaRAaaaAaWNay,a,aajapFSaaal8IaaaYa,aoaasP5aaaafIaaaaaaay8ayTaa,aa94avaaa3XaaaaRAaaaAaWNay,a,aajapFSaaal8IaaaYa,aoaasP5aaaafIaaaaaaay8ayTaa,aa94avaaa3XaaaaRAaaaAaWNay,a +aaaa6aM5aGa aZaaaaaaaaaaaaN,0aY5aW,"aaa +5aaP",aaaaHaNaaaaaaaaaaaaRaaXaa,aaaa6aM5aGa aZaaaaaaaaaaaaN,0aY5aW,"aaa +5aaP",aaaaHaNaaaaaaaaaaaaRaaXaa,aaaa6aM5aGa aZaaaaaaaaaaaaN,0aY5aW +nmuau7afhdVaaaaa a,zaWa5acaKaaaaaaaaa6aPl,aaIaaaa,paaVaaiWPxNaaaa,nmuau7afhdVaaaaa a,zaWa5acaKaaaaaaaaa6aPl,aaIaaaa,paaVaaiWPxNaaaa,nmuau7afhdVaaaaa a,zaWa5acaKaaaaaaaaa6aPl +aataaa,aaUy5a8aakfa,alaaa0azaa,"aa6aNIaaLaao""aaeBa",aataaa,aaUy5a8aakfa,alaaa0azaa,"aa6aNIaaLaao""aaeBa",aataaa,aaUy5a8aakfa +aPaaaaaaaraRaaJFdda,"IaaaogaaaPaY7aaaDa +aaawaaIaL ",a4aXa,aa0aZa6aaaaaaaa2aa,aPaaaaaaaraRaaJFdda,"IaaaogaaaPaY7aaaDa +aaawaaIaL ",a4aXa,aa0aZa6aaaaaaaa2aa,aPaaaaaaaraRaaJFdda,"IaaaogaaaPaY7aaaDa +aaawaaIaL " +aasaRCSoaaCNamaa,aa8t,a2aava8aa,aaDaXaaa8aeaallcaaaaaaaaC,aasaRCSoaaCNamaa,aa8t,a2aava8aa,aaDaXaaa8aeaallcaaaaaaaaC,aasaRCSoaaCNamaa,aa8t +aaaa5,"CagaaGa tasWZEaaaaaaYaXZ,a",aQFaaavka6aaMa4aa,aaaaaaaaaa,aaaa5,"CagaaGa tasWZEaaaaaaYaXZ,a",aQFaaavka6aaMa4aa,aaaaaaaaaa,aaaa5,"CagaaGa tasWZEaaaaaaYaXZ,a" +AaaBaa aa,aaa,aaOaa5aMla,jaNaama0aXaaaaamVl7aa,AaaBaa aa,aaa,aaOaa5aMla,jaNaama0aXaaaaamVl7aa,AaaBaa aa,aaa +5aRa,7aafaaaaaxaaaaaN,"aaa aajaoaaaaagYWa6a ",haaaVmaa4aba6aaaaapaafaamaa,5aRa,7aafaaaaaxaaaaaN,"aaa aajaoaaaaagYWa6a ",haaaVmaa4aba6aaaaapaafaamaa,5aRa,7aafaaaaaxaaaaaN +aanaaaUhaaaaa1TpAwv,"fscaaaaa +","vaauaY amaQa0aaaaaa laqaa"" ",aFaaxaMWaaauaEaahhaaqa,aanaaaUhaaaaa1TpAwv,"fscaaaaa +","vaauaY amaQa0aaaaaa laqaa"" ",aFaaxaMWaaauaEaahhaaqa,aanaaaUhaaaaa1TpAwv,"fscaaaaa +" +aaa9,aaaaaYoaai,aaapaaabaWpnUUaaaac,ZAaaaaKavayhfgaSaa,aaa9,aaaaaYoaai,aaapaaabaWpnUUaaaac,ZAaaaaKavayhfgaSaa,aaa9,aaaaaYoaai +aaEaa a0aaamaaaaxa2aa,"aaaasalag a +CaaRauaga aaaa","aPaaaaOa,a F +aaa7","Waa 3aaaaaadaaalGvxaa",aaEaa a0aaamaaaaxa2aa,"aaaasalag a +CaaRauaga aaaa","aPaaaaOa,a F +aaa7","Waa 3aaaaaadaaalGvxaa",aaEaa a0aaamaaaaxa2aa,"aaaasalag a +CaaRauaga aaaa" +raaaaaam2aaa,Zaaaa Oa8apXaRbkyaat,QCPaq,aaa1Mmaa,raaaaaam2aaa,Zaaaa Oa8apXaRbkyaat,QCPaq,aaa1Mmaa,raaaaaam2aaa,Zaaaa Oa8apXaRbkyaat +za5Iawoaaaaa9Taa39Y3,BhoaSaaaQVHSa41aaa,aaIaaaaaaaAaxLa,aDnKxaaaa5aaaDaaaaaaMaaEaF,za5Iawoaaaaa9Taa39Y3,BhoaSaaaQVHSa41aaa,aaIaaaaaaaAaxLa,aDnKxaaaa5aaaDaaaaaaMaaEaF,za5Iawoaaaaa9Taa39Y3,BhoaSaaaQVHSa41aaa +"raVaaaB,",NHhaaafAYnaaNazJaaaf2aaa2baaaP,"JyaaoaaAaap""aaqaozB",C9aApaaCaaaa0RaDaaHa5amaadR D,"raVaaaB,",NHhaaafAYnaaNazJaaaf2aaa2baaaP,"JyaaoaaAaap""aaqaozB",C9aApaaCaaaa0RaDaaHa5amaadR D,"raVaaaB,",NHhaaafAYnaaNazJaaaf2aaa2baaaP +aSc8aEata,"aaaaa,a4",jaaaaaa,a aaaaaaua07A,aSc8aEata,"aaaaa,a4",jaaaaaa,a aaaaaaua07A,aSc8aEata,"aaaaa,a4" +a1fa,tata4,ayVaGaFayaaaaaaaa,BaMSaaaKFMauaaaa,a1fa,tata4,ayVaGaFayaaaaaaaa,BaMSaaaKFMauaaaa,a1fa,tata4 +"ajaCaaaBNaa""aaDYazkAa",aaaaaa,aaYatOHaaw,aa,"ajaCaaaBNaa""aaDYazkAa",aaaaaa,aaYatOHaaw,aa,"ajaCaaaBNaa""aaDYazkAa",aaaaaa + aaaa,aaasaaaaCaa3aT8aaaUpaA4fabaaeE,"aaaaaQYYca9aai +ajaaaaNfa",aPa8yEaaa , aaaa,aaasaaaaCaa3aT8aaaUpaA4fabaaeE,"aaaaaQYYca9aai +ajaaaaNfa",aPa8yEaaa , aaaa,aaasaaaaCaa3aT8aaaUpaA4fabaaeE +anaWysaaakNaaKaT6aaaaPba,aa,"zmaVa aaJax aaNAaIa FayayY",aaZaaaaaaaOHaWaaaFaaaaaaaaaa,anaWysaaakNaaKaT6aaaaPba,aa,"zmaVa aaJax aaNAaIa FayayY",aaZaaaaaaaOHaWaaaFaaaaaaaaaa,anaWysaaakNaaKaT6aaaaPba,aa +aaah69aaawaj aEawaaAaaaaaaDgaa,aaa7aN,"aa awa0aaaaga,aF1a""Kaaaajsa","Sh6aBMao,yaa,aaaXaamaaL5P",aaah69aaawaj aEawaaAaaaaaaDgaa,aaa7aN,"aa awa0aaaaga,aF1a""Kaaaajsa","Sh6aBMao,yaa,aaaXaamaaL5P",aaah69aaawaj aEawaaAaaaaaaDgaa,aaa7aN +agal,"aaaaaaa aa2a",aa9 aaaq2aaaaaaakapaaaKGaaaa,"HBaoaejaaa aXaG",agal,"aaaaaaa aa2a",aa9 aaaq2aaaaaaakapaaaKGaaaa,"HBaoaejaaa aXaG",agal,"aaaaaaa aa2a" +daaETXazGanaGaaaaQaaaaNNi,adTaaKNa4aHaafawajaLaaAaa,"aEa WaaaaaA aanaajaaaas",Ckkaa2 aaaaaaaYM afKaMaOaaaaRs,daaETXazGanaGaaaaQaaaaNNi,adTaaKNa4aHaafawajaLaaAaa,"aEa WaaaaaA aanaajaaaas",Ckkaa2 aaaaaaaYM afKaMaOaaaaRs,daaETXazGanaGaaaaQaaaaNNi,adTaaKNa4aHaafawajaLaaAaa +ZoaaaFlaaaDaaaaaaDa95 a2aaan,apFaakaJwavaqaaa0aVaLaa1Qa,aaaaiaaaaaa1aaaqad,3j TaaGa,ZoaaaFlaaaDaaaaaaDa95 a2aaan,apFaakaJwavaqaaa0aVaLaa1Qa,aaaaiaaaaaa1aaaqad,3j TaaGa,ZoaaaFlaaaDaaaaaaDa95 a2aaan,apFaakaJwavaqaaa0aVaLaa1Qa +"aaaaa +",aaaa Xaaaaa,waaTad8,ahaaaaaa,"aaaaa +",aaaa Xaaaaa,waaTad8,ahaaaaaa,"aaaaa +",aaaa Xaaaaa +Saa5axaaaaa9aaaoaELayaaa,"ak +ahta6aBamF +aaahaE","aaaa6aa Zba",aaa,Saa5axaaaaa9aaaoaELayaaa,"ak +ahta6aBamF +aaahaE","aaaa6aa Zba",aaa,Saa5axaaaaa9aaaoaELayaaa,"ak +ahta6aBamF +aaahaE" +TAaaaaaaaO,taPaa2aaa aqaaaYar8aaa,aaaaracaBMa74aaaaa,ta3RUaUhxaHaaajfaALya,TAaaaaaaaO,taPaa2aaa aqaaaYar8aaa,aaaaracaBMa74aaaaa,ta3RUaUhxaHaaajfaALya,TAaaaaaaaO,taPaa2aaa aqaaaYar8aaa +aOa0aBaaaja8aR,ayaaaaaaa,aaaaE5haW6Taaaa aaa aaaPaT95ya,aaNaa,aOa0aBaaaja8aR,ayaaaaaaa,aaaaE5haW6Taaaa aaa aaaPaT95ya,aaNaa,aOa0aBaaaja8aR,ayaaaaaaa +aaPaaaaaNZZaoa2MqZaaaa,aaa3aa8avakaa3aNaagLDYr,aUaaaEaaa1HYaaaaXaazaaUaaaama," +aMaaa7aax8aaaaSaaJh4aaHua",aaPaaaaaNZZaoa2MqZaaaa,aaa3aa8avakaa3aNaagLDYr,aUaaaEaaa1HYaaaaXaazaaUaaaama," +aMaaa7aax8aaaaSaaJh4aaHua",aaPaaaaaNZZaoa2MqZaaaa,aaa3aa8avakaa3aNaagLDYr +aaaataaTaaaUdaa1Laaa,laDHlaaaabXIlqa4aaaa,aagraaOaaahaa8aa2aRa,Pacfaaaaa8aaaaaUaa,aaaataaTaaaUdaa1Laaa,laDHlaaaabXIlqa4aaaa,aagraaOaaahaa8aa2aRa,Pacfaaaaa8aaaaaUaa,aaaataaTaaaUdaa1Laaa,laDHlaaaabXIlqa4aaaa +aUar,arlaaaWavXaaTgaa4ea aaa1aaL,,aaaanpaaIRaaRaa0aaLaaaaaaOa,aUar,arlaaaWavXaaTgaa4ea aaa1aaL,,aaaanpaaIRaaRaa0aaLaaaaaaOa,aUar,arlaaaWavXaaTgaa4ea aaa1aaL +,aGaaRaaaw8aa,aaniYEu haaaaaaafaaaaaav,aaaaaahUaa6aaqPxWaaaCa7aaaaaa,,aGaaRaaaw8aa,aaniYEu haaaaaaafaaaaaav,aaaaaahUaa6aaqPxWaaaCa7aaaaaa,,aGaaRaaaw8aa +"aHwaa""gIaafIM5eaaaUaaavraF",uaa9aa Jaaaj6aaaEaa,"a,piaa8",8aaaacaaa,"aHwaa""gIaafIM5eaaaUaaavraF",uaa9aa Jaaaj6aaaEaa,"a,piaa8",8aaaacaaa,"aHwaa""gIaafIM5eaaaUaaavraF",uaa9aa Jaaaj6aaaEaa +aazaafaaaaalL,raaaaaM,aaaFda," aa +6SaaEaaaal +",aazaafaaaaalL,raaaaaM,aaaFda," aa +6SaaEaaaal +",aazaafaaaaalL,raaaaaM +"aCaTFRaagaaVaaPaa aa",akaaYhw3awaTahaaaaFaaaajaaQS,aaapamaaCWV2aa0da,"aHnJaaas,aaaVaaaa0aaaaua","aCaTFRaagaaVaaPaa aa",akaaYhw3awaTahaaaaFaaaajaaQS,aaapamaaCWV2aa0da,"aHnJaaas,aaaVaaaa0aaaaua","aCaTFRaagaaVaaPaa aa",akaaYhw3awaTahaaaaFaaaajaaQS +"6aUaaCaaaa""aAW","a6aaIaaaaaa0a +aaaAaaaaSaP6aaaa",aadaa0aaHaaPaaZaa9Iaaaa,"ikaU9aHaaaa aaCaRCNaa","6aUaaCaaaa""aAW","a6aaIaaaaaa0a +aaaAaaaaSaP6aaaa",aadaa0aaHaaPaaZaa9Iaaaa,"ikaU9aHaaaa aaCaRCNaa","6aUaaCaaaa""aAW","a6aaIaaaaaa0a +aaaAaaaaSaP6aaaa" +"r""aaa7a",aa8axaaaaj0laaraZa,"a2a,XaAAY,aE4amPaa",aa5Xaa,"r""aaa7a",aa8axaaaaj0laaraZa,"a2a,XaAAY,aE4amPaa",aa5Xaa,"r""aaa7a",aa8axaaaaj0laaraZa +aaataaaK,I4aaVaEoaaaaaao4aaa,"aa 0aaw0EeaM",aaaaqU,aaataaaK,I4aaVaEoaaaaaao4aaa,"aa 0aaw0EeaM",aaaaqU,aaataaaK,I4aaVaEoaaaaaao4aaa +UDgaa,aava0aadaakpaTZaaiaYaaaaaaa,vaFaaaEv5aa,"5faaaaFa8aHaaDaT 0qc 6aIN5",UDgaa,aava0aadaakpaTZaaiaYaaaaaaa,vaFaaaEv5aa,"5faaaaFa8aHaaDaT 0qc 6aIN5",UDgaa,aava0aadaakpaTZaaiaYaaaaaaa +yaaaai0aaapaaXabcaafTuara,"anQVMaiaa aaa aaaaaaaJanaa",IaaaaFrGaeaIraa,"aba0a8""laa",yaaaai0aaapaaXabcaafTuara,"anQVMaiaa aaa aaaaaaaJanaa",IaaaaFrGaeaIraa,"aba0a8""laa",yaaaai0aaapaaXabcaafTuara,"anQVMaiaa aaa aaaaaaaJanaa" +raaaIxara2awaagkaaa0aaaFavaJa,xCauaaaaaaOamaaaaaaa,BGxVapaaaAakvoCaJWaaaCaaiaaac,aaaAabxa a9qUaRa6ukaaZaa,raaaIxara2awaagkaaa0aaaFavaJa,xCauaaaaaaOamaaaaaaa,BGxVapaaaAakvoCaJWaaaCaaiaaac,aaaAabxa a9qUaRa6ukaaZaa,raaaIxara2awaagkaaa0aaaFavaJa,xCauaaaaaaOamaaaaaaa +aaaaaSa1aaaaaaaOa,aVaaa,"aqaaarfaaKa +aaXaaaaa98aaar",r6hRaaaaOaaaaCaaaaaaaaa,aaaaaSa1aaaaaaaOa,aVaaa,"aqaaarfaaKa +aaXaaaaa98aaar",r6hRaaaaOaaaaCaaaaaaaaa,aaaaaSa1aaaaaaaOa,aVaaa +aa,l,ra,a,aa,l,ra,a,aa,l +"eaaaaaaT7aaoazaaaa3 +aa",Ba5Ky3agaAacaa," falGaaSaaaaa +a",aaTa5aiXj1aaxaa,"eaaaaaaT7aaoazaaaa3 +aa",Ba5Ky3agaAacaa," falGaaSaaaaa +a",aaTa5aiXj1aaxaa,"eaaaaaaT7aaoazaaaa3 +aa",Ba5Ky3agaAacaa +"aaaaGaOaKaaya aaaaaaaaa ",aaak19a9aHaaaaaaB,"aaMO Ha0asNa",aXy,"aaaaGaOaKaaya aaaaaaaaa ",aaak19a9aHaaaaaaB,"aaMO Ha0asNa",aXy,"aaaaGaOaKaaya aaaaaaaaa ",aaak19a9aHaaaaaaB +aaaqaaeaat,,WFafaaaJYuaaaarSaU7aaRkLaFKaa,"aaaaaaaa0EXiaaaaava,",aaaqaaeaat,,WFafaaaJYuaaaarSaU7aaRkLaFKaa,"aaaaaaaa0EXiaaaaava,",aaaqaaeaat, +"aaaaaaLXx""a1pVaaa +f","DaaaQaaaaaaaatMajaAagaaaaaa,xa",aaaaQa9aaaaaa,aaaWEcjaaazaazVaaaaaaa,"aaaaaaLXx""a1pVaaa +f","DaaaQaaaaaaaatMajaAagaaaaaa,xa",aaaaQa9aaaaaa,aaaWEcjaaazaazVaaaaaaa,"aaaaaaLXx""a1pVaaa +f","DaaaQaaaaaaaatMajaAagaaaaaa,xa" +aaaQaaRaa2a9ayPaoNaaaoaaaa2am,a aaaaaQqaaaaaBa8oaa,PwfraaaaaaoaaaaaU4aVaaaahaaHaa,aPYaaaiaaAnaaa,aaaQaaRaa2a9ayPaoNaaaoaaaa2am,a aaaaaQqaaaaaBa8oaa,PwfraaaaaaoaaaaaU4aVaaaahaaHaa,aPYaaaiaaAnaaa,aaaQaaRaa2a9ayPaoNaaaoaaaa2am,a aaaaaQqaaaaaBa8oaa +aaaa6aaaMaacal7aaaaJaaaauPVaa,aZqlaabaagSNaa1P aaaaaafCaaata,aaAaaaalaa,aMyeaaanaaa0aMa,aaaa6aaaMaacal7aaaaJaaaauPVaa,aZqlaabaagSNaa1P aaaaaafCaaata,aaAaaaalaa,aMyeaaanaaa0aMa,aaaa6aaaMaacal7aaaaJaaaauPVaa,aZqlaabaagSNaa1P aaaaaafCaaata +Taaavusaaa9aara,aOaDaFa1aVaaa3az etagMEaayaa,aaa,aaZyHak6aaaaaHeaIaaaa5aa,Taaavusaaa9aara,aOaDaFa1aVaaa3az etagMEaayaa,aaa,aaZyHak6aaaaaHeaIaaaa5aa,Taaavusaaa9aara,aOaDaFa1aVaaa3az etagMEaayaa +a8a,aaaaaoaa aQipaaaaxa,,"aaavaauaaaaaHa4mAaaaJaqaaaza,a",a8a,aaaaaoaa aQipaaaaxa,,"aaavaauaaaaaHa4mAaaaJaqaaaza,a",a8a,aaaaaoaa aQipaaaaxa +aJa52aaYaHaaaaaqaasRaataaNaa,a1aKqaa,"aCaausbaaaNa0aVaaa""",aaaSPaaawaa,aJa52aaYaHaaaaaqaasRaataaNaa,a1aKqaa,"aCaausbaaaNa0aVaaa""",aaaSPaaawaa,aJa52aaYaHaaaaaqaasRaataaNaa,a1aKqaa +TN,aqnaaaaaaBaaa,aaLaaxaasaHQuaaylGpWia,aaaEaaZaa45ahaaaT ,TN,aqnaaaaaaBaaa,aaLaaxaasaHQuaaylGpWia,aaaEaaZaa45ahaaaT ,TN,aqnaaaaaaBaaa +"aaaaaaFTB,9aaaaaaaGeaaaaaa",aaaaaL5kNpa,"aSaQlaaGF +Xav",zaa4ha6Oa40Wuaaa,"aaaaaaFTB,9aaaaaaaGeaaaaaa",aaaaaL5kNpa,"aSaQlaaGF +Xav",zaa4ha6Oa40Wuaaa,"aaaaaaFTB,9aaaaaaaGeaaaaaa",aaaaaL5kNpa +axaI7aaOaaaIaaMZa,aajlafaaaa,aZaVaP5daaazwaRaa,aaaaarH,axaI7aaOaaaIaaMZa,aajlafaaaa,aZaVaP5daaazwaRaa,aaaaarH,axaI7aaOaaaIaaMZa,aajlafaaaa +taaa aaE,aya5aaaaWafaaaaawafa0aFKaCa aK,Ia3aaagaaaa62a0aaAisqaaL,"aaaa2u9ana6aaaa +aaa",taaa aaE,aya5aaaaWafaaaaawafa0aFKaCa aK,Ia3aaagaaaa62a0aaAisqaaL,"aaaa2u9ana6aaaa +aaa",taaa aaE,aya5aaaaWafaaaaawafa0aFKaCa aK +aaasaauO,aDFaa,aulaaaakaaaaaa,"""aaavabgaaq5",aaasaauO,aDFaa,aulaaaakaaaaaa,"""aaavabgaaq5",aaasaauO,aDFaa +aaaDaMaaa,TadaaaataaaawXaDapaaaaaazMaa,a,"aaaajaaa9OaAaaa4 +Oaaaaa",aaaDaMaaa,TadaaaataaaawXaDapaaaaaazMaa,a,"aaaajaaa9OaAaaa4 +Oaaaaa",aaaDaMaaa,TadaaaataaaawXaDapaaaaaazMaa +"amaa0aUcaaExaxaa,aNaaa1aGaaaK",x6aWaaaaGaaa,aixtaaananaawaaa1aQaOoxaa,"ac aaaaa4ba","amaa0aUcaaExaxaa,aNaaa1aGaaaK",x6aWaaaaGaaa,aixtaaananaawaaa1aQaOoxaa,"ac aaaaa4ba","amaa0aUcaaExaxaa,aNaaa1aGaaaK",x6aWaaaaGaaa +aoaaayaaae,,"aaa2 aBaa5ot3Caac8jafaaiaaaaRh","ga aLaZaaaQa",aoaaayaaae,,"aaa2 aBaa5ot3Caac8jafaaiaaaaRh","ga aLaZaaaQa",aoaaayaaae, +aP,Xaaaaawa,"aYa91aaU,3aaat c",taaYaah1Hazaaaa3pOTBaaaaiaaaj,aP,Xaaaaawa,"aYa91aaU,3aaat c",taaYaah1Hazaaaa3pOTBaaaaiaaaj,aP,Xaaaaawa +aaoXaa,my8fT,"Taaab6y tHaa +abaQDaaga","aaRV""arkawTak4NWala8",aaoXaa,my8fT,"Taaab6y tHaa +abaQDaaga","aaRV""arkawTak4NWala8",aaoXaa,my8fT +GaaZZaaaaaa,W,aaDaahaa4aaaOa,"a,aopQaaQaD",GaaZZaaaaaa,W,aaDaahaa4aaaOa,"a,aopQaaQaD",GaaZZaaaaaa,W +"aNawcaaaaa aS3C2aaSa,aaaa","aYaQaa,aHaaa",,aaCPU XaaaaYl,"aNawcaaaaa aS3C2aaSa,aaaa","aYaQaa,aHaaa",,aaCPU XaaaaYl,"aNawcaaaaa aS3C2aaSa,aaaa","aYaQaa,aHaaa" +" gabaaaaah",aa 3aad,"hxaaiv +Pa",aaaUaIaaaaaaaaaln aa," gabaaaaah",aa 3aad,"hxaaiv +Pa",aaaUaIaaaaaaaaaln aa," gabaaaaah",aa 3aad +"aa,1aaaaaaaapaaua ",adaaapaannmR0aasaPaaaaayaaaax,aaaaarh0ataXn,"aaaaYaaNRraaauaazFaNaaa""zaaQ","aa,1aaaaaaaapaaua ",adaaapaannmR0aasaPaaaaayaaaax,aaaaarh0ataXn,"aaaaYaaNRraaauaazFaNaaa""zaaQ","aa,1aaaaaaaapaaua ",adaaapaannmR0aasaPaaaaayaaaax +aaa,"Awaa aV7scaaatOaIaaa","af3h93Ead""aaaa,",awYYmaaaaaaaaaa,aaa,"Awaa aV7scaaatOaIaaa","af3h93Ead""aaaa,",awYYmaaaaaaaaaa,aaa,"Awaa aV7scaaatOaIaaa" +9aaaaa0aGaaaa,"""afaea 1 aaaRaaaiaaaa",asa,aataEaaarakgaaaaaaaaaa ak,9aaaaa0aGaaaa,"""afaea 1 aaaRaaaiaaaa",asa,aataEaaarakgaaaaaaaaaa ak,9aaaaa0aGaaaa,"""afaea 1 aaaRaaaiaaaa" +aaaaIPaaataaqaaOaMauaH,"caLH4aaaanaacaaaaax,qadaG",ahaaOahaaZaVaaRa,aHa,aaaaIPaaataaqaaOaMauaH,"caLH4aaaanaacaaaaax,qadaG",ahaaOahaaZaVaaRa,aHa,aaaaIPaaataaqaaOaMauaH,"caLH4aaaanaacaaaaax,qadaG" +aWaTapaapR4Laaa,jaeaYaaaaaa7caaavaaWaKaaaa,aaOLm," +a",aWaTapaapR4Laaa,jaeaYaaaaaa7caaavaaWaKaaaa,aaOLm," +a",aWaTapaapR4Laaa,jaeaYaaaaaa7caaavaaWaKaaaa +az21aaaaaaa,larassaFaeaaagaZEaFObl2ayAE,Mybawxaa,aaQ aCaaawa,az21aaaaaaa,larassaFaeaaagaZEaFObl2ayAE,Mybawxaa,aaQ aCaaawa,az21aaaaaaa,larassaFaeaaagaZEaFObl2ayAE +,"aarta""",aa,"aaJaE6aa""aaaaKaoaaaaaataaaaP",,"aarta""",aa,"aaJaE6aa""aaaaKaoaaaaaataaaaP",,"aarta""" +aaaaaaa,akEJaaMafgaaduK3a a,aza8aHahaaaKaaCa aa,aaaaaauQ,aaaaaaa,akEJaaMafgaaduK3a a,aza8aHahaaaKaaCa aa,aaaaaauQ,aaaaaaa,akEJaaMafgaaduK3a a +acYaahaan9Laaa,aaaaaaao,altaq2aa,aaaUaaaaaIaaauYaaxaaaa,acYaahaan9Laaa,aaaaaaao,altaq2aa,aaaUaaaaaIaaauYaaxaaaa,acYaahaan9Laaa,aaaaaaao +"arHQaNaaC a","5Laa""Haa",Oaaa,aUaVaHaaaaaaaadaasZH ayaaaaJa,"arHQaNaaC a","5Laa""Haa",Oaaa,aUaVaHaaaaaaaadaasZH ayaaaaJa,"arHQaNaaC a","5Laa""Haa" +a JaaLm,"jafaXahKaaa +haaaaYa",Maa4aaaaa,aaaaa,a JaaLm,"jafaXahKaaa +haaaaYa",Maa4aaaaa,aaaaa,a JaaLm,"jafaXahKaaa +haaaaYa" +"aalaxzaYaaa9aaaFa""a5CRaqaaaaMa",asCaxe,auf,"5aaC +D4aa Uaa","aalaxzaYaaa9aaaFa""a5CRaqaaaaMa",asCaxe,auf,"5aaC +D4aa Uaa","aalaxzaYaaa9aaaFa""a5CRaqaaaaMa",asCaxe +aaaaaaaaaa6QaiV,aako6CaaKaaaQaeaaazoaaNiPBaaa,"aaaaa,EBPka7aaaaI +aa6a",6 05akVa6aaaiaFaaaaa5aaXaaaaaa,aaaaaaaaaa6QaiV,aako6CaaKaaaQaeaaazoaaNiPBaaa,"aaaaa,EBPka7aaaaI +aa6a",6 05akVa6aaaiaFaaaaa5aaXaaaaaa,aaaaaaaaaa6QaiV,aako6CaaKaaaQaeaaazoaaNiPBaaa +agfaqaba,a,atBa," ""FaaaaEaaaSaaEaaaaada",agfaqaba,a,atBa," ""FaaaaEaaaSaaEaaaaada",agfaqaba,a +sajaaPajaakaadea1aah7aaK2iYJ,aUeaaapaaaaWaaaSbJaaajagf,"aaaaazaa a1aaDGa5aeaya Da","KGaaZaa aaaaaaaan",sajaaPajaakaadea1aah7aaK2iYJ,aUeaaapaaaaWaaaSbJaaajagf,"aaaaazaa a1aaDGa5aeaya Da","KGaaZaa aaaaaaaan",sajaaPajaakaadea1aah7aaK2iYJ,aUeaaapaaaaWaaaSbJaaajagf +aM47AaaNZa,aaaaalaa,acaaaa4a,aaaaD,aM47AaaNZa,aaaaalaa,acaaaa4a,aaaaD,aM47AaaNZa,aaaaalaa +aaaaFaaaWaaaaa,QaawPaaaOaaaYaaa,"apaaaD""l6akTaSada +3a","J""hmva7aayaaaaGva",aaaaFaaaWaaaaa,QaawPaaaOaaaYaaa,"apaaaD""l6akTaSada +3a","J""hmva7aayaaaaGva",aaaaFaaaWaaaaa,QaawPaaaOaaaYaaa +3aa,aaaaaJWCaKa,"aaaIaaazzaafcKaaaa3aa,aaiarjaB",axaaGaEsajjbataY7huaaa,3aa,aaaaaJWCaKa,"aaaIaaazzaafcKaaaa3aa,aaiarjaB",axaaGaEsajjbataY7huaaa,3aa,aaaaaJWCaKa +aOaxB,aaaaRa9aaaa1maaaIa6,a,aaaaaa2,aOaxB,aaaaRa9aaaa1maaaIa6,a,aaaaaa2,aOaxB,aaaaRa9aaaa1maaaIa6 +"aadJaaaKaUMtaaa,aaD aaa +Baaaaa",aaaaaa1Ua,"aaaataaPDHaa aWa""aataaaaa",TaIa,"aadJaaaKaUMtaaa,aaD aaa +Baaaaa",aaaaaa1Ua,"aaaataaPDHaa aWa""aataaaaa",TaIa,"aadJaaaKaUMtaaa,aaD aaa +Baaaaa",aaaaaa1Ua +aqa,t9aZaaaa58axaaeqaaQaFaeZ,aaSBa aUaaaXaaaa,"a2Zaaaa,UaOaaaaaaaaaao0aa,F ",aqa,t9aZaaaa58axaaeqaaQaFaeZ,aaSBa aUaaaXaaaa,"a2Zaaaa,UaOaaaaaaaaaao0aa,F ",aqa,t9aZaaaa58axaaeqaaQaFaeZ +ya4aaQamazhv,a6,aaajaRaaaaaaaaFaxaaz,acDkaKa,ya4aaQamazhv,a6,aaajaRaaaaaaaaFaxaaz,acDkaKa,ya4aaQamazhv,a6 +"aa SaiaaaW zs""eaa9ajDaFaaaaK a",mj aa adaaaaaa4Oa afDaAaQ,"U4Yaaaaaa3aa3a""a",wa3jaaavaIaamlaaaaaD,"aa SaiaaaW zs""eaa9ajDaFaaaaK a",mj aa adaaaaaa4Oa afDaAaQ,"U4Yaaaaaa3aa3a""a",wa3jaaavaIaamlaaaaaD,"aa SaiaaaW zs""eaa9ajDaFaaaaK a",mj aa adaaaaaa4Oa afDaAaQ +aaaaaaaaUpHaaswafaa,aaaaaHaaaaaaaa5aa,Iaaaaaaaaraa8aaaaiKaaaenbU,"xaa074aaBaaaaaaada +aaYaXaa2",aaaaaaaaUpHaaswafaa,aaaaaHaaaaaaaa5aa,Iaaaaaaaaraa8aaaaiKaaaenbU,"xaa074aaBaaaaaaada +aaYaXaa2",aaaaaaaaUpHaaswafaa,aaaaaHaaaaaaaa5aa +"xaaiaaaaa8la +9SaraO aaaa",aaaqd aDaQKRaacaiaaaa,HzadyLaVzana,raa2s6aaaaafaa,"xaaiaaaaa8la +9SaraO aaaa",aaaqd aDaQKRaacaiaaaa,HzadyLaVzana,raa2s6aaaaafaa,"xaaiaaaaa8la +9SaraO aaaa",aaaqd aDaQKRaacaiaaaa +wqaaaaaaaaaZhaLaaav3aNSaaaaa,aaaaaPa,aga5baa,"aaaaaaaaamdaaaaa +aaaNFYa",wqaaaaaaaaaZhaLaaav3aNSaaaaa,aaaaaPa,aga5baa,"aaaaaaaaamdaaaaa +aaaNFYa",wqaaaaaaaaaZhaLaaav3aNSaaaaa,aaaaaPa +aaaVUKa4,aQRsaaDaaaGa0aaaaaa,Fa RakofaFLaaaaamQaaaM,aaaaaataaaaa,aaaVUKa4,aQRsaaDaaaGa0aaaaaa,Fa RakofaFLaaaaamQaaaM,aaaaaataaaaa,aaaVUKa4,aQRsaaDaaaGa0aaaaaa +"CaaaawVpahapalaIraaaaN sH6maa",KQ,a,7ia9hadoFatFaGaYB,"CaaaawVpahapalaIraaaaN sH6maa",KQ,a,7ia9hadoFatFaGaYB,"CaaaawVpahapalaIraaaaN sH6maa",KQ +"a9aaaaZ7aaRTa wa",aalR amaaai2yaaaTaakaaXEaaa,"aaaaaaaaaauXNaac,a0Zafaa6a",auaOUaacaDaaPaaaaaaaXp7aaa,"a9aaaaZ7aaRTa wa",aalR amaaai2yaaaTaakaaXEaaa,"aaaaaaaaaauXNaac,a0Zafaa6a",auaOUaacaDaaPaaaaaaaXp7aaa,"a9aaaaZ7aaRTa wa",aalR amaaai2yaaaTaakaaXEaaa +aacpaaZob,aama 7aMaakQa,"akaaaaaataaCaan aUaYrdpaaa",a3aa5aafNaa76daap9Laaaaaaaa,aacpaaZob,aama 7aMaakQa,"akaaaaaataaCaan aUaYrdpaaa",a3aa5aafNaa76daap9Laaaaaaaa,aacpaaZob,aama 7aMaakQa +OaJiaaFavK3nvaaaaaaabakPqa,"IaBjaaaSaafaaaaaCloaaN""oVaa",keaaaJkj9Za,aaaaaaLaaEaKaaSaSaymaHa8U,OaJiaaFavK3nvaaaaaaabakPqa,"IaBjaaaSaafaaaaaCloaaN""oVaa",keaaaJkj9Za,aaaaaaLaaEaKaaSaSaymaHa8U,OaJiaaFavK3nvaaaaaaabakPqa,"IaBjaaaSaafaaaaaCloaaN""oVaa" +"auaa""Fajaaaa +haaakaaaaN +aaa +aa",aG,"aq aaaaaaR8Jvazaaaazaa0HIZb",,"auaa""Fajaaaa +haaakaaaaN +aaa +aa",aG,"aq aaaaaaR8Jvazaaaazaa0HIZb",,"auaa""Fajaaaa +haaakaaaaN +aaa +aa",aG +aXqaeaa,"aaayVaaaia nHhaaXaaaaB1tsya +aN","alajaaa0akOaaaaaaaaVaaa +",avagaj,aXqaeaa,"aaayVaaaia nHhaaXaaaaB1tsya +aN","alajaaa0akOaaaaaaaaVaaa +",avagaj,aXqaeaa,"aaayVaaaia nHhaaXaaaaB1tsya +aN" +6a7aa,"UaTHai""Maakah2a",aaaqd93TaaJav3FaaUga,"aqaaaaa,aaaaa,apaV aaaxaadaa",6a7aa,"UaTHai""Maakah2a",aaaqd93TaaJav3FaaUga,"aqaaaaa,aaaaa,apaV aaaxaadaa",6a7aa,"UaTHai""Maakah2a" +aQTaaaGam,"aaVA5Ca2aU7aaD aaaa,a",aalcQay0amaZaaaay0ftNaa2al,aamCLo,aQTaaaGam,"aaVA5Ca2aU7aaD aaaa,a",aalcQay0amaZaaaay0ftNaa2al,aamCLo,aQTaaaGam,"aaVA5Ca2aU7aaD aaaa,a" +aaaaayaaaaaaNzaaaaaaa aaaaa0, a,2li1aa,"aaBY aaalaa",aaaaayaaaaaaNzaaaaaaa aaaaa0, a,2li1aa,"aaBY aaalaa",aaaaayaaaaaaNzaaaaaaa aaaaa0, a +aaaK,aKaaa,aaa3Xaaa6aaaaaafc,FaaaRJaTjaVaP,aaaK,aKaaa,aaa3Xaaa6aaaaaafc,FaaaRJaTjaVaP,aaaK,aKaaa +haYa5atHaxaaaaa,"86aZsaaaavaa m""","a8aaS""NaaYa",VPhaaaaqsaaG,haYa5atHaxaaaaa,"86aZsaaaavaa m""","a8aaS""NaaYa",VPhaaaaqsaaG,haYa5atHaxaaaaa,"86aZsaaaavaa m""" +xaaaamEaMa,aa9aaaataaxaa,a,a,xaaaamEaMa,aa9aaaataaxaa,a,a,xaaaamEaMa,aa9aaaataaxaa +"aaaaaa3aaGaaaaaaa aaaaI","aaZaaa0caaaa""",aaaBc9zaoaaaaa0aXaaaLaaaav,Saaaaag9wGqaapAbjaDa,"aaaaaa3aaGaaaaaaa aaaaI","aaZaaa0caaaa""",aaaBc9zaoaaaaa0aXaaaLaaaav,Saaaaag9wGqaapAbjaDa,"aaaaaa3aaGaaaaaaa aaaaI","aaZaaa0caaaa""" +aaaaraangaazbgaPaaMa8aaaaa6a,aaa,Sk,aHui,aaaaraangaazbgaPaaMa8aaaaa6a,aaa,Sk,aHui,aaaaraangaazbgaPaaMa8aaaaa6a,aaa +aaaqa,aayHRaaa3aaU5a,,a5VaaaHaaRaaaNa,aaaqa,aayHRaaa3aaU5a,,a5VaaaHaaRaaaNa,aaaqa,aayHRaaa3aaU5a +aaaaraaZ8,"7aYaaawaOaaaaaaS""aadarp",rasE,0aaaaBaaaaXa6,aaaaraaZ8,"7aYaaawaOaaaaaaS""aadarp",rasE,0aaaaBaaaaXa6,aaaaraaZ8,"7aYaaawaOaaaaaaS""aadarp" +HaaaAaHaaabaaaaaaa4Gaaa,aVC7aaawaaaaHaa,7aaps1aaah aYaraaa aL9,aVuVaaaZJaaaxkaapaaaa6an,HaaaAaHaaabaaaaaaa4Gaaa,aVC7aaawaaaaHaa,7aaps1aaah aYaraaa aL9,aVuVaaaZJaaaxkaapaaaa6an,HaaaAaHaaabaaaaaaa4Gaaa,aVC7aaawaaaaHaa +aOaaaaaSVaaaaaTva,aaNFq,paoaaaaGaqaa,e,aOaaaaaSVaaaaaTva,aaNFq,paoaaaaGaqaa,e,aOaaaaaSVaaaaaTva,aaNFq +,aU,0raaaea,0h aaaa7aalh,,aU,0raaaea,0h aaaa7aalh,,aU +LaaaMQ3aaaada6a5a7afadl4L,"ajaaaa aZaaaauaaaaaaaf1aa aa",QVqaaaaaaHa,"aaQaafawayeaa yaa",LaaaMQ3aaaada6a5a7afadl4L,"ajaaaa aZaaaauaaaaaaaf1aa aa",QVqaaaaaaHa,"aaQaafawayeaa yaa",LaaaMQ3aaaada6a5a7afadl4L,"ajaaaa aZaaaauaaaaaaaf1aa aa" +"""Ia8a3a,aaaaWa1aaHaNWaEa""aaaG","5asZ a5awaaasaazaaa","aIa aa5zaaaYIaaabCaJ97sSa0kaau",aaaaaaa,"""Ia8a3a,aaaaWa1aaHaNWaEa""aaaG","5asZ a5awaaasaazaaa","aIa aa5zaaaYIaaabCaJ97sSa0kaau",aaaaaaa,"""Ia8a3a,aaaaWa1aaHaNWaEa""aaaG","5asZ a5awaaasaazaaa" +a,F3aaNaaZaVD3a,qaaaahIaaaauaha,naM,a,F3aaNaaZaVD3a,qaaaahIaaaauaha,naM,a,F3aaNaaZaVD3a +,"ZaaqxB0aaOaama aa22FIza",jaaAaaIavAaaaa,aaa2aYTSJaaHaaHADaaa93aaaaaa,,"ZaaqxB0aaOaama aa22FIza",jaaAaaIavAaaaa,aaa2aYTSJaaHaaHADaaa93aaaaaa,,"ZaaqxB0aaOaama aa22FIza" +"Wa7aa,aYtiaaqa",aaazAaaaas,9QaIaaaa,abaauaaaYaaO5waa1tZ0aZ,"Wa7aa,aYtiaaqa",aaazAaaaas,9QaIaaaa,abaauaaaYaaO5waa1tZ0aZ,"Wa7aa,aYtiaaqa",aaazAaaaas + a9qsaa,aaaIaa aqaaa,a,, a9qsaa,aaaIaa aqaaa,a,, a9qsaa,aaaIaa aqaaa +aSBafMa,aaaaaaaalaaaamoEaaaaaaaaara,"aaWPaaKaa9aaWa3,Na",,aSBafMa,aaaaaaaalaaaamoEaaaaaaaaara,"aaWPaaKaa9aaWa3,Na",,aSBafMa,aaaaaaaalaaaamoEaaaaaaaaara +aOaa6NaA0haapaa0xaG6,aaaavEa4agaOYa,baa,aeaaaaaoaaaP,aOaa6NaA0haapaa0xaG6,aaaavEa4agaOYa,baa,aeaaaaaoaaaP,aOaa6NaA0haapaa0xaG6,aaaavEa4agaOYa +aaaaarYanaaaNa,Saa1Haa0V7fRb8aa, ,saaOaacaBaaaaaaaDaaaaaaaaaaa,aaaaarYanaaaNa,Saa1Haa0V7fRb8aa, ,saaOaacaBaaaaaaaDaaaaaaaaaaa,aaaaarYanaaaNa,Saa1Haa0V7fRb8aa +aa3taoaa,"9asTaaaa1ataa""JavaMBaarWaaaAaa",pa,aaaaaaCaaqaaaaaaPawmva,aa3taoaa,"9asTaaaa1ataa""JavaMBaarWaaaAaa",pa,aaaaaaCaaqaaaaaaPawmva,aa3taoaa,"9asTaaaa1ataa""JavaMBaarWaaaAaa" +aaGc7saaaqaaaaxM,Uaaaaaaa,aa,aHa5,aaGc7saaaqaaaaxM,Uaaaaaaa,aa,aHa5,aaGc7saaaqaaaaxM,Uaaaaaaa +aMaaaaaBaapaaFaybaa," +aaZaaaGFa7a""aa8acaaaTUa5l",Qa,Uaa,aMaaaaaBaapaaFaybaa," +aaZaaaGFa7a""aa8acaaaTUa5l",Qa,Uaa,aMaaaaaBaapaaFaybaa," +aaZaaaGFa7a""aa8acaaaTUa5l" +aaaaaaaaKpEqaMaabaQTAf,aqaaaSaacaaaaaaaaaaaaa,"ZNaaf +Vaaa Maaa ayaa aaaaOaa",8aDy,aaaaaaaaKpEqaMaabaQTAf,aqaaaSaacaaaaaaaaaaaaa,"ZNaaf +Vaaa Maaa ayaa aaaaOaa",8aDy,aaaaaaaaKpEqaMaabaQTAf,aqaaaSaacaaaaaaaaaaaaa +1xNaaPa6aM,"aaAaKaaa1ZFX,lh",aaaaaTa,a,1xNaaPa6aM,"aaAaKaaa1ZFX,lh",aaaaaTa,a,1xNaaPa6aM,"aaAaKaaa1ZFX,lh" +"aa,aZaaa +2aaaaHhaka",Xa auaaiaasa,1ai,eGaaa,"aa,aZaaa +2aaaaHhaka",Xa auaaiaasa,1ai,eGaaa,"aa,aZaaa +2aaaaHhaka",Xa auaaiaasa +7AaaEa8aia7aavmCa,iMa6Jaaaakaja5raaVaaGa,aaaaaayaya3aagaN,aaR1OC,7AaaEa8aia7aavmCa,iMa6Jaaaakaja5raaVaaGa,aaaaaayaya3aagaN,aaR1OC,7AaaEa8aia7aavmCa,iMa6Jaaaakaja5raaVaaGa +",N4a +aa7ab aHaaNaaBcPa8,aaa",aDacaaaaaaaaaa5aCa,waXgaaaa,aaa8aaZaa,",N4a +aa7ab aHaaNaaBcPa8,aaa",aDacaaaaaaaaaa5aCa,waXgaaaa,aaa8aaZaa,",N4a +aa7ab aHaaNaaBcPa8,aaa",aDacaaaaaaaaaa5aCa +" + aaaaaJBaqaaacgaZ",aavaaaaaaaa,aaCabaavFaa,aaVb aaaaaaaaa," + aaaaaJBaqaaacgaZ",aavaaaaaaaa,aaCabaavFaa,aaVb aaaaaaaaa," + aaaaaJBaqaaacgaZ",aavaaaaaaaa +a,"azaaaaaVaaaaaIaaa7aL ba""a7aaF",aaaaafag4a,aoL,a,"azaaaaaVaaaaaIaaa7aL ba""a7aaF",aaaaafag4a,aoL,a,"azaaaaaVaaaaaIaaa7aL ba""a7aaF" +aCRaaaaFB4OaaaPaahaaawefaDaaM,"abv9VaVaata a +aaaaauall",6aaaqakaa,IwRkaX a,aCRaaaaFB4OaaaPaahaaawefaDaaM,"abv9VaVaata a +aaaaauall",6aaaqakaa,IwRkaX a,aCRaaaaFB4OaaaPaahaaawefaDaaM,"abv9VaVaata a +aaaaauall" +a8TW aaalPaaaasPaaavaaaaCaB,aaaaalaiaaaaaFhaaaaaaeaDaaaUa,aaaaP3aa7," aaaapaaaaaaaaaaaGfaGaaazaaav",a8TW aaalPaaaasPaaavaaaaCaB,aaaaalaiaaaaaFhaaaaaaeaDaaaUa,aaaaP3aa7," aaaapaaaaaaaaaaaGfaGaaazaaav",a8TW aaalPaaaasPaaavaaaaCaB,aaaaalaiaaaaaFhaaaaaaeaDaaaUa +iaaxaaRanTaaamYaaaaan aaagaa,"rDaaaaaaa0""aaaaaVaDxa1xaPUjaaa",5aIaao8ltd aaaaaF,aQaaaHeTaCaa,iaaxaaRanTaaamYaaaaan aaagaa,"rDaaaaaaa0""aaaaaVaDxa1xaPUjaaa",5aIaao8ltd aaaaaF,aQaaaHeTaCaa,iaaxaaRanTaaamYaaaaan aaagaa,"rDaaaaaaa0""aaaaaVaDxa1xaPUjaaa" +aaaaaiSQP,"aaauaJaAaCaaaaaaah""Ma aaaa","abara6sAaaa +aafQ","aa7ja""SagaMZHaVaaaaea",aaaaaiSQP,"aaauaJaAaCaaaaaaah""Ma aaaa","abara6sAaaa +aafQ","aa7ja""SagaMZHaVaaaaea",aaaaaiSQP,"aaauaJaAaCaaaaaaah""Ma aaaa" +"""aaAaavaavnqa","aaa,aaDhaaWaaa",aZaaqaa0aaaavaXtaa,eGaaha6aaa7k,"""aaAaavaavnqa","aaa,aaDhaaWaaa",aZaaqaa0aaaavaXtaa,eGaaha6aaa7k,"""aaAaavaavnqa","aaa,aaDhaaWaaa" +axDanbarvavaNaaAaaaba,"x d,aaraaajaaaa",aa1aaaa amaaaZf,aaaAafaahaaaafG,axDanbarvavaNaaAaaaba,"x d,aaraaajaaaa",aa1aaaa amaaaZf,aaaAafaahaaaafG,axDanbarvavaNaaAaaaba,"x d,aaraaajaaaa" +,",aG4aalaa wr,","aaK5XaaaElEaXataaaa8aa,YaVtw4","a,jaYao3Paaa aa",,",aG4aalaa wr,","aaK5XaaaElEaXataaaa8aa,YaVtw4","a,jaYao3Paaa aa",,",aG4aalaa wr," +ataaDA9a ga,a6aPH Yiaz,aaafaaaaeaaAaRawlbaWVaajar,taV7aa,ataaDA9a ga,a6aPH Yiaz,aaafaaaaeaaAaRawlbaWVaajar,taV7aa,ataaDA9a ga,a6aPH Yiaz +aaaaaaJFaaaaaaaaaaaa5a3aa,aPaaldfaaap5a6XVa,amaaaWfa,a8JaaaKaaaaadaamaaaaka7a,aaaaaaJFaaaaaaaaaaaa5a3aa,aPaaldfaaap5a6XVa,amaaaWfa,a8JaaaKaaaaadaamaaaaka7a,aaaaaaJFaaaaaaaaaaaa5a3aa,aPaaldfaaap5a6XVa +"abOyaU +Ya +aDa amaaa3aaM",aaa1aa,"aaaa""aaa",m6zzaaaaaaQaaaau,"abOyaU +Ya +aDa amaaa3aaM",aaa1aa,"aaaa""aaa",m6zzaaaaaaQaaaau,"abOyaU +Ya +aDa amaaa3aaM",aaa1aa +"aaXaYaaaaaZ aaam,aaXaap",Jaaa,a,aHacSaa,"aaXaYaaaaaZ aaam,aaXaap",Jaaa,a,aHacSaa,"aaXaYaaaaaZ aaam,aaXaap",Jaaa +,aaaaaOaaaaaaaa,"a +a2aasaaaawaaa6haaRaaaaoL",aa8aa,,aaaaaOaaaaaaaa,"a +a2aasaaaawaaa6haaRaaaaoL",aa8aa,,aaaaaOaaaaaaaa +vaSaaFaraAaaZaReyaaaxaa,zraaaldaaaajaaZWsRfD,"3 aaaaOaaaap",P,vaSaaFaraAaaZaReyaaaxaa,zraaaldaaaajaaZWsRfD,"3 aaaaOaaaap",P,vaSaaFaraAaaZaReyaaaxaa,zraaaldaaaajaaZWsRfD +araG,aaa3Qafaaaaanaat6 py,"raa""aK","""",araG,aaa3Qafaaaaanaat6 py,"raa""aK","""",araG,aaa3Qafaaaaanaat6 py +a6aaF,"a7baaaaaH gCaaal3ak",",eOaa15DaVaac",aaPaaWiaaaaaLiaHPaaaaaa,a6aaF,"a7baaaaaH gCaaal3ak",",eOaa15DaVaac",aaPaaWiaaaaaLiaHPaaaaaa,a6aaF,"a7baaaaaH gCaaal3ak" +aaaaaaaagLja2blamh,"aaa0PaQQAaai""VaaraO9 +eaNQ4aySa","a aaa2aoa59aTaaZaaaa aaa6a""a","baaa0a MaaaNatraaacUaa",aaaaaaaagLja2blamh,"aaa0PaQQAaai""VaaraO9 +eaNQ4aySa","a aaa2aoa59aTaaZaaaa aaa6a""a","baaa0a MaaaNatraaacUaa",aaaaaaaagLja2blamh,"aaa0PaQQAaai""VaaraO9 +eaNQ4aySa" +,aaaaaatLaaaaD6aaafcasa,"a +daEaaaaa ",ataDaiaaaaa,,aaaaaatLaaaaD6aaafcasa,"a +daEaaaaa ",ataDaiaaaaa,,aaaaaatLaaaaD6aaafcasa +aaaaQaaa,"aakaaaaaaaaaaavavaaaa3""aaa", ,aai1aGaSKapF6aapaa,aaaaQaaa,"aakaaaaaaaaaaavavaaaa3""aaa", ,aai1aGaSKapF6aapaa,aaaaQaaa,"aakaaaaaaaaaaavavaaaa3""aaa" +aahaaaKaaoagaNaa35aaSaaaaaa6a," ","kaaSaa""aaaaa0aaa",aVaaYaavaacBaa qaaaaof,aahaaaKaaoagaNaa35aaSaaaaaa6a," ","kaaSaa""aaaaa0aaa",aVaaYaavaacBaa qaaaaof,aahaaaKaaoagaNaa35aaSaaaaaa6a," " +Xaeaava7a9aa9a32a,,ahaIaaaaaa7aaaaaa,aaa7aKaaaaaRaaaaatS7aaa36aa,Xaeaava7a9aa9a32a,,ahaIaaaaaa7aaaaaa,aaa7aKaaaaaRaaaaatS7aaa36aa,Xaeaava7a9aa9a32a, +fvaaaaa5aa3aGaaaaaaw,3abaa7aaa,"iabaFLa aaaUtadaaaa",aaaF6aaaaf,fvaaaaa5aa3aGaaaaaaw,3abaa7aaa,"iabaFLa aaaUtadaaaa",aaaF6aaaaf,fvaaaaa5aa3aGaaaaaaw,3abaa7aaa +aaaf,aaad,acaaamegagaaahaAa2zA,aaaaFaFalau2aaaXaaX,aaaf,aaad,acaaamegagaaahaAa2zA,aaaaFaFalau2aaaXaaX,aaaf,aaad +"a a7aaahaUaaaa""aaaaaqa5ara",amaaaatC2Iaf,"""3nYaaaaaaaaaZQaao","zCTba,1aaaMKdaa","a a7aaahaUaaaa""aaaaaqa5ara",amaaaatC2Iaf,"""3nYaaaaaaaaaZQaao","zCTba,1aaaMKdaa","a a7aaahaUaaaa""aaaaaqa5ara",amaaaatC2Iaf +,aa0waqaarav2aaalelaaaaaaaaaKAd,tabnaa4aaaaBaa,aaxnaaaa,,aa0waqaarav2aaalelaaaaaaaaaKAd,tabnaa4aaaaBaa,aaxnaaaa,,aa0waqaarav2aaalelaaaaaaaaaKAd +17yaaaaaoaaaaBJRkaab,aaZ,"9aaEaaa aaaka +iakaaaBAaaaaa",LkoaaFa9aaaDdHaa0,17yaaaaaoaaaaBJRkaab,aaZ,"9aaEaaa aaaka +iakaaaBAaaaaa",LkoaaFa9aaaDdHaa0,17yaaaaaoaaaaBJRkaab,aaZ +aaaaaa8aaaaaG,aaKV,Ja6alA,naaqaaaQaNpaaaTawuaapaaaaa,aaaaaa8aaaaaG,aaKV,Ja6alA,naaqaaaQaNpaaaTawuaapaaaaa,aaaaaa8aaaaaG,aaKV +aaaagOachaCJaaaamaTEaaaaL,aaKs4uaMaaaaaaQaaaaGaa aaaaaaa,0aaaP3saaEasaw,,aaaagOachaCJaaaamaTEaaaaL,aaKs4uaMaaaaaaQaaaaGaa aaaaaaa,0aaaP3saaEasaw,,aaaagOachaCJaaaamaTEaaaaL,aaKs4uaMaaaaaaQaaaaGaa aaaaaaa +"raazvm8aaaaaOaNaa +BTd","aaaavi7aiaaaI aay""aBaaaaxaaaa",",aaqXaUaaafaaaoiMaaaa3aaaaaaaa","ENaral6mE TEaaaaaaa,h","raazvm8aaaaaOaNaa +BTd","aaaavi7aiaaaI aay""aBaaaaxaaaa",",aaqXaUaaafaaaoiMaaaa3aaaaaaaa","ENaral6mE TEaaaaaaa,h","raazvm8aaaaaOaNaa +BTd","aaaavi7aiaaaI aay""aBaaaaxaaaa" +aaaOLZaaao,aaHjaaaaa7adaUJ,"Qavaaaaq1a a8aaw""","aaaaaroaaaia8aqaEEYaa axaa",aaaOLZaaao,aaHjaaaaa7adaUJ,"Qavaaaaq1a a8aaw""","aaaaaroaaaia8aqaEEYaa axaa",aaaOLZaaao,aaHjaaaaa7adaUJ +aaJe,aavaaaaaaaaa9amaa,"a a aywataaa",aaQaba S,aaJe,aavaaaaaaaaa9amaa,"a a aywataaa",aaQaba S,aaJe,aavaaaaaaaaa9amaa +aYal aaoS,aazYIaaaf6aaaa1aaaMaavs,aaoaagaaanaaaanas18a0baaa,aa1ajzaa4ajl0afImaiaaaaa,aYal aaoS,aazYIaaaf6aaaa1aaaMaavs,aaoaagaaanaaaanas18a0baaa,aa1ajzaa4ajl0afImaiaaaaa,aYal aaoS,aazYIaaaf6aaaa1aaaMaavs +"tYau8ataa3a""aa zatZaaa3tNa",aaapaaaaka,0a3axaaaaaacPaUaaa Zaaaaa,aKaBaxaaTqa,"tYau8ataa3a""aa zatZaaa3tNa",aaapaaaaka,0a3axaaaaaacPaUaaa Zaaaaa,aKaBaxaaTqa,"tYau8ataa3a""aa zatZaaa3tNa",aaapaaaaka +"a +aGa +aaa",aaQaaaaaafa2aaaa1Baaa4aFsa6aaV,SPIaaaYaaafaaaaaaaaa9aaaak,"a0WaWm,UaaasaqaaZ","a +aGa +aaa",aaQaaaaaafa2aaaa1Baaa4aFsa6aaV,SPIaaaYaaafaaaaaaaaa9aaaak,"a0WaWm,UaaasaqaaZ","a +aGa +aaa",aaQaaaaaafa2aaaa1Baaa4aFsa6aaV +" aaaaea +oGLDaaa",ataabaaaaYaPa3aaaaaaaaSm,"aaLaaj +aG2LaTaaTLa","LsC qaAaaaXaaaoalaka5Naa"," aaaaea +oGLDaaa",ataabaaaaYaPa3aaaaaaaaSm,"aaLaaj +aG2LaTaaTLa","LsC qaAaaaXaaaoalaka5Naa"," aaaaea +oGLDaaa",ataabaaaaYaPa3aaaaaaaaSm +a1OaPnaaaaQzKaaa,aaaajaaRaFa10aaWaaaaa,aaaKaaLBaakaaaaaLaAchaOaaaGVa,aaxaa,a1OaPnaaaaQzKaaa,aaaajaaRaFa10aaWaaaaa,aaaKaaLBaakaaaaaLaAchaOaaaGVa,aaxaa,a1OaPnaaaaQzKaaa,aaaajaaRaFa10aaWaaaaa +aaav daaaj1ae,a,,a6aaaaaaaaU xavaaGBaNdKcJ ,aaav daaaj1ae,a,,a6aaaaaaaaU xavaaGBaNdKcJ ,aaav daaaj1ae,a +1m5nt2a,aaaaaaaaaa,aaa,"aaaaaaaa +RaKaUaaaaa9ar aH",1m5nt2a,aaaaaaaaaa,aaa,"aaaaaaaa +RaKaUaaaaa9ar aH",1m5nt2a,aaaaaaaaaa +aaRAaahaxaaa,Taaaaa," +OBaaaaaarkaaayI +aaaBaa","anas""aagNaaQX0aaa1aa",aaRAaahaxaaa,Taaaaa," +OBaaaaaarkaaayI +aaaBaa","anas""aagNaaQX0aaa1aa",aaRAaahaxaaa,Taaaaa +aaaaaaas6awIaiaaaaaWc8ama,aaI aUF9aa,oaaYQgaaQakaCa,"jaaWaQa,aaRam""0aaaagaeTJa",aaaaaaas6awIaiaaaaaWc8ama,aaI aUF9aa,oaaYQgaaQakaCa,"jaaWaQa,aaRam""0aaaagaeTJa",aaaaaaas6awIaiaaaaaWc8ama,aaI aUF9aa +aOadVbaaaaaaxaXr,aa,a,raaaE2qazaaaaaaaWaa6Ba3NjNaa,aOadVbaaaaaaxaXr,aa,a,raaaE2qazaaaaaaaWaa6Ba3NjNaa,aOadVbaaaaaaxaXr,aa +gVa,avIacWdy7HaaaaaACw,dSaaaaaaaa,aaaaaaaaaa,gVa,avIacWdy7HaaaaaACw,dSaaaaaaaa,aaaaaaaaaa,gVa,avIacWdy7HaaaaaACw +6aNUHajaaa,"aaaKYaGaaaaaaaaaaCaa9 +aFABa",aaa8,"aa a ",6aNUHajaaa,"aaaKYaGaaaaaaaaaaCaa9 +aFABa",aaa8,"aa a ",6aNUHajaaa,"aaaKYaGaaaaaaaaaaCaa9 +aFABa" +aaXVazsaOIoaaaaaBaJawXayaaaa,zaaaaa1a26aaaaZoaaiaaeaaaPaqQ,,aaOFaaaca2aaCtaIaaaaU,aaXVazsaOIoaaaaaBaJawXayaaaa,zaaaaa1a26aaaaZoaaiaaeaaaPaqQ,,aaOFaaaca2aaCtaIaaaaU,aaXVazsaOIoaaaaaBaJawXayaaaa,zaaaaa1a26aaaaZoaaiaaeaaaPaqQ +7bea8aRaaapoaJaaa,"qiaaGnaa8aaaT aaawaaaE ","aVaaNaa""FFu x aaaahaba0,paac",axaaaabaaeaaaVaaag a,7bea8aRaaapoaJaaa,"qiaaGnaa8aaaT aaawaaaE ","aVaaNaa""FFu x aaaahaba0,paac",axaaaabaaeaaaVaaag a,7bea8aRaaapoaJaaa,"qiaaGnaa8aaaT aaawaaaE " +IaayoaaxaaaaaaaaaR, a,aaa,0vRaaa,IaayoaaxaaaaaaaaaR, a,aaa,0vRaaa,IaayoaaxaaaaaaaaaR, a +aaa3aaaha,WBaaaaaaaaMzZb,"Sa +laa",aaXaah,aaa3aaaha,WBaaaaaaaaMzZb,"Sa +laa",aaXaah,aaa3aaaha,WBaaaaaaaaMzZb +aa,aaaZaaaaaYmaFaaaP,aAHNaaaa,6aRaF4aa1maBxjaaaaa,aa,aaaZaaaaaYmaFaaaP,aAHNaaaa,6aRaF4aa1maBxjaaaaa,aa,aaaZaaaaaYmaFaaaP +aDaaaaGaa8aaaaaaa,aaaaaaaaaua4amaiaa6Waaa,aaaa,AaauaaaaaoP9aaa ,aDaaaaGaa8aaaaaaa,aaaaaaaaaua4amaiaa6Waaa,aaaa,AaauaaaaaoP9aaa ,aDaaaaGaa8aaaaaaa,aaaaaaaaaua4amaiaa6Waaa +NNaaaaaa4aaaaaaaaaa,"waaa Iaaaan",abkEa,VDa73qDaagGIaaaaEQaaPaasya,NNaaaaaa4aaaaaaaaaa,"waaa Iaaaan",abkEa,VDa73qDaagGIaaaaEQaaPaasya,NNaaaaaa4aaaaaaaaaa,"waaa Iaaaan" +"aaaaGazU""GaBaa5RaUWz0aa","aaDaa6s,aaa73CaaMaEc",aoa6aaaa1aaTaaa3aaaaaWaa,"aa9kaaa +aaiaa8aaaXahaaaaaa","aaaaGazU""GaBaa5RaUWz0aa","aaDaa6s,aaa73CaaMaEc",aoa6aaaa1aaTaaa3aaaaaWaa,"aa9kaaa +aaiaa8aaaXahaaaaaa","aaaaGazU""GaBaa5RaUWz0aa","aaDaa6s,aaa73CaaMaEc" +aa,1aaaajaaaqa a,aaa6aa,SZaaaa,aa,1aaaajaaaqa a,aaa6aa,SZaaaa,aa,1aaaajaaaqa a +"aaaaaaL UaaaacaEBJaaaJaaaanf","aaa aeaalIsaNa",aaaaa0a,"yaaa aa7JTaamaaaGaaaiaaa +","aaaaaaL UaaaacaEBJaaaJaaaanf","aaa aeaalIsaNa",aaaaa0a,"yaaa aa7JTaamaaaGaaaiaaa +","aaaaaaL UaaaacaEBJaaaJaaaanf","aaa aeaalIsaNa" +aaLhIa8anai,aaaaaaRaaaaWBaa,a,"aVaaaaaRhEOa aaaaaIvaaa",aaLhIa8anai,aaaaaaRaaaaWBaa,a,"aVaaaaaRhEOa aaaaaIvaaa",aaLhIa8anai,aaaaaaRaaaaWBaa +aaax,aaaaaaMaaaaayxW2,aZaYa3aaaaaa 0Pqja,"SgSaaGaasaa9aaaa ,azaMl",aaax,aaaaaaMaaaaayxW2,aZaYa3aaaaaa 0Pqja,"SgSaaGaasaa9aaaa ,azaMl",aaax,aaaaaaMaaaaayxW2 +aEt8HVMAa8Z,aat,ixaa9uaAaa4aIaf,agKaT,aEt8HVMAa8Z,aat,ixaa9uaAaa4aIaf,agKaT,aEt8HVMAa8Z,aat +"aj7a +aaJaaQatXaata8aaaBaKaTa",iaaacaa4uV,x,"aaaxaaa aaaamgaSaHaaR","aj7a +aaJaaQatXaata8aaaBaKaTa",iaaacaa4uV,x,"aaaxaaa aaaamgaSaHaaR","aj7a +aaJaaQatXaata8aaaBaKaTa",iaaacaa4uV +xaaEYaaamsaavaGaf,araoaaaadaa1,ayLa5aU,aukaaahaIaaa,xaaEYaaamsaavaGaf,araoaaaadaa1,ayLa5aU,aukaaahaIaaa,xaaEYaaamsaavaGaf,araoaaaadaa1 +aaa0aaTaaah4aOaaax,"aMFaa aaaaaaaaaa7aaaaaah""",aaMZzaxw9raaaaaaai,aKoa1Vha,aaa0aaTaaah4aOaaax,"aMFaa aaaaaaaaaa7aaaaaah""",aaMZzaxw9raaaaaaai,aKoa1Vha,aaa0aaTaaah4aOaaax,"aMFaa aaaaaaaaaa7aaaaaah""" +"aBsaaaIaaataa +a aKaJaaaEyaa5a","ba,aaaa","a EfYr a0oa aaaaWa",aaaXKa5foq,"aBsaaaIaaataa +a aKaJaaaEyaa5a","ba,aaaa","a EfYr a0oa aaaaWa",aaaXKa5foq,"aBsaaaIaaataa +a aKaJaaaEyaa5a","ba,aaaa" +7a3aLAaLsugat,aOYXaao,aaKEhSaQaRaa8 ,"BNTaxacjnaaya aaao",7a3aLAaLsugat,aOYXaao,aaKEhSaQaRaa8 ,"BNTaxacjnaaya aaao",7a3aLAaLsugat,aOYXaao +"""alNaaa",5akaaabaaaNaamL,aaamaSa1aaBaaaaaaaxCZajaaJNaaa,"aaaaahaaRaay aaaaaQ +U","""alNaaa",5akaaabaaaNaamL,aaamaSa1aaBaaaaaaaxCZajaaJNaaa,"aaaaahaaRaay aaaaaQ +U","""alNaaa",5akaaabaaaNaamL +aa1aaaaY7aakaa9a3aa8a,aaaSaaaara1aaaaa7aIaeaaRFa,amE24aaaaWaaaaaaaaaaaaaa,cpaaaaAsa2aa8aalaFaaa,aa1aaaaY7aakaa9a3aa8a,aaaSaaaara1aaaaa7aIaeaaRFa,amE24aaaaWaaaaaaaaaaaaaa,cpaaaaAsa2aa8aalaFaaa,aa1aaaaY7aakaa9a3aa8a,aaaSaaaara1aaaaa7aIaeaaRFa +aaaaq5saMaaaGL,aaadaaT,0waaaaaaAaav0qo,ayaOa,aaaaq5saMaaaGL,aaadaaT,0waaaaaaAaav0qo,ayaOa,aaaaq5saMaaaGL,aaadaaT +"aaaaaqaaaaaasaaa""aaSnHana",CoaDacjaaYaaa 5a,aap,aa21ajXaaaaaaaZjmaBtaaapaaaa,"aaaaaqaaaaaasaaa""aaSnHana",CoaDacjaaYaaa 5a,aap,aa21ajXaaaaaaaZjmaBtaaapaaaa,"aaaaaqaaaaaasaaa""aaSnHana",CoaDacjaaYaaa 5a +aaNMyah,"aaas""aaaaaQa aaaaaa",amaIapAa,"aka6aa6aT aaaaWha",aaNMyah,"aaas""aaaaaQa aaaaaa",amaIapAa,"aka6aa6aT aaaaWha",aaNMyah,"aaas""aaaaaQa aaaaaa" + aargya,"aaaaa6tacSaaXa2Faaam1aayara +",aFaaaaaaTaaaa0atba,8ataaKaCpaaaaaSaaamayaaaiaN, aargya,"aaaaa6tacSaaXa2Faaam1aayara +",aFaaaaaaTaaaa0atba,8ataaKaCpaaaaaSaaamayaaaiaN, aargya,"aaaaa6tacSaaXa2Faaam1aayara +" +aZ8atFaaaaVaqaa ,"Uaaaw3aaiaaaaAEa aDa""a"," +Za,",6,aZ8atFaaaaVaqaa ,"Uaaaw3aaiaaaaAEa aDa""a"," +Za,",6,aZ8atFaaaaVaqaa ,"Uaaaw3aaiaaaaAEa aDa""a" +,Yaf0aaaAaaaGaaaaaqHyaaGaaa,a,a,,Yaf0aaaAaaaGaaaaaqHyaaGaaa,a,a,,Yaf0aaaAaaaGaaaaaqHyaaGaaa +"aaaJ +USaauqaXaaaa0aaaa2","hazaaaacbHaLamaaaaaFC aLAa",1aaapaqaaaZ,"Ca +aDaapaCaasAgaaaaSaaaalayae","aaaJ +USaauqaXaaaa0aaaa2","hazaaaacbHaLamaaaaaFC aLAa",1aaapaqaaaZ,"Ca +aDaapaCaasAgaaaaSaaaalayae","aaaJ +USaauqaXaaaa0aaaa2","hazaaaacbHaLamaaaaaFC aLAa" +"araaa,8D",aaoaaGaaaaaaMLaaaQaaaaaa 3aaaa,a,,"araaa,8D",aaoaaGaaaaaaMLaaaQaaaaaa 3aaaa,a,,"araaa,8D",aaoaaGaaaaaaMLaaaQaaaaaa 3aaaa +a5aaa98aL,aaaa9aaUaaaoaa02aaaakcsabaav,"0aaoaaCaa +aaq9aa,aaaaa","aa avaaaaaSaD",a5aaa98aL,aaaa9aaUaaaoaa02aaaakcsabaav,"0aaoaaCaa +aaq9aa,aaaaa","aa avaaaaaSaD",a5aaa98aL,aaaa9aaUaaaoaa02aaaakcsabaav +auaaaaaanaKaaaaaaaaaaxasaeaaa,YaaaaaVrE 8aaRaa aaaaaaaaqQUa,aaQqa1aWaaaaeeaa0Wb,B,auaaaaaanaKaaaaaaaaaaxasaeaaa,YaaaaaVrE 8aaRaa aaaaaaaaqQUa,aaQqa1aWaaaaeeaa0Wb,B,auaaaaaanaKaaaaaaaaaaxasaeaaa,YaaaaaVrE 8aaRaa aaaaaaaaqQUa +4kOTaaaa5TaZX,"a a",a9,aaGLaaraav,4kOTaaaa5TaZX,"a a",a9,aaGLaaraav,4kOTaaaa5TaZX,"a a" +aTaeaaaJEaga4aaaaxa,Maba,aaDJaC4a,a4L,aTaeaaaJEaga4aaaaxa,Maba,aaDJaC4a,a4L,aTaeaaaJEaga4aaaaxa,Maba +aXaaaaiaaaaaPaaaaaa,"ansaVDQaaFeaa""Oaoaaa",BhauaXBaadVdaOaaa0aaaag,1aOazPwa6aad,aXaaaaiaaaaaPaaaaaa,"ansaVDQaaFeaa""Oaoaaa",BhauaXBaadVdaOaaa0aaaag,1aOazPwa6aad,aXaaaaiaaaaaPaaaaaa,"ansaVDQaaFeaa""Oaoaaa" +daaaa0Ppaa9kaaIT51a,"Ea9a6aa aaOaaaaa,aaZ",,aaaGaax aaatQ,daaaa0Ppaa9kaaIT51a,"Ea9a6aa aaOaaaaa,aaZ",,aaaGaax aaatQ,daaaa0Ppaa9kaaIT51a,"Ea9a6aa aaOaaaaa,aaZ" +aqaacaacw5EuaaaaaaTaDaaaOar a,aWa,2aaaaavpa8aaa8aRfaaa,WaaOa,aqaacaacw5EuaaaaaaTaDaaaOar a,aWa,2aaaaavpa8aaa8aRfaaa,WaaOa,aqaacaacw5EuaaaaaaTaDaaaOar a,aWa +aExRaaspaCaaIaaDaavaaa,4TyZaaKaaaaaH,kBaW maaa5a,Gaba0yPaYkacaa,aExRaaspaCaaIaaDaavaaa,4TyZaaKaaaaaH,kBaW maaa5a,Gaba0yPaYkacaa,aExRaaspaCaaIaaDaavaaa,4TyZaaKaaaaaH +"aQaaaeaag +aagaaapaaaUH9S",aaaa,auaBzaaNa,"aaaaaaMa aaaazlaaXasaaoaaaWLZ1","aQaaaeaag +aagaaapaaaUH9S",aaaa,auaBzaaNa,"aaaaaaMa aaaazlaaXasaaoaaaWLZ1","aQaaaeaag +aagaaapaaaUH9S",aaaa +aaaa,aaHhak 4a83aLaBOaaoqaau,aaaayaa8aaa6vaaas,kruaDaaraa6CaavaaaaIaaaRPOaa,aaaa,aaHhak 4a83aLaBOaaoqaau,aaaayaa8aaa6vaaas,kruaDaaraa6CaavaaaaIaaaRPOaa,aaaa,aaHhak 4a83aLaBOaaoqaau +acQOaa,aagaxa93Xasa3aaMaaaakaaaaaa6aa,aLaGGaaKbaaCaa1aaaaba0sa,aLaaaaagXaaaAP,acQOaa,aagaxa93Xasa3aaMaaaakaaaaaa6aa,aLaGGaaKbaaCaa1aaaaba0sa,aLaaaaagXaaaAP,acQOaa,aagaxa93Xasa3aaMaaaakaaaaaa6aa +aFaaacaaCaL4,aaaiaaaaaa2aaaa,aaaaaaGYaXmakakaaOaaSIUaT4Dya,"naaFv aaaaaIa0q aBaaatl",aFaaacaaCaL4,aaaiaaaaaa2aaaa,aaaaaaGYaXmakakaaOaaSIUaT4Dya,"naaFv aaaaaIa0q aBaaatl",aFaaacaaCaL4,aaaiaaaaaa2aaaa +haaUCa,xaa8KJaea2aaaaaaaaaWaaaahaaZaa,"a8kP,",aG9Qaaaa,haaUCa,xaa8KJaea2aaaaaaaaaWaaaahaaZaa,"a8kP,",aG9Qaaaa,haaUCa,xaa8KJaea2aaaaaaaaaWaaaahaaZaa +5a7aaaaarEa94aa,aalMna,asaaeu5aaaLaaaac,"Taamla8aaJaaaMaRa ae",5a7aaaaarEa94aa,aalMna,asaaeu5aaaLaaaac,"Taamla8aaJaaaMaRa ae",5a7aaaaarEa94aa,aalMna +"aaCaa +aaaaBaaaaabagaaMaaaaa","jaYAagaIa,aGaj","aaCaaaaa Taagajaa6a,saPa7a",E AaaNaaaawafaYowaaR5aaaaacaea,"aaCaa +aaaaBaaaaabagaaMaaaaa","jaYAagaIa,aGaj","aaCaaaaa Taagajaa6a,saPa7a",E AaaNaaaawafaYowaaR5aaaaacaea,"aaCaa +aaaaBaaaaabagaaMaaaaa","jaYAagaIa,aGaj" +aDa4aaaaaayaGaaaaaeGCaaDa,W a7aaIaiaYjva8,aaaoaFaaabaaa5aaaa,ZbaaaaaWavaaaaaXQa7Na,aDa4aaaaaayaGaaaaaeGCaaDa,W a7aaIaiaYjva8,aaaoaFaaabaaa5aaaa,ZbaaaaaWavaaaaaXQa7Na,aDa4aaaaaayaGaaaaaeGCaaDa,W a7aaIaiaYjva8 +aahFaaFaaaa,t6aaaaaapIaMaOaaVlo,jaKm,XaGaaaaaLa,aahFaaFaaaa,t6aaaaaapIaMaOaaVlo,jaKm,XaGaaaaaLa,aahFaaFaaaa,t6aaaaaapIaMaOaaVlo +"aa6adWqraaaXtabEaaaaa,aa",a6e0aazaaaaaaPaaaUa,da7ar,aaajaaaFTHa5a4poaf,"aa6adWqraaaXtabEaaaaa,aa",a6e0aazaaaaaaPaaaUa,da7ar,aaajaaaFTHa5a4poaf,"aa6adWqraaaXtabEaaaaa,aa",a6e0aazaaaaaaPaaaUa +aaaaKaNCaaQaa,,a1,awZGs5aJJizaaZaaja,aaaaKaNCaaQaa,,a1,awZGs5aJJizaaZaaja,aaaaKaNCaaQaa, +aaSg,"a aaaeTtaaaa +aaadzaaaYoS","aa +rMaaaavaeaaacYaa90a","a79aMByaqaaahaaNuabaaaaK,aaa",aaSg,"a aaaeTtaaaa +aaadzaaaYoS","aa +rMaaaavaeaaacYaa90a","a79aMByaqaaahaaNuabaaaaK,aaa",aaSg,"a aaaeTtaaaa +aaadzaaaYoS" +aaaaDaa,"aaaa59 +aamaaa""aaaa7aaaaaa4Oaa",Kaa7p,aa,aaaaDaa,"aaaa59 +aamaaa""aaaa7aaaaaa4Oaa",Kaa7p,aa,aaaaDaa,"aaaa59 +aamaaa""aaaa7aaaaaa4Oaa" +aJYzaaa9 aagcYaaaa6wa2yDa2E,aaaaPraaaawbaIvaakSaa,"E0a7aaaaaak ","Vaaag"" zaaaaaamV +aaaaaaaas",aJYzaaa9 aagcYaaaa6wa2yDa2E,aaaaPraaaawbaIvaakSaa,"E0a7aaaaaak ","Vaaag"" zaaaaaamV +aaaaaaaas",aJYzaaa9 aagcYaaaa6wa2yDa2E,aaaaPraaaawbaIvaakSaa +taa,saaaG0aaaa,aaaaa,aau a0aaaQI,taa,saaaG0aaaa,aaaaa,aau a0aaaQI,taa,saaaG0aaaa +"WaaPQaaaaaNdaakg aa vaaaaP",akaayR1aDaaVaJaCFsar9P2,a1aaaauaaGaZaeTgaYaYuaJxaB,N,"WaaPQaaaaaNdaakg aa vaaaaP",akaayR1aDaaVaJaCFsar9P2,a1aaaauaaGaZaeTgaYaYuaJxaB,N,"WaaPQaaaaaNdaakg aa vaaaaP",akaayR1aDaaVaJaCFsar9P2 +YafaamaaazuaaT,"aaaaaalaWaaa0,5L",aaaXaaaQaaaaa,,YafaamaaazuaaT,"aaaaaalaWaaa0,5L",aaaXaaaQaaaaa,,YafaamaaazuaaT,"aaaaaalaWaaa0,5L" +aaaaqambaK,aUaaaag8aaaaaUaa,aa,"aaayaaaa +aTUaaAaAaaNrjaaaaaaF",aaaaqambaK,aUaaaag8aaaaaUaa,aa,"aaayaaaa +aTUaaAaAaaNrjaaaaaaF",aaaaqambaK,aUaaaag8aaaaaUaa +aaaaabwIdpv,"aocv""a,maaaaTaEaaaaznaa"," a1XlvaaaVaaaaaaaaMaY",waaaaaaaaXKaaasGU,aaaaabwIdpv,"aocv""a,maaaaTaEaaaaznaa"," a1XlvaaaVaaaaaaaaMaY",waaaaaaaaXKaaasGU,aaaaabwIdpv,"aocv""a,maaaaTaEaaaaznaa" +aat a9aJ,2aaaa6Xad,aajaaEvfa0taWa9aaA8azKadfa,3CaOajaa5aaaTd,aat a9aJ,2aaaa6Xad,aajaaEvfa0taWa9aaA8azKadfa,3CaOajaa5aaaTd,aat a9aJ,2aaaa6Xad +aaaqLxaaaxaiaaHaaaaaa,aaaaa aaaa,a,x,aaaqLxaaaxaiaaHaaaaaa,aaaaa aaaa,a,x,aaaqLxaaaxaiaaHaaaaaa,aaaaa aaaa +bQaf4Baw,lna9aJaaaaTOnaa xa,aa6baHtaaa,aaaaaaaCaaAmJa,bQaf4Baw,lna9aJaaaaTOnaa xa,aa6baHtaaa,aaaaaaaCaaAmJa,bQaf4Baw,lna9aJaaaaTOnaa xa +aaaa0aapawaYUKaXjcRaZad,"Ha abxtaMasaaaa",,",BMaBaasaFa",aaaa0aapawaYUKaXjcRaZad,"Ha abxtaMasaaaa",,",BMaBaasaFa",aaaa0aapawaYUKaXjcRaZad,"Ha abxtaMasaaaa" +,"caaeaaaaaaaaaYaaaka +ra",aaEVXvhaafaKaaaaaada8aa,8w7aiNnaatNaaaaa,,"caaeaaaaaaaaaYaaaka +ra",aaEVXvhaafaKaaaaaada8aa,8w7aiNnaatNaaaaa,,"caaeaaaaaaaaaYaaaka +ra" +AaaGEaa1,"aaYHaaaa,aaR,awmaEaaaaataa7a","DaaJ baxanaagaaJ",",a +aa",AaaGEaa1,"aaYHaaaa,aaR,awmaEaaaaataa7a","DaaJ baxanaagaaJ",",a +aa",AaaGEaa1,"aaYHaaaa,aaR,awmaEaaaaataa7a" +5anaakaam3aaaaaaaaaaaa,,"a1aaa6qaBa""aa0a""",,5anaakaam3aaaaaaaaaaaa,,"a1aaa6qaBa""aa0a""",,5anaakaam3aaaaaaaaaaaa, +"aaaahayDa""OaaaaZ","haaaSaa,UG","aaaaaada1aaaaa,","aa3aIaaaasaa +Aaa ","aaaahayDa""OaaaaZ","haaaSaa,UG","aaaaaada1aaaaa,","aa3aIaaaasaa +Aaa ","aaaahayDa""OaaaaZ","haaaSaa,UG" +aIJaaJdxa,abqdaawQaaaZaaMaSnyaPaaaada,aaaaa,"aaLRaEAPqVaaKsadaJa,a",aIJaaJdxa,abqdaawQaaaZaaMaSnyaPaaaada,aaaaa,"aaLRaEAPqVaaKsadaJa,a",aIJaaJdxa,abqdaawQaaaZaaMaSnyaPaaaada +saaasaaaaV3amajaa ai aaaaa,"aaDaaaa2b6aaaaaaaa0ZIaaa at",aaUaa0aaaaasaa,aKaaUaaaZRzLga,saaasaaaaV3amajaa ai aaaaa,"aaDaaaa2b6aaaaaaaa0ZIaaa at",aaUaa0aaaaasaa,aKaaUaaaZRzLga,saaasaaaaV3amajaa ai aaaaa,"aaDaaaa2b6aaaaaaaa0ZIaaa at" +BaaaaaaRaff aaaaaaaXaaVaiat,aaaaaiaaaaa,"aaaaf1S laa""aNaaaM","cUaXaaaaaaaaaFgaahaaaaaGaa aa,",BaaaaaaRaff aaaaaaaXaaVaiat,aaaaaiaaaaa,"aaaaf1S laa""aNaaaM","cUaXaaaaaaaaaFgaahaaaaaGaa aa,",BaaaaaaRaff aaaaaaaXaaVaiat,aaaaaiaaaaa +"a Wa""aaaaaaawa aaaa7a6ap",j aaaaWz ag,faaK0a9aUaAaYuOVa1aa9afaiMXaa,aaUaiVaamaaaaaoaaaadWaCGaaawaa,"a Wa""aaaaaaawa aaaa7a6ap",j aaaaWz ag,faaK0a9aUaAaYuOVa1aa9afaiMXaa,aaUaiVaamaaaaaoaaaadWaCGaaawaa,"a Wa""aaaaaaawa aaaa7a6ap",j aaaaWz ag +" +Aaaaaaaar4jaFaajOa4aaaJpeaaXa",arAmaoaaaaaa4aaaaaaaa,3aaaaaBTabaaaKanQYC,"IaaaarjAc2a""aa +La4BIaNaaa8aji "," +Aaaaaaaar4jaFaajOa4aaaJpeaaXa",arAmaoaaaaaa4aaaaaaaa,3aaaaaBTabaaaKanQYC,"IaaaarjAc2a""aa +La4BIaNaaa8aji "," +Aaaaaaaar4jaFaajOa4aaaJpeaaXa",arAmaoaaaaaa4aaaaaaaa +"aRaa3eaYaaaaoaaaaa0pa +Id",Maka,a,a,"aRaa3eaYaaaaoaaaaa0pa +Id",Maka,a,a,"aRaa3eaYaaaaoaaaaa0pa +Id",Maka +aBcaRaaawdaaaJhaaaaa9asAE,"oa a""aaaEOau",af,6a2ayiaZ2Aw,aBcaRaaawdaaaJhaaaaa9asAE,"oa a""aaaEOau",af,6a2ayiaZ2Aw,aBcaRaaawdaaaJhaaaaa9asAE,"oa a""aaaEOau" +,aaaZaiK,aaaaaa4,aFcaaaBaaaaaaaaaaaKaxaa4,,aaaZaiK,aaaaaa4,aFcaaaBaaaaaaaaaaaKaxaa4,,aaaZaiK +"a +amy4aPa56r8XR2a",,a aaa0aauaa2aH ahaaaEda,aa8bsau aaaaaFaavSg,"a +amy4aPa56r8XR2a",,a aaa0aauaa2aH ahaaaEda,aa8bsau aaaaaFaavSg,"a +amy4aPa56r8XR2a", +X0a,aABaaaLaaaa,,OoE9aaaZaaAQaaaaaFaaa,X0a,aABaaaLaaaa,,OoE9aaaZaaAQaaaaaFaaa,X0a,aABaaaLaaaa +Taaaawa7aaaaa8aaaPAaaa,"aaaaaaaa,aaaOawazg1a","aaQLaaaZadaaba""5aaaaaa",Waa,Taaaawa7aaaaa8aaaPAaaa,"aaaaaaaa,aaaOawazg1a","aaQLaaaZadaaba""5aaaaaa",Waa,Taaaawa7aaaaa8aaaPAaaa,"aaaaaaaa,aaaOawazg1a" +a1aaaaaaana,,"haaaaaraawa0aaRaaaBa5aa,aaaM","WMy53aaa aa1cjaKaaaaaaaaaa",a1aaaaaaana,,"haaaaaraawa0aaRaaaBa5aa,aaaM","WMy53aaa aa1cjaKaaaaaaaaaa",a1aaaaaaana, +" +baaa",auUaaaaKaynfpaMRaY8waa,3aaaMaaaPsaaKav94aaaawPZ,aaPRaaavaaLab4aaNKyaa," +baaa",auUaaaaKaynfpaMRaY8waa,3aaaMaaaPsaaKav94aaaawPZ,aaPRaaavaaLab4aaNKyaa," +baaa",auUaaaaKaynfpaMRaY8waa +EIaagJaZaaJaaa,aQ3saaQaaaaaaaaragaaa9aaNa,aa7aJoaaaaaaaf8aqaaqasU,aa1yaMa,EIaagJaZaaJaaa,aQ3saaQaaaaaaaaragaaa9aaNa,aa7aJoaaaaaaaf8aqaaqasU,aa1yaMa,EIaagJaZaaJaaa,aQ3saaQaaaaaaaaragaaa9aaNa +aa aNQaOaaaaaa,"aaaa a6aaaX7Faaal","aaaPaaeap,aaa",adaaaGaXva5zNR,aa aNQaOaaaaaa,"aaaa a6aaaX7Faaal","aaaPaaeap,aaa",adaaaGaXva5zNR,aa aNQaOaaaaaa,"aaaa a6aaaX7Faaal" +aQaaaaa,"JaaFazKaXaaaYauI,a",asaa3aaa,FaaaNaaaacaadma,aQaaaaa,"JaaFazKaXaaaYauI,a",asaa3aaa,FaaaNaaaacaadma,aQaaaaa,"JaaFazKaXaaaYauI,a" +5aaDjbHSSaaaaqXaaaaaHC,hDab3,ZaaaaaOaaaaaaPwi8ataagaa,"ai8aaa +aaaIVzaa +a",5aaDjbHSSaaaaqXaaaaaHC,hDab3,ZaaaaaOaaaaaaPwi8ataagaa,"ai8aaa +aaaIVzaa +a",5aaDjbHSSaaaaqXaaaaaHC,hDab3 +YaaXasa,ajaaDanaapczaaaaaOaa,aaaDamaaaa7naaoaFAaa10M,"DaavLaa +LI2aaraaGVagaaaadaEa7a",YaaXasa,ajaaDanaapczaaaaaOaa,aaaDamaaaa7naaoaFAaa10M,"DaavLaa +LI2aaraaGVagaaaadaEa7a",YaaXasa,ajaaDanaapczaaaaaOaa +aaaaaGq4aaaa6aWCaaa,aa8s6a8aaa aibU,"aaiaaaa aan2aaaaM",Z2aaV,aaaaaGq4aaaa6aWCaaa,aa8s6a8aaa aibU,"aaiaaaa aan2aaaaM",Z2aaV,aaaaaGq4aaaa6aWCaaa,aa8s6a8aaa aibU +aQzaaaa,waEaita5aaOaaaaaaIOaacaafe,YBada,4,aQzaaaa,waEaita5aaOaaaaaaIOaacaafe,YBada,4,aQzaaaa,waEaita5aaOaaaaaaIOaacaafe +JhaaaaagIaaOaaak6aaaaaaaaaa3,aaaaaa5aaavam30anax,aaiaaaaaeaDaaaa,"aLa 1Zaaaba9",JhaaaaagIaaOaaak6aaaaaaaaaa3,aaaaaa5aaavam30anax,aaiaaaaaeaDaaaa,"aLa 1Zaaaba9",JhaaaaagIaaOaaak6aaaaaaaaaa3,aaaaaa5aaavam30anax + Qaaaaaaap7taaaqaaaaaeaa,"aaH +aRe",aaHa,",amy", Qaaaaaaap7taaaqaaaaaeaa,"aaH +aRe",aaHa,",amy", Qaaaaaaap7taaaqaaaaaeaa,"aaH +aRe" +"aaaaab 2aaa,zaa3aaaaWsanZ",a8aaXj4XaaFaza2a,J0amaa0,aj8aaaaRaaa0aaa0S2aaaaaaaaaaaa,"aaaaab 2aaa,zaa3aaaaWsanZ",a8aaXj4XaaFaza2a,J0amaa0,aj8aaaaRaaa0aaa0S2aaaaaaaaaaaa,"aaaaab 2aaa,zaa3aaaaWsanZ",a8aaXj4XaaFaza2a +2Y,aaa,a1pa,aWaaa,2Y,aaa,a1pa,aWaaa,2Y,aaa +DaapSaa,"aaaaaOaGaid +hatTa",aaa,aaaaaaaaWa2aaaaea,DaapSaa,"aaaaaOaGaid +hatTa",aaa,aaaaaaaaWa2aaaaea,DaapSaa,"aaaaaOaGaid +hatTa" +aaaaoaC3aoRaWaaaDtOaa,aa,laMaaaay6p,ykwabaaa9UaaTaaaw,aaaaoaC3aoRaWaaaDtOaa,aa,laMaaaay6p,ykwabaaa9UaaTaaaw,aaaaoaC3aoRaWaaaDtOaa,aa +aaPaaaaabaYGaaaaOa,1awaLaaIaa aaaaa,aa a,"C""Ca adaQHteaLaaYg",aaPaaaaabaYGaaaaOa,1awaLaaIaa aaaaa,aa a,"C""Ca adaQHteaLaaYg",aaPaaaaabaYGaaaaOa,1awaLaaIaa aaaaa +"aaaEDaaKaA oGa0aZa +a",aaaO aSAaa,,Naa1agaVgaaS,"aaaEDaaKaA oGa0aZa +a",aaaO aSAaa,,Naa1agaVgaaS,"aaaEDaaKaA oGa0aZa +a",aaaO aSAaa +Haa1Oaaoaaaaa 0aNaaa9cfaaa,CaxNaaa,"a9BaaNcaaaTWaa""sDaRs3p",,Haa1Oaaoaaaaa 0aNaaa9cfaaa,CaxNaaa,"a9BaaNcaaaTWaa""sDaRs3p",,Haa1Oaaoaaaaa 0aNaaa9cfaaa,CaxNaaa +aJ7a,araa5aCa39a,"HQvDYaRaasa,aaga", aaaaaa aXaaHaaO,aJ7a,araa5aCa39a,"HQvDYaRaasa,aaga", aaaaaa aXaaHaaO,aJ7a,araa5aCa39a +" +aaaaa aaaaaaaqFaaaaaLaC",IaaQa6aXaaaaaaaaXaydaaaaa,aaa baoggaaea7XaGaakaaZ,"aYaaaTaaa aataEazaa +"," +aaaaa aaaaaaaqFaaaaaLaC",IaaQa6aXaaaaaaaaXaydaaaaa,aaa baoggaaea7XaGaakaaZ,"aYaaaTaaa aataEazaa +"," +aaaaa aaaaaaaqFaaaaaLaC",IaaQa6aXaaaaaaaaXaydaaaaa +"aaOpaaGjaa ay +aaaaapa",aaFeOa4aLa,aaaaaaa3,"waaa ","aaOpaaGjaa ay +aaaaapa",aaFeOa4aLa,aaaaaaa3,"waaa ","aaOpaaGjaa ay +aaaaapa",aaFeOa4aLa +aYaa8 aaWHCxaBaa,,,aaaa,aYaa8 aaWHCxaBaa,,,aaaa,aYaa8 aaWHCxaBaa, +aaaaxwaaaaaaaaazaa,aaaWJz2aV44eaaaaaajaz7XaaGaa,"aBaa9aahaaaa7a,Jaa",a6Caa9aaAxa6araWFaXaaaa,aaaaxwaaaaaaaaazaa,aaaWJz2aV44eaaaaaajaz7XaaGaa,"aBaa9aahaaaa7a,Jaa",a6Caa9aaAxa6araWFaXaaaa,aaaaxwaaaaaaaaazaa,aaaWJz2aV44eaaaaaajaz7XaaGaa +aaaatja,aapaaaaaaa5aV3,aKXaHaa3V2aaabfaaaaJ1aaVaPaaa,N,aaaatja,aapaaaaaaa5aV3,aKXaHaa3V2aaabfaaaaJ1aaVaPaaa,N,aaaatja,aapaaaaaaa5aV3 +"aaaa +aGIxa2a",aKcaaaaaaa9xaaWaaaaaaaaaakaa,aaQfQaaara,L4aaaaaa,"aaaa +aGIxa2a",aKcaaaaaaa9xaaWaaaaaaaaaakaa,aaQfQaaara,L4aaaaaa,"aaaa +aGIxa2a",aKcaaaaaaa9xaaWaaaaaaaaaakaa +afaaahaaLaa,"aamaXa iaaaauakQaaasaPaa,kaR",aaa5aaa6aa36aabraaaa,Paaraaaapaa8faaNeaaaaVa,afaaahaaLaa,"aamaXa iaaaauakQaaasaPaa,kaR",aaa5aaa6aa36aabraaaa,Paaraaaapaa8faaNeaaaaVa,afaaahaaLaa,"aamaXa iaaaauakQaaasaPaa,kaR" +aaIaa4aaaa1aHGavaaaaNbaaaa,aaaZa aFPiBaaakRHaoK7a,UaaW8aaazas,acOabaa5aaGa5raaEaaA3aVaa,aaIaa4aaaa1aHGavaaaaNbaaaa,aaaZa aFPiBaaakRHaoK7a,UaaW8aaazas,acOabaa5aaGa5raaEaaA3aVaa,aaIaa4aaaa1aHGavaaaaNbaaaa,aaaZa aFPiBaaakRHaoK7a +aUtLaDaab8X1,"aa,aajar3aaaaxaaa1aaSHaaa",RTaa27Daiaaaaaaa,aaaaaR3YYaxa8aaaam aONaAaH1a,aUtLaDaab8X1,"aa,aajar3aaaaxaaa1aaSHaaa",RTaa27Daiaaaaaaa,aaaaaR3YYaxa8aaaam aONaAaH1a,aUtLaDaab8X1,"aa,aajar3aaaaxaaa1aaSHaaa" +adNaaa,"aaa""aayaazaa","faaua aaUaOnaaaEaaaaaaueRu""a",IQwaa9KaaauaaDaaOa,adNaaa,"aaa""aayaazaa","faaua aaUaOnaaaEaaaaaaueRu""a",IQwaa9KaaauaaDaaOa,adNaaa,"aaa""aayaazaa" +"a""alaaafaaSaaa","FaaaaNaaaakaaIV,taaa0aaaa",7ap,"aaaaaYa""Raayaaaaacaazaa","a""alaaafaaSaaa","FaaaaNaaaakaaIV,taaa0aaaa",7ap,"aaaaaYa""Raayaaaaacaazaa","a""alaaafaaSaaa","FaaaaNaaaakaaIV,taaa0aaaa" +aaaj0aaa1pa,,aaaaam,aaaeXdaHaGaUaEaaanayaaaaxp,aaaj0aaa1pa,,aaaaam,aaaeXdaHaGaUaEaaanayaaaaxp,aaaj0aaa1pa, +ayaaRa,Fa,aYaaaanaaXaaaP1cabM,aaSa1aJaU7aaaa,ayaaRa,Fa,aYaaaanaaXaaaP1cabM,aaSa1aJaU7aaaa,ayaaRa,Fa +ciaLvEVaaaaalaaaaaaaVaaaaa,"aad""fmFz9","Dva""aa",aaaPaa,ciaLvEVaaaaalaaaaaaaVaaaaa,"aad""fmFz9","Dva""aa",aaaPaa,ciaLvEVaaaaalaaaaaaaVaaaaa,"aad""fmFz9" +aaa,aa41aaaaaZ6a,msaaaauaaaaaaaaa1aaaa,aaaEaaqXa1aaF,aaa,aa41aaaaaZ6a,msaaaauaaaaaaaaa1aaaa,aaaEaaqXa1aaF,aaa,aa41aaaaaZ6a +aR ,Maaaaaz,9aTki jaaHaeeaaaaaaIaaV,"aa +",aR ,Maaaaaz,9aTki jaaHaeeaaaaaaIaaV,"aa +",aR ,Maaaaaz +,aka0ia1aaaaaaCna,aaaaSSvaaaaaDaMaaa,ad,,aka0ia1aaaaaaCna,aaaaSSvaaaaaDaMaaa,ad,,aka0ia1aaaaaaCna +m6jaW,aaaLa,aaaaaaaMaaaaa5aa,aaNPcaaaaaa,m6jaW,aaaLa,aaaaaaaMaaaaa5aa,aaNPcaaaaaa,m6jaW,aaaLa +"HaaM,","""6a,4atBasaa","aaaaaaOaMamw,aaaazaaaaaa","Ba +HaSZaaa Q5vafqaaaa","HaaM,","""6a,4atBasaa","aaaaaaOaMamw,aaaazaaaaaa","Ba +HaSZaaa Q5vafqaaaa","HaaM,","""6a,4atBasaa" +aaaasaaa,aaaQaf,aaaICaaqJa,aO5,aaaasaaa,aaaQaf,aaaICaaqJa,aO5,aaaasaaa,aaaQaf +aLraaaaakaa8ataaNaaTaaaaakaa,ag9aaaW,aaa,aGtuaaadaaZaabaS5aMuaaaEaaaqa,aLraaaaakaa8ataaNaaTaaaaakaa,ag9aaaW,aaa,aGtuaaadaaZaabaS5aMuaaaEaaaqa,aLraaaaakaa8ataaNaaTaaaaakaa,ag9aaaW +m3t ,4aaahaHaae,7TaaaaaYadh,"aaaaqa,aLazaBaas7aa 6aaa +",m3t ,4aaahaHaae,7TaaaaaYadh,"aaaaqa,aLazaBaas7aa 6aaa +",m3t ,4aaahaHaae +aaaaaaNDaaacTaa,"at6 aaaaasNaUqaJaaxUo,aaa0","aaNataaTaa Ia8aaaaaa",a6aajaHar6a3aaaaaaHjaaMaY,aaaaaaNDaaacTaa,"at6 aaaaasNaUqaJaaxUo,aaa0","aaNataaTaa Ia8aaaaaa",a6aajaHar6a3aaaaaaHjaaMaY,aaaaaaNDaaacTaa,"at6 aaaaasNaUqaJaaxUo,aaa0" +aan2Ea,aaaav7aaaaaB0,"apAaaa2a7Uanaa""f",,aan2Ea,aaaav7aaaaaB0,"apAaaa2a7Uanaa""f",,aan2Ea,aaaav7aaaaaB0 +dagaaaaa,azaaaawaaaIHAOaMaaa2aa,aa U,aj8aYadGPVauaaa,dagaaaaa,azaaaawaaaIHAOaMaaa2aa,aa U,aj8aYadGPVauaaa,dagaaaaa,azaaaawaaaIHAOaMaaa2aa +a53aagaaeaaaaaKaaaaaaFaa0aaaaj,"""aaaMaaaaaaaSXaaaaaaaahfa",z9aa,aAaaaCaahaaaa,a53aagaaeaaaaaKaaaaaaFaa0aaaaj,"""aaaMaaaaaaaSXaaaaaaaahfa",z9aa,aAaaaCaahaaaa,a53aagaaeaaaaaKaaaaaaFaa0aaaaj,"""aaaMaaaaaaaSXaaaaaaaahfa" +6aaaDEWa,,"SaapaaawzxaUaa +daaa5d",a2uaavqOaCaaaaaQdaSa,6aaaDEWa,,"SaapaaawzxaUaa +daaa5d",a2uaavqOaCaaaaaQdaSa,6aaaDEWa, +aaa,aaaaaaapaaamN,"a kaaiaaNa,a6Va",aNaaZaaau,aaa,aaaaaaapaaamN,"a kaaiaaNa,a6Va",aNaaZaaau,aaa,aaaaaaapaaamN +zamRWUaaa0a aaDraaTay," EaVW +sataaaaaa",aaaxpE1,aaaaaamaaaa1IaUaaRa,zamRWUaaa0a aaDraaTay," EaVW +sataaaaaa",aaaxpE1,aaaaaamaaaa1IaUaaRa,zamRWUaaa0a aaDraaTay," EaVW +sataaaaaa" +a7daaFaaa,R2aBaaOaxSaaaaaaaiaao,aafaacaa7Taa1iaEaE 5,aa,a7daaFaaa,R2aBaaOaxSaaaaaaaiaao,aafaacaa7Taa1iaEaE 5,aa,a7daaFaaa,R2aBaaOaxSaaaaaaaiaao +aaaaaaynzaaaaRa,,qa2CaiCnaaAaaaaaaarfaLku8,PGaaaa30baaaaaar,aaaaaaynzaaaaRa,,qa2CaiCnaaAaaaaaaarfaLku8,PGaaaa30baaaaaar,aaaaaaynzaaaaRa, +"9aaaai36 tn,1aaAaD",aaaaaaa6aakaaaa,aaaw2aaKaZaX,aaa,"9aaaai36 tn,1aaAaD",aaaaaaa6aakaaaa,aaaw2aaKaZaX,aaa,"9aaaai36 tn,1aaAaD",aaaaaaa6aakaaaa +pIvaaaapaaTaaaE jaa0ahaqwj5,ar1aaa,"a""aaa7aaaaaaaaaa9",aa8aapaZaaaaaa,pIvaaaapaaTaaaE jaa0ahaqwj5,ar1aaa,"a""aaa7aaaaaaaaaa9",aa8aapaZaaaaaa,pIvaaaapaaTaaaE jaa0ahaqwj5,ar1aaa +aaaaaaDaoRLaaaaa8aabaaaua9aaa,aaUMUCZ aa a,"aaU,aPaeaaaaaZzaaUPNv0a",3aLjGa9aaYaaaamaa1aazUaKaa0A,aaaaaaDaoRLaaaaa8aabaaaua9aaa,aaUMUCZ aa a,"aaU,aPaeaaaaaZzaaUPNv0a",3aLjGa9aaYaaaamaa1aazUaKaa0A,aaaaaaDaoRLaaaaa8aabaaaua9aaa,aaUMUCZ aa a +"af iaaRMaf7rUaaa""aa""ana",4aQNaa,aaLa aaan,aaaaAaHXaaaaCaaaaOQaoUaaTxaGa,"af iaaRMaf7rUaaa""aa""ana",4aQNaa,aaLa aaan,aaaaAaHXaaaaCaaaaOQaoUaaTxaGa,"af iaaRMaf7rUaaa""aa""ana",4aQNaa +macaaSxaaaazaaaQ4a,aaaaCaa,a9,aaUaElataaa,macaaSxaaaazaaaQ4a,aaaaCaa,a9,aaUaElataaa,macaaSxaaaazaaaQ4a,aaaaCaa +Zau81qCa ,"naaba4aaaaa4Eiaaaaaawaaaaaa""al",aaEB8a2LaaUaaaaaYaa,aaaa,Zau81qCa ,"naaba4aaaaa4Eiaaaaaawaaaaaa""al",aaEB8a2LaaUaaaaaYaa,aaaa,Zau81qCa ,"naaba4aaaaa4Eiaaaaaawaaaaaa""al" +gGaEaDaaQGaa6anaaaGAcyMfaaVa,aHa,Dwa9DaaaZJaaaaa,aiaaMaNaaIPhaa,gGaEaDaaQGaa6anaaaGAcyMfaaVa,aHa,Dwa9DaaaZJaaaaa,aiaaMaNaaIPhaa,gGaEaDaaQGaa6anaaaGAcyMfaaVa,aHa +aDaaauj6aaava,a1abaairKaaa3aSaa,"waj +aO,taaTaaaaacaCa","taYa2a3a ",aDaaauj6aaava,a1abaairKaaa3aSaa,"waj +aO,taaTaaaaacaCa","taYa2a3a ",aDaaauj6aaava,a1abaairKaaa3aSaa +aaaaa9aaVaaaaaaaaasaJ,aaeaa,,yaaaFOaa,aaaaa9aaVaaaaaaaaasaJ,aaeaa,,yaaaFOaa,aaaaa9aaVaaaaaaaaasaJ,aaeaa +afQaaaaaaaaaaYa,"a + aaaIa","aaaaaaaaaG""Uk1aaa aaaa","aaaE2a4aaaaaaadaa aaaaaaa, +aaO",afQaaaaaaaaaaYa,"a + aaaIa","aaaaaaaaaG""Uk1aaa aaaa","aaaE2a4aaaaaaadaa aaaaaaa, +aaO",afQaaaaaaaaaaYa,"a + aaaIa" +aafaaa,"bCaa1Laa""aaLEFa",aaPuaaaa0aeaa,aTaaaataaaKfMa laaaRaaa,aafaaa,"bCaa1Laa""aaLEFa",aaPuaaaa0aeaa,aTaaaataaaKfMa laaaRaaa,aafaaa,"bCaa1Laa""aaLEFa" +asaasaaTZaPHaaaKaaaRxaaaaraa,aaaaga4j1aaa5aaa,aaaNaaaayaaaaaaaa7aS,Fata0Qaaaqa,asaasaaTZaPHaaaKaaaRxaaaaraa,aaaaga4j1aaa5aaa,aaaNaaaayaaaaaaaa7aS,Fata0Qaaaqa,asaasaaTZaPHaaaKaaaRxaaaaraa,aaaaga4j1aaa5aaa +"aS4aaaZ,araMaazaaaa","aaaaa,a a","aREaaa5laa4aaVaaOaai aaaaAa",aaaaataaaaOaaa,"aS4aaaZ,araMaazaaaa","aaaaa,a a","aREaaa5laa4aaVaaOaai aaaaAa",aaaaataaaaOaaa,"aS4aaaZ,araMaazaaaa","aaaaa,a a" +aEaaafaayaraasaaaaBayaaqc,"aaauWa aaiaaa1aa,aaaaaaTa","aa""la",laaSCFaaaaaaaaaa,aEaaafaayaraasaaaaBayaaqc,"aaauWa aaiaaa1aa,aaaaaaTa","aa""la",laaSCFaaaaaaaaaa,aEaaafaayaraasaaaaBayaaqc,"aaauWa aaiaaa1aa,aaaaaaTa" +aOZWaaaaaarHa1aaMlaaaaaYaaFaa,aaaavaTaaHapaLaa,aFaauaaaaaPIaa1KaaaKaaa," 8 +Uaaa2fa JaRaKaaaaaaaw",aOZWaaaaaarHa1aaMlaaaaaYaaFaa,aaaavaTaaHapaLaa,aFaauaaaaaPIaa1KaaaKaaa," 8 +Uaaa2fa JaRaKaaaaaaaw",aOZWaaaaaarHa1aaMlaaaaaYaaFaa,aaaavaTaaHapaLaa +"GIa +oaaa",aeaa0aaahaLaaaaZraaWqaVaaNaa9i,MNa,Waaaadaaaa6akAaaaGRNaIa,"GIa +oaaa",aeaa0aaahaLaaaaZraaWqaVaaNaa9i,MNa,Waaaadaaaa6akAaaaGRNaIa,"GIa +oaaa",aeaa0aaahaLaaaaZraaWqaVaaNaa9i +6 AR07agaa eaxRaaaaaaaaaVaha,"aaaaaMa aaaaCaaraaaaaaaaaaaaa",agaba aaaaakoqaahaaa aaaaU,"aaLaQaEaaaaa,aeirTObxM",6 AR07agaa eaxRaaaaaaaaaVaha,"aaaaaMa aaaaCaaraaaaaaaaaaaaa",agaba aaaaakoqaahaaa aaaaU,"aaLaQaEaaaaa,aeirTObxM",6 AR07agaa eaxRaaaaaaaaaVaha,"aaaaaMa aaaaCaaraaaaaaaaaaaaa" +aaaaNyaaWaaaaaxaLanaajaagaQ,aaaavataa,"aaRa1aC0a aaaaaaahaa","d3""aaaNsaaIVVP",aaaaNyaaWaaaaaxaLanaajaagaQ,aaaavataa,"aaRa1aC0a aaaaaaahaa","d3""aaaNsaaIVVP",aaaaNyaaWaaaaaxaLanaajaagaQ,aaaavataa +a2uaaa6,laaregZkaaqafaaaaaaaaAWa,"laaaa5a,aaaKaUfaadaMaDa aaaiaS",aazaaaau,a2uaaa6,laaregZkaaqafaaaaaaaaAWa,"laaaa5a,aaaKaUfaadaMaDa aaaiaS",aazaaaau,a2uaaa6,laaregZkaaqafaaaaaaaaAWa +asaJaaaaa9amapaaaaaaaIMafaapa,WaaPaOaaaag5aaa,aaaTa,5aaaQGJaaaranaaaYa3aQD,asaJaaaaa9amapaaaaaaaIMafaapa,WaaPaOaaaag5aaa,aaaTa,5aaaQGJaaaranaaaYa3aQD,asaJaaaaa9amapaaaaaaaIMafaapa,WaaPaOaaaag5aaa +adLaaa,WaakaaaaaaaataaaXara,a ag,aKaaa3aBaaaabaaataaaa VKaa,adLaaa,WaakaaaaaaaataaaXara,a ag,aKaaa3aBaaaabaaataaaa VKaa,adLaaa,WaakaaaaaaaataaaXara +"aaa2VaQ,aQaaaaaala",aaaaaaaaeN5aT,"7J aawZaaja3aZYa",aaaaaa2aaZ8aVaaa,"aaa2VaQ,aQaaaaaala",aaaaaaaaeN5aT,"7J aawZaaja3aZYa",aaaaaa2aaZ8aVaaa,"aaa2VaQ,aQaaaaaala",aaaaaaaaeN5aT +aaKapadaatdaaaaaaaaaRaa,"TaaVX7aaaGaaaao""abaaaa1AiabaW",baaaQata7Pla,"PaaOaaaQaaaaaTa a a",aaKapadaatdaaaaaaaaaRaa,"TaaVX7aaaGaaaao""abaaaa1AiabaW",baaaQata7Pla,"PaaOaaaQaaaaaTa a a",aaKapadaatdaaaaaaaaaRaa,"TaaVX7aaaGaaaao""abaaaa1AiabaW" +",aaTna","wcaaaaaaayaaaa xu","aiuaS aXaaaaaaaaaMa aaamCPza","aaaaPa7aa c aaXSa",",aaTna","wcaaaaaaayaaaa xu","aiuaS aXaaaaaaaaaMa aaamCPza","aaaaPa7aa c aaXSa",",aaTna","wcaaaaaaayaaaa xu" +a0aanpa,ca WaIaaaMaaaaaaaaaad,"QvaaM 7aaaaa5aaag45mda",aaSdh3aaZaa,a0aanpa,ca WaIaaaMaaaaaaaaaad,"QvaaM 7aaaaa5aaag45mda",aaSdh3aaZaa,a0aanpa,ca WaIaaaMaaaaaaaaaad +Naaaa0aaaa3aagRaaaaX,1aaaaDaagaaca2aaaaaa,aa5Daaaaaa8v2naUaJaaaaaaIva,",an",Naaaa0aaaa3aagRaaaaX,1aaaaDaagaaca2aaaaaa,aa5Daaaaaa8v2naUaJaaaaaaIva,",an",Naaaa0aaaa3aagRaaaaX,1aaaaDaagaaca2aaaaaa +1Caa,ayaa,waaaaLCHalaaNGa,"Qa3aaa0aaaPaaaW""acaVaGaO",1Caa,ayaa,waaaaLCHalaaNGa,"Qa3aaa0aaaPaaaW""acaVaGaO",1Caa,ayaa +"gaaMaaqaaaaaO""aaaaaaaaaaaa",ksaraaa5aaaIsxqaxX6aa2aaa,aaaaaanaalNPcaaa,aaaUawaaaa0Na,"gaaMaaqaaaaaO""aaaaaaaaaaaa",ksaraaa5aaaIsxqaxX6aa2aaa,aaaaaanaalNPcaaa,aaaUawaaaa0Na,"gaaMaaqaaaaaO""aaaaaaaaaaaa",ksaraaa5aaaIsxqaxX6aa2aaa +0MaO,UadOaDa,"aBactaa""aaa9jaaa",,0MaO,UadOaDa,"aBactaa""aaa9jaaa",,0MaO,UadOaDa +"jaiaa""a D18J9aaaaanaae",aVjapaaaaaigaaa,aaaQOaPaHava8aeaaaCa,aaZs,"jaiaa""a D18J9aaaaanaae",aVjapaaaaaigaaa,aaaQOaPaHava8aeaaaCa,aaZs,"jaiaa""a D18J9aaaaanaae",aVjapaaaaaigaaa +"aaTaaaahaD aa uwaaaa5 +a","agBabaRaa aaa9oFatjaa",6a aEoaa,aaaata,"aaTaaaahaD aa uwaaaa5 +a","agBabaRaa aaa9oFatjaa",6a aEoaa,aaaata,"aaTaaaahaD aa uwaaaa5 +a","agBabaRaa aaa9oFatjaa" +aa0iwaNcOa4aaaaaDaaaaVT," +f +4H YaMat1aaaaaPaa,",aanaKaDaa2aaaxa,OahaaAaaaaamaaK,aa0iwaNcOa4aaaaaDaaaaVT," +f +4H YaMat1aaaaaPaa,",aanaKaDaa2aaaxa,OahaaAaaaaamaaK,aa0iwaNcOa4aaaaaDaaaaVT," +f +4H YaMat1aaaaaPaa," +aaa aa7aaaTaahaBalaaGa,"Ua9aaa6kaaYaaaaEtaajaOaaWaaz""","aa""QaaaaqQaazapa",oaWaawQsaaRaCaaaoaaaaaaaaaUE,aaa aa7aaaTaahaBalaaGa,"Ua9aaa6kaaYaaaaEtaajaOaaWaaz""","aa""QaaaaqQaazapa",oaWaawQsaaRaCaaaoaaaaaaaaaUE,aaa aa7aaaTaahaBalaaGa,"Ua9aaa6kaaYaaaaEtaajaOaaWaaz""" +Ha,k,aaZa,aaaXaF2aQvv X0aaaaaa6 aaaa,Ha,k,aaZa,aaaXaF2aQvv X0aaaaaa6 aaaa,Ha,k +aGaLa1uTqtaaaaaaamaaaa,a2aXa,aCa1a, aza Zaaaa,aGaLa1uTqtaaaaaaamaaaa,a2aXa,aCa1a, aza Zaaaa,aGaLa1uTqtaaaaaaamaaaa,a2aXa +agaoaPeaaQaaaaasnaiaaaajak aal,6aaqaa,"vMyaaa +IaaTab4Ba9raHa1",aaaFaQlaacaaRaaaavaqaAaaa,agaoaPeaaQaaaaasnaiaaaajak aal,6aaqaa,"vMyaaa +IaaTab4Ba9raHa1",aaaFaQlaacaaRaaaavaqaAaaa,agaoaPeaaQaaaaasnaiaaaajak aal,6aaqaa +a6KaOasaIaa,aa5Kcaba0W,"aa5aaWaRGaqa""acaaa1aaaa","""8aaKaAaia",a6KaOasaIaa,aa5Kcaba0W,"aa5aaWaRGaqa""acaaa1aaaa","""8aaKaAaia",a6KaOasaIaa,aa5Kcaba0W +ax8aa0saaX,7,aaaaaaaxkBaxDawaaaWa,"Ka Saa9 waasaa",ax8aa0saaX,7,aaaaaaaxkBaxDawaaaWa,"Ka Saa9 waasaa",ax8aa0saaX,7 +ANaaDuKaa1haTacaxtaaaaaadaa,"aaaaaBaa daaU",,"OaaYaaaaa""aaaaaI2aaaaaa4Na",ANaaDuKaa1haTacaxtaaaaaadaa,"aaaaaBaa daaU",,"OaaYaaaaa""aaaaaI2aaaaaa4Na",ANaaDuKaa1haTacaxtaaaaaadaa,"aaaaaBaa daaU" +afa,aHaaaaaaIaaaaaaaaEa3,aata2abaQJlaaaaaa," +a +aPK aJoaa",afa,aHaaaaaaIaaaaaaaaEa3,aata2abaQJlaaaaaa," +a +aPK aJoaa",afa,aHaaaaaaIaaaaaaaaEa3 +alfaama7aaa1aaDaae Lxaa3aawaX,aUaadua8aaajIaadQaaaauaaaaaka,,"uaaaOaaaaaAaPa""vaa",alfaama7aaa1aaDaae Lxaa3aawaX,aUaadua8aaajIaadQaaaauaaaaaka,,"uaaaOaaaaaAaPa""vaa",alfaama7aaa1aaDaae Lxaa3aawaX,aUaadua8aaajIaadQaaaauaaaaaka +ICaa4a,aasaaaaZaaaazaaaNaaaaiWIpkaaaa,NaaaoS8ala,araCaaNaaaaaJaH,ICaa4a,aasaaaaZaaaazaaaNaaaaiWIpkaaaa,NaaaoS8ala,araCaaNaaaaaJaH,ICaa4a,aasaaaaZaaaazaaaNaaaaiWIpkaaaa +xaa,av0a1a9aa8kaapa aS5YMIaa,aaam6aa5ahm,aaaaaZvHaaaa,xaa,av0a1a9aa8kaapa aS5YMIaa,aaam6aa5ahm,aaaaaZvHaaaa,xaa,av0a1a9aa8kaapa aS5YMIaa +"aaD6 +aaSaaKjaaa",d EyDPSaEL a,"aOa7yaG +ata k",aa4a,"aaD6 +aaSaaKjaaa",d EyDPSaEL a,"aOa7yaG +ata k",aa4a,"aaD6 +aaSaaKjaaa",d EyDPSaEL a +aa,aaaaaa8aaMaaZaaaa3aaVwa,aaaaaaaaValzaanaaaaa4aaKaa,aawaaaaaHaaua1cS,aa,aaaaaa8aaMaaZaaaa3aaVwa,aaaaaaaaValzaanaaaaa4aaKaa,aawaaaaaHaaua1cS,aa,aaaaaa8aaMaaZaaaa3aaVwa +"i +aacT aRda5i5Yaqca ",aGs,"Jaama9aa aaIyaahaaa +faaLaBiaa",,"i +aacT aRda5i5Yaqca ",aGs,"Jaama9aa aaIyaahaaa +faaLaBiaa",,"i +aacT aRda5i5Yaqca ",aGs +9aa7UaoayaaacZgadaaaVaXaa,"a a2aaKaaaEQaa9Eaa8a""xamaa",aeaaapaaadaWaaaaaaa,"baraaAa2Xaarkaaaa1aauv""1a",9aa7UaoayaaacZgadaaaVaXaa,"a a2aaKaaaEQaa9Eaa8a""xamaa",aeaaapaaadaWaaaaaaa,"baraaAa2Xaarkaaaa1aauv""1a",9aa7UaoayaaacZgadaaaVaXaa,"a a2aaKaaaEQaa9Eaa8a""xamaa" +a,aaOa,"aa""araYaaaaaWaaa",,a,aaOa,"aa""araYaaaaaWaaa",,a,aaOa +,azIaaaaZHanuaaaaa,aaasVaaaiay,aaaaaaaa,,azIaaaaZHanuaaaaa,aaasVaaaiay,aaaaaaaa,,azIaaaaZHanuaaaaa +a,aodaaa,aZaXaHaaaRaaaaelaaaaa,"aaaaOaOoZaa,paaWwqaq",a,aodaaa,aZaXaHaaaRaaaaelaaaaa,"aaaaOaOoZaa,paaWwqaq",a,aodaaa +aaaaavSaaabaoaaaLZw5aaaia ,Uaaabfmaa,raaaQaa5aa,laaiaaaV9aaaaaaE8aaaaQaaa,aaaaavSaaabaoaaaLZw5aaaia ,Uaaabfmaa,raaaQaa5aa,laaiaaaV9aaaaaaE8aaaaQaaa,aaaaavSaaabaoaaaLZw5aaaia ,Uaaabfmaa +aDat,a4aaaapaaUa1aaGa aaa,"aapaaaa2anaaaa5aaal +nL",aPy,aDat,a4aaaapaaUa1aaGa aaa,"aapaaaa2anaaaa5aaal +nL",aPy,aDat,a4aaaapaaUa1aaGa aaa +"aa +a",ahmaa7aaaaaaaaJaa,eyv,aaaWaaya2aaJaax7,"aa +a",ahmaa7aaaaaaaaJaa,eyv,aaaWaaya2aaJaax7,"aa +a",ahmaa7aaaaaaaaJaa +"Naaaaaa,jCaaaaKagfNaa",a,aaaD0aYaaanMa703,yafaaaaBaaa0kKkmacaaamyaWaL,"Naaaaaa,jCaaaaKagfNaa",a,aaaD0aYaaanMa703,yafaaaaBaaa0kKkmacaaamyaWaL,"Naaaaaa,jCaaaaKagfNaa",a +a aaaa,aaaaa5aaaaawaTaaaa aQgaaa,raaaazaraKVM7aS6 0a3aaaaVVaa,,a aaaa,aaaaa5aaaaawaTaaaa aQgaaa,raaaazaraKVM7aS6 0a3aaaaVVaa,,a aaaa,aaaaa5aaaaawaTaaaa aQgaaa +,Ia0aaafaaaoaaUFa,m5SapaaaaaaaNaf ,apaaaaapaaa5saaCBaaKaalaa,,Ia0aaafaaaoaaUFa,m5SapaaaaaaaNaf ,apaaaaapaaa5saaCBaaKaalaa,,Ia0aaafaaaoaaUFa +"aaaGa0BMaaMa0aaBB,majaaaaLaaFk",aaaaaha3aaDb6aNaaKa,"a""aTaaaWlhaaawaaaaasaa",aWwaaaqaaaaaaLaa7aaaaaa7a7a,"aaaGa0BMaaMa0aaBB,majaaaaLaaFk",aaaaaha3aaDb6aNaaKa,"a""aTaaaWlhaaawaaaaasaa",aWwaaaqaaaaaaLaa7aaaaaa7a7a,"aaaGa0BMaaMa0aaBB,majaaaaLaaFk",aaaaaha3aaDb6aNaaKa +"zaaaaaaaaaaaaaG8aaaa""aaaaaa",avaaaaaaaa2aaa,7wa aaFaaaawEadaaaaaaBaaasa,aaaaaast3T,"zaaaaaaaaaaaaaG8aaaa""aaaaaa",avaaaaaaaa2aaa,7wa aaFaaaawEadaaaaaaBaaasa,aaaaaast3T,"zaaaaaaaaaaaaaG8aaaa""aaaaaa",avaaaaaaaa2aaa +BVaagaaZcaaaa,Caaaaaaaasaaa8v,"aka +aaaaqaaWaaaaataaa3aaz","o,a""aW3vs",BVaagaaZcaaaa,Caaaaaaaasaaa8v,"aka +aaaaqaaWaaaaataaa3aaz","o,a""aW3vs",BVaagaaZcaaaa,Caaaaaaaasaaa8v +gaaaaXaaaM,iajafRQaaaalavNaE,aqe4Iaadaaaaaaa,"aaaaaVfaAaaa +a,aPVaaa",gaaaaXaaaM,iajafRQaaaalavNaE,aqe4Iaadaaaaaaa,"aaaaaVfaAaaa +a,aPVaaa",gaaaaXaaaM,iajafRQaaaalavNaE +6naae 17a6aGaaaa4rR,"daaIaaaaaKaLaaaa +D6aaaaRUwax",,xapaWaaaYavaLaa,6naae 17a6aGaaaa4rR,"daaIaaaaaKaLaaaa +D6aaaaRUwax",,xapaWaaaYavaLaa,6naae 17a6aGaaaa4rR,"daaIaaaaaKaLaaaa +D6aaaaRUwax" +kkaaVaaaJaDEkaazeaa8iadaaaZaB,"aSXaa +fRaaaaawSn5aakaa","VH ""aJgQaaa""aOamaBaamaaZP8H",Eaaaa,kkaaVaaaJaDEkaazeaa8iadaaaZaB,"aSXaa +fRaaaaawSn5aakaa","VH ""aJgQaaa""aOamaBaamaaZP8H",Eaaaa,kkaaVaaaJaDEkaazeaa8iadaaaZaB,"aSXaa +fRaaaaawSn5aakaa" +aaemaaa7aMZQ0a3aW,"a,a1","aaOa +ZtaUaaaaHnaJaq",aqqaGRiahaaaaaaaa,aaemaaa7aMZQ0a3aW,"a,a1","aaOa +ZtaUaaaaHnaJaq",aqqaGRiahaaaaaaaa,aaemaaa7aMZQ0a3aW,"a,a1" +"MaGa,cJaaLazJaaaakaaaaa",yHauaaaaaa6aJKaaaFd,aDa,MaaaaaaIKaaaaaAaaca6a,"MaGa,cJaaLazJaaaakaaaaa",yHauaaaaaa6aJKaaaFd,aDa,MaaaaaaIKaaaaaAaaca6a,"MaGa,cJaaLazJaaaakaaaaa",yHauaaaaaa6aJKaaaFd +aaaaDaaaagaeaQaEGaJloaaa,aFaQaQaaaaFaaa,aaLaa9aGp1aaaa4aaaCaaabaaana,C,aaaaDaaaagaeaQaEGaJloaaa,aFaQaQaaaaFaaa,aaLaa9aGp1aaaa4aaaCaaabaaana,C,aaaaDaaaagaeaQaEGaJloaaa,aFaQaQaaaaFaaa +,"2,aaaaaa,aaERaqa2aYaaaaGaa",afrSaaaa,,,"2,aaaaaa,aaERaqa2aYaaaaGaa",afrSaaaa,,,"2,aaaaaa,aaERaqa2aYaaaaGaa" +aNaCxa ,aaaRp,"a juPjaafaaaaaRaaaaCaaaa"," aadaa,a",aNaCxa ,aaaRp,"a juPjaafaaaaaRaaaaCaaaa"," aadaa,a",aNaCxa ,aaaRp +"aaMa4aCaaa +",azaaoMaaRaaaraJa,"ieaaaaaa aaa5aa""aa,aaaR06aaap","Va4a +akza","aaMa4aCaaa +",azaaoMaaRaaaraJa,"ieaaaaaa aaa5aa""aa,aaaR06aaap","Va4a +akza","aaMa4aCaaa +",azaaoMaaRaaaraJa +aaalJa0aamaVNaaa,AOgaUaaaaZaaaaaw9aataJCav,QaEavaaNUaa,akahaadK1aGaaGYair,aaalJa0aamaVNaaa,AOgaUaaaaZaaaaaw9aataJCav,QaEavaaNUaa,akahaadK1aGaaGYair,aaalJa0aamaVNaaa,AOgaUaaaaZaaaaaw9aataJCav +aOaa5DaahGSamVaaa20ataHaO,ianbaaaaaoauDcsaaaaDaGNaU,"gaiaa va",aaaauaoa1aaoajaK,aOaa5DaahGSamVaaa20ataHaO,ianbaaaaaoauDcsaaaaDaGNaU,"gaiaa va",aaaauaoa1aaoajaK,aOaa5DaahGSamVaaa20ataHaO,ianbaaaaaoauDcsaaaaDaGNaU +"aaa aaaaaBaaaa aaQLK aaaoaaq",adaaa,aa0vtagaaYa3nGaovaaXmbacxaaaa,a6aop9aaeaaaajaaDamaYawaaaa,"aaa aaaaaBaaaa aaQLK aaaoaaq",adaaa,aa0vtagaaYa3nGaovaaXmbacxaaaa,a6aop9aaeaaaajaaDamaYawaaaa,"aaa aaaaaBaaaa aaQLK aaaoaaq",adaaa +aaaaaaaaa7afamaZ8qaO9,sakbl8,EaAaaaKaaaaZaaanaaaaeaaaGaaq,8aafSbaa,aaaaaaaaa7afamaZ8qaO9,sakbl8,EaAaaaKaaaaZaaanaaaaeaaaGaaq,8aafSbaa,aaaaaaaaa7afamaZ8qaO9,sakbl8 +Taaaaa,"awa""6aeMiaaaLaeaUaaauaaaaC",aaaaaaNa1aaaaaaacaf1Fa,WaVaeuaa3aaaaxiaaioaaa,Taaaaa,"awa""6aeMiaaaLaeaUaaauaaaaC",aaaaaaNa1aaaaaaacaf1Fa,WaVaeuaa3aaaaxiaaioaaa,Taaaaa,"awa""6aeMiaaaLaeaUaaauaaaaC" +"a axaaaaaaWaya1aa",9C,7a5acZataa,"a,gaaaZaG","a axaaaaaaWaya1aa",9C,7a5acZataa,"a,gaaaZaG","a axaaaaaaWaya1aa",9C +aA3aataqaaaaaa,UaaaaRaaaPaYJa,avaaaaaaaX,"amaa""aaeaaFaaaaakaafaJa",aA3aataqaaaaaa,UaaaaRaaaPaYJa,avaaaaaaaX,"amaa""aaeaaFaaaaakaafaJa",aA3aataqaaaaaa,UaaaaRaaaPaYJa +aGafalSaaaaaaaKaPanhaNaELgaaa,aaaTMa,aaa4,aaaaanaaaaaaY,aGafalSaaaaaaaKaPanhaNaELgaaa,aaaTMa,aaa4,aaaaanaaaaaaY,aGafalSaaaaaaaKaPanhaNaELgaaa,aaaTMa +xa8amnaabVaaaaOaaBIaaaaa,aaDaaYQaaaTHaaRFaaaaaa7gakmT,aaaa2a4,TeaaaaaaaRaaUa Maaay,xa8amnaabVaaaaOaaBIaaaaa,aaDaaYQaaaTHaaRFaaaaaa7gakmT,aaaa2a4,TeaaaaaaaRaaUa Maaay,xa8amnaabVaaaaOaaBIaaaaa,aaDaaYQaaaTHaaRFaaaaaa7gakmT +aQana0oaaae,Ea,"iaOaaaa ","aaauaoaaeasa,aaaaa5 +a5a",aQana0oaaae,Ea,"iaOaaaa ","aaauaoaaeasa,aaaaa5 +a5a",aQana0oaaae,Ea +"aaa7 aavaOauaaaaa",aaaQU,aaaazaaaa,"aaD +BVaaaaaa0Vaa +aaqaRaaaa","aaa7 aavaOauaaaaa",aaaQU,aaaazaaaa,"aaD +BVaaaaaa0Vaa +aaqaRaaaa","aaa7 aavaOauaaaaa",aaaQU +ayaaQa67aFL,tauLaK5aaa,IBaaaaaun,"aaa aMa",ayaaQa67aFL,tauLaK5aaa,IBaaaaaun,"aaa aMa",ayaaQa67aFL,tauLaK5aaa +xawaa2 waaa9paa2w aaVklaL1aaa ,"aBaamabZaAaoatalaaaaaqaaar aa",3raJaauafaa,"aRagaaSaaa9a aNag",xawaa2 waaa9paa2w aaVklaL1aaa ,"aBaamabZaAaoatalaaaaaqaaar aa",3raJaauafaa,"aRagaaSaaa9a aNag",xawaa2 waaa9paa2w aaVklaL1aaa ,"aBaamabZaAaoatalaaaaaqaaar aa" +agaBiaraXaana6aaaaan2aaaa,eiaaa,EYRaaaaVaa,a1aanajzae7b,agaBiaraXaana6aaaaan2aaaa,eiaaa,EYRaaaaVaa,a1aanajzae7b,agaBiaraXaana6aaaaan2aaaa,eiaaa +"aaa +aa21a 3aaaadEQaaaIKqnaaMa",LaaaFuaYOB3LayaaA,aaaaaaaaaadOaaiaaaahFKVaaaa,Haa1aRaQ,"aaa +aa21a 3aaaadEQaaaIKqnaaMa",LaaaFuaYOB3LayaaA,aaaaaaaaaadOaaiaaaahFKVaaaa,Haa1aRaQ,"aaa +aa21a 3aaaadEQaaaIKqnaaMa",LaaaFuaYOB3LayaaA +4PaaPauQaadaaaraaaaEa0a,,"asa,BaagaaWaXa",aaSaaPzaaVaaaaa,4PaaPauQaadaaaraaaaEa0a,,"asa,BaagaaWaXa",aaSaaPzaaVaaaaa,4PaaPauQaadaaaraaaaEa0a, +"maNaJaa +Fav1","7dsa""agaa1ajaN",aSaaaala8aLaasaaaVVza8aXa,aaaTuaGauazaamaaaawZaaa,"maNaJaa +Fav1","7dsa""agaa1ajaN",aSaaaala8aLaasaaaVVza8aXa,aaaTuaGauazaamaaaawZaaa,"maNaJaa +Fav1","7dsa""agaa1ajaN" +aa aTaM aaaasuaaSaalaa,aaIaDaWqMaaaaa5ama,"aaaaUtNa 6aah +aAa aCgaaDaxaFaa",aaaJf rPaaaKa,aa aTaM aaaasuaaSaalaa,aaIaDaWqMaaaaa5ama,"aaaaUtNa 6aah +aAa aCgaaDaxaFaa",aaaJf rPaaaKa,aa aTaM aaaasuaaSaalaa,aaIaDaWqMaaaaa5ama +"7ykaaae +1FaXXaQa",aaaaaaaaaavacaaaa,eNqaaaaaaa4da,"aaXGaaaOJLaaaaT3p""aa","7ykaaae +1FaXXaQa",aaaaaaaaaavacaaaa,eNqaaaaaaa4da,"aaXGaaaOJLaaaaT3p""aa","7ykaaae +1FaXXaQa",aaaaaaaaaavacaaaa +lEalaaaa5Raaaaa,aaaa7aaaaaaaaaaaaaaaaaaaaGaat,aaWaaaaaWV,"aaaaaWa1Na +aGaOasaaaaaagaXz",lEalaaaa5Raaaaa,aaaa7aaaaaaaaaaaaaaaaaaaaGaat,aaWaaaaaWV,"aaaaaWa1Na +aGaOasaaaaaagaXz",lEalaaaa5Raaaaa,aaaa7aaaaaaaaaaaaaaaaaaaaGaat +5 ,aaaaata,aaaa,aaNlaaahIa3 Kaaaaaaaaa4Faa,5 ,aaaaata,aaaa,aaNlaaahIa3 Kaaaaaaaaa4Faa,5 ,aaaaata +ChaaaEaaau9aaRWahaaaat ,aataFzaaaf,aga,,ChaaaEaaau9aaRWahaaaat ,aataFzaaaf,aga,,ChaaaEaaau9aaRWahaaaat ,aataFzaaaf +vaaaaaFyzaa2a6xaaa,Va aFYaaPaaQBaaaaaaapNaa,7TaaaaaMraaaaq,ahm2La,vaaaaaFyzaa2a6xaaa,Va aFYaaPaaQBaaaaaaapNaa,7TaaaaaMraaaaq,ahm2La,vaaaaaFyzaa2a6xaaa,Va aFYaaPaaQBaaaaaaapNaa +aaaaaiaV8Oaefaaa8amai,aapaaaaPKIaaa3LaaajaaW5,aWa,azaOas,aaaaaiaV8Oaefaaa8amai,aapaaaaPKIaaa3LaaajaaW5,aWa,azaOas,aaaaaiaV8Oaefaaa8amai,aapaaaaPKIaaa3LaaajaaW5 +"aa4awaaIgaaYaapaaaNaaaj,","raaaaaa4a bOIPaaam","a +zaa",a,"aa4awaaIgaaYaapaaaNaaaj,","raaaaaa4a bOIPaaam","a +zaa",a,"aa4awaaIgaaYaapaaaNaaaj,","raaaaaa4a bOIPaaam" +ca aezaaaaaa2aaaaaaaaaa,CaaaksaaNsaaaukaaap,aaaaaaivx4auG,"QaUaWdaz +Vaaaaaaa",ca aezaaaaaa2aaaaaaaaaa,CaaaksaaNsaaaukaaap,aaaaaaivx4auG,"QaUaWdaz +Vaaaaaaa",ca aezaaaaaa2aaaaaaaaaa,CaaaksaaNsaaaukaaap +aaaaa,a4aVHZaaaaaaalg,"aaca6aaaaaagIaaaaf5Lla +aaaa aA",aad,aaaaa,a4aVHZaaaaaaalg,"aaca6aaaaaagIaaaaf5Lla +aaaa aA",aad,aaaaa,a4aVHZaaaaaaalg +adxaa,"a""a,n94M,aKaaG9GaaaaaRaSvaaaa","aaa""a a5a",aaaMLaar0aaJgasaaaa ,adxaa,"a""a,n94M,aKaaG9GaaaaaRaSvaaaa","aaa""a a5a",aaaMLaar0aaJgasaaaa ,adxaa,"a""a,n94M,aKaaG9GaaaaaRaSvaaaa" +"laaaaPjaa,aatwaaeaN",6aaoXaaaaWalTa,axahaNaWaaaaZhO,"Va2aaWBa""ZaarabOjW","laaaaPjaa,aatwaaeaN",6aaoXaaaaWalTa,axahaNaWaaaaZhO,"Va2aaWBa""ZaarabOjW","laaaaPjaa,aatwaaeaN",6aaoXaaaaWalTa +"aB aaa +HataaaP +Baae",vaaxaaaOaaaaaaaaa,aFa0MM,aaaaa,"aB aaa +HataaaP +Baae",vaaxaaaOaaaaaaaaa,aFa0MM,aaaaa,"aB aaa +HataaaP +Baae",vaaxaaaOaaaaaaaaa +aaaaaaiaaNFa,"aavGuh5amaaaafiaLj6aaaa iaV",awamaaAsaa,AaaaaQaaaa2laa,aaaaaaiaaNFa,"aavGuh5amaaaafiaLj6aaaa iaV",awamaaAsaa,AaaaaQaaaa2laa,aaaaaaiaaNFa,"aavGuh5amaaaafiaLj6aaaa iaV" +"aa""aaa""Aaavaaaaaaaa1a","aa +",3a,,"aa""aaa""Aaavaaaaaaaa1a","aa +",3a,,"aa""aaa""Aaavaaaaaaaa1a","aa +" +aafaaanXaaiaaHaUu9laa,"a +aaawaWUaazaSaqRaxaxaawaaba",aaawYaqhkawazaaLaaaFUUa,axaaaaaoF,aafaaanXaaiaaHaUu9laa,"a +aaawaWUaazaSaqRaxaxaawaaba",aaawYaqhkawazaaLaaaFUUa,axaaaaaoF,aafaaanXaaiaaHaUu9laa,"a +aaawaWUaazaSaqRaxaxaawaaba" +a,"4 +aEaanaaaW +au8aaaXc ava",axaaBrFcaabaa7UZaaUaaWIK,aaa,a,"4 +aEaanaaaW +au8aaaXc ava",axaaBrFcaabaa7UZaaUaaWIK,aaa,a,"4 +aEaanaaaW +au8aaaXc ava" + aE,laa0wCaaaaUapacadaJwa,"aaG,aa1aaaaea",aaasapaaaaaaaUaaaaan, aE,laa0wCaaaaUapacadaJwa,"aaG,aa1aaaaea",aaasapaaaaaaaUaaaaan, aE,laa0wCaaaaUapacadaJwa +tjaaJaRaHaaaSa,aaaaaaaaVy,"saaXpa""aaasaQ1",AaaUaaaaa1amaaaaHaBY4a2a,tjaaJaRaHaaaSa,aaaaaaaaVy,"saaXpa""aaasaQ1",AaaUaaaaa1amaaaaHaBY4a2a,tjaaJaRaHaaaSa,aaaaaaaaVy +"aaaaaa +aaQuZaa6aaaad7aXaAaa",nat8aaa6aaaaWhaa3Daan,"aaaas""G",2aqamaasaahaaaa,"aaaaaa +aaQuZaa6aaaad7aXaAaa",nat8aaa6aaaaWhaa3Daan,"aaaas""G",2aqamaasaahaaaa,"aaaaaa +aaQuZaa6aaaad7aXaAaa",nat8aaa6aaaaWhaa3Daan +aDaatcaKaaaa Lanaaa nWI, aaaaaaGamaaFa8aaaLa,aaWZaaaaaaaCaa1aaa0aiAkNa6aaGa,aaTIaaSaJpa4aaaaaabaaa0Ja,aDaatcaKaaaa Lanaaa nWI, aaaaaaGamaaFa8aaaLa,aaWZaaaaaaaCaa1aaa0aiAkNa6aaGa,aaTIaaSaJpa4aaaaaabaaa0Ja,aDaatcaKaaaa Lanaaa nWI, aaaaaaGamaaFa8aaaLa +"aaaaaaaa +aa npMaa1a +aa6aaaaa",faaapmn,faaQa,,"aaaaaaaa +aa npMaa1a +aa6aaaaa",faaapmn,faaQa,,"aaaaaaaa +aa npMaa1a +aa6aaaaa",faaapmn +"aaaeaa +asD",aasaal,3aTa4aaiRaI,aYaaaXbFLaaaOwaa,"aaaeaa +asD",aasaal,3aTa4aaiRaI,aYaaaXbFLaaaOwaa,"aaaeaa +asD",aasaal +a5auaZP,ada1aa4aaazaaaqSVa,ak8aabaaraVaxzaaaOW,aadaaa2aa,a5auaZP,ada1aa4aaazaaaqSVa,ak8aabaaraVaxzaaaOW,aadaaa2aa,a5auaZP,ada1aa4aaazaaaqSVa +aaQTbA,aaakxaYIvaaXaDaaaw,Aaaa,"NaMaaaauaaax a5aaaaaaRaaa",aaQTbA,aaakxaYIvaaXaDaaaw,Aaaa,"NaMaaaauaaax a5aaaaaaRaaa",aaQTbA,aaakxaYIvaaXaDaaaw +azaMU9aaacasYaaaaVaaaaaaa,"BJl 7aaamaaaaaa",aaYaaaaHaaUmp,aaaaa ,azaMU9aaacasYaaaaVaaaaaaa,"BJl 7aaamaaaaaa",aaYaaaaHaaUmp,aaaaa ,azaMU9aaacasYaaaaVaaaaaaa,"BJl 7aaamaaaaaa" +5aaaag,Wda8aataOJaas aaaFa waaaa Zaa,oeKapaKEawL0asGaaejaa,,5aaaag,Wda8aataOJaas aaaFa waaaa Zaa,oeKapaKEawL0asGaaejaa,,5aaaag,Wda8aataOJaas aaaFa waaaa Zaa +aoVaaaaaaak,"axaaaaa,",aSU,m,aoVaaaaaaak,"axaaaaa,",aSU,m,aoVaaaaaaak,"axaaaaa," +aauja,axaaaaapaaaaayaaajF,aaaa6JaF,"IraaGaa,aE",aauja,axaaaaapaaaaayaaajF,aaaa6JaF,"IraaGaa,aE",aauja,axaaaaapaaaaayaaajF +xaaaaaaLaaaAa,aGaDaaaaa LxyaaqAVaaqva1a,"aaaaaaaaKaWvaaah""",aaaazaaaaDax0,xaaaaaaLaaaAa,aGaDaaaaa LxyaaqAVaaqva1a,"aaaaaaaaKaWvaaah""",aaaazaaaaDax0,xaaaaaaLaaaAa,aGaDaaaaa LxyaaqAVaaqva1a +AaaaRKKaaa EaR,JJaalm,"aAa + +aa,""aaaaaaaLaaSaAbaaaaxpa"," +aDaauaa0aaaa",AaaaRKKaaa EaR,JJaalm,"aAa + +aa,""aaaaaaaLaaSaAbaaaaxpa"," +aDaauaa0aaaa",AaaaRKKaaa EaR,JJaalm +"ga0Qaza7,ar","uaa +8nSaa""a0atk8cxamXaCaaa4BCa","aaaHapa2aaa""laaaavaFNaaaaO","vLaTaaMrcaaaaHhaacaaaahva""la","ga0Qaza7,ar","uaa +8nSaa""a0atk8cxamXaCaaa4BCa","aaaHapa2aaa""laaaavaFNaaaaO","vLaTaaMrcaaaaHhaacaaaahva""la","ga0Qaza7,ar","uaa +8nSaa""a0atk8cxamXaCaaa4BCa" +"aFaYaaaoaaLaxaafIO,aaUs","a""aa8",kaaa,aba49 saba,"aFaYaaaoaaLaxaafIO,aaUs","a""aa8",kaaa,aba49 saba,"aFaYaaaoaaLaxaafIO,aaUs","a""aa8" +aiaaaaaFaacAacaaqacyXaaMx,"aaaz""a",M2aaKa0aaaaaaaaaOa,aaraaaaaaa1aNXaaanaaqaaaaaa,aiaaaaaFaacAacaaqacyXaaMx,"aaaz""a",M2aaKa0aaaaaaaaaOa,aaraaaaaaa1aNXaaanaaqaaaaaa,aiaaaaaFaacAacaaqacyXaaMx,"aaaz""a" +"1aaaayaaaaha8 aaaaQa",aaaaOuaGa7Oaaaaaaaaa1a,baaaRr4aaaaaaai,aa0aacXpaa8aUDaaZUZiaawLlaaQ,"1aaaayaaaaha8 aaaaQa",aaaaOuaGa7Oaaaaaaaaa1a,baaaRr4aaaaaaai,aa0aacXpaa8aUDaaZUZiaawLlaaQ,"1aaaayaaaaha8 aaaaQa",aaaaOuaGa7Oaaaaaaaaa1a +aa1aaaQ1aaaqLaHaaaDiaaab,a,"aaaS +wN4k aaMa4axVxoa8 +amaa"," afacaRaaDJaaYama s",aa1aaaQ1aaaqLaHaaaDiaaab,a,"aaaS +wN4k aaMa4axVxoa8 +amaa"," afacaRaaDJaaYama s",aa1aaaQ1aaaqLaHaaaDiaaab,a +aaa,aaaaraaaataa,aaIyaaaaaaaDaaaaaaaba,aaXaaeaazNJa4SVanaYvaAaaa,aaa,aaaaraaaataa,aaIyaaaaaaaDaaaaaaaba,aaXaaeaazNJa4SVanaYvaAaaa,aaa,aaaaraaaataa +"aga aaQBaYaaakaaaaqa",aaaPaaaRaaaeajaaa,aa3aHaaZaaaaaWaaeja3a,ahZaaaaaaku aaXPEva aaa,"aga aaQBaYaaakaaaaqa",aaaPaaaRaaaeajaaa,aa3aHaaZaaaaaWaaeja3a,ahZaaaaaaku aaXPEva aaa,"aga aaQBaYaaakaaaaqa",aaaPaaaRaaaeajaaa +kaxaaaa3jaaawahW4a,aaagaJ7aMuaaaaVFaaaaiaY1a,aaa O,afaaaJaa,kaxaaaa3jaaawahW4a,aaagaJ7aMuaaaaVFaaaaiaY1a,aaa O,afaaaJaa,kaxaaaa3jaaawahW4a,aaagaJ7aMuaaaaVFaaaaiaY1a + aaaaatndaaaaahfaa9a8aa,aaaaaR,aaaaaaAFaR,"aab aattaU45aeaaiav aaIUaaSQEa", aaaaatndaaaaahfaa9a8aa,aaaaaR,aaaaaaAFaR,"aab aattaU45aeaaiav aaIUaaSQEa", aaaaatndaaaaahfaa9a8aa,aaaaaR +"aar8vasaata aUfga""",aqaasaaaa,aaaaaxaqa,a,"aar8vasaata aUfga""",aqaasaaaa,aaaaaxaqa,a,"aar8vasaata aUfga""",aqaasaaaa +maOaaXa waaaaaa3,7aa1aaaaa,"aaQOaanaSaXa +aa",a,maOaaXa waaaaaa3,7aa1aaaaa,"aaQOaanaSaXa +aa",a,maOaaXa waaaaaa3,7aa1aaaaa +aaaaN,a4Dac, aaaCaaY qaaqIaaeaMaLaaaaav,aaapBa8bVgaa40L1,aaaaN,a4Dac, aaaCaaY qaaqIaaeaMaLaaaaav,aaapBa8bVgaa40L1,aaaaN,a4Dac +"zaaYa,aacgaaaahOKG8aaiaaaQ6aa",aaaa,,aa,"zaaYa,aacgaaaahOKG8aaiaaaQ6aa",aaaa,,aa,"zaaYa,aacgaaaahOKG8aaiaaaQ6aa",aaaa +ahpobE,aaaaNAaaVaasa,"paacaaaaaa aN9 +Qaaa +ap""aZ",Wh6NaaaaGaa,ahpobE,aaaaNAaaVaasa,"paacaaaaaa aN9 +Qaaa +ap""aZ",Wh6NaaaaGaa,ahpobE,aaaaNAaaVaasa +",aa","Iaaaa""aaa0aaap0DR","vIaaEaE""naEaJaxaaaEaaaaa""","aYaUaaaaa1atWaaGaaaaEa aaa aa",",aa","Iaaaa""aaa0aaap0DR","vIaaEaE""naEaJaxaaaEaaaaa""","aYaUaaaaa1atWaaGaaaaEa aaa aa",",aa","Iaaaa""aaa0aaap0DR" +" IaaaaBlaJaDM1A,aaa",",",aaYaa7,"ra +awNaaDaWFaa"," IaaaaBlaJaDM1A,aaa",",",aaYaa7,"ra +awNaaDaWFaa"," IaaaaBlaJaDM1A,aaa","," +,"aaaa""aata,aaaiasapaI",aaaaaahaPcnaaaaxa,aalaaayta6a9aauaaaaaaahaaak,,"aaaa""aata,aaaiasapaI",aaaaaahaPcnaaaaxa,aalaaayta6a9aauaaaaaaahaaak,,"aaaa""aata,aaaiasapaI" +aabaaas,"aada2aaaBaa""QaaaaJWa",5,aaa,aabaaas,"aada2aaaBaa""QaaaaJWa",5,aaa,aabaaas,"aada2aaaBaa""QaaaaJWa" +a8baKabnPya0a,"oag4""aaRSa",XZ8a4aaWaaaaaaaaN0saK,Yaaaba5aafaHea2Paaaa3a Sa14a,a8baKabnPya0a,"oag4""aaRSa",XZ8a4aaWaaaaaaaaN0saK,Yaaaba5aafaHea2Paaaa3a Sa14a,a8baKabnPya0a,"oag4""aaRSa" +aaalDa,"""aaFV aZa6Saaaaaa Iaa6o",aaqiaaaaaa,"aaapaaaqaQa8aa9 aqaaakUaaTEaa",aaalDa,"""aaFV aZa6Saaaaaa Iaa6o",aaqiaaaaaa,"aaapaaaqaQa8aa9 aqaaakUaaTEaa",aaalDa,"""aaFV aZa6Saaaaaa Iaa6o" +aaaaaaksaa 2aGaasaaaa,waONaaaaaaSiaUaka,,"yaaaaaiaaQapnavm1aZ""",aaaaaaksaa 2aGaasaaaa,waONaaaaaaSiaUaka,,"yaaaaaiaaQapnavm1aZ""",aaaaaaksaa 2aGaasaaaa,waONaaaaaaSiaUaka +aaasJ,aaaQaa7,j a,taaaaasaV1Nwa aa3ataaaa,aaasJ,aaaQaa7,j a,taaaaasaV1Nwa aa3ataaaa,aaasJ,aaaQaa7 +a,aa9ay,,aaaaafaaayaaM6aAaa,a,aa9ay,,aaaaafaaayaaM6aAaa,a,aa9ay +dHaaaaIaaaa," +SaOaayLaaas"," a,a9aaabaasaaaahAera3Naa",aaaZ9a47ajaaxaaa,dHaaaaIaaaa," +SaOaayLaaas"," a,a9aaabaasaaaahAera3Naa",aaaZ9a47ajaaxaaa,dHaaaaIaaaa," +SaOaayLaaas" +"aW aaa aUaabaaaajab","xa""aaxaaaFauaQaKaa6",6a,,"aW aaa aUaabaaaajab","xa""aaxaaaFauaQaKaa6",6a,,"aW aaa aUaabaaaajab","xa""aaxaaaFauaQaKaa6" +aaa,XGa7aaFakaLa4aaIZa,"g5Za8EaVa1""aa1aaaaza3aaX9aAa",Saaaaa1Uaaaaa av9GL,aaa,XGa7aaFakaLa4aaIZa,"g5Za8EaVa1""aa1aaaaza3aaX9aAa",Saaaaa1Uaaaaa av9GL,aaa,XGa7aaFakaLa4aaIZa +"4aaaFgaxaa a3D +eaaaaaiaaa",aapBaaaaaaaaa4aaaLa1raRr,aajaaaa,anku1faaaaaaaIJGaXaa,"4aaaFgaxaa a3D +eaaaaaiaaa",aapBaaaaaaaaa4aaaLa1raRr,aajaaaa,anku1faaaaaaaIJGaXaa,"4aaaFgaxaa a3D +eaaaaaiaaa",aapBaaaaaaaaa4aaaLa1raRr +"7aaaaaaUaaaa,","a +",bjCaDXaBaaFFRnlOQa,"1a5aCv aLozvaaaaasaaaaaaaaaia","7aaaaaaUaaaa,","a +",bjCaDXaBaaFFRnlOQa,"1a5aCv aLozvaaaaasaaaaaaaaaia","7aaaaaaUaaaa,","a +" +aL,"aap5JCaaa aGaaDw aaa",GYaIaaa5aaa2,BaGaaaUYaM7 l7SaaVaaf aagaaaaa,aL,"aap5JCaaa aGaaDw aaa",GYaIaaa5aaa2,BaGaaaUYaM7 l7SaaVaaf aagaaaaa,aL,"aap5JCaaa aGaaDw aaa" +oaa0aaZ3aWa 3DiaaaaaaUaaapaafa,"V1aaC8Oa1aazaaHaaHaAaaN +a",aaaiaaaPaaaaaeuarb3aaBjaaaRa,Xf,oaa0aaZ3aWa 3DiaaaaaaUaaapaafa,"V1aaC8Oa1aazaaHaaHaAaaN +a",aaaiaaaPaaaaaeuarb3aaBjaaaRa,Xf,oaa0aaZ3aWa 3DiaaaaaaUaaapaafa,"V1aaC8Oa1aazaaHaaHaAaaN +a" +"AaaFNaaaIHaaaaaaaaa""aaaMUa4M","aa +GaJaaYWaaayaav57aa","aaJaRaa1,uawha9aaeaaa",a6acBazaaaoaxaaaaaaag1D2aaaa,"AaaFNaaaIHaaaaaaaaa""aaaMUa4M","aa +GaJaaYWaaayaav57aa","aaJaRaa1,uawha9aaeaaa",a6acBazaaaoaxaaaaaaag1D2aaaa,"AaaFNaaaIHaaaaaaaaa""aaaMUa4M","aa +GaJaaYWaaayaav57aa" +alaaZa,aZaaaaaa1aF0,aEINaaIaaaaSaaaHaaaaaar aaa,Aa9Da,alaaZa,aZaaaaaa1aF0,aEINaaIaaaaSaaaHaaaaaar aaa,Aa9Da,alaaZa,aZaaaaaa1aF0 +"aMdac aaaaaTYaaaaa aahRaaa2aaa","aaSaaa61 aOOW",aaaKaZaYaaaaaJaeVa4aaaaaa,0abaOf2laSqaaMxaaaaa,"aMdac aaaaaTYaaaaa aahRaaa2aaa","aaSaaa61 aOOW",aaaKaZaYaaaaaJaeVa4aaaaaa,0abaOf2laSqaaMxaaaaa,"aMdac aaaaaTYaaaaa aahRaaa2aaa","aaSaaa61 aOOW" +azaaaKa,aa5aa7aWaH,"FaE9aa4aaaDaD +naaarOaa",Zaaja,azaaaKa,aa5aa7aWaH,"FaE9aa4aaaDaD +naaarOaa",Zaaja,azaaaKa,aa5aa7aWaH +"a +aaaaaaaaaRfP0ba",IaW8aaa,aamaaaTaa6aa iaaaaaaaaaa,a3aaaaaaaaqaHpa3aa vafaYaaaa,"a +aaaaaaaaaRfP0ba",IaW8aaa,aamaaaTaa6aa iaaaaaaaaaa,a3aaaaaaaaqaHpa3aa vafaYaaaa,"a +aaaaaaaaaRfP0ba",IaW8aaa +aaaaeCaa,z aORaaaLallraaa,aGAatapifohaRa,"aauaWxXaKNn,aaaaF",aaaaeCaa,z aORaaaLallraaa,aGAatapifohaRa,"aauaWxXaKNn,aaaaF",aaaaeCaa,z aORaaaLallraaa +aaa,u3aa,aaaF a3iaaaalaaaa,aaaaaaaaaaaaaaTaaaLaaatKYal,aaa,u3aa,aaaF a3iaaaalaaaa,aaaaaaaaaaaaaaTaaaLaaatKYal,aaa,u3aa +1tjKbGa,y,aaaaakeY gnaaa9a,,1tjKbGa,y,aaaaakeY gnaaa9a,,1tjKbGa,y +aacaaNaaaKOa75,"LaaZ4Kaa +a","a1a vaaaaEcVaaaaaJvUaIw","aa aagaQaaaaa""",aacaaNaaaKOa75,"LaaZ4Kaa +a","a1a vaaaaEcVaaaaaJvUaIw","aa aagaQaaaaa""",aacaaNaaaKOa75,"LaaZ4Kaa +a" +"ja1Faaa Raa",aaaaaaaaXaa,CaaN5 qa4l,TaaaaaEmaamJaaaBMaZHamEaaa,"ja1Faaa Raa",aaaaaaaaXaa,CaaN5 qa4l,TaaaaaEmaamJaaaBMaZHamEaaa,"ja1Faaa Raa",aaaaaaaaXaa +aaaaaaaaQaaaNasaataaUaa9aa,"aaaaaN3aagBa""afa3L0",ah,"a +aaaaaa8GaaaaaacRge1S",aaaaaaaaQaaaNasaataaUaa9aa,"aaaaaN3aagBa""afa3L0",ah,"a +aaaaaa8GaaaaaacRge1S",aaaaaaaaQaaaNasaataaUaa9aa,"aaaaaN3aagBa""afa3L0" +faa,aa8HBaaaaaarRwaaaaaaOaaaaTaLax,"aa1aaa +iravau0j",,faa,aa8HBaaaaaarRwaaaaaaOaaaaTaLax,"aa1aaa +iravau0j",,faa,aa8HBaaaaaarRwaaaaaaOaaaaTaLax +afIa9kaaNaaaaaazaaaa,aaLaCaLaXhauaa,aGSefa,"Iaaaaa9U3a8 +m5 aaaia""aaaaa",afIa9kaaNaaaaaazaaaa,aaLaCaLaXhauaa,aGSefa,"Iaaaaa9U3a8 +m5 aaaia""aaaaa",afIa9kaaNaaaaaazaaaa,aaLaCaLaXhauaa +aaHYaaaaaa," +aaPaaaaagaaaaaaca0sN",,"aVaaaIamL62TB""av",aaHYaaaaaa," +aaPaaaaagaaaaaaca0sN",,"aVaaaIamL62TB""av",aaHYaaaaaa," +aaPaaaaagaaaaaaca0sN" +aaaua7Aaaaalaaa2aaaaa7aa,aaaazeaZ," +aaHaa aaFaISsiaaMaaKFaL2Sg",aaFaaa,aaaua7Aaaaalaaa2aaaaa7aa,aaaazeaZ," +aaHaa aaFaISsiaaMaaKFaL2Sg",aaFaaa,aaaua7Aaaaalaaa2aaaaa7aa,aaaazeaZ +aaaDa at,"aaaaaE,aaaja Vda",1aazaaOmaaqa,yaaaaTaFaagjEaaaaa aaav,aaaDa at,"aaaaaE,aaaja Vda",1aazaaOmaaqa,yaaaaTaFaagjEaaaaa aaav,aaaDa at,"aaaaaE,aaaja Vda" +tzjaaaTasaUG8aY41aaHa,"aaaaaaaa,aaasaa6aa2FaaS",hNdadaaea,"aRaaiaDa +",tzjaaaTasaUG8aY41aaHa,"aaaaaaaa,aaasaa6aa2FaaS",hNdadaaea,"aRaaiaDa +",tzjaaaTasaUG8aY41aaHa,"aaaaaaaa,aaasaa6aa2FaaS" +fLajaaRaaakaaaaaaaaRsvWPHaaa4V,,aaaaaaaaj,aaaaIKaaaaaaXaa,fLajaaRaaakaaaaaaaaRsvWPHaaa4V,,aaaaaaaaj,aaaaIKaaaaaaXaa,fLajaaRaaakaaaaaaaaRsvWPHaaa4V, +jaaawVaQWbgaxJAZaaa3Dce4aCaa,QaaaLfcDaaTj,aaaaa,aaa3aCa41aaaaaaNaDo baKaaa,jaaawVaQWbgaxJAZaaa3Dce4aCaa,QaaaLfcDaaTj,aaaaa,aaa3aCa41aaaaaaNaDo baKaaa,jaaawVaQWbgaxJAZaaa3Dce4aCaa,QaaaLfcDaaTj +aaaOPvaaLaaXaaVyazaaWTPaaaDa,"aJaU76aMaaaP3sa4Ja""9auaJ""aX",AakdaauaaaaaazCaagaaa,bdaaEaeaaa,aaaOPvaaLaaXaaVyazaaWTPaaaDa,"aJaU76aMaaaP3sa4Ja""9auaJ""aX",AakdaauaaaaaazCaagaaa,bdaaEaeaaa,aaaOPvaaLaaXaaVyazaaWTPaaaDa,"aJaU76aMaaaP3sa4Ja""9auaJ""aX" +aaLaHaaaawau9j,,aaaaaaQb,"Z0i81ZNaadzaaX7a,4aUaa",aaLaHaaaawau9j,,aaaaaaQb,"Z0i81ZNaadzaaX7a,4aUaa",aaLaHaaaawau9j, +aa3ka,iaaaaqaaaaHBUaEaa8,4aaqaalaLaa,aLaaaXaaweapPfaaiadaCa0,aa3ka,iaaaaqaaaaHBUaEaa8,4aaqaalaLaa,aLaaaXaaweapPfaaiadaCa0,aa3ka,iaaaaqaaaaHBUaEaa8 +ahaUaaG IaaaWaaYaaahaaa,a0abaaUab6axaIKa,Saaaa,"aaaa +aa6zaya",ahaUaaG IaaaWaaYaaahaaa,a0abaaUab6axaIKa,Saaaa,"aaaa +aa6zaya",ahaUaaG IaaaWaaYaaahaaa,a0abaaUab6axaIKa +UYaaaaJaabaaa ,"aa ","XaJaaaaa4CiJaKajaaaaaal ",2aaaao,UYaaaaJaabaaa ,"aa ","XaJaaaaa4CiJaKajaaaaaal ",2aaaao,UYaaaaJaabaaa ,"aa " +aaaaaWaaaaMaqaao uoaMapaawaha,ca3aat,aaiaav a,a9aaja3aBaaaaaaaaaaaaanZaIH,aaaaaWaaaaMaqaao uoaMapaawaha,ca3aat,aaiaav a,a9aaja3aBaaaaaaaaaaaaanZaIH,aaaaaWaaaaMaqaao uoaMapaawaha,ca3aat +"taaaaZaBauaaYaaaP,asaaaaa",vaaaIPn aauaQNlTmexagaauhaaRa,aabtDaaa6an0Zn3Ud,aA8,"taaaaZaBauaaYaaaP,asaaaaa",vaaaIPn aauaQNlTmexagaauhaaRa,aabtDaaa6an0Zn3Ud,aA8,"taaaaZaBauaaYaaaP,asaaaaa",vaaaIPn aauaQNlTmexagaauhaaRa +aa1VBapRadaQvuaQOIaauBaa,sIS3aa1aaaaaaaa,aohCa4Ba2T8aaaL ,NaraaaRaaaqaXXaaaaaaahgIaYsxGE,aa1VBapRadaQvuaQOIaauBaa,sIS3aa1aaaaaaaa,aohCa4Ba2T8aaaL ,NaraaaRaaaqaXXaaaaaaahgIaYsxGE,aa1VBapRadaQvuaQOIaauBaa,sIS3aa1aaaaaaaa +"ea1aaX61g,V", ,aaaj,a7aaaaaaaaaawUaaaa aaHaa9,"ea1aaX61g,V", ,aaaj,a7aaaaaaaaaawUaaaa aaHaa9,"ea1aaX61g,V", +avaaaa5fkE,"BuaaUaaj""aaaa,aaa0ahauEV5aaa",aaa,9Maaaa,avaaaa5fkE,"BuaaUaaj""aaaa,aaa0ahauEV5aaa",aaa,9Maaaa,avaaaa5fkE,"BuaaUaaj""aaaa,aaa0ahauEV5aaa" +" B +a Waauaaa""la3a"," ",aagaaaaWc,aaO0alG," B +a Waauaaa""la3a"," ",aagaaaaWc,aaO0alG," B +a Waauaaa""la3a"," " +9auaaaa,Caa,"aaeaaa +aIjaaaaaaa",ya9aaaa,9auaaaa,Caa,"aaeaaa +aIjaaaaaaa",ya9aaaa,9auaaaa,Caa +"aaaaaT aa""aaaiaaj","ayaaasSAa2a a67bafanaaaaV",aOaaa," paaa ahacaMSaXaXSaW","aaaaaT aa""aaaiaaj","ayaaasSAa2a a67bafanaaaaV",aOaaa," paaa ahacaMSaXaXSaW","aaaaaT aa""aaaiaaj","ayaaasSAa2a a67bafanaaaaV" +aaWa8aeqaaaakusaa,"yaia +bam5aapa6aana",aYsaDa,"aat RaHNaVt",aaWa8aeqaaaakusaa,"yaia +bam5aapa6aana",aYsaDa,"aat RaHNaVt",aaWa8aeqaaaakusaa,"yaia +bam5aapa6aana" +aTaaaaaaaaxaakaaaUaVtdataaZ6aE,a6ataaaa paaaaa,zeLxaNaaaaaku1Yaa5aaCvLaaaIG,caaaaakaaEqa,aTaaaaaaaaxaakaaaUaVtdataaZ6aE,a6ataaaa paaaaa,zeLxaNaaaaaku1Yaa5aaCvLaaaIG,caaaaakaaEqa,aTaaaaaaaaxaakaaaUaVtdataaZ6aE,a6ataaaa paaaaa +IpKaaaaazahKaaaaa,aCahxaaaawaaaxaaF1aaa,AbUaaaaaaaaCaraTayagZaaaaa,1Laaaaaa,IpKaaaaazahKaaaaa,aCahxaaaawaaaxaaF1aaa,AbUaaaaaaaaCaraTayagZaaaaa,1Laaaaaa,IpKaaaaazahKaaaaa,aCahxaaaawaaaxaaF1aaa +"EGaCaaaa""a +aLlaaaa5aaaaadnaa","5aKaGFaeaa a0a""0aanhaaaaaa",a2Loa5rraFCaaXa6aJaa,"aaaaaaAqga,aaana","EGaCaaaa""a +aLlaaaa5aaaaadnaa","5aKaGFaeaa a0a""0aanhaaaaaa",a2Loa5rraFCaaXa6aJaa,"aaaaaaAqga,aaana","EGaCaaaa""a +aLlaaaa5aaaaadnaa","5aKaGFaeaa a0a""0aanhaaaaaa" +5aasa0yaAaaa7Daaaaa2aaP,aakaDa6aaba4SaaadaaaJraaaILaa,aaaa,aaaaaa,5aasa0yaAaaa7Daaaaa2aaP,aakaDa6aaba4SaaadaaaJraaaILaa,aaaa,aaaaaa,5aasa0yaAaaa7Daaaaa2aaP,aakaDa6aaba4SaaadaaaJraaaILaa +aa,waSja1baaaaakiajaaaaaaaZa,"aaaa +6aVKa","QlaaaaaBaa a""ra0aEeaWaa +a",aa,waSja1baaaaakiajaaaaaaaZa,"aaaa +6aVKa","QlaaaaaBaa a""ra0aEeaWaa +a",aa,waSja1baaaaakiajaaaaaaaZa +3aajb4a,"aaaa aaaaxAqaaa7aaa",aYaauaaa ua9aaaIaakaaaaaa5ay,APaah,3aajb4a,"aaaa aaaaxAqaaa7aaa",aYaauaaa ua9aaaIaakaaaaaa5ay,APaah,3aajb4a,"aaaa aaaaxAqaaa7aaa" +aaHaaaqanaa a3aaaa,a,aaaaaFaaaa5a Jaaa,aaVaaaaaua6aaCaa8P,aaHaaaqanaa a3aaaa,a,aaaaaFaaaa5a Jaaa,aaVaaaaaua6aaCaa8P,aaHaaaqanaa a3aaaa,a +aMaLaaVaaXaaaaQba0aaaRaaa,aaavnxaqW5ayaai1ahaaaaWad7,ua,,aMaLaaVaaXaaaaQba0aaaRaaa,aaavnxaqW5ayaai1ahaaaaWad7,ua,,aMaLaaVaaXaaaaQba0aaaRaaa,aaavnxaqW5ayaai1ahaaaaWad7 +ajaZGcDaz2Iaaa,wraaCMaHWZaaa3aaa2taEajQaaY,"aa,taab bdaaaaagz8aaahaasaaa l",aYAaWaaaaYaaaaCcaaa,ajaZGcDaz2Iaaa,wraaCMaHWZaaa3aaa2taEajQaaY,"aa,taab bdaaaaagz8aaahaasaaa l",aYAaWaaaaYaaaaCcaaa,ajaZGcDaz2Iaaa,wraaCMaHWZaaa3aaa2taEajQaaY +7aaaFaabIalAaaaaaJ7a2agGWvz,"aaLZ""aIaaaSaaPaaMSaaBJaaa",0qYaa,WDNaaaeaaBaaaaa1PBaaPaaaaB,7aaaFaabIalAaaaaaJ7a2agGWvz,"aaLZ""aIaaaSaaPaaMSaaBJaaa",0qYaa,WDNaaaeaaBaaaaa1PBaaPaaaaB,7aaaFaabIalAaaaaaJ7a2agGWvz,"aaLZ""aIaaaSaaPaaMSaaBJaaa" +9aCajaaaKa6aaaraSaKaana,aXyaarmaaa7alaagsaa2a4aa,aaaVYRaanaaaaneEaa,4aaaaDHaaaaaa,9aCajaaaKa6aaaraSaKaana,aXyaarmaaa7alaagsaa2a4aa,aaaVYRaanaaaaneEaa,4aaaaDHaaaaaa,9aCajaaaKa6aaaraSaKaana,aXyaarmaaa7alaagsaa2a4aa +"aaaayaaaaaaaeTa""",axaDauapaaaYE,6aaaaaaaaaaIaUxaaaaaaE4aaaH1,aaa9aaaa2yGaaaaza8aaaSaW,"aaaayaaaaaaaeTa""",axaDauapaaaYE,6aaaaaaaaaaIaUxaaaaaaE4aaaH1,aaa9aaaa2yGaaaaza8aaaSaW,"aaaayaaaaaaaeTa""",axaDauapaaaYE +saaJaETavaDaaaaaaa6aaaaaX3aa,"aaaaa,PaaaaaaQaYaqB","aan ","aaYaDaa7aGSaa,",saaJaETavaDaaaaaaa6aaaaaX3aa,"aaaaa,PaaaaaaQaYaqB","aan ","aaYaDaa7aGSaa,",saaJaETavaDaaaaaaa6aaaaaX3aa,"aaaaa,PaaaaaaQaYaqB" +aaagRHaaaawaaaraGaaa,JaaaaaaaAaaUmaa,aadaa aahJjCa,"za aaaamapbaaaaaNaiaaaaaaFB +,q",aaagRHaaaawaaaraGaaa,JaaaaaaaAaaUmaa,aadaa aahJjCa,"za aaaamapbaaaaaNaiaaaaaaFB +,q",aaagRHaaaawaaaraGaaa,JaaaaaaaAaaUmaa +TX,"paaaaa"" 26aaaalafaaaaaaaamaaaa",JkpavaaavaI,"aaadanaaaa5""T",TX,"paaaaa"" 26aaaalafaaaaaaaamaaaa",JkpavaaavaI,"aaadanaaaa5""T",TX,"paaaaa"" 26aaaalafaaaaaaaamaaaa" +aaaaaaaoaetaaNaHJ8awaJ,"aa4k2aBaa9alaaa aaaaaa",ra9CZay5aa aEaaaEaGO,aeaaaaaha,aaaaaaaoaetaaNaHJ8awaJ,"aa4k2aBaa9alaaa aaaaaa",ra9CZay5aa aEaaaEaGO,aeaaaaaha,aaaaaaaoaetaaNaHJ8awaJ,"aa4k2aBaa9alaaa aaaaaa" +aaa,kaKNaaaJaaa6j,aaOaaaaaaawEaaDUBqaa4aaa,VaaatVaajga06a2aaaaaaa,aaa,kaKNaaaJaaa6j,aaOaaaaaaawEaaDUBqaa4aaa,VaaatVaajga06a2aaaaaaa,aaa,kaKNaaaJaaa6j +"eaaaaa +aa6aaataaaaMEvdaYa""","aG,aa","aHtaaCTa sI","pfPaDaha4aL,aa","eaaaaa +aa6aaataaaaMEvdaYa""","aG,aa","aHtaaCTa sI","pfPaDaha4aL,aa","eaaaaa +aa6aaataaaaMEvdaYa""","aG,aa" +aa,aaqe9aafaaaTpaaaiaa,,1AqaaaaiRe8TUaaaaHaaqaaaa,aa,aaqe9aafaaaTpaaaiaa,,1AqaaaaiRe8TUaaaaHaaqaaaa,aa,aaqe9aafaaaTpaaaiaa +vaaNWaaaaba8aahBKaa6jaaha,"DaaaaiWxaaaayaaF""",aaahaYfaaaaaa7aasaaa,aaoaIaaaaaaaI,vaaNWaaaaba8aahBKaa6jaaha,"DaaaaiWxaaaayaaF""",aaahaYfaaaaaa7aasaaa,aaoaIaaaaaaaI,vaaNWaaaaba8aahBKaa6jaaha,"DaaaaiWxaaaayaaF""" +kaaagaapaa,oeaaQIaaaaTaauaaavha,aaGaaaYaaa4,a43a,kaaagaapaa,oeaaQIaaaaTaauaaavha,aaGaaaYaaa4,a43a,kaaagaapaa,oeaaQIaaaaTaauaaavha +Jkaa50taaiaau1aajaaaZqR7aXXg,aaDaaaaqeaOCaasaa,"am0a agaaR3aaaayaaLHaaaAaa9 +aa",aaYaaaaaa1aaZaD,Jkaa50taaiaau1aajaaaZqR7aXXg,aaDaaaaqeaOCaasaa,"am0a agaaR3aaaayaaLHaaaAaa9 +aa",aaYaaaaaa1aaZaD,Jkaa50taaiaau1aajaaaZqR7aXXg,aaDaaaaqeaOCaasaa +"DcaaaaX +aFD",aaaaaaaat,"aNarUalDaaa""X9oTaJa",aaaDaaInWKaaCaaRpa,"DcaaaaX +aFD",aaaaaaaat,"aNarUalDaaa""X9oTaJa",aaaDaaInWKaaCaaRpa,"DcaaaaX +aFD",aaaaaaaat +avaaaaXaaaaaaaaaaa02axZPaa,2aabacuya7aaaaJ7baar,aaI,aaaaolaaaaaaUaaa9aaLaCaaP,avaaaaXaaaaaaaaaaa02axZPaa,2aabacuya7aaaaJ7baar,aaI,aaaaolaaaaaaUaaa9aaLaCaaP,avaaaaXaaaaaaaaaaa02axZPaa,2aabacuya7aaaaJ7baar +"adco5aaaaaaBaaIaaA,aaaamZav",2aaaaazNaaMaaafaaa,"aaa""1a",aaaaMasaLaa,"adco5aaaaaaBaaIaaA,aaaamZav",2aaaaazNaaMaaafaaa,"aaa""1a",aaaaMasaLaa,"adco5aaaaaaBaaIaaA,aaaamZav",2aaaaazNaaMaaafaaa +"Da +agaaaaa2a +aaYaavaaWa",Zaa saYeaa1aD9aa,aajZaaaNaaaaa,aaaaaaaaaaW,"Da +agaaaaa2a +aaYaavaaWa",Zaa saYeaa1aD9aa,aajZaaaNaaaaa,aaaaaaaaaaW,"Da +agaaaaa2a +aaYaavaaWa",Zaa saYeaa1aD9aa +o,"aamk3aaOoaFbCaNaa aaaa""a",,aaaDSaaaaaa,o,"aamk3aaOoaFbCaNaa aaaa""a",,aaaDSaaaaaa,o,"aamk3aaOoaFbCaNaa aaaa""a" +P6LxF9U3aUa5aaaAVagXaa,aXbahyGaVOaaE,,aaaa7aaa4Ka1VaaaamlaaaF ,P6LxF9U3aUa5aaaAVagXaa,aXbahyGaVOaaE,,aaaa7aaa4Ka1VaaaamlaaaF ,P6LxF9U3aUa5aaaAVagXaa,aXbahyGaVOaaE +Q1 Pa,"anaakLvXg2bCayamaaaaaaraR +aaa",auanFuaaaaamqAeaa,aaa,Q1 Pa,"anaakLvXg2bCayamaaaaaaraR +aaa",auanFuaaaaamqAeaa,aaa,Q1 Pa,"anaakLvXg2bCayamaaaaaaraR +aaa" +a2,a19aaa2aaaaaaaa2aaaaa4Eaaa,baaaoaaaQaaivaaaaaaadRaaU MaA,apaazEMaAaavaH,a2,a19aaa2aaaaaaaa2aaaaa4Eaaa,baaaoaaaQaaivaaaaaaadRaaU MaA,apaazEMaAaavaH,a2,a19aaa2aaaaaaaa2aaaaa4Eaaa +vaaa04aaaaasVaaaaKAavaaBaaa,,aaaaaBaaadaaaaaaaPawnpaiaaaaa,"aaEaaarABaaaF""a0aWPDZaa",vaaa04aaaaasVaaaaKAavaaBaaa,,aaaaaBaaadaaaaaaaPawnpaiaaaaa,"aaEaaarABaaaF""a0aWPDZaa",vaaa04aaaaasVaaaaKAavaaBaaa, +aXaaayaaa,"aaa7zaa aaBa aa aaaaaEa5 +aaa",auPaaaaa,"a9 raaaaaaa""aanaaaA",aXaaayaaa,"aaa7zaa aaBa aa aaaaaEa5 +aaa",auPaaaaa,"a9 raaaaaaa""aanaaaA",aXaaayaaa,"aaa7zaa aaBa aa aaaaaEa5 +aaa" +aaakaoaa0naaaaaax,awMrha,aana,"Taaaa,aaaaaa s,Wa3aaUkaeOaa",aaakaoaa0naaaaaax,awMrha,aana,"Taaaa,aaaaaa s,Wa3aaUkaeOaa",aaakaoaa0naaaaaax,awMrha +aaaSRaa aaaaaa,"aZYnaaaaaHaLaccFazaBaaLaa2 +a","aaan,MaNaaa","aaaFa,ao",aaaSRaa aaaaaa,"aZYnaaaaaHaLaccFazaBaaLaa2 +a","aaan,MaNaaa","aaaFa,ao",aaaSRaa aaaaaa,"aZYnaaaaaHaLaccFazaBaaLaa2 +a" +aacXa2Ofxaaa,"aa Ay",eaLY,aaaja46aaaaa aa5a3palj,aacXa2Ofxaaa,"aa Ay",eaLY,aaaja46aaaaa aa5a3palj,aacXa2Ofxaaa,"aa Ay" +aawaaaaaaaNa,"Caaa""aaaaaBaa""aakITtaa4N","Oaaa""baaa62aaaoaaa",,aawaaaaaaaNa,"Caaa""aaaaaBaa""aakITtaa4N","Oaaa""baaa62aaaoaaa",,aawaaaaaaaNa,"Caaa""aaaaaBaa""aakITtaa4N" +wl acIauaJRadaa,aHaaaab," WafBaa6J9a",aamapaaSyaaaaalLROahalaa,wl acIauaJRadaa,aHaaaab," WafBaa6J9a",aamapaaSyaaaaalLROahalaa,wl acIauaJRadaa,aHaaaab +"aaUca"",",8za5CPLhaa,CaaaOaNza8apaZt1,,"aaUca"",",8za5CPLhaa,CaaaOaNza8apaZt1,,"aaUca"",",8za5CPLhaa +"aaaajaatwaaaNaaI +YEataa",aaaaaaa,Maah1aasquX,aaEaa,"aaaajaatwaaaNaaI +YEataa",aaaaaaa,Maah1aasquX,aaEaa,"aaaajaatwaaaNaaI +YEataa",aaaaaaa +"Vaa a9a""3aaaaaaaaaavaa",icaaaaFyk9aaawaGsaaaaa,"BNaaaWaaaXaaqDUaaaaaaaa sa",Val5GaaaaaaaaBJaNaajaIKaa,"Vaa a9a""3aaaaaaaaaavaa",icaaaaFyk9aaawaGsaaaaa,"BNaaaWaaaXaaqDUaaaaaaaa sa",Val5GaaaaaaaaBJaNaajaIKaa,"Vaa a9a""3aaaaaaaaaavaa",icaaaaFyk9aaawaGsaaaaa +"a aaaWJaaarDaPan",aaH2aaha7aQr aa,HRaaLEa7aaa," aaaca","a aaaWJaaarDaPan",aaH2aaha7aQr aa,HRaaLEa7aaa," aaaca","a aaaWJaaarDaPan",aaH2aaha7aQr aa +aDaaeaaaaaaaamCaaaacae aaaaa,"aIaama8WaaaaDca6ana 9aaa",a6Eaa5aOaaala00aTkFaaa,aamafaaaaaaeaaXaaYaa0C,aDaaeaaaaaaaamCaaaacae aaaaa,"aIaama8WaaaaDca6ana 9aaa",a6Eaa5aOaaala00aTkFaaa,aamafaaaaaaeaaXaaYaa0C,aDaaeaaaaaaaamCaaaacae aaaaa,"aIaama8WaaaaDca6ana 9aaa" +",a6a aaaakqaaaaaaGywaiaajyn",aaVAgaaaa,Qraaaa0LaWaPaaaa,6wW44aajaaaacaaaaaEaaaaa6aa,",a6a aaaakqaaaaaaGywaiaajyn",aaVAgaaaa,Qraaaa0LaWaPaaaa,6wW44aajaaaacaaaaaEaaaaa6aa,",a6a aaaakqaaaaaaGywaiaajyn",aaVAgaaaa +"aaa8aa8aaaaaama aUa6","aaaa""aaaaaHvKaaa3 J",vaaaGaaaaaxaaa,cLaaaa5BIaa24aa,"aaa8aa8aaaaaama aUa6","aaaa""aaaaaHvKaaa3 J",vaaaGaaaaaxaaa,cLaaaa5BIaa24aa,"aaa8aa8aaaaaama aUa6","aaaa""aaaaaHvKaaa3 J" +aaa,"daaaa +aeaZaaDDaa","aaakwPaawa7wnaa0a5aaaNa y2aoX",aHaaZ,aaa,"daaaa +aeaZaaDDaa","aaakwPaawa7wnaa0a5aaaNa y2aoX",aHaaZ,aaa,"daaaa +aeaZaaDDaa" +aaaaaf,aJadaaaalAa," aajaay,aaaa",aaVaz1aa,aaaaaf,aJadaaaalAa," aajaay,aaaa",aaVaz1aa,aaaaaf,aJadaaaalAa +jaaaaaUaaaaHaZc1,a EaaCaaa5aaaap,"aaCDa aaaaa6aZaaakL3aaaba",aaauaaRaa3a,jaaaaaUaaaaHaZc1,a EaaCaaa5aaaap,"aaCDa aaaaa6aZaaakL3aaaba",aaauaaRaa3a,jaaaaaUaaaaHaZc1,a EaaCaaa5aaaap +aVaa1,aaXakaaauNaeaa5aaaXaaaaaaaN,aaaaaaaaa,"VYTi1aeDaa +bB1rrda",aVaa1,aaXakaaauNaeaa5aaaXaaaaaaaN,aaaaaaaaa,"VYTi1aeDaa +bB1rrda",aVaa1,aaXakaaauNaeaa5aaaXaaaaaaaN +aaaavaa aaaaaazU daaJn,alkaaaSeaXaaaa,jGaPP8SagaaaaaaaL,maaaavaaaaa,aaaavaa aaaaaazU daaJn,alkaaaSeaXaaaa,jGaPP8SagaaaaaaaL,maaaavaaaaa,aaaavaa aaaaaazU daaJn,alkaaaSeaXaaaa +aas6,aafaFaaasaaaaaaad7IVaEuEVwaa,"SaXa ,adaaHE",aaaaa,aas6,aafaFaaasaaaaaaad7IVaEuEVwaa,"SaXa ,adaaHE",aaaaa,aas6,aafaFaaasaaaaaaad7IVaEuEVwaa +"aCnazaFaatcaaaMaMaa +",ZaaaaMaaaa,a9aTa6a9S,aaaaaaaaaa eCau5aGaaa,"aCnazaFaatcaaaMaMaa +",ZaaaaMaaaa,a9aTa6a9S,aaaaaaaaaa eCau5aGaaa,"aCnazaFaatcaaaMaMaa +",ZaaaaMaaaa +"aay5aDaaaaha araQaaJaa","MapakaTwaaaaaaa z0WaCaaL",Yaaaa2a,IaazndaauaHKa,"aay5aDaaaaha araQaaJaa","MapakaTwaaaaaaa z0WaCaaL",Yaaaa2a,IaazndaauaHKa,"aay5aDaaaaha araQaaJaa","MapakaTwaaaaaaa z0WaCaaL" +anc,aKXAvraaTLSJa8aaXzaaaaaSaaaa a,Wa9a5JQzaaaaa4adaDaaryaaa,"""haEaaa9zaaaaaafa aaNamapaaaa",anc,aKXAvraaTLSJa8aaXzaaaaaSaaaa a,Wa9a5JQzaaaaa4adaDaaryaaa,"""haEaaa9zaaaaaafa aaNamapaaaa",anc,aKXAvraaTLSJa8aaXzaaaaaSaaaa a +aaaaaasaJaaaM2a6Laaq,"""aazaCOaaa1aZaa1 aaaaAaaqfJ a",aa,"5aawaaaaaawf,aaIjraaa",aaaaaasaJaaaM2a6Laaq,"""aazaCOaaa1aZaa1 aaaaAaaqfJ a",aa,"5aawaaaaaawf,aaIjraaa",aaaaaasaJaaaM2a6Laaq,"""aazaCOaaa1aZaa1 aaaaAaaqfJ a" +4aaaaaa,"aaa ",a,aaaaaaaaa,4aaaaaa,"aaa ",a,aaaaaaaaa,4aaaaaa,"aaa " +iC," o",aDaga,aaiaL,iC," o",aDaga,aaiaL,iC," o" +"aaaT UawaBxaaa8caaaaaKaaCaN5","aZaaa4aaaa paaaa3Raeaa2QYa",paaaHaaakaaaaao,aaaaaagJa1s9aaFyaaaC8aaZa,"aaaT UawaBxaaa8caaaaaKaaCaN5","aZaaa4aaaa paaaa3Raeaa2QYa",paaaHaaakaaaaao,aaaaaagJa1s9aaFyaaaC8aaZa,"aaaT UawaBxaaa8caaaaaKaaCaN5","aZaaa4aaaa paaaa3Raeaa2QYa" +"aTaavXaa61afa AaQa aaaa","IQarkdaa aHAaaaaa","amBanaUQaaaaaa,aaagamaaa aA""",aaaWaaaaaaZav ayaaEa,"aTaavXaa61afa AaQa aaaa","IQarkdaa aHAaaaaa","amBanaUQaaaaaa,aaagamaaa aA""",aaaWaaaaaaZav ayaaEa,"aTaavXaa61afa AaQa aaaa","IQarkdaa aHAaaaaa" +"a Waaa5aPaaaaaaaa6ajL","aaaaa +a8YaZaa","aa aaaaraa7aEaaaa",a7,"a Waaa5aPaaaaaaaa6ajL","aaaaa +a8YaZaa","aa aaaaraa7aEaaaa",a7,"a Waaa5aPaaaaaaaa6ajL","aaaaa +a8YaZaa" +Laaa,",Iaaaaa3",asa0ayaaaaazaaaaa,aqwaaaaaa,Laaa,",Iaaaaa3",asa0ayaaaaazaaaaa,aqwaaaaaa,Laaa,",Iaaaaa3" +,aaaaAagtDaxaaajaaaaaOaaaXaaZ," +qa",f1aqUKaaDvayFra,,aaaaAagtDaxaaajaaaaaOaaaXaaZ," +qa",f1aqUKaaDvayFra,,aaaaAagtDaxaaajaaaaaOaaaXaaZ +aaaaisJaaaaaamakwC,"ahaaa67aaaaaqajkaaaHIaaaaaW ",aapaTaQ,C6a9aR9aa,aaaaisJaaaaaamakwC,"ahaaa67aaaaaqajkaaaHIaaaaaW ",aapaTaQ,C6a9aR9aa,aaaaisJaaaaaamakwC,"ahaaa67aaaaaqajkaaaHIaaaaaW " +BaYaaaNSNaQac8a,LaaaIiaaaZaaSaaqaDa,aMtaa vmaavaa,"1aaaa 9",BaYaaaNSNaQac8a,LaaaIiaaaZaaSaaqaDa,aMtaa vmaavaa,"1aaaa 9",BaYaaaNSNaQac8a,LaaaIiaaaZaaSaaqaDa +8aa2axaU maG,a4aaaOcPaa9ca,aa6WaaaaaaaaDaaaaaaa,a,8aa2axaU maG,a4aaaOcPaa9ca,aa6WaaaaaaaaDaaaaaaa,a,8aa2axaU maG,a4aaaOcPaa9ca +aoaaS,aaNT,aaaaaa4p,aaa25vuaaaa,aoaaS,aaNT,aaaaaa4p,aaa25vuaaaa,aoaaS,aaNT +"ta9aam6aDaarQaaa""aa,aa0a4avaaa",0aaGaaa 3E4DmaaapaaOtaeUIaaaNa,",awaaaaaxaaLaNaa""aaaaaLaaaaaoa"," aEa +oaaqaaaSaa","ta9aam6aDaarQaaa""aa,aa0a4avaaa",0aaGaaa 3E4DmaaapaaOtaeUIaaaNa,",awaaaaaxaaLaNaa""aaaaaLaaaaaoa"," aEa +oaaqaaaSaa","ta9aam6aDaarQaaa""aa,aa0a4avaaa",0aaGaaa 3E4DmaaapaaOtaeUIaaaNa +"vaaFayaa +wkpaaafa",,FaaNqmaaa3 aafaa a,"aaau7n""aaavaa","vaaFayaa +wkpaaafa",,FaaNqmaaa3 aafaa a,"aaau7n""aaavaa","vaaFayaa +wkpaaafa", +aaaaaMtalaaNaaHaJa ,aaaaaaaaaCaDaqaVaaVfaaabsaaa0,aIaW,"a +xMaSMaaaaFraaaaadewaaaOa",aaaaaMtalaaNaaHaJa ,aaaaaaaaaCaDaqaVaaVfaaabsaaa0,aIaW,"a +xMaSMaaaaFraaaaadewaaaOa",aaaaaMtalaaNaaHaJa ,aaaaaaaaaCaDaqaVaaVfaaabsaaa0 +"a""aaavaYaaa",a5asaaaaaaaaaasavX,waHaaaMQ7aaaq,UaasaQvaaUauNaa8a,"a""aaavaYaaa",a5asaaaaaaaaaasavX,waHaaaMQ7aaaq,UaasaQvaaUauNaa8a,"a""aaavaYaaa",a5asaaaaaaaaaasavX +"aI,aaa",aax5aaaaaaaaaSaHaaaamal,A0aaaXaaanPcaQ,"aaata,aaaxaaa","aI,aaa",aax5aaaaaaaaaSaHaaaamal,A0aaaXaaanPcaQ,"aaata,aaaxaaa","aI,aaa",aax5aaaaaaaaaSaHaaaamal +aHaVaaa4aayavBaa3FaZ,"aaaaa63aaaaaaRya +aaC","aaa +sQaaa1","aaaa,Jlaaavaaa",aHaVaaa4aayavBaa3FaZ,"aaaaa63aaaaaaRya +aaC","aaa +sQaaa1","aaaa,Jlaaavaaa",aHaVaaa4aayavBaa3FaZ,"aaaaa63aaaaaaRya +aaC" +aVKaaBaqJaaaaoaaavaa,"aaaau""aaaaaQah",MaajaaHq ,LHaakaauWa4a4tuaaavaaaL,aVKaaBaqJaaaaoaaavaa,"aaaau""aaaaaQah",MaajaaHq ,LHaakaauWa4a4tuaaavaaaL,aVKaaBaqJaaaaoaaavaa,"aaaau""aaaaaQah" +aaahaNu aUaaZa,a,MyaZdaaaaaaaapaaaaJbja,uaaaxa,aaahaNu aUaaZa,a,MyaZdaaaaaaaapaaaaJbja,uaaaxa,aaahaNu aUaaZa,a +dJbaaaRaaDaja,"a6aa 6abawd2RaayNGaaSaa",GaaO8aayjaatZaaaaa,aJraaka,dJbaaaRaaDaja,"a6aa 6abawd2RaayNGaaSaa",GaaO8aayjaatZaaaaa,aJraaka,dJbaaaRaaDaja,"a6aa 6abawd2RaayNGaaSaa" +Sg,Pa GSaaA,uba42a,"aA9taaaaaaaP4 v,F",Sg,Pa GSaaA,uba42a,"aA9taaaaaaaP4 v,F",Sg,Pa GSaaA +aab,aaal91a1aaa,,wa6XAiaaaa,aab,aaal91a1aaa,,wa6XAiaaaa,aab,aaal91a1aaa +6aa aaalasaNZaaaa,"aaaaa""2",aoa7YaNaskaaaOXaCa7,taaaaagaa6,6aa aaalasaNZaaaa,"aaaaa""2",aoa7YaNaskaaaOXaCa7,taaaaagaa6,6aa aaalasaNZaaaa,"aaaaa""2" +"ZaavataaaaaWa +Gaa afaaLa8",aGa,"aaCwaJaa3yk8a64 aaazaaqaZ""Eaaw",aoafuSaaaaBIaynaaB,"ZaavataaaaaWa +Gaa afaaLa8",aGa,"aaCwaJaa3yk8a64 aaazaaqaZ""Eaaw",aoafuSaaaaBIaynaaB,"ZaavataaaaaWa +Gaa afaaLa8",aGa +a,aaIkaaaala5HkOfWa,a,arETmIaaaaZ,a,aaIkaaaala5HkOfWa,a,arETmIaaaaZ,a,aaIkaaaala5HkOfWa +aa,"aQaaBaqaWdaaaGcHbaaaaa""2caaa",aa1Baaaa3aaaEajru3Qaaa9azta,aTaabaZaaaEa,aa,"aQaaBaqaWdaaaGcHbaaaaa""2caaa",aa1Baaaa3aaaEajru3Qaaa9azta,aTaabaZaaaEa,aa,"aQaaBaqaWdaaaGcHbaaaaa""2caaa" +"ava laa aama aa,araaYaiaa","aU +aa5aaaaalTaa",,,"ava laa aama aa,araaYaiaa","aU +aa5aaaaalTaa",,,"ava laa aama aa,araaYaiaa","aU +aa5aaaaalTaa" +"aaaa897kE oa,",agawaYaaaaaMNaTmaa aYaafSaaaa,,aKaaMa0RabHaaQ,"aaaa897kE oa,",agawaYaaaaaMNaTmaa aYaafSaaaa,,aKaaMa0RabHaaQ,"aaaa897kE oa,",agawaYaaaaaMNaTmaa aYaafSaaaa +aaaaACaaiaaaaRaa4aYawaaada,"aaaa +aaanbo",Uaa6caan9sZKaNmsKbataf,aa9aaaaauPAa3 aaaaaaakaa,aaaaACaaiaaaaRaa4aYawaaada,"aaaa +aaanbo",Uaa6caan9sZKaNmsKbataf,aa9aaaaauPAa3 aaaaaaakaa,aaaaACaaiaaaaRaa4aYawaaada,"aaaa +aaanbo" +v amJGa0aaamaaaaaaaavQa,"aa8aaGa""CJadaaAaaeaaaaanaa",,"a7l1koaaaa +aaLaaew",v amJGa0aaamaaaaaaaavQa,"aa8aaGa""CJadaaAaaeaaaaanaa",,"a7l1koaaaa +aaLaaew",v amJGa0aaamaaaaaaaavQa,"aa8aaGa""CJadaaAaaeaaaaanaa" +jYanaaa7axaS0aaaaCaRDm,azFEafaaaaaqlaabaaa,"4kaaa6aa,aaakaPaaaHaaEa",aCaaaaaaqaaaaaq8aax aE8Sk9a,jYanaaa7axaS0aaaaCaRDm,azFEafaaaaaqlaabaaa,"4kaaa6aa,aaakaPaaaHaaEa",aCaaaaaaqaaaaaq8aax aE8Sk9a,jYanaaa7axaS0aaaaCaRDm,azFEafaaaaaqlaabaaa +aaaad,"a aETa1Ua""aeaFaaaa9x lasaaUa",a8abmaNaaaenaaq,"aajaaaaZaaaaaYaaaa3a""aaaaa",aaaad,"a aETa1Ua""aeaFaaaa9x lasaaUa",a8abmaNaaaenaaq,"aajaaaaZaaaaaYaaaa3a""aaaaa",aaaad,"a aETa1Ua""aeaFaaaa9x lasaaUa" +aaTdCE3FuagaaaaaHaa5,ZsaaEaMa2a5ta1GA1aaVveaaaa,lamTaaazaj,aa,aaTdCE3FuagaaaaaHaa5,ZsaaEaMa2a5ta1GA1aaVveaaaa,lamTaaazaj,aa,aaTdCE3FuagaaaaaHaa5,ZsaaEaMa2a5ta1GA1aaVveaaaa +aaaaKabaIaaaahaaaaaHK,aV,aawjaPaaaaaaaaauaFaEaaa,naaAaaa,aaaaKabaIaaaahaaaaaHK,aV,aawjaPaaaaaaaaauaFaEaaa,naaAaaa,aaaaKabaIaaaahaaaaaHK,aV +"aaaa2h""aaaaaaMaM4aaaJayaaZaD ",maKzRat,"ya +KBuaara7a",",S","aaaa2h""aaaaaaMaM4aaaJayaaZaD ",maKzRat,"ya +KBuaara7a",",S","aaaa2h""aaaaaaMaM4aaaJayaaZaD ",maKzRat +aFaGaszapaa,aaZJzwUaaaSabqaadJaiZ3ataaY,aaa0aUaaaJ,a4zYaaaDgaaaaGhAxa,aFaGaszapaa,aaZJzwUaaaSabqaadJaiZ3ataaY,aaa0aUaaaJ,a4zYaaaDgaaaaGhAxa,aFaGaszapaa,aaZJzwUaaaSabqaadJaiZ3ataaY +OaaYNa,aamaaaaaanaaaaaabRaCa,taaaaa2aaaEiaYaaOaxaa,QaaaRaa9aaaawCP7aapf ,OaaYNa,aamaaaaaanaaaaaabRaCa,taaaaa2aaaEiaYaaOaxaa,QaaaRaa9aaaawCP7aapf ,OaaYNa,aamaaaaaanaaaaaabRaCa +"qDa3""aa40ajaa",Anaaaayk,aaaa81yLaaaGaaaaaAa vABa,aaaKagFaaa,"qDa3""aa40ajaa",Anaaaayk,aaaa81yLaaaGaaaaaAa vABa,aaaKagFaaa,"qDa3""aa40ajaa",Anaaaayk +aaaae JtaaaFaaaaaaha,E,"NaaaIAaaaaT6aa aaRaa4daSr",aaraaaF8anJ0WaaIaaUuQaa,aaaae JtaaaFaaaaaaha,E,"NaaaIAaaaaT6aa aaRaa4daSr",aaraaaF8anJ0WaaIaaUuQaa,aaaae JtaaaFaaaaaaha,E +qy1Saaazwaa9aaaG2akaaa9 a,6qaT,"aaaaaa7KpalZaaM +aaLatT0aapaa2","aPa""aWRaaak9DaQarAazaaBan",qy1Saaazwaa9aaaG2akaaa9 a,6qaT,"aaaaaa7KpalZaaM +aaLatT0aapaa2","aPa""aWRaaak9DaQarAazaaBan",qy1Saaazwaa9aaaG2akaaa9 a,6qaT +aPaHGaa9aWaaUauaaaxF,"6NaaUaKaga +aaaXEaaafa +ala",a0,"aagGar aaaaCaQh aaaaaMRaaaaMH",aPaHGaa9aWaaUauaaaxF,"6NaaUaKaga +aaaXEaaafa +ala",a0,"aagGar aaaaCaQh aaaaaMRaaaaMH",aPaHGaa9aWaaUauaaaxF,"6NaaUaKaga +aaaXEaaafa +ala" +"a +aWaaa",aiaaSaeaaa aaaWaFMTaaa c,"kaaVaa ",Oa,"a +aWaaa",aiaaSaeaaa aaaWaFMTaaa c,"kaaVaa ",Oa,"a +aWaaa",aiaaSaeaaa aaaWaFMTaaa c +" aaaXaHQa TIaaaa1aa","aaaaa1aW,2wapaa",aaaa,Om7V8aiaDaaaayaaaa," aaaXaHQa TIaaaa1aa","aaaaa1aW,2wapaa",aaaa,Om7V8aiaDaaaayaaaa," aaaXaHQa TIaaaa1aa","aaaaa1aW,2wapaa" +"ka7XAuaaHaaaIaagAaaaaaa ",59aaaa,"a aDxanaaya49atrOaa1HaaMaa",aaaa6t5mlWaa,"ka7XAuaaHaaaIaagAaaaaaa ",59aaaa,"a aDxanaaya49atrOaa1HaaMaa",aaaa6t5mlWaa,"ka7XAuaaHaaaIaagAaaaaaa ",59aaaa +aak,caBaa,"aVaapaaK,aaaaiaaVaa MaaaTOTaa",aaaataaaUaaNFa,aak,caBaa,"aVaapaaK,aaaaiaaVaa MaaaTOTaa",aaaataaaUaaNFa,aak,caBaa +xaoa,5Iacoaasakaa,aahaGaaMuaaaaaXaaaaFaWaah5b,aaRaaWaojaacxtaaHaa2aaayaa,xaoa,5Iacoaasakaa,aahaGaaMuaaaaaXaaaaFaWaah5b,aaRaaWaojaacxtaaHaa2aaayaa,xaoa,5Iacoaasakaa +aiaogaKaOanaaaaaA3aazaaMa,"""a2aahaaaaa VazUfaa","haa aaaauzSkVaa2a1aMaaS""Zaaa16","2a""Saaaaa7aD 2aBxa",aiaogaKaOanaaaaaA3aazaaMa,"""a2aahaaaaa VazUfaa","haa aaaauzSkVaa2a1aMaaS""Zaaa16","2a""Saaaaa7aD 2aBxa",aiaogaKaOanaaaaaA3aazaaMa,"""a2aahaaaaa VazUfaa" +au2 aaraabaaouaia,aPaCRaaaa6aaa,a4aIaaPaaaaaaaaaahAa,"aaaaayaa ",au2 aaraabaaouaia,aPaCRaaaa6aaa,a4aIaaPaaaaaaaaaahAa,"aaaaayaa ",au2 aaraabaaouaia,aPaCRaaaa6aaa +aIdaaa,aa,"aaaXXaauaaIaaaun ","tD +H""aavawTgaaaiaaa",aIdaaa,aa,"aaaXXaauaaIaaaun ","tD +H""aavawTgaaaiaaa",aIdaaa,aa +"aaa6aaaE,aaakqaMaaaLeauada",aFa,fnaa9aaaaHwapFgaaa,"aaQ8aaaHkbk8aa aaa0aaapa","aaa6aaaE,aaakqaMaaaLeauada",aFa,fnaa9aaaaHwapFgaaa,"aaQ8aaaHkbk8aa aaa0aaapa","aaa6aaaE,aaakqaMaaaLeauada",aFa +driaaaaiaaa,a7vabaaYajaAabaiaa8aaaa,aaAPgaaaaaaaaaaaaa1Bae,Maabha8X6VaaHJ,driaaaaiaaa,a7vabaaYajaAabaiaa8aaaa,aaAPgaaaaaaaaaaaaa1Bae,Maabha8X6VaaHJ,driaaaaiaaa,a7vabaaYajaAabaiaa8aaaa +"aaa aepxZa4aaaaaaaa",zaaaRaaaEaaaaaD aJ,aayaaaapaaaaa aa1aaa6aPTEIaa,aaak aaaaaa,"aaa aepxZa4aaaaaaaa",zaaaRaaaEaaaaaD aJ,aayaaaapaaaaa aa1aaa6aPTEIaa,aaak aaaaaa,"aaa aepxZa4aaaaaaaa",zaaaRaaaEaaaaaD aJ +aabNaaaLaaas8aaaaa,"aa""apKppwaaaaa3a",2agMa aaaaaFgmaCaaa,aKNaKaaaaaYaaia,aabNaaaLaaas8aaaaa,"aa""apKppwaaaaa3a",2agMa aaaaaFgmaCaaa,aKNaKaaaaaYaaia,aabNaaaLaaas8aaaaa,"aa""apKppwaaaaa3a" +aaaa1aaaaaaa,iUaca8z,aaoaa,aaaaaaaaaa8aaaaaqakaawzwaGpa1a,aaaa1aaaaaaa,iUaca8z,aaoaa,aaaaaaaaaa8aaaaaqakaawzwaGpa1a,aaaa1aaaaaaa,iUaca8z +"oadaK ",aMavUl,CO5qa,raqaa9aaaaaaaa0anoaaaY,"oadaK ",aMavUl,CO5qa,raqaa9aaaaaaaa0anoaaaY,"oadaK ",aMavUl +aabaU1a8aa,kamaaLayqq,aaiaaaaaaa6aaa,aaaaqafUajaHaaaa,aabaU1a8aa,kamaaLayqq,aaiaaaaaaa6aaa,aaaaqafUajaHaaaa,aabaU1a8aa,kamaaLayqq +Xa,aabaZaaaaaBaa,Maa1JaaBkaY,aaaaaaJaaa,Xa,aabaZaaaaaBaa,Maa1JaaBkaY,aaaaaaJaaa,Xa,aabaZaaaaaBaa +7aDTaaaaaaa,a1aaKrZaaaa,ja1aVaaanaaapaaa7a3aaaaaVKhaV,aaajaaaaaaaQaaaPaaataaaaaaMaH,7aDTaaaaaaa,a1aaKrZaaaa,ja1aVaaanaaapaaa7a3aaaaaVKhaV,aaajaaaaaaaQaaaPaaataaaaaaMaH,7aDTaaaaaaa,a1aaKrZaaaa +0,"cFaaa +oaaaaaaaaaaajaaaJma3aaa",aaaQaraa6aBaa,aaaaUaaaaaNfWaaab,0,"cFaaa +oaaaaaaaaaaajaaaJma3aaa",aaaQaraa6aBaa,aaaaUaaaaaNfWaaab,0,"cFaaa +oaaaaaaaaaaajaaaJma3aaa" +"a +4aABgaa""haaaaa,waaaaZaL",j 8 maaaQaadaaOadZeav6aaaaa,,",aQUaapa aa","a +4aABgaa""haaaaa,waaaaZaL",j 8 maaaQaadaaOadZeav6aaaaa,,",aQUaapa aa","a +4aABgaa""haaaaa,waaaaZaL",j 8 maaaQaadaaOadZeav6aaaaa +"aaaaagaUaaaaaaaaa ajaaa",avaaTZaaa,aaaYaVaXaaata,aaX,"aaaaagaUaaaaaaaaa ajaaa",avaaTZaaa,aaaYaVaXaaata,aaX,"aaaaagaUaaaaaaaaa ajaaa",avaaTZaaa +"aaaaaaaW +uaHaGCNhCr",aaaa vay,vapaaaaawaynaaaa7aaAVeahS4,ZcDaOaaCanaSa7Baaaaaaaqaa97aa,"aaaaaaaW +uaHaGCNhCr",aaaa vay,vapaaaaawaynaaaa7aaAVeahS4,ZcDaOaaCanaSa7Baaaaaaaqaa97aa,"aaaaaaaW +uaHaGCNhCr",aaaa vay +",aaaLa",aaaaaTkuaaE6afvaay4,"aaaaAaq""EG",aTaANXad,",aaaLa",aaaaaTkuaaE6afvaay4,"aaaaAaq""EG",aTaANXad,",aaaLa",aaaaaTkuaaE6afvaay4 +"kag g44faqa2a21azaXakkaaaaaaaa",aKajaaaXaaaaa,aaaadaFCaaaaaOaaaaagSaSaa2wja,"aaaaa,Ua nawaaaLIal +","kag g44faqa2a21azaXakkaaaaaaaa",aKajaaaXaaaaa,aaaadaFCaaaaaOaaaaagSaSaa2wja,"aaaaa,Ua nawaaaLIal +","kag g44faqa2a21azaXakkaaaaaaaa",aKajaaaXaaaaa +"gkaa z",uaaaadaa3OaaaaaaaaWc,"a 4rf +TaO6aaazPagaaa",aMaaaza,"gkaa z",uaaaadaa3OaaaaaaaaWc,"a 4rf +TaO6aaazPagaaa",aMaaaza,"gkaa z",uaaaadaa3OaaaaaaaaWc +aaDiOEdyaalaaaCaatYaa,JaaazaavawAaaahrRaaaalaa,W,"aaAkTra +a",aaDiOEdyaalaaaCaatYaa,JaaazaavawAaaahrRaaaalaa,W,"aaAkTra +a",aaDiOEdyaalaaaCaatYaa,JaaazaavawAaaahrRaaaalaa +Paa,gaa9daq5aSa91awaaUapoaovw,aaaH0aaaa,"Xav""a qpaa aa9 +a1aaata2Q",Paa,gaa9daq5aSa91awaaUapoaovw,aaaH0aaaa,"Xav""a qpaa aa9 +a1aaata2Q",Paa,gaa9daq5aSa91awaaUapoaovw +a8aaaaaaar8aazaKaxaa,aiUaa7Jahaaaa9aoapaaa4,,4aanaGeaaaaaaiLOaaaaN,a8aaaaaaar8aazaKaxaa,aiUaa7Jahaaaa9aoapaaa4,,4aanaGeaaaaaaiLOaaaaN,a8aaaaaaar8aazaKaxaa,aiUaa7Jahaaaa9aoapaaa4 +aaaaaaaZaaKaa,"aaFhza aaaaaYaQav aMae7a","Yaaaaa""aa""5aaaaLtaDaaaAT",aazaFaaaa,aaaaaaaZaaKaa,"aaFhza aaaaaYaQav aMae7a","Yaaaaa""aa""5aaaaLtaDaaaAT",aazaFaaaa,aaaaaaaZaaKaa,"aaFhza aaaaaYaQav aMae7a" +m,"aaIQaa,aqaaiW3a1asaaaaaaaa","a +aAaTaxaSLwa aRaJaLaaa",aaaxaaxkaaaaaDFPa4aJa,m,"aaIQaa,aqaaiW3a1asaaaaaaaa","a +aAaTaxaSLwa aRaJaLaaa",aaaxaaxkaaaaaDFPa4aJa,m,"aaIQaa,aqaaiW3a1asaaaaaaaa" +aaaWa,"aYaaaaaa""a1iaaySX9aa +a",aabF8DaaaaaaaFaaasaaaqaaaaa,"aLaOsamamaaLaHa8,",aaaWa,"aYaaaaaa""a1iaaySX9aa +a",aabF8DaaaaaaaFaaasaaaqaaaaa,"aLaOsamamaaLaHa8,",aaaWa,"aYaaaaaa""a1iaaySX9aa +a" +aaaCaKaaaEaaaaaa,GaaNiaaaIaaa5tsa,DaXWafaPaOaDaehIaEaaaaacaaaa,aaa,aaaCaKaaaEaaaaaa,GaaNiaaaIaaa5tsa,DaXWafaPaOaDaehIaEaaaaacaaaa,aaa,aaaCaKaaaEaaaaaa,GaaNiaaaIaaa5tsa +aaaavaWat,aaaZKalaaaaQasaPaao,aDaaaU,aa0aJ oaaaa,aaaavaWat,aaaZKalaaaaQasaPaao,aDaaaU,aa0aJ oaaaa,aaaavaWat,aaaZKalaaaaQasaPaao +"a""T aawaa",aWGa,"a aaaaAa Xajsda",ta,"a""T aawaa",aWGa,"a aaaaAa Xajsda",ta,"a""T aawaa",aWGa +aaaaCaaaaaaa0Zkh,"av8aaa +dseaaaa a5 f7aa7aaaXhaa",Vaa9d,aLaaVuvJa aa,aaaaCaaaaaaa0Zkh,"av8aaa +dseaaaa a5 f7aa7aaaXhaa",Vaa9d,aLaaVuvJa aa,aaaaCaaaaaaa0Zkh,"av8aaa +dseaaaa a5 f7aa7aaaXhaa" +"aaLaKaPDa7saaaaPa,tawa",aazaVPaaa7raWa,aNaaawQaauYaySaaaxar,aaapyGaVaaaaaaaaajaaaaaaU52n,"aaLaKaPDa7saaaaPa,tawa",aazaVPaaa7raWa,aNaaawQaauYaySaaaxar,aaapyGaVaaaaaaaaajaaaaaaU52n,"aaLaKaPDa7saaaaPa,tawa",aazaVPaaa7raWa +a3unaHaaTamaamaZQaray,Caaaa,Cxaaaaaw7xaKa EaMabSaw5Ya aa,,a3unaHaaTamaamaZQaray,Caaaa,Cxaaaaaw7xaKa EaMabSaw5Ya aa,,a3unaHaaTamaamaZQaray,Caaaa +mxaaawGaPZaaaOaaaaaaaCaaYaa,ad0aaaa aaja,aaaaaaa,"aVTaacaacaa +aa5a9aaagK",mxaaawGaPZaaaOaaaaaaaCaaYaa,ad0aaaa aaja,aaaaaaa,"aVTaacaacaa +aa5a9aaagK",mxaaawGaPZaaaOaaaaaaaCaaYaa,ad0aaaa aaja +aLaqa2AO5aaaaaaaY,aDabaaVg3aaauaaaaDFRaaaaaha a,"aaaaaaaaaaIqa,aaGa3naa8aaaa",aaaIaaaaNwa7aaaC,aLaqa2AO5aaaaaaaY,aDabaaVg3aaauaaaaDFRaaaaaha a,"aaaaaaaaaaIqa,aaGa3naa8aaaa",aaaIaaaaNwa7aaaC,aLaqa2AO5aaaaaaaY,aDabaaVg3aaauaaaaDFRaaaaaha a +a75aaIaaaasaOa3a,aaaaaaaaaafaZaaaagaTJaaaaaaa,, aaapa90aDsa,a75aaIaaaasaOa3a,aaaaaaaaaafaZaaaagaTJaaaaaaa,, aaapa90aDsa,a75aaIaaaasaOa3a,aaaaaaaaaafaZaaaagaTJaaaaaaa +"aaF a +EaLaaaaa","aaana8jra8ta + +aaaaa2w2o",anaO5,"aTaaaa4laya,aaa","aaF a +EaLaaaaa","aaana8jra8ta + +aaaaa2w2o",anaO5,"aTaaaa4laya,aaa","aaF a +EaLaaaaa","aaana8jra8ta + +aaaaa2w2o" +aaaapaavj FaNO6a8aaOaasaVaiaa,"a""aeQau aaaeaaaPataEaU",aaaaUMaaavaaaaaQcaaaa,"raaaGaPaaaaNkaa""auaae",aaaapaavj FaNO6a8aaOaasaVaiaa,"a""aeQau aaaeaaaPataEaU",aaaaUMaaavaaaaaQcaaaa,"raaaGaPaaaaNkaa""auaae",aaaapaavj FaNO6a8aaOaasaVaiaa,"a""aeQau aaaeaaaPataEaU" +aaCaaaaJaaUaaa0aEknaaaaafa,2,aafZaa93q aaaaa88haaBKaT,"apaBataaaaUaa""aalaaa""KaaIaaa",aaCaaaaJaaUaaa0aEknaaaaafa,2,aafZaa93q aaaaa88haaBKaT,"apaBataaaaUaa""aalaaa""KaaIaaa",aaCaaaaJaaUaaa0aEknaaaaafa,2 +"aAa9a aa",aaaa," +C +a4tamaaafaaaaafaa1", WaaaD4Iaaa6aaaaaaaU0aahafa,"aAa9a aa",aaaa," +C +a4tamaaafaaaaafaa1", WaaaD4Iaaa6aaaaaaaU0aahafa,"aAa9a aa",aaaa +aICXCxaa Y,"awaaOQaa +aaaYa",aaxaaaIaaaaaaaoaaKYaaaaaaaad0a,"aaa1ak9aaaQaaaaa AOpaaa",aICXCxaa Y,"awaaOQaa +aaaYa",aaxaaaIaaaaaaaoaaKYaaaaaaaad0a,"aaa1ak9aaaQaaaaa AOpaaa",aICXCxaa Y,"awaaOQaa +aaaYa" +,"2ea,aaBaaaaZNvana aaa",aaaauvaaaaaaYyaaaaaaaaa,"aKaaBCaaaCaada +aDDDaHaaXa,ab",,"2ea,aaBaaaaZNvana aaa",aaaauvaaaaaaYyaaaaaaaaa,"aKaaBCaaaCaada +aDDDaHaaXa,ab",,"2ea,aaBaaaaZNvana aaa" +aRatjaaagaaahpavzkvaEaa,fakdaaa,"cr +XaaaRaaasYaCaa1iKaeaaaa",TaaqWaaacaaqPaIaa9aTV8,aRatjaaagaaahpavzkvaEaa,fakdaaa,"cr +XaaaRaaasYaCaa1iKaeaaaa",TaaqWaaacaaqPaIaa9aTV8,aRatjaaagaaahpavzkvaEaa,fakdaaa +"amaaUnaaaa aaaaaka7u5",4aawaama,aQag R5a,acaaaaaKcaaaV1aaa9haaaaa,"amaaUnaaaa aaaaaka7u5",4aawaama,aQag R5a,acaaaaaKcaaaV1aaa9haaaaa,"amaaUnaaaa aaaaaka7u5",4aawaama +7f,aaeaaaNah taalaaa4aqWa0,5aiaOaOax,aaaauaaaa,7f,aaeaaaNah taalaaa4aqWa0,5aiaOaOax,aaaauaaaa,7f,aaeaaaNah taalaaa4aqWa0 +9aFakaanaaaaaja,"naaataag4 ",aaaaaU9aaaayaSuRqaaaa,a,9aFakaanaaaaaja,"naaataag4 ",aaaaaU9aaaayaSuRqaaaa,a,9aFakaanaaaaaja,"naaataag4 " +aaL1,lWaMxaga1a6waa6wa7,a1aaa1aQaD,a,aaL1,lWaMxaga1a6waa6wa7,a1aaa1aQaD,a,aaL1,lWaMxaga1a6waa6wa7 +aIoKaS7aqLaaoaTaaaYWaa aaa,aa7aadaaaaaqKa4Waa,"aa8aKaa,aDaayB",KaaaaaapRaaaaaa,aIoKaS7aqLaaoaTaaaYWaa aaa,aa7aadaaaaaqKa4Waa,"aa8aKaa,aDaayB",KaaaaaapRaaaaaa,aIoKaS7aqLaaoaTaaaYWaa aaa,aa7aadaaaaaqKa4Waa +aavraaaaaaau,"aaPaaSalaaaaaaauaaa,Em55dfaa",am,Jaaa3,aavraaaaaaau,"aaPaaSalaaaaaaauaaa,Em55dfaa",am,Jaaa3,aavraaaaaaau,"aaPaaSalaaaaaaauaaa,Em55dfaa" +,RaaM3xaaeaaa,aaaWaajaataGaanrNIaaaaaOa,"GsaAataa aaGBVaaa4a",,RaaM3xaaeaaa,aaaWaajaataGaanrNIaaaaaOa,"GsaAataa aaGBVaaa4a",,RaaM3xaaeaaa +4aaaaJa,axaCaaU5aQ,"aaya 8mazraraaapaaa5","aw9Ca aNJ0af5nI",4aaaaJa,axaCaaU5aQ,"aaya 8mazraraaapaaa5","aw9Ca aNJ0af5nI",4aaaaJa,axaCaaU5aQ +aC aaeaaaY5aaa,aa oaBaa4oqmAaa,aaa,aayIiaaaaLW,aC aaeaaaY5aaa,aa oaBaa4oqmAaa,aaa,aayIiaaaaLW,aC aaeaaaY5aaa,aa oaBaa4oqmAaa + aU4aaa,Naaaaaa,"aaarasa5 +zIa", zaaaaa, aU4aaa,Naaaaaa,"aaarasa5 +zIa", zaaaaa, aU4aaa,Naaaaaa +,aaaaaaaM,a,"aataaaaaaaMta5a1vEPaaaaaad""",,aaaaaaaM,a,"aataaaaaaaMta5a1vEPaaaaaad""",,aaaaaaaM +," TF""aaaaaaajaaaa M",aaaaaaaaWpSaagarDF, aOdaa8aCiYDaanFaaOaaJai,," TF""aaaaaaajaaaa M",aaaaaaaaWpSaagarDF, aOdaa8aCiYDaanFaaOaaJai,," TF""aaaaaaajaaaa M" +"aaWauaaaWaaaQ9uaa,a6aTa7",aaaaaga,"aa aaa2pY aAaa,aaa0Eaaq3ka b ",ayDaaa7aaiaBHN,"aaWauaaaWaaaQ9uaa,a6aTa7",aaaaaga,"aa aaa2pY aAaa,aaa0Eaaq3ka b ",ayDaaa7aaiaBHN,"aaWauaaaWaaaQ9uaa,a6aTa7",aaaaaga +yyEaaaaaaaaa,aJagaaaa7aa,",aaaaaaL 0aaaaR","avaaa25,aaaNajrHxKaa0aaaa",yyEaaaaaaaaa,aJagaaaa7aa,",aaaaaaL 0aaaaR","avaaa25,aaaNajrHxKaa0aaaa",yyEaaaaaaaaa,aJagaaaa7aa +,aekaaaaVaaHvde,iaaQ DaX5aEaia, anaaaaaaas0aa7aaaatCQad 0Ra8,,aekaaaaVaaHvde,iaaQ DaX5aEaia, anaaaaaaas0aa7aaaatCQad 0Ra8,,aekaaaaVaaHvde +aAaIZN7aa28I3aHaqaaKa,a1aaYaaaPsaa3KaaI,a,7aaaaa,aAaIZN7aa28I3aHaqaaKa,a1aaYaaaPsaa3KaaI,a,7aaaaa,aAaIZN7aa28I3aHaqaaKa,a1aaYaaaPsaa3KaaI +Ws,"asaaaaug""aaaa",waaaa,a0zapBa,Ws,"asaaaaug""aaaa",waaaa,a0zapBa,Ws,"asaaaaug""aaaa" +YaGaaaataaa3anaa,"aaaaaaa a2aaaHJaaxaDaabI",1aaaaaIglaaaeg1amLtaaaKaaKaaaa,aaaNaaJ2,YaGaaaataaa3anaa,"aaaaaaa a2aaaHJaaxaDaabI",1aaaaaIglaaaeg1amLtaaaKaaKaaaa,aaaNaaJ2,YaGaaaataaa3anaa,"aaaaaaa a2aaaHJaaxaDaabI" +nfnQaua4aeaa,kaaaqpaUa," pf","FSa +7ta8aaaadaaa",nfnQaua4aeaa,kaaaqpaUa," pf","FSa +7ta8aaaadaaa",nfnQaua4aeaa,kaaaqpaUa +aSaaaaaaaaa,"Qja +aaaEaSaaaea +aYKa",aBat5AChaGeaataaa,aaspaavaaapCaaaK,aSaaaaaaaaa,"Qja +aaaEaSaaaea +aYKa",aBat5AChaGeaataaa,aaspaavaaapCaaaK,aSaaaaaaaaa,"Qja +aaaEaSaaaea +aYKa" +FOuaaa,aca 7uradaazaUaJaa," paRaJaiRaauZJaVaNqPaaM 6aaa",aaa9aaT8aaaaaaRasaa,FOuaaa,aca 7uradaazaUaJaa," paRaJaiRaauZJaVaNqPaaM 6aaa",aaa9aaT8aaaaaaRasaa,FOuaaa,aca 7uradaazaUaJaa +hCaaaqaaoaZa8a,aawaqamIbasaJavaaa,a,aaaPa3aR,hCaaaqaaoaZa8a,aawaqamIbasaJavaaa,a,aaaPa3aR,hCaaaqaaoaZa8a,aawaqamIbasaJavaaa +KVgaaaaaaBaaaaaaaaAaaaXaaaaa,aaFaaaaaHNnafxaaa,abrMfaaq,"a4aXa +a",KVgaaaaaaBaaaaaaaaAaaaXaaaaa,aaFaaaaaHNnafxaaa,abrMfaaq,"a4aXa +a",KVgaaaaaaBaaaaaaaaAaaaXaaaaa,aaFaaaaaHNnafxaaa +aadam8xa0aaTUaaa9aaaaDaaod4," + +aaH 6Qas5Aaaaaa","4aH aa7a",aaaaa aaabMaayaraaKKUaaSaa,aadam8xa0aaTUaaa9aaaaDaaod4," + +aaH 6Qas5Aaaaaa","4aH aa7a",aaaaa aaabMaayaraaKKUaaSaa,aadam8xa0aaTUaaa9aaaaDaaod4," + +aaH 6Qas5Aaaaaa" +KaKaa,aaaRA ZaaAa7Wn0Y3a1Ea,aaa,a,KaKaa,aaaRA ZaaAa7Wn0Y3a1Ea,aaa,a,KaKaa,aaaRA ZaaAa7Wn0Y3a1Ea +aaaaaVaDaaaa1iama,aaaaaZqE,aPaju,"awrxaa1aak +aaaaaWUaaaaaAa",aaaaaVaDaaaa1iama,aaaaaZqE,aPaju,"awrxaa1aak +aaaaaWUaaaaaAa",aaaaaVaDaaaa1iama,aaaaaZqE +aSapaaaaOaaaaaa0aaaaaaRaanaa,aDNam9aayuZaaWaaByNaa,aaaamaaa9aaaaaaaacAbaNaFY,"aaaaana""a aaKSaTaaGypaaakaw",aSapaaaaOaaaaaa0aaaaaaRaanaa,aDNam9aayuZaaWaaByNaa,aaaamaaa9aaaaaaaacAbaNaFY,"aaaaana""a aaKSaTaaGypaaakaw",aSapaaaaOaaaaaa0aaaaaaRaanaa,aDNam9aayuZaaWaaByNaa +"BqaCnJaaDO1a +xaCaaazhaaaaa a7",aahaaaaaa2aaaaaJaaPE3aKaaaga,aZaa,"aaaaaabF +aaeapafaaK","BqaCnJaaDO1a +xaCaaazhaaaaa a7",aahaaaaaa2aaaaaJaaPE3aKaaaga,aZaa,"aaaaaabF +aaeapafaaK","BqaCnJaaDO1a +xaCaaazhaaaaa a7",aahaaaaaa2aaaaaJaaPE3aKaaaga +a0ao ,,"aaaaaaaaaaaoaya aa +aFZaDa3a,",jQaaaaanaaaaaaihal3agNoaSaa,a0ao ,,"aaaaaaaaaaaoaya aa +aFZaDa3a,",jQaaaaanaaaaaaihal3agNoaSaa,a0ao , +a8aaaaaD9ER1aAaPaqs ZYaaa,"aaaagPaaaaaaVLgadaaaaSJaa8p""",aaaaaaa,"aHagaXaSLaa4 aa6aaZFalc",a8aaaaaD9ER1aAaPaqs ZYaaa,"aaaagPaaaaaaVLgadaaaaSJaa8p""",aaaaaaa,"aHagaXaSLaa4 aa6aaZFalc",a8aaaaaD9ER1aAaPaqs ZYaaa,"aaaagPaaaaaaVLgadaaaaSJaa8p""" +9aaaaaFoPac1,A0aaagvaaa,aaapaaaFaee,aaaoaaaadaaaaaT,9aaaaaFoPac1,A0aaagvaaa,aaapaaaFaee,aaaoaaaadaaaaaT,9aaaaaFoPac1,A0aaagvaaa +aaglfsaX7aa0aa3Jaaa,BaaaPAaaaadaaa,,aIQaaa,aaglfsaX7aa0aa3Jaaa,BaaaPAaaaadaaa,,aIQaaa,aaglfsaX7aa0aa3Jaaa,BaaaPAaaaadaaa +aGuasaFiaaMeN0Bva2a,"a gRaaaaSa",aaa,"aaQaaa BfaKqaVaaaa,Daa",aGuasaFiaaMeN0Bva2a,"a gRaaaaSa",aaa,"aaQaaa BfaKqaVaaaa,Daa",aGuasaFiaaMeN0Bva2a,"a gRaaaaSa" +saaaaowb9aaat,AaVaYaXaaaRaaaaaar,aOaaaaaPa,aal2ea1,saaaaowb9aaat,AaVaYaXaaaRaaaaaar,aOaaaaaPa,aal2ea1,saaaaowb9aaat,AaVaYaXaaaRaaaaaar +aua0aaaAaXTIa8aaa6aagakaaca,aaa6aQaaaaaoaUaaaaaaa,adlJaa,aaaaaamaaaaD3aZaabaaW,aua0aaaAaXTIa8aaa6aagakaaca,aaa6aQaaaaaoaUaaaaaaa,adlJaa,aaaaaamaaaaD3aZaabaaW,aua0aaaAaXTIa8aaa6aagakaaca,aaa6aQaaaaaoaUaaaaaaa +Ta7daja5,aaaaaWa,aaDanua,APaVaaYaaaaaaaaasBaadah8,Ta7daja5,aaaaaWa,aaDanua,APaVaaYaaaaaaaaasBaadah8,Ta7daja5,aaaaaWa +ayaaa04Saaqaa,laaTaaaaz,1Qa,aaaamaaaC4a,ayaaa04Saaqaa,laaTaaaaz,1Qa,aaaamaaaC4a,ayaaa04Saaqaa,laaTaaaaz +aaaav1aaa,D,"MVHaaaa +aaaaaaaaaa",aVaasaaaaJ2A,aaaav1aaa,D,"MVHaaaa +aaaaaaaaaa",aVaasaaaaJ2A,aaaav1aaa,D +aadaFacaaaaoaaatajkaaa,"aa,aa",aaz,NEQ,aadaFacaaaaoaaatajkaaa,"aa,aa",aaz,NEQ,aadaFacaaaaoaaatajkaaa,"aa,aa" +a7LaDaaaaaapaDaMVaaaWHauaaa,tauaa2FdaJaa,aaa aaa9aDCaa,paaAaaaqaGaaaa,a7LaDaaaaaapaDaMVaaaWHauaaa,tauaa2FdaJaa,aaa aaa9aDCaa,paaAaaaqaGaaaa,a7LaDaaaaaapaDaMVaaaWHauaaa,tauaa2FdaJaa +taahaa9a53,,aaaUaaaa8aV,aazaaaZa7a1aa,taahaa9a53,,aaaUaaaa8aV,aazaaaZa7a1aa,taahaa9a53, +"a7,Maaq",araaaaaataaMaaX8,aaaaaaaCamaaa,aaaaaaa,"a7,Maaq",araaaaaataaMaaX8,aaaaaaaCamaaa,aaaaaaa,"a7,Maaq",araaaaaataaMaaX8 +aaaIa9 aaNaaw9za,aaaaaay9GaoVgaaY apoa0aaaaaa,,aaV,aaaIa9 aaNaaw9za,aaaaaay9GaoVgaaY apoa0aaaaaa,,aaV,aaaIa9 aaNaaw9za,aaaaaay9GaoVgaaY apoa0aaaaaa +9UaaKta5aRKaaxIaWaxaaaaUaqPa,saiaSaaaaaaaaa7aaLU,aaCazIaIaEzaKa,aRwaaaVaaqvFaaDPa,9UaaKta5aRKaaxIaWaxaaaaUaqPa,saiaSaaaaaaaaa7aaLU,aaCazIaIaEzaKa,aRwaaaVaaqvFaaDPa,9UaaKta5aRKaaxIaWaxaaaaUaqPa,saiaSaaaaaaaaa7aaLU +"azaaa""FNaa XafavaaaaaMa",aNaaaaaDaTaaJSadaaBau5HJaaaa,8caOMaTwaaaaPaaaDiaCraayPWWaaD,"aa A2aah5aa3 a Jam","azaaa""FNaa XafavaaaaaMa",aNaaaaaDaTaaJSadaaBau5HJaaaa,8caOMaTwaaaaPaaaDiaCraayPWWaaD,"aa A2aah5aa3 a Jam","azaaa""FNaa XafavaaaaaMa",aNaaaaaDaTaaJSadaaBau5HJaaaa +"puaaaaaaaaDa7,qaHfx",,Nrl1aaa,aaaGkaLaaaaEaaauaq,"puaaaaaaaaDa7,qaHfx",,Nrl1aaa,aaaGkaLaaaaEaaauaq,"puaaaaaaaaDa7,qaHfx", +aaAcaaaMagaaaaTaafaaPaPao,aaZ MPaaS,aaaaaaaIaema,aaa a,aaAcaaaMagaaaaTaafaaPaPao,aaZ MPaaS,aaaaaaaIaema,aaa a,aaAcaaaMagaaaaTaafaaPaPao,aaZ MPaaS +aaaaPZywn,GaaZaarE2DDabaaKa1aaaE2a6a a, ZaDyAaEaa,aaaa,aaaaPZywn,GaaZaarE2DDabaaKa1aaaE2a6a a, ZaDyAaEaa,aaaa,aaaaPZywn,GaaZaarE2DDabaaKa1aaaE2a6a a +4aaasaYagaaV,ua aaqaaaMauaQeRaaraaa,aaaRmaLaaa2a,a,4aaasaYagaaV,ua aaqaaaMauaQeRaaraaa,aaaRmaLaaa2a,a,4aaasaYagaaV,ua aaqaaaMauaQeRaaraaa +"aX +taaia9uaaIagaaaa","aaaaa +dAaVa","aaaaaaaaaBamaLaa,a5vLchaa","a4v,aaaaaaaPaaPaGaaaaaTFaaaaa","aX +taaia9uaaIagaaaa","aaaaa +dAaVa","aaaaaaaaaBamaLaa,a5vLchaa","a4v,aaaaaaaPaaPaGaaaaaTFaaaaa","aX +taaia9uaaIagaaaa","aaaaa +dAaVa" +aaY2 Ea,DaaaaaaaazaecaaaaaSAaag4bAaaaa,,"3,,EWb4za,aV",aaY2 Ea,DaaaaaaaazaecaaaaaSAaag4bAaaaa,,"3,,EWb4za,aV",aaY2 Ea,DaaaaaaaazaecaaaaaSAaag4bAaaaa +"0""yaxa7aabafaarqf",oaaFC3ayLaeamaaa,azaa,Kp7aOcaaUaaaaaaa,"0""yaxa7aabafaarqf",oaaFC3ayLaeamaaa,azaa,Kp7aOcaaUaaaaaaa,"0""yaxa7aabafaarqf",oaaFC3ayLaeamaaa +"NaLaaIaSLahaaa +e9ZaY Daaaaaa","uaaaaaaabaka9aaamaa ,0aaNa",aekaaaaoaaaaaaaaA,aaa,"NaLaaIaSLahaaa +e9ZaY Daaaaaa","uaaaaaaabaka9aaamaa ,0aaNa",aekaaaaoaaaaaaaaA,aaa,"NaLaaIaSLahaaa +e9ZaY Daaaaaa","uaaaaaaabaka9aaamaa ,0aaNa" +aaaataZaaaaaaMKaWnaaaaaa,a,aataaa,5MaaXaaaDYRqaaz0aaaa,aaaataZaaaaaaMKaWnaaaaaa,a,aataaa,5MaaXaaaDYRqaaz0aaaa,aaaataZaaaaaaMKaWnaaaaaa,a +QaakXyaYVapaaJaaaaaadaaaaJm,a a a ,"adaVaaraa aaHaaanakaa8 +ta","a, +aaaaaaa9aaazaaaPJaaa""aab",QaakXyaYVapaaJaaaaaadaaaaJm,a a a ,"adaVaaraa aaHaaanakaa8 +ta","a, +aaaaaaa9aaazaaaPJaaa""aab",QaakXyaYVapaaJaaaaaadaaaaJm,a a a +"D""",OaRcaaa,"aahcaaaaSah6o7aaaaaa,9aG",aaaaaaaayaP6eaNS aaaB,"D""",OaRcaaa,"aahcaaaaSah6o7aaaaaa,9aG",aaaaaaaayaP6eaNS aaaB,"D""",OaRcaaa +"aaaaqac6""aa","aaaaeapB +a5aaenaaaiaaa",aPaaaDaaaaataBr,"a +aCaaaPaLsaaa +aaaCX","aaaaqac6""aa","aaaaeapB +a5aaenaaaiaaa",aPaaaDaaaaataBr,"a +aCaaaPaLsaaa +aaaCX","aaaaqac6""aa","aaaaeapB +a5aaenaaaiaaa" +aOa,ZapHaaaDfaat,aLaaa3UaaaiaaBavaaaWaaaaa,1,aOa,ZapHaaaDfaat,aLaaa3UaaaiaaBavaaaWaaaaa,1,aOa,ZapHaaaDfaat +aaaaaVgaaaa7aaaoPaaaaa,a04aaaaA,aaaaul1,,aaaaaVgaaaa7aaaoPaaaaa,a04aaaaA,aaaaul1,,aaaaaVgaaaa7aaaoPaaaaa,a04aaaaA +aaMaaaaag,YaaagNDaaaaaa2,a,"qaya2anDU aaaa laaaaada",aaMaaaaag,YaaagNDaaaaaa2,a,"qaya2anDU aaaa laaaaada",aaMaaaaag,YaaagNDaaaaaa2 +tawaaaaa9h5,aaaaaazeaeWagaaaaaaaBaJQvar0ta,CaaPaVa," aaVaag0v,aaPaaaaa aa",tawaaaaa9h5,aaaaaazeaeWagaaaaaaaBaJQvar0ta,CaaPaVa," aaVaag0v,aaPaaaaa aa",tawaaaaa9h5,aaaaaazeaeWagaaaaaaaBaJQvar0ta +aaaaagaaaOaa5aaaaaKagaa,aaaYaOUaa7JCnaT ac,f aaaJqaa9a1a,aaaa9ajaaxaaa0aX,aaaaagaaaOaa5aaaaaKagaa,aaaYaOUaa7JCnaT ac,f aaaJqaa9a1a,aaaa9ajaaxaaa0aX,aaaaagaaaOaa5aaaaaKagaa,aaaYaOUaa7JCnaT ac +aqax2hzRaI blaT,8aaTai,"a,9a7a",a,aqax2hzRaI blaT,8aaTai,"a,9a7a",a,aqax2hzRaI blaT,8aaTai +"aQa""2aaasaaaaaUwiarriEaaa2ae",aaFaabGaj6z0aKaZaaa4aaa9xvaHkb,amza,LKa,"aQa""2aaasaaaaaUwiarriEaaa2ae",aaFaabGaj6z0aKaZaaa4aaa9xvaHkb,amza,LKa,"aQa""2aaasaaaaaUwiarriEaaa2ae",aaFaabGaj6z0aKaZaaa4aaa9xvaHkb +aa aaPaaaLaaaaaDZaaa,hyaaa,aaaeaa7haaaaa,laaaa2gaaM7p0XkyaSKafaaaaaaaaa,aa aaPaaaLaaaaaDZaaa,hyaaa,aaaeaa7haaaaa,laaaa2gaaM7p0XkyaSKafaaaaaaaaa,aa aaPaaaLaaaaaDZaaa,hyaaa +aaaaaaPaaa,aekaaaacaa,aaaaaaagaaaaaa5aAaana,"9Daa +jaaa5DKaa",aaaaaaPaaa,aekaaaacaa,aaaaaaagaaaaaa5aAaana,"9Daa +jaaa5DKaa",aaaaaaPaaa,aekaaaacaa +hQaaaVRaaaamaKvaala,SadaaBYaaaC5afiaaPaaua,aaaaaaaaaaLaaafajYyaaaawaa,aTOaaatxfa,hQaaaVRaaaamaKvaala,SadaaBYaaaC5afiaaPaaua,aaaaaaaaaaLaaafajYyaaaawaa,aTOaaatxfa,hQaaaVRaaaamaKvaala,SadaaBYaaaC5afiaaPaaua +aaazaaXHFaadaaaCpawaAQta,"aTaafaaa2aaaa""aaaaaax8a",aD,"oTcYEa +adaaaaaa",aaazaaXHFaadaaaCpawaAQta,"aTaafaaa2aaaa""aaaaaax8a",aD,"oTcYEa +adaaaaaa",aaazaaXHFaadaaaCpawaAQta,"aTaafaaa2aaaa""aaaaaax8a" +P,"a +UqFaaaaaaMaaaaNaq",anaaRaxaTOWa9aaajaaOwJ,"aaaaaaaMavaza aaaaca",P,"a +UqFaaaaaaMaaaaNaq",anaaRaxaTOWa9aaajaaOwJ,"aaaaaaaMavaza aaaaca",P,"a +UqFaaaaaaMaaaaNaq" +" aiaaaaFaaafnaapaaa",,"aBaa,"" +gaaaFawaaaaxaaaa2TaGaa",aCa2Qa," aiaaaaFaaafnaapaaa",,"aBaa,"" +gaaaFawaaaaxaaaa2TaGaa",aCa2Qa," aiaaaaFaaafnaapaaa", +aaY5aa1WcadS6BQca4aa aaa,"1maaaahN""aa",aaaXaaaa,ResRaa1,aaY5aa1WcadS6BQca4aa aaa,"1maaaahN""aa",aaaXaaaa,ResRaa1,aaY5aa1WcadS6BQca4aa aaa,"1maaaahN""aa" +a,aa2,aaaaWaU3aaSaayaa,aaYaa,a,aa2,aaaaWaU3aaSaayaa,aaYaa,a,aa2 +aiaaaa8eKaHaa,aaoaa,Zaa,"XvoaOaa Vay9aSM4F",aiaaaa8eKaHaa,aaoaa,Zaa,"XvoaOaa Vay9aSM4F",aiaaaa8eKaHaa,aaoaa +"aa""I1laaaaaVV aaKiaaaK3Zaa",Macaaaa,Caaa7au,"aaa8aQT +aaaaa","aa""I1laaaaaVV aaKiaaaK3Zaa",Macaaaa,Caaa7au,"aaa8aQT +aaaaa","aa""I1laaaaaVV aaKiaaaK3Zaa",Macaaaa +aOSzBaaaG aaalaaa qa af,a,aLqadWv,a1a,aOSzBaaaG aaalaaa qa af,a,aLqadWv,a1a,aOSzBaaaG aaalaaa qa af,a +" +lsaaWNkYaana",aa,yaSaaaa9aaaKTaaYuRa6,," +lsaaWNkYaana",aa,yaSaaaa9aaaKTaaYuRa6,," +lsaaWNkYaana",aa +,"aa aaa3aaaaaaaQ,aQSa","afaaaF +aK",a,,"aa aaa3aaaaaaaQ,aQSa","afaaaF +aK",a,,"aa aaa3aaaaaaaQ,aQSa" +6ar ,iKaaazaaaa,axtaaaMaaa9KarPa,,6ar ,iKaaazaaaa,axtaaaMaaa9KarPa,,6ar ,iKaaazaaaa +a,aafbaaZa7aarawaJax,jaxaUga,laaaa36awKwaaaaU1aCaaagISaaaaa,a,aafbaaZa7aarawaJax,jaxaUga,laaaa36awKwaaaaU1aCaaagISaaaaa,a,aafbaaZa7aarawaJax +"Aa7aa,fbmsaaaaYaN5xa alcYa","aa4zjzjiaaaaaGZqa""aO","PAOcaaSa +aaaKWaaaBaE9"," aa1 a","Aa7aa,fbmsaaaaYaN5xa alcYa","aa4zjzjiaaaaaGZqa""aO","PAOcaaSa +aaaKWaaaBaE9"," aa1 a","Aa7aa,fbmsaaaaYaN5xa alcYa","aa4zjzjiaaaaaGZqa""aO" +aaAauaaltIXaZaa,"aaaaaaaaaaBaaaaUaaraa3aaa +aaR",U4aaaaaapaaEcaa0aR,WaeaaaaaJ0aa,aaAauaaltIXaZaa,"aaaaaaaaaaBaaaaUaaraa3aaa +aaR",U4aaaaaapaaEcaa0aR,WaeaaaaaJ0aa,aaAauaaltIXaZaa,"aaaaaaaaaaBaaaaUaaraa3aaa +aaR" +"4Paana3aaaa aa ,A","2Haaya""ha9a1","aaa aae0Qaaadaaaaaa","XaEaa +haaraEaaaaanaa3OaaTLf","4Paana3aaaa aa ,A","2Haaya""ha9a1","aaa aae0Qaaadaaaaaa","XaEaa +haaraEaaaaanaa3OaaTLf","4Paana3aaaa aa ,A","2Haaya""ha9a1" +Ja8NaaaG aAOaaamaaaata0apa a,2U5OIMaaaaUSappaUaaaaac,paaaS,aaa5SaVaTaabaUaaaaaVa,Ja8NaaaG aAOaaamaaaata0apa a,2U5OIMaaaaUSappaUaaaaac,paaaS,aaa5SaVaTaabaUaaaaaVa,Ja8NaaaG aAOaaamaaaata0apa a,2U5OIMaaaaUSappaUaaaaac +aaPsadaaaaO6aa aaaT3Zaj,"aaaiaidaaaaaaadaaV2j abaa",aaaaaDa,aa8uaaaFBaTaP0ocqQQ0QHaasaaaa,aaPsadaaaaO6aa aaaT3Zaj,"aaaiaidaaaaaaadaaV2j abaa",aaaaaDa,aa8uaaaFBaTaP0ocqQQ0QHaasaaaa,aaPsadaaaaO6aa aaaT3Zaj,"aaaiaidaaaaaaadaaV2j abaa" +aaaXaaaaaaa6aaka,aaaaIaMTaaTaaapaaaaadaaaaaa,aQeaaaajaaaayBhaa aaoaaa,"a""6aaWapaPaaGa +auAUaaaXa",aaaXaaaaaaa6aaka,aaaaIaMTaaTaaapaaaaadaaaaaa,aQeaaaajaaaayBhaa aaoaaa,"a""6aaWapaPaaGa +auAUaaaXa",aaaXaaaaaaa6aaka,aaaaIaMTaaTaaapaaaaadaaaaaa +E,aaaaa,"Saaa8 aaaaOauwaaa""aaaaaaaah",aaaaYgaaa9aMHJaga,E,aaaaa,"Saaa8 aaaaOauwaaa""aaaaaaaah",aaaaYgaaa9aMHJaga,E,aaaaa +aaa4aaaaa aaat,aXGaaaaIaaaana,3aaaaiEaae,"a,a,aaEP5aaaXaa +aaacaaaaaaYa",aaa4aaaaa aaat,aXGaaaaIaaaana,3aaaaiEaae,"a,a,aaEP5aaaXaa +aaacaaaaaaYa",aaa4aaaaa aaat,aXGaaaaIaaaana +aeaalaaa,a4aN0a,atMaaWaa76bGaaa,"aaa6QaaM +aaaaaaaaaaYaaah8",aeaalaaa,a4aN0a,atMaaWaa76bGaaa,"aaa6QaaM +aaaaaaaaaaYaaah8",aeaalaaa,a4aN0a +"raaa,ta4aaAaTQa aa Ras",aaaaaaa2qa47arO9aa,"Qa""QapPaa5aa aaasRaX1aS",n,"raaa,ta4aaAaTQa aa Ras",aaaaaaa2qa47arO9aa,"Qa""QapPaa5aa aaasRaX1aS",n,"raaa,ta4aaAaTQa aa Ras",aaaaaaa2qa47arO9aa +aSaaaaaaWaLa,8,a,na4aJaLaanlataaKaVazGaa,aSaaaaaaWaLa,8,a,na4aJaLaanlataaKaVazGaa,aSaaaaaaWaLa,8 +MaaFaaaaaU a1aOaGagaaMaRaaaa,Jk,a,gauaaJaaqaoaaaaaab5Baaayaaaaa,MaaFaaaaaU a1aOaGagaaMaRaaaa,Jk,a,gauaaJaaqaoaaaaaab5Baaayaaaaa,MaaFaaaaaU a1aOaGagaaMaRaaaa,Jk +bqaaa,Da2,an6JaFa8aaaaraBaaaa9a,,bqaaa,Da2,an6JaFa8aaaaraBaaaa9a,,bqaaa,Da2 +rDaaaaaQa,aVaa5vaaFaxttViaupa,"G""aaaHhaiaaaQyaUaZ",aVRJaaaaaaaagq4,rDaaaaaQa,aVaa5vaaFaxttViaupa,"G""aaaHhaiaaaQyaUaZ",aVRJaaaaaaaagq4,rDaaaaaQa,aVaa5vaaFaxttViaupa +aaaosaaaDaWaaP,AaaalaahaaaaaTKanaaaFWpjgOa,araaaaaaaaaacaaaSaaaaa,ma9aaanaFaataaAaatraaaacaaaama,aaaosaaaDaWaaP,AaaalaahaaaaaTKanaaaFWpjgOa,araaaaaaaaaacaaaSaaaaa,ma9aaanaFaataaAaatraaaacaaaama,aaaosaaaDaWaaP,AaaalaahaaaaaTKanaaaFWpjgOa +HeT0Da,UaaanWPaaaaaaaFaY,"QYaaa,Raa caaaaoaNaaaaaaaab",aaDMJ9uqMGaa,HeT0Da,UaaanWPaaaaaaaFaY,"QYaaa,Raa caaaaoaNaaaaaaaab",aaDMJ9uqMGaa,HeT0Da,UaaanWPaaaaaaaFaY +aaaapaaaa8FLoacuMao7V,3vOZaaaaaah,agaabaaaaa,"eaawa5anama aaaAags",aaaapaaaa8FLoacuMao7V,3vOZaaaaaah,agaabaaaaa,"eaawa5anama aaaAags",aaaapaaaa8FLoacuMao7V,3vOZaaaaaah +aaaaaf6 QaaaWaDaW,"a aaak akMaGaaa",eMadaaaaqaaaaaYaaSSwaAaaa,yaSfaaaaUkaaaaadaaa,aaaaaf6 QaaaWaDaW,"a aaak akMaGaaa",eMadaaaaqaaaaaYaaSSwaAaaa,yaSfaaaaUkaaaaadaaa,aaaaaf6 QaaaWaDaW,"a aaak akMaGaaa" +laaxaUa,"Qa +aaaa5 aaaaataaaaag",aaaaiaaHaa,"aaa aaxFaaaaadaaafaaCaDN aYa",laaxaUa,"Qa +aaaa5 aaaaataaaaag",aaaaiaaHaa,"aaa aaxFaaaaadaaafaaCaDN aYa",laaxaUa,"Qa +aaaa5 aaaaataaaaag" +"saaaaFaaB,vaa +gl3GzaaaukaTaW",aaaSaPfaaeaaWCac,aaCaRaaHaaa,aaaaa,"saaaaFaaB,vaa +gl3GzaaaukaTaW",aaaSaPfaaeaaWCac,aaCaRaaHaaa,aaaaa,"saaaaFaaB,vaa +gl3GzaaaukaTaW",aaaSaPfaaeaaWCac +aaxraaaaaaglaaa,aaRaaaaaaS,"""DaaybrjaMasaaWaaaazaaaaaaaa",aaaryyaatbkMaz,aaxraaaaaaglaaa,aaRaaaaaaS,"""DaaybrjaMasaaWaaaazaaaaaaaa",aaaryyaatbkMaz,aaxraaaaaaglaaa,aaRaaaaaaS +"aaaHka q18yxaa5paaaaZa5aaa",hqaaa,aaaxdHaaa8Eaaaaaaaaq,aa,"aaaHka q18yxaa5paaaaZa5aaa",hqaaa,aaaxdHaaa8Eaaaaaaaaq,aa,"aaaHka q18yxaa5paaaaZa5aaa",hqaaa +a,aZaaaCoT,aaNaaaaaNaalaxaaaar,aTaaajaaaaa,a,aZaaaCoT,aaNaaaaaNaalaxaaaar,aTaaajaaaaa,a,aZaaaCoT +"PFx aOdc NdaaaapnaVaaahXa",aaLaaxaSiia7aaayyaaVgaaaaBoNTa,aaFBTaTaaaaaaaMN6a aa,aL,"PFx aOdc NdaaaapnaVaaahXa",aaLaaxaSiia7aaayyaaVgaaaaBoNTa,aaFBTaTaaaaaaaMN6a aa,aL,"PFx aOdc NdaaaapnaVaaahXa",aaLaaxaSiia7aaayyaaVgaaaaBoNTa +"""v",a9aaaaaaaaaaaKaa,aaa80aaGaaYaaa7aagI4a3eaa,aaNa3Giaaaat gaaPVa,"""v",a9aaaaaaaaaaaKaa,aaa80aaGaaYaaa7aagI4a3eaa,aaNa3Giaaaat gaaPVa,"""v",a9aaaaaaaaaaaKaa +aaaaHaAaEgaaNaaa aa2aP,7pSa51aaaaazaa,aaRaa,aaaaahaIasBaaaoaaaaaJaiaa,aaaaHaAaEgaaNaaa aa2aP,7pSa51aaaaazaa,aaRaa,aaaaahaIasBaaaoaaaaaJaiaa,aaaaHaAaEgaaNaaa aa2aP,7pSa51aaaaazaa +afaaktaaaPataaaaaaXaMaa3aa,aTaaa,"TaaNYaaaaVykaaw awta",aaaaaaaa,afaaktaaaPataaaaaaXaMaa3aa,aTaaa,"TaaNYaaaaVykaaw awta",aaaaaaaa,afaaktaaaPataaaaaaXaMaa3aa,aTaaa +"Vafa3aiw +aaaE +",aaPCfa,"auaCZdaaaaYaa +aaaJaaHan",JaaaRFn1aaahnaaHaaae GZap0aXa,"Vafa3aiw +aaaE +",aaPCfa,"auaCZdaaaaYaa +aaaJaaHan",JaaaRFn1aaahnaaHaaae GZap0aXa,"Vafa3aiw +aaaE +",aaPCfa +aaaaccVaaaKaaaa,"aaaeaaAarR aa",aaaTaBaJaGaxaaaaaaaAaafaakDa,La,aaaaccVaaaKaaaa,"aaaeaaAarR aa",aaaTaBaJaGaxaaaaaaaAaafaakDa,La,aaaaccVaaaKaaaa,"aaaeaaAarR aa" +sOnpaeamaaaPaaaaa6a,aaa2,"agVa,aaaB xPaaFaaaUaaa ",afa0aa,sOnpaeamaaaPaaaaa6a,aaa2,"agVa,aaaB xPaaFaaaUaaa ",afa0aa,sOnpaeamaaaPaaaaa6a,aaa2 +aaha8aaaa,aaVaaDaQ,"VZaKa""aa",a3aQa5Taaaaaaaa5paaaaaaaaaaa,aaha8aaaa,aaVaaDaQ,"VZaKa""aa",a3aQa5Taaaaaaaa5paaaaaaaaaaa,aaha8aaaa,aaVaaDaQ +"xaCaaaVajaeag""aa5aaaaa aaa6","arna, saaNaaataR4aaaababayaM",aba9aaaasaaaaaaan8aaj,aaJ7WaaNadai42aa,"xaCaaaVajaeag""aa5aaaaa aaa6","arna, saaNaaataR4aaaababayaM",aba9aaaasaaaaaaan8aaj,aaJ7WaaNadai42aa,"xaCaaaVajaeag""aa5aaaaa aaa6","arna, saaNaaataR4aaaababayaM" +aaoa,aazaa,yaa7z,aaaaaEaayMaa,aaoa,aazaa,yaa7z,aaaaaEaayMaa,aaoa,aazaa +hPjYa,"aaNaZXa +aaa","awa +zaaaaaaagaaaaaaaRaG8s",a,hPjYa,"aaNaZXa +aaa","awa +zaaaaaaagaaaaaaaRaG8s",a,hPjYa,"aaNaZXa +aaa" +aaaa,caMaamadRaaWaaaJaaaUaLaaa,aYaa6aaaaOaaSaaaaaaaQa,xUJpaaaaaa9aaaaaaqaaa,aaaa,caMaamadRaaWaaaJaaaUaLaaa,aYaa6aaaaOaaSaaaaaaaQa,xUJpaaaaaa9aaaaaaqaaa,aaaa,caMaamadRaaWaaaJaaaUaLaaa +6aaa avaNfaaHBZaaarjaa,"aaa5aaaaaaa TaaaLLaaANAa8aa0aa",aaE0ha5aP kyjaaaauaE,"iaaakEaaa""S9aaJa0aa",6aaa avaNfaaHBZaaarjaa,"aaa5aaaaaaa TaaaLLaaANAa8aa0aa",aaE0ha5aP kyjaaaauaE,"iaaakEaaa""S9aaJa0aa",6aaa avaNfaaHBZaaarjaa,"aaa5aaaaaaa TaaaLLaaANAa8aa0aa" +",",aaOiaaGFaaa5,"Iaaa0aT,aaaaa +ax caaOg7a","aaGDaaaaaaaaaam +aaha",",",aaOiaaGFaaa5,"Iaaa0aT,aaaaa +ax caaOg7a","aaGDaaaaaaaaaam +aaha",",",aaOiaaGFaaa5 +a,,aaaaafFDalo38aaaEupaw6WaBaY,aaaaaa,a,,aaaaafFDalo38aaaEupaw6WaBaY,aaaaaa,a, +aaaaaaa3aGa1,"GaaLaaa""aat9teaaYaNaaa"," +jaafAaaaa","abyaaaahaaaapv +",aaaaaaa3aGa1,"GaaLaaa""aat9teaaYaNaaa"," +jaafAaaaa","abyaaaahaaaapv +",aaaaaaa3aGa1,"GaaLaaa""aat9teaaYaNaaa" +"a4aaasE""aa0aaaaaaaa","a,5aaa4aXGaaxa",aa1arViV,XJahaaza1aaZaCxaaNaaRaa,"a4aaasE""aa0aaaaaaaa","a,5aaa4aXGaaxa",aa1arViV,XJahaaza1aaZaCxaaNaaRaa,"a4aaasE""aa0aaaaaaaa","a,5aaa4aXGaaxa" +la,lJa0bhaa af,,aaaR0caa3,la,lJa0bhaa af,,aaaR0caa3,la,lJa0bhaa af +"a,aaaaSB N6aaoa4Ra",wa3a5Fm08,aazaaa,"aEaaaftaaLVVaca""ftaaauacajaga","a,aaaaSB N6aaoa4Ra",wa3a5Fm08,aazaaa,"aEaaaftaaLVVaca""ftaaauacajaga","a,aaaaSB N6aaoa4Ra",wa3a5Fm08 +aaNaMaadSaaa,UaaaaaauVUaaa aBaaaacaM6,"aaT""aa 0aaaaaaPeaaZaaaaa az","uaaadyaaaaaa6ad +t",aaNaMaadSaaa,UaaaaaauVUaaa aBaaaacaM6,"aaT""aa 0aaaaaaPeaaZaaaaa az","uaaadyaaaaaa6ad +t",aaNaMaadSaaa,UaaaaaauVUaaa aBaaaacaM6 +"OQaaa0aaaaaa3azK,",VX,"asaaLaf +aJaaKaPa4aanaaaaxaaha",aLajGaa,"OQaaa0aaaaaa3azK,",VX,"asaaLaf +aJaaKaPa4aanaaaaxaaha",aLajGaa,"OQaaa0aaaaaa3azK,",VX +"aa4aaaa +aaarr",xIaaSawaaaaadeaa,aDabaa,"a +T","aa4aaaa +aaarr",xIaaSawaaaaadeaa,aDabaa,"a +T","aa4aaaa +aaarr",xIaaSawaaaaadeaa +aaaaaaaRa9aaaaabhaaaawalp,"Ntaa7ataaaaKaavaGa9 +aa +aa,6aaa",aaaaaaa3aa,TadaaHeadaaaaaaaa,aaaaaaaRa9aaaaabhaaaawalp,"Ntaa7ataaaaKaavaGa9 +aa +aa,6aaa",aaaaaaa3aa,TadaaHeadaaaaaaaa,aaaaaaaRa9aaaaabhaaaawalp,"Ntaa7ataaaaKaavaGa9 +aa +aa,6aaa" +"F +,aiv9CaaP","a aaaWiaaW",yaala7aaSa,aaW,"F +,aiv9CaaP","a aaaWiaaW",yaala7aaSa,aaW,"F +,aiv9CaaP","a aaaWiaaW" +"""",a,"aam22ZFaaaB +","7a6aaa6aaaaa +aaa1aaaaaaaTO","""",a,"aam22ZFaaaB +","7a6aaa6aaaaa +aaa1aaaaaaaTO","""",a +Xaaaaaaq7At,maa2,aWQ,"Xa4Bn7auaIa5aaaMW SNa,Da",Xaaaaaaq7At,maa2,aWQ,"Xa4Bn7auaIa5aaaMW SNa,Da",Xaaaaaaq7At,maa2 +aaaataJaaFaH,aa8EaaanaaaaWaaaaaaYaaabaaal,"aagavaa +vaaaf6zalazaaaOQJa","aaV aaQDdaaxaabaaaKOpaaaEqaa",aaaataJaaFaH,aa8EaaanaaaaWaaaaaaYaaabaaal,"aagavaa +vaaaf6zalazaaaOQJa","aaV aaQDdaaxaabaaaKOpaaaEqaa",aaaataJaaFaH,aa8EaaanaaaaWaaaaaaYaaabaaal +aBaa5aaDlaafaaa,aAaaCa9,aaaaaaaLaza,c aaaaaaaKaea,aBaa5aaDlaafaaa,aAaaCa9,aaaaaaaLaza,c aaaaaaaKaea,aBaa5aaDlaafaaa,aAaaCa9 +"faaax,a4Wa77 avjaaaaaaaaHa0aaT",baaaaaatVvXaaaQCau1a,"aSanaa 4",acaaaaaaa3,"faaax,a4Wa77 avjaaaaaaaaHa0aaT",baaaaaatVvXaaaQCau1a,"aSanaa 4",acaaaaaaa3,"faaax,a4Wa77 avjaaaaaaaaHa0aaT",baaaaaatVvXaaaQCau1a +"aOaaa6aQua +aIj aaaVl",aIaaapaEaaamaaaV9baMaqaaaa3Saa,,aeaxaaaaaaaraaaaasMuaaaVa3aa,"aOaaa6aQua +aIj aaaVl",aIaaapaEaaamaaaV9baMaqaaaa3Saa,,aeaxaaaaaaaraaaaasMuaaaVa3aa,"aOaaa6aQua +aIj aaaVl",aIaaapaEaaamaaaV9baMaqaaaa3Saa +"qF1a7QaaaaaauuaaaK a +5aaaaa",aAaaaaoSa0aaaaaaaaaaA,aa7aaaaqa3wa2a,haaaaia4a7aaaPaaaaaaazTdaaae,"qF1a7QaaaaaauuaaaK a +5aaaaa",aAaaaaoSa0aaaaaaaaaaA,aa7aaaaqa3wa2a,haaaaia4a7aaaPaaaaaaazTdaaae,"qF1a7QaaaaaauuaaaK a +5aaaaa",aAaaaaoSa0aaaaaaaaaaA +"aC0LMvaaDaaauaxaaP uaaTzaa",,aRaaCaaaaaaaaaGaa,"aCuaa,asqa""aaaaa2NW0Fa3lunaar","aC0LMvaaDaaauaxaaP uaaTzaa",,aRaaCaaaaaaaaaGaa,"aCuaa,asqa""aaaaa2NW0Fa3lunaar","aC0LMvaaDaaauaxaaP uaaTzaa", +746a9ayaaRagaanKa,Uaa Samaahzaaaam,pHaaaaJT5iEataLaaaIapaGaatax,aaay3aaaHaaaggaaGaaa8LOa,746a9ayaaRagaanKa,Uaa Samaahzaaaam,pHaaaaJT5iEataLaaaIapaGaatax,aaay3aaaHaaaggaaGaaa8LOa,746a9ayaaRagaanKa,Uaa Samaahzaaaam +auaaht,ZabCa9aa,aaEeNaaaaaaaaaa aaaa,a,auaaht,ZabCa9aa,aaEeNaaaaaaaaaa aaaa,a,auaaht,ZabCa9aa +"aaaaaUfaa""aVaLawaataaataAaCa",GE,"a +aaaajaSG""Faaua",waaaa,"aaaaaUfaa""aVaLawaataaataAaCa",GE,"a +aaaajaSG""Faaua",waaaa,"aaaaaUfaa""aVaLawaataaataAaCa",GE +d6aaaaaaGMaaGaaaabBa,"Zdaah7Oua9avFa aaaaNa",r3aaaaaaaaIaaaaQxa3ADaa7maa,FBaFaQaaaoaa3aWaasaaa,d6aaaaaaGMaaGaaaabBa,"Zdaah7Oua9avFa aaaaNa",r3aaaaaaaaIaaaaQxa3ADaa7maa,FBaFaQaaaoaa3aWaasaaa,d6aaaaaaGMaaGaaaabBa,"Zdaah7Oua9avFa aaaaNa" +xKcaiTaaaMa maaaNaaaaaaH,araaaaaraRahaaata,aaAaaqa9aF,"aaa93aaa7aaa""DaaxaaiAw",xKcaiTaaaMa maaaNaaaaaaH,araaaaaraRahaaata,aaAaaqa9aF,"aaa93aaa7aaa""DaaxaaiAw",xKcaiTaaaMa maaaNaaaaaaH,araaaaaraRahaaata +k9aaaaaaa3aaaaaaaE,aa,a3jPaUaa7E5daJa,Z,k9aaaaaaa3aaaaaaaE,aa,a3jPaUaa7E5daJa,Z,k9aaaaaaa3aaaaaaaE,aa +aaaatcaAaaaEazaaW,aa,aaazaaaaaaaaala,"a6""aqcaa7aYOsqaG",aaaatcaAaaaEazaaW,aa,aaazaaaaaaaaala,"a6""aqcaa7aYOsqaG",aaaatcaAaaaEazaaW,aa +qga5oaTaaa,aaXa3aaaaaaaraaaaaaaaTaqaSaa,"WnNa7a,OUaaaaS +a",aa4ha,qga5oaTaaa,aaXa3aaaaaaaraaaaaaaaTaqaSaa,"WnNa7a,OUaaaaS +a",aa4ha,qga5oaTaaa,aaXa3aaaaaaaraaaaaaaaTaqaSaa +"h1 aaaa",aQa,a,aa,"h1 aaaa",aQa,a,aa,"h1 aaaa",aQa + aaRaaYmaaGaaDana,"ataadaa""aaaaaeaaaSalawaaaaaaa","aaaaaK +HMaaaaaaaa",aMaaaUR daaaaMM3, aaRaaYmaaGaaDana,"ataadaa""aaaaaeaaaSalawaaaaaaa","aaaaaK +HMaaaaaaaa",aMaaaUR daaaaMM3, aaRaaYmaaGaaDana,"ataadaa""aaaaaeaaaSalawaaaaaaa" +aaaLa1a naaDoaaavaiBw2b,aYa8 SaaaPaazaraaAaYaaawa,0a39aaOaaaa0,laaar33aa4asdxaaauqJ5G7aaaga,aaaLa1a naaDoaaavaiBw2b,aYa8 SaaaPaazaraaAaYaaawa,0a39aaOaaaa0,laaar33aa4asdxaaauqJ5G7aaaga,aaaLa1a naaDoaaavaiBw2b,aYa8 SaaaPaazaraaAaYaaawa +EaaOaLAaa raaa,"aa""aawaEawaGaa710aaaFha",aaaaO,"IagM waaaaa11ahVaa,gca",EaaOaLAaa raaa,"aa""aawaEawaGaa710aaaFha",aaaaO,"IagM waaaaa11ahVaa,gca",EaaOaLAaa raaa,"aa""aawaEawaGaa710aaaFha" +PBaaaaacaaa,ataaK,aaaa2aa4azhXa,aZaIoaaaB9aaavaF,PBaaaaacaaa,ataaK,aaaa2aa4azhXa,aZaIoaaaB9aaavaF,PBaaaaacaaa,ataaK +aaaPa6aaaaaav2,aaaSaYeEAahaaa1Baa6aaaa3ea,"a aa +baaaaoaaNRHaaIaa",aa,aaaPa6aaaaaav2,aaaSaYeEAahaaa1Baa6aaaa3ea,"a aa +baaaaoaaNRHaaIaa",aa,aaaPa6aaaaaav2,aaaSaYeEAahaaa1Baa6aaaa3ea +aaoaaxqaaaaaylaMTaT,aaaa alaapa9aaaaaa,a,"aaaa1XExraaaadaBp +aaYOsaakraa",aaoaaxqaaaaaylaMTaT,aaaa alaapa9aaaaaa,a,"aaaa1XExraaaadaBp +aaYOsaakraa",aaoaaxqaaaaaylaMTaT,aaaa alaapa9aaaaaa +B,"AaayaaLaaaOaaaaaaaCaaaaaxa,jMn",aaa4aaaaaaaa,aaaaaaaaataagaaacsacaaagaVa,B,"AaayaaLaaaOaaaaaaaCaaaaaxa,jMn",aaa4aaaaaaaa,aaaaaaaaataagaaacsacaaagaVa,B,"AaayaaLaaaOaaaaaaaCaaaaaxa,jMn" +"aaa""aCe",7aXaa,"a3kAam aaajaaaaUaa",aaVaaaaaaaaaaa,"aaa""aCe",7aXaa,"a3kAam aaajaaaaUaa",aaVaaaaaaaaaaa,"aaa""aCe",7aXaa +aa,aaaaaaKa,Ma,daaaaHaaaTdaaaaaaDaaaaaaRa,aa,aaaaaaKa,Ma,daaaaHaaaTdaaaaaaDaaaaaaRa,aa,aaaaaaKa +taaaaaaaaaaaaGaaaDcas,aa,"a6javbaaZaaaaTxaaTa2caaasa ",aaLajqaaaFaaaaaaaaoaaaa6aaUa,taaaaaaaaaaaaGaaaDcas,aa,"a6javbaaZaaaaTxaaTa2caaasa ",aaLajqaaaFaaaaaaaaoaaaa6aaUa,taaaaaaaaaaaaGaaaDcas,aa +aVa,"Va3Naa""eaaaaaNa0""",2Hha6a9XaGVaaaaaZaaaa1aaadaiaa,aaaaoaaaaOaa7anaaaaaaa,aVa,"Va3Naa""eaaaaaNa0""",2Hha6a9XaGVaaaaaZaaaa1aaadaiaa,aaaaoaaaaOaa7anaaaaaaa,aVa,"Va3Naa""eaaaaaNa0""" +,paaaaaXaaaQejaaaaa,"aBa9aaAxparb""aaEja","aagaaIaNaaa +aaLaWVpSa1aRa",,paaaaaXaaaQejaaaaa,"aBa9aaAxparb""aaEja","aagaaIaNaaa +aaLaWVpSa1aRa",,paaaaaXaaaQejaaaaa +aaaaaa1aaSaa,UTaaaHanTaaaaaaLaaa,aabaaaalFpaar0a aaamaadaaaz,"a""aaaaaLcaaaaa",aaaaaa1aaSaa,UTaaaHanTaaaaaaLaaa,aabaaaalFpaar0a aaamaadaaaz,"a""aaaaaLcaaaaa",aaaaaa1aaSaa,UTaaaHanTaaaaaaLaaa +"aaahaqai0aMTaaaw 4aaaa8",aaTRaaadaFd6aaa,aa,a9aSSaa,"aaahaqai0aMTaaaw 4aaaa8",aaTRaaadaFd6aaa,aa,a9aSSaa,"aaahaqai0aMTaaaw 4aaaa8",aaTRaaadaFd6aaa +aaaabaC,aa7aaaaTacN,"azaw +aNGZVas",uana,aaaabaC,aa7aaaaTacN,"azaw +aNGZVas",uana,aaaabaC,aa7aaaaTacN +ataatVaaEa9aDa4F,,YaaPHeY9,aOv1aUv,ataatVaaEa9aDa4F,,YaaPHeY9,aOv1aUv,ataatVaaEa9aDa4F, +aavm5MaaFaat2aucrz,"aWaaaaF,wx","aama aJHIq","aaaa UaeaQaaaJ +qaaaaa",aavm5MaaFaat2aucrz,"aWaaaaF,wx","aama aJHIq","aaaa UaeaQaaaJ +qaaaaa",aavm5MaaFaat2aucrz,"aWaaaaF,wx" +"y7aasoa63raTaaaaaa +aaaaaaanazU",aaa,"ateCaay +aaaMaaaaaaaaLaaraa",44aaaaaJaa,"y7aasoa63raTaaaaaa +aaaaaaanazU",aaa,"ateCaay +aaaMaaaaaaaaLaaraa",44aaaaaJaa,"y7aasoa63raTaaaaaa +aaaaaaanazU",aaa +"aMaa +",7akajaadaaaaaaaaea6yaaNk a,"amaaaw,aZaaa aaEaa gaa0aaaHda","aaa aa,3aaaeMag +a6F,aCa","aMaa +",7akajaadaaaaaaaaea6yaaNk a,"amaaaw,aZaaa aaEaa gaa0aaaHda","aaa aa,3aaaeMag +a6F,aCa","aMaa +",7akajaadaaaaaaaaea6yaaNk a +7aq7aaaaaCaaFWaMaa,aaX,aag4IaasRakaaDaaaYaRaae,645aaaW,7aq7aaaaaCaaFWaMaa,aaX,aag4IaasRakaaDaaaYaRaae,645aaaW,7aq7aaaaaCaaFWaMaa,aaX +sga1aUaarrajakaaaB9aa0aa,aaa6aaauaaaWXaataaa,"xa aaaa",aaSaaa,sga1aUaarrajakaaaB9aa0aa,aaa6aaauaaaWXaataaa,"xa aaaa",aaSaaa,sga1aUaarrajakaaaB9aa0aa,aaa6aaauaaaWXaataaa +"aKaaaa LYGa",aaUaXfaaaaaaiy1aaaaaBaa,aaa2qa2aa,apaaaaaa,"aKaaaa LYGa",aaUaXfaaaaaaiy1aaaaaBaa,aaa2qa2aa,apaaaaaa,"aKaaaa LYGa",aaUaXfaaaaaaiy1aaaaaBaa +a4Tta0aaNHaaaaaaaaaaai,aUvaaaaaaaxaaPaaV,dayaaaPa59aaaaaDaaa8QIqaYoo,aWaaV,a4Tta0aaNHaaaaaaaaaaai,aUvaaaaaaaxaaPaaV,dayaaaPa59aaaaaDaaa8QIqaYoo,aWaaV,a4Tta0aaNHaaaaaaaaaaai,aUvaaaaaaaxaaPaaV +aaaye HaaaaEaaaaaa,"aaa +aaa0","3k""aFa","t""aaI",aaaye HaaaaEaaaaaa,"aaa +aaa0","3k""aFa","t""aaI",aaaye HaaaaEaaaaaa,"aaa +aaa0" +aaaTKaaaaaa,aSk,aaaE6aGa,"Taay Ba 7aURD",aaaTKaaaaaa,aSk,aaaE6aGa,"Taay Ba 7aURD",aaaTKaaaaaa,aSk +aZaaa2SYHaOaa,mkaPaEaa,aaNI2aLhakhPa,aaaYaVaaanaaaaaaB3aa,aZaaa2SYHaOaa,mkaPaEaa,aaNI2aLhakhPa,aaaYaVaaanaaaaaaB3aa,aZaaa2SYHaOaa,mkaPaEaa +"aaa,3aaaS aaaaaaaaa",Gaaaaaaaa6iaGVaaaaaZa,a,alpaaaaaIayataaPal6aaa7,"aaa,3aaaS aaaaaaaaa",Gaaaaaaaa6iaGVaaaaaZa,a,alpaaaaaIayataaPal6aaa7,"aaa,3aaaS aaaaaaaaa",Gaaaaaaaa6iaGVaaaaaZa +ajgWfaaaBxhxaaaaba0aaaaa,aOIa3hhaai aLaaaa,aaFaxarf,"aW""a,aaTaabHUE",ajgWfaaaBxhxaaaaba0aaaaa,aOIa3hhaai aLaaaa,aaFaxarf,"aW""a,aaTaabHUE",ajgWfaaaBxhxaaaaba0aaaaa,aOIa3hhaai aLaaaa +a09aawaaaaaaoa5saaaa,aaap4aaIaaahaaaMfaaaaaaaa3is,"a6Iaa0""aa88Laaa""BaaaQpz","aQjaaD""EZgt",a09aawaaaaaaoa5saaaa,aaap4aaIaaahaaaMfaaaaaaaa3is,"a6Iaa0""aa88Laaa""BaaaQpz","aQjaaD""EZgt",a09aawaaaaaaoa5saaaa,aaap4aaIaaahaaaMfaaaaaaaa3is +Uaa4eaea aVYaHa0aaaNaaaaaaa,"aanXa""RQaaaQaaaaaRa",aaaSIKXaafktkaaa,"aPaa3ahaauL5Aasva +jaaa5aaaUaDa",Uaa4eaea aVYaHa0aaaNaaaaaaa,"aanXa""RQaaaQaaaaaRa",aaaSIKXaafktkaaa,"aPaa3ahaauL5Aasva +jaaa5aaaUaDa",Uaa4eaea aVYaHa0aaaNaaaaaaa,"aanXa""RQaaaQaaaaaRa" +,GaEx0a16akpaaaLaaaJfwa6Eaaaaaa,"av4btVXaaDaaCaa aaaaauaa","aaaaaaaauaaBca27aa,aP3aaaRaa",,GaEx0a16akpaaaLaaaJfwa6Eaaaaaa,"av4btVXaaDaaCaa aaaaauaa","aaaaaaaauaaBca27aa,aP3aaaRaa",,GaEx0a16akpaaaLaaaJfwa6Eaaaaaa +a,aaaaaaaSf,"Baa1 aaa Fa""4aapaaIGaaaMan",aaaaaaaa,a,aaaaaaaSf,"Baa1 aaa Fa""4aapaaIGaaaMan",aaaaaaaa,a,aaaaaaaSf +aYUa,jaaWaWahaaUSzaaaa7,aaaa0aanaBYwaa3aaaBcj,aOaKaa2aSaCaaRx,aYUa,jaaWaWahaaUSzaaaa7,aaaa0aanaBYwaa3aaaBcj,aOaKaa2aSaCaaRx,aYUa,jaaWaWahaaUSzaaaa7 +Ra,aaaaaY5aaaWagaaMa1aYa22aaga," vaT",aa5aaaaaaWaaO,Ra,aaaaaY5aaaWagaaMa1aYa22aaga," vaT",aa5aaaaaaWaaO,Ra,aaaaaY5aaaWagaaMa1aYa22aaga +aatPaehyacaaaljaaaaaaa0d4a,5QWXaoa4Wapaa,aaa,"aa ""jaXxaaLbMa",aatPaehyacaaaljaaaaaaa0d4a,5QWXaoa4Wapaa,aaa,"aa ""jaXxaaLbMa",aatPaehyacaaaljaaaaaaa0d4a,5QWXaoa4Wapaa +ZaLaagaaaaaaUalaaa1,MafaaXnRaQfaazabyaa,"""aa9Qa9aeaacaFenHaR8aa ",aeaaaa,ZaLaagaaaaaaUalaaa1,MafaaXnRaQfaazabyaa,"""aa9Qa9aeaacaFenHaR8aa ",aeaaaa,ZaLaagaaaaaaUalaaa1,MafaaXnRaQfaazabyaa +at8aakzaVaakaaaaaaaagaaFaIoaaa,aahaJasZaaDaaaaLaP,aAa9jpwaa9a,aaa6aY azaaa1,at8aakzaVaakaaaaaaaagaaFaIoaaa,aahaJasZaaDaaaaLaP,aAa9jpwaa9a,aaa6aY azaaa1,at8aakzaVaakaaaaaaaagaaFaIoaaa,aahaJasZaaDaaaaLaP +"WaFnaa6Maaaa9 ",aaKaah4V aaaUfaaa5atqQa,7JGaxaaaaaaaaaaQaaa aFa7,OJcoaaaAa8a3QaA5aT eV,"WaFnaa6Maaaa9 ",aaKaah4V aaaUfaaa5atqQa,7JGaxaaaaaaaaaaQaaa aFa7,OJcoaaaAa8a3QaA5aT eV,"WaFnaa6Maaaa9 ",aaKaah4V aaaUfaaa5atqQa +a6a2Ua7a1ka,"ayaaaa""42uTaahOV","aauaaa""",aa aaaaaaqyaa4tW,a6a2Ua7a1ka,"ayaaaa""42uTaahOV","aauaaa""",aa aaaaaaqyaa4tW,a6a2Ua7a1ka,"ayaaaa""42uTaahOV" +aaaaaZQaaaaaaaGaYaaaaZTaaaa,aa0yaaqabgaa7aaaaajagaa,aaaaaQaaaaaaaazaa5aa,aaaaaaaaaaaaaaalaFya,aaaaaZQaaaaaaaGaYaaaaZTaaaa,aa0yaaqabgaa7aaaaajagaa,aaaaaQaaaaaaaazaa5aa,aaaaaaaaaaaaaaalaFya,aaaaaZQaaaaaaaGaYaaaaZTaaaa,aa0yaaqabgaa7aaaaajagaa +RaaaaCaNs,"aa8Ph,HbaaaJaaaa",aaaaaaNkAaj4 abakbaaa,b Zaaaaaaaaaa8ak,RaaaaCaNs,"aa8Ph,HbaaaJaaaa",aaaaaaNkAaj4 abakbaaa,b Zaaaaaaaaaa8ak,RaaaaCaNs,"aa8Ph,HbaaaJaaaa" +"aaa +fJaaaj",,baa,"aafaaaaaToaaaiaaNa""IVz +uqTaatE","aaa +fJaaaj",,baa,"aafaaaaaToaaaiaaNa""IVz +uqTaatE","aaa +fJaaaj", +fa aXa6aaL,xaMaaaaaaaBubaoaaVa,Laaaaa,Aaaa,fa aXa6aaL,xaMaaaaaaaBubaoaaVa,Laaaaa,Aaaa,fa aXa6aaL,xaMaaaaaaaBubaoaaVa +aaaaaaavaasRa6aaaJ,aaaaaiaaaMa0JauajaaN,3Koaaaaaaa1aaaaa5aaaaaa,"gaSraRVaNa1ayaaapaaaCqa,T8",aaaaaaavaasRa6aaaJ,aaaaaiaaaMa0JauajaaN,3Koaaaaaaa1aaaaa5aaaaaa,"gaSraRVaNa1ayaaapaaaCqa,T8",aaaaaaavaasRa6aaaJ,aaaaaiaaaMa0JauajaaN +"aaaaLa +aaqakaaaM7a aa7aa", bBNaaaaXPaa,aalaaaa,"aaa av","aaaaLa +aaqakaaaM7a aa7aa", bBNaaaaXPaa,aalaaaa,"aaa av","aaaaLa +aaqakaaaM7a aa7aa", bBNaaaaXPaa +"aaaaqWara6aaaaaxa +v",Vmaa," a,","maaaLt +","aaaaqWara6aaaaaxa +v",Vmaa," a,","maaaLt +","aaaaqWara6aaaaaxa +v",Vmaa +"aaaaaUaaaea51 Haaua7araaa",8aaaaaaQagaf,SuaSjLaa Na,aaaaaramaawaaaaRaaaaaaaDaaa,"aaaaaUaaaea51 Haaua7araaa",8aaaaaaQagaf,SuaSjLaa Na,aaaaaramaawaaaaRaaaaaaaDaaa,"aaaaaUaaaea51 Haaua7araaa",8aaaaaaQagaf +,aaaasaaaa68MMaKLaaaa,aaaaWaaaaygLaa,taaaaGaa3ADar,,aaaasaaaa68MMaKLaaaa,aaaaWaaaaygLaa,taaaaGaa3ADar,,aaaasaaaa68MMaKLaaaa +wbQe Qaqaa,"Haaaaq""aaaL8C","caaa,DgaTaCaz",7,wbQe Qaqaa,"Haaaaq""aaaL8C","caaa,DgaTaCaz",7,wbQe Qaqaa,"Haaaaq""aaaL8C" +aaaaafaaaaZheajanaaB,aaaataaaaaaaaafaaraaJaaaaaRa,BaJaaaaraaygaaSaaa,aaaJ9raGraaaaRakaBiaaaaaHa4aW5,aaaaafaaaaZheajanaaB,aaaataaaaaaaaafaaraaJaaaaaRa,BaJaaaaraaygaaSaaa,aaaJ9raGraaaaRakaBiaaaaaHa4aW5,aaaaafaaaaZheajanaaB,aaaataaaaaaaaafaaraaJaaaaaRa +"Yasaaaa7S1ha raXtaaavZaa3amLWa","aaaoda7iaaza7aaa""aaaaaa","auaaaa +aaa",AaFaaaVaa GaaaaIaaaIaaYaag,"Yasaaaa7S1ha raXtaaavZaa3amLWa","aaaoda7iaaza7aaa""aaaaaa","auaaaa +aaa",AaFaaaVaa GaaaaIaaaIaaYaag,"Yasaaaa7S1ha raXtaaavZaa3amLWa","aaaoda7iaaza7aaa""aaaaaa" +aaaaa5,"a aaR","aa,aaakaLaaoa",aaaMaRaRaaFcadaaaYa,aaaaa5,"a aaR","aa,aaakaLaaoa",aaaMaRaRaaFcadaaaYa,aaaaa5,"a aaR" +O,Ra,aaaaaa,aaUa7,O,Ra,aaaaaa,aaUa7,O,Ra +aaa,aaaaaaxwtaaiauOagakaaoaaaa,UaaaanaGd aaaaaaa6aaa,a,aaa,aaaaaaxwtaaiauOagakaaoaaaa,UaaaanaGd aaaaaaa6aaa,a,aaa,aaaaaaxwtaaiauOagakaaoaaaa + qaaqraaaaaaq,aoIaaa5piaM4Jata a," +aaaAa",a2a, qaaqraaaaaaq,aoIaaa5piaM4Jata a," +aaaAa",a2a, qaaqraaaaaaq,aoIaaa5piaM4Jata a +amPhaaAaaa,aNha,aQyaQaaxafmgJaT,"tfaaaaa""XaasQVIaaZa a4aH",amPhaaAaaa,aNha,aQyaQaaxafmgJaT,"tfaaaaa""XaasQVIaaZa a4aH",amPhaaAaaa,aNha +"ShaqSyRaaaaatLYaUaaaVa,",lo,"aTaoaaaud,""a",7aXxaUaaaaX,"ShaqSyRaaaaatLYaUaaaVa,",lo,"aTaoaaaud,""a",7aXxaUaaaaX,"ShaqSyRaaaaatLYaUaaaVa,",lo +8,ca,aaT,U,8,ca,aaT,U,8,ca +6abaaaaaahaaUQaD0kaaHakMaaa1K,"aaaZOaeh""a,b 2aaa""6a 7aaza",aaaORaIrn,ZoaAaaaKF,6abaaaaaahaaUQaD0kaaHakMaaa1K,"aaaZOaeh""a,b 2aaa""6a 7aaza",aaaORaIrn,ZoaAaaaKF,6abaaaaaahaaUQaD0kaaHakMaaa1K,"aaaZOaeh""a,b 2aaa""6a 7aaza" +a4IaaaaSaCSoaaa3a9daa6C4a3a,Baa,aaaa,Qajaa,a4IaaaaSaCSoaaa3a9daa6C4a3a,Baa,aaaa,Qajaa,a4IaaaaSaCSoaaa3a9daa6C4a3a,Baa +asa8aaYpI,"aPaaaamAQaZaHaanaaam +WaKaa",aac,YaEanaa,asa8aaYpI,"aPaaaamAQaZaHaanaaam +WaKaa",aac,YaEanaa,asa8aaYpI,"aPaaaamAQaZaHaanaaam +WaKaa" +" + aaaaaVaaaaH1aa2Ha""ajHaayIaWa","aeSaaaaaf,17aaSaaa",aaaaatatsaaaaaaa4aaa3aAaR," +fabaaazaaaaaaP"," + aaaaaVaaaaH1aa2Ha""ajHaayIaWa","aeSaaaaaf,17aaSaaa",aaaaatatsaaaaaaa4aaa3aAaR," +fabaaazaaaaaaP"," + aaaaaVaaaaH1aa2Ha""ajHaayIaWa","aeSaaaaaf,17aaSaaa" +,"6aaaaEala5aaaa""",yaaaaaZaaaaeaaRadn,"ZU +aaa,aaaHaxaaaa",,"6aaaaEala5aaaa""",yaaaaaZaaaaeaaRadn,"ZU +aaa,aaaHaxaaaa",,"6aaaaEala5aaaa""" +a,aJaaatKaaaaaaaaraaaahaBaa7,"aaana0aBaaala naayFaqYaaaaaaW",aaaAaa aaaa,a,aJaaatKaaaaaaaaraaaahaBaa7,"aaana0aBaaala naayFaqYaaaaaaW",aaaAaa aaaa,a,aJaaatKaaaaaaaaraaaahaBaa7 +aa2kF,"aew4aaaFaaaaai""kd2aaaga",amcweaaD3aa,aaaazaRalaTaa a,aa2kF,"aew4aaaFaaaaai""kd2aaaga",amcweaaD3aa,aaaazaRalaTaa a,aa2kF,"aew4aaaFaaaaai""kd2aaaga" +"XiaaaaC""yNg9atz","mZaa""aTa7K aafaaaaaa","aKaDadROaTaaaNa""auaaaaR",8BhoaWahaa0z,"XiaaaaC""yNg9atz","mZaa""aTa7K aafaaaaaa","aKaDadROaTaaaNa""auaaaaR",8BhoaWahaa0z,"XiaaaaC""yNg9atz","mZaa""aTa7K aafaaaaaa" +3aaaaKawXmzaaaayaaaiREaaa,a70abpXqdlaaZaHaaaaauaa,aHuaaaaaaa8aaZaaaaHfaGaOaa,anaa3aaaap,3aaaaKawXmzaaaayaaaiREaaa,a70abpXqdlaaZaHaaaaauaa,aHuaaaaaaa8aaZaaaaHfaGaOaa,anaa3aaaap,3aaaaKawXmzaaaayaaaiREaaa,a70abpXqdlaaZaHaaaaauaa +aaaaaaaaaaaXaaJn aaIE0,aaa,"g t,aaaaanfaEaaTaraR",aaaaafawaa94aa,aaaaaaaaaaaXaaJn aaIE0,aaa,"g t,aaaaanfaEaaTaraR",aaaaafawaa94aa,aaaaaaaaaaaXaaJn aaIE0,aaa +"alUo +aaAJ +",5i2aGaEGUaaaaaaawJ,"XGaaaZqaa9""aXaa",Xaqaaaaaajat3caaa7anuxaAaaacan,"alUo +aaAJ +",5i2aGaEGUaaaaaaawJ,"XGaaaZqaa9""aXaa",Xaqaaaaaajat3caaa7anuxaAaaacan,"alUo +aaAJ +",5i2aGaEGUaaaaaaawJ +a ZaaaaXaa7aaUlaaaz6D,,"a aacaaajawaaMa","aq,aaaaDaaaJaaaa8aaaara",a ZaaaaXaa7aaUlaaaz6D,,"a aacaaajawaaMa","aq,aaaaDaaaJaaaa8aaaara",a ZaaaaXaa7aaUlaaaz6D, +aaaaaaaaSa a,"aiaaaaaakSaa +aa +a Pa",aaQraaPafCaaaayaa,aaxaaaaaFaaaaaaaXaBaaraaa,aaaaaaaaSa a,"aiaaaaaakSaa +aa +a Pa",aaQraaPafCaaaayaa,aaxaaaaaFaaaaaaaXaBaaraaa,aaaaaaaaSa a,"aiaaaaaakSaa +aa +a Pa" +aaaaaaaaaav4aaaaaa,falaaaaaaf,aL," +ahWw",aaaaaaaaaav4aaaaaa,falaaaaaaf,aL," +ahWw",aaaaaaaaaav4aaaaaa,falaaaaaaf +aWykaWaaaaaalQCaa,aaaaXaaakFcaaCZaaaavaazaa,NT8oaaHaawa,"HuKoaaaaataazaaasNa,aaaaa",aWykaWaaaaaalQCaa,aaaaXaaakFcaaCZaaaavaazaa,NT8oaaHaawa,"HuKoaaaaataazaaasNa,aaaaa",aWykaWaaaaaalQCaa,aaaaXaaakFcaaCZaaaavaazaa +auaaLaaaaa, Jaba,aaaaahaRaDVf08Caar1pa aaaaaa,agaHa3ap0a,auaaLaaaaa, Jaba,aaaaahaRaDVf08Caar1pa aaaaaa,agaHa3ap0a,auaaLaaaaa, Jaba +"waftaaaNaVaaaaa""a8Jaa JBCa","aaaHyoakV aPx5aaaaaaaavpvsnv",aYvWaZ9af1aLaaaPxa,"a ","waftaaaNaVaaaaa""a8Jaa JBCa","aaaHyoakV aPx5aaaaaaaavpvsnv",aYvWaZ9af1aLaaaPxa,"a ","waftaaaNaVaaaaa""a8Jaa JBCa","aaaHyoakV aPx5aaaaaaaavpvsnv" +aaaaaaagaPaaa6aaaCaaa,aaGYaaaaS,",Baa",wa3caWqMaa9haaea0aata6C,aaaaaaagaPaaa6aaaCaaa,aaGYaaaaS,",Baa",wa3caWqMaa9haaea0aata6C,aaaaaaagaPaaa6aaaCaaa,aaGYaaaaS +"aaasaaWaa1aBaaQ6 +aHyaInaZaaaaa",aa6a,aaaaaap,PaGaaaaanvae6aanaaDav,"aaasaaWaa1aBaaQ6 +aHyaInaZaaaaa",aa6a,aaaaaap,PaGaaaaanvae6aanaaDav,"aaasaaWaa1aBaaQ6 +aHyaInaZaaaaa",aa6a +maaa9aa,aa1a,"aInvS kIaaZaaaaa",taK,maaa9aa,aa1a,"aInvS kIaaZaaaaa",taK,maaa9aa,aa1a +a,aawaaaT4eaBL,ya,aaq,a,aawaaaT4eaBL,ya,aaq,a,aawaaaT4eaBL +"0P2da aaaatOaaL",aaakDatWa ,"baaaka3 +3XaZaaVaaf6ra1ara",aaW0,"0P2da aaaatOaaL",aaakDatWa ,"baaaka3 +3XaZaaVaaf6ra1ara",aaW0,"0P2da aaaatOaaL",aaakDatWa +"aa a",aEaa5daCaaa5FaSaa wUx t,"aFa7aaaaj +","aa a70 i1FcaaOaa","aa a",aEaa5daCaaa5FaSaa wUx t,"aFa7aaaaj +","aa a70 i1FcaaOaa","aa a",aEaa5daCaaa5FaSaa wUx t +aafaaflaAa,,Caa waaa,aaaaaaaaoaaaawaakuaaLaa4aaaaga,aafaaflaAa,,Caa waaa,aaaaaaaaoaaaawaakuaaLaa4aaaaga,aafaaflaAa, +aaaaaNzjPAam,avaa,Zad,"aa aaaaaaai""hncMaaaaaaaaa",aaaaaNzjPAam,avaa,Zad,"aa aaaaaaai""hncMaaaaaaaaa",aaaaaNzjPAam,avaa +"aalaaaaaa92z,",ga0ad3FaEaqBaavaaaaaaaaaKMa3b,Maa,aP EaaaGaayaagaT DraaaJ,"aalaaaaaa92z,",ga0ad3FaEaqBaavaaaaaaaaaKMa3b,Maa,aP EaaaGaayaagaT DraaaJ,"aalaaaaaa92z,",ga0ad3FaEaqBaavaaaaaaaaaKMa3b +"avaaajrWaaaJalaQaHV7LuaK,4a",a2WaaQaMat,PqqyaaXaaaaaa,zaa2,"avaaajrWaaaJalaQaHV7LuaK,4a",a2WaaQaMat,PqqyaaXaaaaaa,zaa2,"avaaajrWaaaJalaQaHV7LuaK,4a",a2WaaQaMat +aamaaa,"Oaa3aRaaaaaaa""aeaaaP"," aaa","aM +",aamaaa,"Oaa3aRaaaaaaa""aeaaaP"," aaa","aM +",aamaaa,"Oaa3aRaaaaaaa""aeaaaP" +"aanaaaa,adu",a,akjaaaa9aaa,aaaaaDa2jC,"aanaaaa,adu",a,akjaaaa9aaa,aaaaaDa2jC,"aanaaaa,adu",a +"4aBaaarFaaa atg","a1Naaaa +Zaaaa",PhaaaagqaaKaal3RaaaaaseNa5aaa,"aaahaq7uaxaaa aaaHG","4aBaaarFaaa atg","a1Naaaa +Zaaaa",PhaaaagqaaKaal3RaaaaaseNa5aaa,"aaahaq7uaxaaa aaaHG","4aBaaarFaaa atg","a1Naaaa +Zaaaa" +"axa aam",aatafag,"4bca awpaaaMiaabG",a9o0aaaEaaVaaaaaeaac7Jaaaaaaa,"axa aam",aatafag,"4bca awpaaaMiaabG",a9o0aaaEaaVaaaaaeaac7Jaaaaaaa,"axa aam",aatafag +aa5JaaaT,Taaa,asaaaiaKaaaaagaa,"a 50aWaX aaajaaaaaC6iaZ7aa",aa5JaaaT,Taaa,asaaaiaKaaaaagaa,"a 50aWaX aaajaaaaaC6iaZ7aa",aa5JaaaT,Taaa +aS60aaa j2P,aaapaaaaaV,paRaa,aaaCYa,aS60aaa j2P,aaapaaaaaV,paRaa,aaaCYa,aS60aaa j2P,aaapaaaaaV +J7aaaaaDhFaaaEaaa,a4,aaQIadJ3baaadaaaaa,BaCJoa0aaaaaaUaa3araaaaaaaTa,J7aaaaaDhFaaaEaaa,a4,aaQIadJ3baaadaaaaa,BaCJoa0aaaaaaUaa3araaaaaaaTa,J7aaaaaDhFaaaEaaa,a4 +adaLaaaaraaZaSaQziaAaaaJx,a48aV6ajaQ1,anaaHaaaaao9aBaaaava2Zaaaaa,aaW,adaLaaaaraaZaSaQziaAaaaJx,a48aV6ajaQ1,anaaHaaaaao9aBaaaava2Zaaaaa,aaW,adaLaaaaraaZaSaQziaAaaaJx,a48aV6ajaQ1 +aaa,zMN0,a,"aaa8FmRaaaabapaZx5,aaa",aaa,zMN0,a,"aaa8FmRaaaabapaZx5,aaa",aaa,zMN0 +Gaqa,aaQaaaaa1aRaYa m96aOaaa,aaaCa2akiaaaaa4Oaaaaaa,JaaaNauc6aaaaamaacaaaaaaTYaa,Gaqa,aaQaaaaa1aRaYa m96aOaaa,aaaCa2akiaaaaa4Oaaaaaa,JaaaNauc6aaaaamaacaaaaaaTYaa,Gaqa,aaQaaaaa1aRaYa m96aOaaa +",a69aX a0iafaaa",a7aavOTaaQaaoaaoiaaaaaafaQsa,vuaaraaaaoa9a,yaya4aYa4laaaaaaa,",a69aX a0iafaaa",a7aavOTaaQaaoaaoiaaaaaafaQsa,vuaaraaaaoa9a,yaya4aYa4laaaaaaa,",a69aX a0iafaaa",a7aavOTaaQaaoaaoiaaaaaafaQsa +aa,aa,Asaataz,avaaazaaafaaakmJa,aa,aa,Asaataz,avaaazaaafaaakmJa,aa,aa +aTaaaaCaaaU,aaaBFaTa,ZaOaw7a8,aa,aTaaaaCaaaU,aaaBFaTa,ZaOaw7a8,aa,aTaaaaCaaaU,aaaBFaTa +CNaaadpaaaaja,aaaaa,a 9daaEaaaDaaaaaaaaaaa,xaaFaalJmtaa,CNaaadpaaaaja,aaaaa,a 9daaEaaaDaaaaaaaaaaa,xaaFaalJmtaa,CNaaadpaaaaja,aaaaa +aaanaaaaa,oaaxaaaaaaG3cwaamaaadaaaS,waaaaaIaKaQB2aaa aaB,Waajaaaya3aaalaTaa,aaanaaaaa,oaaxaaaaaaG3cwaamaaadaaaS,waaaaaIaKaQB2aaa aaB,Waajaaaya3aaalaTaa,aaanaaaaa,oaaxaaaaaaG3cwaamaaadaaaS +aMaaa,aaIaE,2,Gaa8aaaaa,aMaaa,aaIaE,2,Gaa8aaaaa,aMaaa,aaIaE +"aaauaaa7aZraa d",ajm,hOaaHsXa,aada,"aaauaaa7aZraa d",ajm,hOaaHsXa,aada,"aaauaaa7aZraa d",ajm +"Sa,aaaaia",aaaaaHk1aaaaa3aaa,"da9a aa1vaXaaaahaFf",aajbD5caagaaa5GaWdaa,"Sa,aaaaia",aaaaaHk1aaaaa3aaa,"da9a aa1vaXaaaahaFf",aajbD5caagaaa5GaWdaa,"Sa,aaaaia",aaaaaHk1aaaaa3aaa +aa6xaaSmGOaaaaaal6aa aLaaa,"qX ,sVQ2aaa",aaaama1e1an9Eaa5a3aaaahHaaua7,a5aafuaTaaa3,aa6xaaSmGOaaaaaal6aa aLaaa,"qX ,sVQ2aaa",aaaama1e1an9Eaa5a3aaaahHaaua7,a5aafuaTaaa3,aa6xaaSmGOaaaaaal6aa aLaaa,"qX ,sVQ2aaa" +aaaH aaaaaaaH,zaaa,aaaTaaaKa,a q,aaaH aaaaaaaH,zaaa,aaaTaaaKa,a q,aaaH aaaaaaaH,zaaa +" +aJaa0aaaQa aZaaaAaa 9",aaa8i UaaaaaaNaca,aaagaGaGaaaPaxZa,UeAaaaaaxa4a1aaaaaaa," +aJaa0aaaQa aZaaaAaa 9",aaa8i UaaaaaaNaca,aaagaGaGaaaPaxZa,UeAaaaaaxa4a1aaaaaaa," +aJaa0aaaQa aZaaaAaa 9",aaa8i UaaaaaaNaca +6aaala,"azaaa aaRaa a,aaaaWKaaFaaaaa",52A,"aaa7W11 +aaUaa qaa",6aaala,"azaaa aaRaa a,aaaaWKaaFaaaaa",52A,"aaa7W11 +aaUaa qaa",6aaala,"azaaa aaRaa a,aaaaWKaaFaaaaa" +"aaaaaK4aa""zaaw0aS4ax6aFa a",aaaaaaEaaa8WUagaaaaam,"yCaaaa""aa9",ZabvjaaaaagaaacaaMSaLaa ataa,"aaaaaK4aa""zaaw0aS4ax6aFa a",aaaaaaEaaa8WUagaaaaam,"yCaaaa""aa9",ZabvjaaaaagaaacaaMSaLaa ataa,"aaaaaK4aa""zaaw0aS4ax6aFa a",aaaaaaEaaa8WUagaaaaam +a8a9aaRVa,zaaaaQ,"Ma,aaaaaaxaaFgoaam",aa9vGaaataeaa,a8a9aaRVa,zaaaaQ,"Ma,aaaaaaxaaFgoaam",aa9vGaaataeaa,a8a9aaRVa,zaaaaQ +1aBaLaaaaauyaLAaE2aawaayaXaa3,aaaaa,42aabaICaaaN5l,XagaaaTwa aa,1aBaLaaaaauyaLAaE2aawaayaXaa3,aaaaa,42aabaICaaaN5l,XagaaaTwa aa,1aBaLaaaaauyaLAaE2aawaayaXaa3,aaaaa +Waxaaaaaaaa,a6aaaa,aaajOGaLaaaaaamaa aaaaaakafaae,aaaaaa,Waxaaaaaaaa,a6aaaa,aaajOGaLaaaaaamaa aaaaaakafaae,aaaaaa,Waxaaaaaaaa,a6aaaa +4aCkapataKa9aaaa,eQa,aaaakpaaaUaaaaaaa4MaaaaaaaaXga,aaaaaaYaa,4aCkapataKa9aaaa,eQa,aaaakpaaaUaaaaaaa4MaaaaaaaaXga,aaaaaaYaa,4aCkapataKa9aaaa,eQa +"aaaaa0aaa Maa","saadaKaaaaakaav""aLa",aoEab,aaaapabaaaaaaaKaa1KuhaaNaaa,"aaaaa0aaa Maa","saadaKaaaaakaav""aLa",aoEab,aaaapabaaaaaaaKaa1KuhaaNaaa,"aaaaa0aaa Maa","saadaKaaaaakaav""aLa" +aELaaVaaaacYa,Va,aaQa, aNaGcGaaPa,aELaaVaaaacYa,Va,aaQa, aNaGcGaaPa,aELaaVaaaacYa,Va +a,"aQaaalaagaa +GaaPaaaaMEI",uaaaaa,a5aa,a,"aQaaalaagaa +GaaPaaaaMEI",uaaaaa,a5aa,a,"aQaaalaagaa +GaaPaaaaMEI" +wWJaaaaYaaaaga8LaP,aaa,waaaanaaa2JaIBa,TaaSaaaat,wWJaaaaYaaaaga8LaP,aaa,waaaanaaa2JaIBa,TaaSaaaat,wWJaaaaYaaaaga8LaP,aaa +"a,UVa 4aVa71Xna6aQ5Fna1 ",ajvra aazaaba,aaa7aqae8au6WaxBaa2aoa,aaaaaa,"a,UVa 4aVa71Xna6aQ5Fna1 ",ajvra aazaaba,aaa7aqae8au6WaxBaa2aoa,aaaaaa,"a,UVa 4aVa71Xna6aQ5Fna1 ",ajvra aazaaba +aaGPayeaJYBaaaaaaaGaaC,aaV,aa1Laqa,ueBaaOapaiaeaawlaaaaKaaVa,aaGPayeaJYBaaaaaaaGaaC,aaV,aa1Laqa,ueBaaOapaiaeaawlaaaaKaaVa,aaGPayeaJYBaaaaaaaGaaC,aaV +aqana1TOQaaaaX,"aYPa +aasasaahCa","6aaaagPja +aa",aJaiBYaaa5ya,aqana1TOQaaaaX,"aYPa +aasasaahCa","6aaaagPja +aa",aJaiBYaaa5ya,aqana1TOQaaaaX,"aYPa +aasasaahCa" +IE aaja,"aaaYaa,5aaaa",aa,afaaMiajaqaaaapaUaly,IE aaja,"aaaYaa,5aaaa",aa,afaaMiajaqaaaapaUaly,IE aaja,"aaaYaa,5aaaa" +aaaaaaaaQaaV,aYaaa,paaaaaWaaa,aaaaa,aaaaaaaaQaaV,aYaaa,paaaaaWaaa,aaaaa,aaaaaaaaQaaV,aYaaa +Ja,1haaaaGaFama,CaaaDaaaaqaaaa1aaqaa8aa7a4,akaa8,Ja,1haaaaGaFama,CaaaDaaaaqaaaa1aaqaa8aa7a4,akaa8,Ja,1haaaaGaFama +2aa,aMaacaaaPaaTaaaa,Waag8gaaaRbaayaaaaa,aaaaN,2aa,aMaacaaaPaaTaaaa,Waag8gaaaRbaayaaaaa,aaaaN,2aa,aMaacaaaPaaTaaaa +"naVaaaa0Faaaa aaaHa5",aaaaaC,,"aaaapxuaa3aa,aaaTaaaaaaa","naVaaaa0Faaaa aaaHa5",aaaaaC,,"aaaapxuaa3aa,aaaTaaaaaaa","naVaaaa0Faaaa aaaHa5",aaaaaC +"Mbaaayaqaa""JaaaN",Z8adPaaaaaaqaP5alXa9tpaaaaa,"aaap4aamaaaB""",EaaaUaaaau aaaa,"Mbaaayaqaa""JaaaN",Z8adPaaaaaaqaP5alXa9tpaaaaa,"aaap4aamaaaB""",EaaaUaaaau aaaa,"Mbaaayaqaa""JaaaN",Z8adPaaaaaaqaP5alXa9tpaaaaa +"a CagaaaLafEaaaawjHd axqsa,Daa","hDaaaa6aa,a7a","aaah +abaza9a",,"a CagaaaLafEaaaawjHd axqsa,Daa","hDaaaa6aa,a7a","aaah +abaza9a",,"a CagaaaLafEaaaawjHd axqsa,Daa","hDaaaa6aa,a7a" +"xaaya2aa9hBaa19ahaaa,aozZ"," +aawaaaacOPgCaa1jpaaaaai",,aaMaaaaVQaPaaaaa,"xaaya2aa9hBaa19ahaaa,aozZ"," +aawaaaacOPgCaa1jpaaaaai",,aaMaaaaVQaPaaaaa,"xaaya2aa9hBaa19ahaaa,aozZ"," +aawaaaacOPgCaa1jpaaaaai" +H8aamaaaaNaaaaa5a9aaaOB6Fy,aaaaLaqraaaasaaaa,BWa7Z,aaFkuaaaa5aaatza,H8aamaaaaNaaaaa5a9aaaOB6Fy,aaaaLaqraaaasaaaa,BWa7Z,aaFkuaaaa5aaatza,H8aamaaaaNaaaaa5a9aaaOB6Fy,aaaaLaqraaaasaaaa +ENa9aaa4aaxaaaaaax a,aaapPa,aaaaqaafaaM,aaaBaaaaaaa,ENa9aaa4aaxaaaaaax a,aaapPa,aaaaqaafaaM,aaaBaaaaaaa,ENa9aaa4aaxaaaaaax a,aaapPa +"aa +aaasaaaa",Qaaaj5aaa,aaaaaaaaafaaaXD2JOHuaaaXa8,"CbaR,aaTnasaaaa","aa +aaasaaaa",Qaaaj5aaa,aaaaaaaaafaaaXD2JOHuaaaXa8,"CbaR,aaTnasaaaa","aa +aaasaaaa",Qaaaj5aaa +aamaapaZrHa aaaXpI5aaX1Maa,a,aaa5aaaeaa5aa ,aa29PN4aaa76aaaaa0,aamaapaZrHa aaaXpI5aaX1Maa,a,aaa5aaaeaa5aa ,aa29PN4aaa76aaaaa0,aamaapaZrHa aaaXpI5aaX1Maa,a +BHFaaa3XaaMacayUaaaH3aa,"Su,Qaaaayaa",xaaau5aaaaGa,"aaanaaaaOcaaanTcaxdaa,",BHFaaa3XaaMacayUaaaH3aa,"Su,Qaaaayaa",xaaau5aaaaGa,"aaanaaaaOcaaanTcaxdaa,",BHFaaa3XaaMacayUaaaH3aa,"Su,Qaaaayaa" +aaaaSaaaZaaa,aI,QaaXcka3Y,yaa,aaaaSaaaZaaa,aI,QaaXcka3Y,yaa,aaaaSaaaZaaa,aI +paa,DCUhaaaaaaaaTaJRgp0,a2aaaAf1,"3Baaaaaa""aaBeaaa7aaaXaaaaaa",paa,DCUhaaaaaaaaTaJRgp0,a2aaaAf1,"3Baaaaaa""aaBeaaa7aaaXaaaaaa",paa,DCUhaaaaaaaaTaJRgp0 +naaaacva9,"U4aZaa5EaJoi,yaaaaa",0a ,jaSQaaZjai,naaaacva9,"U4aZaa5EaJoi,yaaaaa",0a ,jaSQaaZjai,naaaacva9,"U4aZaa5EaJoi,yaaaaa" +aaaaaaRaaaCaaaaaDafa,Wajaaaa,gaqyYaaaaaaoa,saaxF2aaGRaaaGaakaa,aaaaaaRaaaCaaaaaDafa,Wajaaaa,gaqyYaaaaaaoa,saaxF2aaGRaaaGaakaa,aaaaaaRaaaCaaaaaDafa,Wajaaaa +,"Laa +za","aa baWa6aajP7",a mpa,,"Laa +za","aa baWa6aajP7",a mpa,,"Laa +za" +aaaaaaBaan a0faPaaaa aaaa,,"TrcZaata,IaWa +eaa +a",NaaaaJaaaXaaGaaa,aaaaaaBaan a0faPaaaa aaaa,,"TrcZaata,IaWa +eaa +a",NaaaaJaaaXaaGaaa,aaaaaaBaan a0faPaaaa aaaa, +aaaaaaaaaaaaauUawaanaL,aa mhafAyaaKaa,aaaaaaaaaaaaMaaaaaaa,aaai,aaaaaaaaaaaaauUawaanaL,aa mhafAyaaKaa,aaaaaaaaaaaaMaaaaaaa,aaai,aaaaaaaaaaaaauUawaanaL,aa mhafAyaaKaa +"akaaa""aaZ3aaaaavaaa",aaUaaaaZ,aseaYaaasta86aaDaaaa1aaBUQa,aaAaa,"akaaa""aaZ3aaaaavaaa",aaUaaaaZ,aseaYaaasta86aaDaaaa1aaBUQa,aaAaa,"akaaa""aaZ3aaaaavaaa",aaUaaaaZ +ab8CEa3aaRalaTa,aaOaaaXOaaaVaLmtaaana aaaaaaD,aaaUaaaasagaa3Maaaaaa8aaa,caL4aa1cCaUaaToapaaaa,ab8CEa3aaRalaTa,aaOaaaXOaaaVaLmtaaana aaaaaaD,aaaUaaaasagaa3Maaaaaa8aaa,caL4aa1cCaUaaToapaaaa,ab8CEa3aaRalaTa,aaOaaaXOaaaVaLmtaaana aaaaaaD diff --git a/components/succinct-dsv/doctest/DoctestDriver.hs b/components/succinct-dsv/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-dsv/doctest/config.json #-} +#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/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Bits.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Bits.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Bits.hs @@ -0,0 +1,49 @@ +module Data.Succinct.Dsv.Internal.Bits where + +import Data.Bits.Pext +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +import qualified Data.Vector.Storable as DVS + +testWord8s :: Word64 -> Word64 +testWord8s w = let w8s = w + w4s = w8s .|. (w8s .>. 4) + w2s = w4s .|. (w4s .>. 2) + w1s = w2s .|. (w2s .>. 1) + in pext w1s 0x0101010101010101 +{-# INLINE testWord8s #-} + +zipOr :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +zipOr as bs = DVS.generate (DVS.length as `max` DVS.length bs) go + where go :: Int -> Word64 + go u = + let ui = fromIntegral u + in if ui < DVS.length as && ui < DVS.length bs + then DVS.unsafeIndex as ui .|. DVS.unsafeIndex bs ui + else error "Different sized vectors" +{-# INLINE zipOr #-} + +zip2Or :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] +zip2Or (a:as) (b:bs) = zipOr a b:zip2Or as bs +zip2Or (a:as) [] = a:zip2Or as [] +zip2Or [] (b:bs) = b:zip2Or [] bs +zip2Or [] [] = [] +{-# INLINE zip2Or #-} + +zipAnd :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +zipAnd as bs = DVS.generate (DVS.length as `max` DVS.length bs) go + where go :: Int -> Word64 + go u = + let ui = fromIntegral u + in if ui < DVS.length as && ui < DVS.length bs + then DVS.unsafeIndex as ui .&. DVS.unsafeIndex bs ui + else error "Different sized vectors" +{-# INLINE zipAnd #-} + +zip2And :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] +zip2And (a:as) (b:bs) = zipAnd a b:zip2And as bs +zip2And (a:as) [] = a:zip2And as [] +zip2And [] (b:bs) = b:zip2And [] bs +zip2And [] [] = [] +{-# INLINE zip2And #-} diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Broadword.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Broadword.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Broadword.hs @@ -0,0 +1,18 @@ +module Data.Succinct.Dsv.Internal.Broadword where + +import Data.Bits.Pdep +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +class FillWord64 a where + fillWord64 :: a -> Word64 + +instance FillWord64 Word8 where + fillWord64 w = 0x0101010101010101 * fromIntegral w + {-# INLINE fillWord64 #-} + +toggle64 :: Word64 -> Word64 -> Word64 +toggle64 carry w = + let c = carry .&. 0x1 + in let addend = pdep (0x5555555555555555 .<. c) w + in ((addend .<. 1) .|. c) + comp w diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Char.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Char.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Char.hs @@ -0,0 +1,16 @@ +module Data.Succinct.Dsv.Internal.Char where + +import Data.Char +import Data.Word + +doubleQuote :: Word8 +doubleQuote = fromIntegral (ord '"') + +comma :: Word8 +comma = fromIntegral (ord ',') + +pipe :: Word8 +pipe = fromIntegral (ord '|') + +newline :: Word8 +newline = fromIntegral (ord '\n') diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Char/Word64.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Char/Word64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Char/Word64.hs @@ -0,0 +1,17 @@ +module Data.Succinct.Dsv.Internal.Char.Word64 where + +import Data.Word + +import qualified Data.Succinct.Dsv.Internal.Char as C + +doubleQuote :: Word64 +doubleQuote = 0x0101010101010101 * fromIntegral C.doubleQuote + +comma :: Word64 +comma = 0x0101010101010101 * fromIntegral C.comma + +pipe :: Word64 +pipe = 0x0101010101010101 * fromIntegral C.pipe + +newline :: Word64 +newline = 0x0101010101010101 * fromIntegral C.newline diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Vector.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Vector.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Internal/Vector.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} + +module Data.Succinct.Dsv.Internal.Vector + ( empty64 + , constructNS + , ltWord + , indexCsvChunk + , oddsMask + ) where + +import Control.Monad.ST +import Data.Bits.Pdep +import Data.Word +import Foreign.Storable (Storable) +import GHC.Int +import GHC.Prim +import GHC.Word hiding (ltWord) +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Storable.Mutable as DVSM + +empty64 :: DVS.Vector Word64 +empty64 = DVS.replicate 64 0 +{-# NOINLINE empty64 #-} + +constructNS :: forall a s. Storable a => Int -> s -> (s -> DVS.Vector a -> (s, a)) -> (s, DVS.Vector a) +constructNS n s f = DVS.createT (go 0 s) + where go :: forall q. Int -> s -> ST q (s, DVS.MVector q a) + go n1 s1 = do + mv :: DVS.MVector q a <- DVSM.unsafeNew n + u <- DVS.unsafeFreeze mv + let (s2, w) = f s1 (DVS.take n1 u) + DVSM.unsafeWrite mv n1 w + return (s2, mv) +{-# INLINE constructNS #-} + +ltWord :: Word64 -> Word64 -> Word64 +#if MIN_VERSION_base(4,17,2) +ltWord (W64# a#) (W64# b#) = fromIntegral (I# (ltWord64# a# b#)) +#else +ltWord (W64# a#) (W64# b#) = fromIntegral (I64# (ltWord# a# b#)) +#endif +{-# INLINE ltWord #-} + +indexCsvChunk :: + Count + -> Word64 + -> DVS.Vector Word64 + -> DVS.Vector Word64 + -> DVS.Vector Word64 + -> (DVS.Vector Word64, DVS.Vector Word64, Word64, Word64) +indexCsvChunk qqCount qqCarry mks nls qqs = runST $ do + tmks <- DVSM.unsafeNew len + tnls <- DVSM.unsafeNew len + (newCount, newCarry) <- go 0 qqCount qqCarry tmks tnls + rmks <- DVS.unsafeFreeze tmks + rnls <- DVS.unsafeFreeze tnls + return (rmks, rnls, newCount, newCarry) + where len = DVS.length mks + go :: Int -> Word64 -> Word64 -> DVSM.MVector z Word64 -> DVSM.MVector z Word64 -> ST z (Count, Word64) + go i pc carry tmks tnls | i < len = do + let qq = DVS.unsafeIndex qqs i + let mk = DVS.unsafeIndex mks i + let nl = DVS.unsafeIndex nls i + + let enters = pdep (oddsMask .<. (0x1 .&. pc)) qq + let leaves = pdep (oddsMask .<. (0x1 .&. comp pc)) qq + + let compLeaves = comp leaves + let preQuoteMask = enters + compLeaves + let quoteMask = preQuoteMask + carry + let newCarry = quoteMask `ltWord` (enters .|. compLeaves .|. carry) + + DVSM.unsafeWrite tmks i ((nl .|. mk) .&. quoteMask) + DVSM.unsafeWrite tnls i ( nl .&. quoteMask) + + go (i + 1) (popCount1 qq + pc) newCarry tmks tnls + go _ pc carry _ _ = return (pc, carry) +{-# INLINE indexCsvChunk #-} + +oddsMask :: Word64 +oddsMask = 0x5555555555555555 +{-# INLINE oddsMask #-} diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor.hs @@ -0,0 +1,45 @@ +module Data.Succinct.Dsv.Lazy.Cursor + ( DsvCursor (..) + , makeCursor + , trim + , atEnd + , nextField + , advanceField + , nextRow + , nextPosition + ) where + +import Data.Function +import Data.Word +import Data.Succinct.Dsv.Lazy.Cursor.Internal +import Data.Succinct.Dsv.Lazy.Cursor.Type +import HaskellWorks.Data.Vector.AsVector64s +import Prelude + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Dsv.Internal.Char as C +import qualified Data.Succinct.Dsv.Internal.Vector as DVS +import qualified Data.Succinct.Simd.Comparison as DVS + +makeIndexes :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] -> ([DVS.Vector Word64], [DVS.Vector Word64]) +makeIndexes ds ns qs = unzip $ go 0 0 ds ns qs + where go pc carry (dv:dvs) (nv:nvs) (qv:qvs) = + let (dv', nv', pc', carry') = DVS.indexCsvChunk pc carry dv nv qv in + (dv', nv'):go pc' carry' dvs nvs qvs + go _ _ [] [] [] = [(DVS.empty64, DVS.empty64)] + go _ _ _ _ _ = error "Unbalanced inputs" + +makeCursor :: Word8 -> LBS.ByteString -> DsvCursor +makeCursor delimiter lbs = DsvCursor + { dsvCursorText = lbs + , dsvCursorMarkers = ib + , dsvCursorNewlines = nls + , dsvCursorPosition = 0 + } + where ws = asVector64s 64 lbs + ibq = DVS.cmpEqWord8s C.doubleQuote <$> ws + ibn = DVS.cmpEqWord8s C.newline <$> ws + ibd = DVS.cmpEqWord8s delimiter <$> ws + (ib, nls) = makeIndexes ibd ibn ibq +{-# INLINE makeCursor #-} diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Internal.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Internal.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Internal.hs @@ -0,0 +1,67 @@ +module Data.Succinct.Dsv.Lazy.Cursor.Internal + ( nextField + , nextPosition + , atEnd + , nextRow + , trim + , advanceField + ) where + +import Data.Succinct.Dsv.Lazy.Cursor.Type +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Prelude + +import qualified Data.ByteString.Lazy as LBS + +advanceField :: Count -> DsvCursor -> DsvCursor +advanceField n cursor = cursor + { dsvCursorPosition = newPos + } + where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorMarkers cursor) (currentRank + n) - 1 +{-# INLINE advanceField #-} + +nextField :: DsvCursor -> DsvCursor +nextField cursor = cursor + { dsvCursorPosition = newPos + } + where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1) - 1 +{-# INLINE nextField #-} + +nextPosition :: DsvCursor -> DsvCursor +nextPosition cursor = cursor + { dsvCursorPosition = if LBS.null (LBS.drop (fromIntegral newPos) (dsvCursorText cursor)) + then fromIntegral (LBS.length (dsvCursorText cursor)) + else newPos + } + where newPos = dsvCursorPosition cursor + 1 +{-# INLINE nextPosition #-} + +atEnd :: DsvCursor -> Bool +atEnd c = LBS.null (LBS.drop (fromIntegral (dsvCursorPosition c)) (dsvCursorText c)) +{-# INLINE atEnd #-} + +nextRow :: DsvCursor -> DsvCursor +nextRow cursor = cursor + { dsvCursorPosition = if newPos > dsvCursorPosition cursor + then newPos + else fromIntegral (LBS.length (dsvCursorText cursor)) + + } + where currentRank = rank1 (dsvCursorNewlines cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorNewlines cursor) (currentRank + 1) - 1 +{-# INLINE nextRow #-} + +trim :: DsvCursor -> DsvCursor +trim c = if dsvCursorPosition c >= 512 + then trim c + { dsvCursorText = LBS.drop 512 (dsvCursorText c) + , dsvCursorMarkers = drop 1 (dsvCursorMarkers c) + , dsvCursorNewlines = drop 1 (dsvCursorNewlines c) + , dsvCursorPosition = dsvCursorPosition c - 512 + } + else c +{-# INLINE trim #-} diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Lazy.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Lazy.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Lazy.hs @@ -0,0 +1,116 @@ +{-| +Module : Data.Succinct.Dsv.Lazy.Cursor.Strict +Description : Extraction functions that yields lazy bytestrings +-} +module Data.Succinct.Dsv.Lazy.Cursor.Lazy + ( snippet + , getRowListBetween + , getRowVectorBetween + , toListList + , toListVector + , toVectorVector + , selectListList + , mapSelectListList + ) where + +import Data.Function +import Data.Succinct.Dsv.Lazy.Cursor.Internal +import Data.Succinct.Dsv.Lazy.Cursor.Type +import Data.Succinct.RankSelect.Base.Rank1 +import Prelude + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as L +import qualified Data.Vector as DV + +{- HLINT ignore "Reduce duplication" -} + +snippet :: DsvCursor -> LBS.ByteString +snippet c = LBS.take (len `max` 0) $ LBS.drop posC $ dsvCursorText c + where d = nextField c + posC = fromIntegral $ dsvCursorPosition c + posD = fromIntegral $ dsvCursorPosition d + len = posD - posC +{-# INLINE snippet #-} + +getRowVectorBetween :: DsvCursor -> DsvCursor -> Bool -> DV.Vector LBS.ByteString +getRowVectorBetween c d dEnd = DV.unfoldrN fields go c + where cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c) + dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d) + c2d = fromIntegral (dr - cr) + fields = if dEnd then c2d +1 else c2d + go :: DsvCursor -> Maybe (LBS.ByteString, DsvCursor) + go e = case nextField e of + f -> case nextPosition f of + g -> case snippet e of + s -> Just (s, g) + {-# INLINE go #-} +{-# INLINE getRowVectorBetween #-} + +getRowListBetween :: DsvCursor -> DsvCursor -> Bool -> [LBS.ByteString] +getRowListBetween c d dEnd = take fields (L.unfoldr go c) + where cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c) + dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d) + c2d = fromIntegral (dr - cr) + fields = if dEnd then c2d +1 else c2d + go :: DsvCursor -> Maybe (LBS.ByteString, DsvCursor) + go e = case nextField e of + f -> case nextPosition f of + g -> case snippet e of + s -> Just (s, g) + {-# INLINE go #-} +{-# INLINE getRowListBetween #-} + +toListList :: DsvCursor -> [[LBS.ByteString]] +toListList c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then getRowListBetween c d dEnd:toListList (trim d) + else [] + where nr = nextRow c + d = nextPosition nr + dEnd = atEnd nr +{-# INLINE toListList #-} + +toListVector :: DsvCursor -> [DV.Vector LBS.ByteString] +toListVector c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then getRowVectorBetween c d dEnd:toListVector (trim d) + else [] + where nr = nextRow c + d = nextPosition nr + dEnd = atEnd nr +{-# INLINE toListVector #-} + +toVectorVector :: DsvCursor -> DV.Vector (DV.Vector LBS.ByteString) +toVectorVector = DV.fromList . toListVector +{-# INLINE toVectorVector #-} + +selectRowFrom :: [Int] -> DsvCursor -> [LBS.ByteString] +selectRowFrom sel c = go <$> sel + where go :: Int -> LBS.ByteString + go n = snippet nc + where nc = nextPosition (advanceField (fromIntegral n) c) + {-# INLINE go #-} +{-# INLINE selectRowFrom #-} + +mapSelectRowFrom :: [(Int, LBS.ByteString -> LBS.ByteString)] -> DsvCursor -> [LBS.ByteString] +mapSelectRowFrom sel c = uncurry go <$> sel + where go :: Int -> (LBS.ByteString -> LBS.ByteString) -> LBS.ByteString + go n f = f (snippet nc) + where nc = nextPosition (advanceField (fromIntegral n) c) + {-# INLINE go #-} +{-# INLINE mapSelectRowFrom #-} + +selectListList :: [Int] -> DsvCursor -> [[LBS.ByteString]] +selectListList sel c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then selectRowFrom sel c:selectListList sel (trim d) + else [] + where nr = nextRow c + d = nextPosition nr +{-# INLINE selectListList #-} + +mapSelectListList :: [(Int, LBS.ByteString -> LBS.ByteString)] -> DsvCursor -> [[LBS.ByteString]] +mapSelectListList sel c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then mapSelectRowFrom sel c:mapSelectListList sel (trim d) + else [] + where nr = nextRow c + d = nextPosition nr +{-# INLINE mapSelectListList #-} diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Strict.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Strict.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Strict.hs @@ -0,0 +1,93 @@ +{-| +Module : Data.Succinct.Dsv.Lazy.Cursor.Strict +Description : Extraction functions that yields strict bytestrings +-} +module Data.Succinct.Dsv.Lazy.Cursor.Strict + ( snippet + , getRowListBetween + , getRowVectorBetween + , toListList + , toListVector + , toVectorVector + ) where + +import Data.Function +import Data.Succinct.Dsv.Lazy.Cursor.Internal +import Data.Succinct.Dsv.Lazy.Cursor.Type +import Data.Succinct.RankSelect.Base.Rank1 +import Prelude + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as L +import qualified Data.Vector as DV + +{- HLINT ignore "Reduce duplication" -} + +snippet :: DsvCursor -> Int -> BS.ByteString -> BS.ByteString +snippet c offset bs = BS.take (len `max` 0) $ BS.drop posC bs + where d = nextField c + posC = fromIntegral (dsvCursorPosition c) - offset + posD = fromIntegral (dsvCursorPosition d) - offset + len = posD - posC +{-# INLINE snippet #-} + +getRowListBetween :: DsvCursor -> DsvCursor -> Bool -> [BS.ByteString] +getRowListBetween c d dEnd = take fields (L.unfoldr go c) + where bsA = fromIntegral $ dsvCursorPosition c + bsZ = fromIntegral $ dsvCursorPosition d + bsT = dsvCursorText c + bs = LBS.toStrict $ LBS.take (bsZ - bsA) (LBS.drop bsA bsT) + + cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c) + dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d) + c2d = fromIntegral (dr - cr) + fields = if dEnd then c2d +1 else c2d + go :: DsvCursor -> Maybe (BS.ByteString, DsvCursor) + go e = case nextField e of + f -> case nextPosition f of + g -> case snippet e (fromIntegral bsA) bs of + s -> Just (s, g) + {-# INLINE go #-} +{-# INLINE getRowListBetween #-} + +getRowVectorBetween :: DsvCursor -> DsvCursor -> Bool -> DV.Vector BS.ByteString +getRowVectorBetween c d dEnd = DV.unfoldrN fields go c + where bsA = fromIntegral $ dsvCursorPosition c + bsZ = fromIntegral $ dsvCursorPosition d + bsT = dsvCursorText c + bs = LBS.toStrict $ LBS.take (bsZ - bsA) (LBS.drop bsA bsT) + + cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c) + dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d) + c2d = fromIntegral (dr - cr) + fields = if dEnd then c2d +1 else c2d + go :: DsvCursor -> Maybe (BS.ByteString, DsvCursor) + go e = case nextField e of + f -> case nextPosition f of + g -> case snippet e (fromIntegral bsA) bs of + s -> Just (s, g) + {-# INLINE go #-} +{-# INLINE getRowVectorBetween #-} + +toListList :: DsvCursor -> [[BS.ByteString]] +toListList c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then getRowListBetween c d dEnd:toListList (trim d) + else [] + where nr = nextRow c + d = nextPosition nr + dEnd = atEnd nr +{-# INLINE toListList #-} + +toListVector :: DsvCursor -> [DV.Vector BS.ByteString] +toListVector c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then getRowVectorBetween c d dEnd:toListVector (trim d) + else [] + where nr = nextRow c + d = nextPosition nr + dEnd = atEnd nr +{-# INLINE toListVector #-} + +toVectorVector :: DsvCursor -> DV.Vector (DV.Vector BS.ByteString) +toVectorVector = DV.fromList . toListVector +{-# INLINE toVectorVector #-} diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Type.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Type.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Lazy/Cursor/Type.hs @@ -0,0 +1,17 @@ +module Data.Succinct.Dsv.Lazy.Cursor.Type where + +import Control.DeepSeq (NFData) +import Data.Word +import GHC.Generics (Generic) + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector.Storable as DVS + +data DsvCursor = DsvCursor + { dsvCursorText :: !LBS.ByteString + , dsvCursorMarkers :: ![DVS.Vector Word64] + , dsvCursorNewlines :: ![DVS.Vector Word64] + , dsvCursorPosition :: !Word64 + } deriving (Eq, Show, Generic) + +instance NFData DsvCursor diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Dsv.Strict.Cursor + ( DsvCursor(..) + , snippet + , nextField + , nextPosition + , nextRow + , mmapCursor + , toListVector + , toVectorVector + ) where + +import Data.Word +import Data.Succinct.Dsv.Strict.Cursor.Type +import HaskellWorks.Data.Product +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy + +import qualified Data.ByteString as BS +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Dsv.Strict.Cursor.Internal as SVS +import qualified HaskellWorks.Data.FromForeignRegion as IO + +mmapCursor :: Word8 -> Bool -> FilePath -> IO (DsvCursor BS.ByteString CsPoppy) +mmapCursor delimiter useIndex filePath = do + (!bs) :*: (!v) <- IO.mmapFromForeignRegion filePath + let !_ = v :: DVS.Vector Word64 + (!markers, !newlines) <- if useIndex + then (,) + <$> IO.mmapFromForeignRegion (filePath ++ ".markers.idx") + <*> IO.mmapFromForeignRegion (filePath ++ ".newlines.idx") + else return $ SVS.makeIndexes delimiter v + return DsvCursor + { dsvCursorDelimiter = delimiter + , dsvCursorText = bs + , dsvCursorMarkers = makeCsPoppy markers + , dsvCursorNewlines = makeCsPoppy newlines + , dsvCursorPosition = 0 + } + +snippet :: DsvCursor BS.ByteString CsPoppy -> BS.ByteString +snippet c = BS.take (len `max` 0) $ BS.drop posC $ dsvCursorText c + where d = nextField c + posC = fromIntegral $ dsvCursorPosition c + posD = fromIntegral $ dsvCursorPosition d + len = posD - posC +{-# INLINE snippet #-} + +atEnd :: DsvCursor BS.ByteString CsPoppy -> Bool +atEnd c = BS.null (BS.drop (fromIntegral (dsvCursorPosition c)) (dsvCursorText c)) +{-# INLINE atEnd #-} + +nextField :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy +nextField cursor = cursor + { dsvCursorPosition = newPos + } + where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1) - 1 +{-# INLINE nextField #-} + +nextRow :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy +nextRow cursor = cursor + { dsvCursorPosition = if newPos > dsvCursorPosition cursor + then newPos + else fromIntegral (BS.length (dsvCursorText cursor)) + + } + where currentRank = rank1 (dsvCursorNewlines cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorNewlines cursor) (currentRank + 1) - 1 +{-# INLINE nextRow #-} + +nextPosition :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy +nextPosition cursor = cursor + { dsvCursorPosition = if BS.null (BS.drop (fromIntegral newPos) (dsvCursorText cursor)) + then fromIntegral (BS.length (dsvCursorText cursor)) + else newPos + } + where newPos = dsvCursorPosition cursor + 1 +{-# INLINE nextPosition #-} + +getRowBetween :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy -> DV.Vector BS.ByteString +getRowBetween c d = DV.unfoldrN c2d go c + where cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c) + dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d) + c2d = fromIntegral (dr - cr) + go :: DsvCursor BS.ByteString CsPoppy -> Maybe (BS.ByteString, DsvCursor BS.ByteString CsPoppy) + go e = case nextField e of + f -> case nextPosition f of + g -> case snippet e of + s -> Just (s, g) + {-# INLINE go #-} +{-# INLINE getRowBetween #-} + +toListVector :: DsvCursor BS.ByteString CsPoppy -> [DV.Vector BS.ByteString] +toListVector c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then getRowBetween c d:toListVector d + else [] + where d = nextPosition (nextRow c) +{-# INLINE toListVector #-} + +toVectorVector :: DsvCursor BS.ByteString CsPoppy -> DV.Vector (DV.Vector BS.ByteString) +toVectorVector = DV.fromList . toListVector +{-# INLINE toVectorVector #-} diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Internal.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Internal.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Internal.hs @@ -0,0 +1,129 @@ +module Data.Succinct.Dsv.Strict.Cursor.Internal where + +import Control.Monad.ST +import Data.Bits (popCount) +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Dsv.Internal.Bits +import Data.Succinct.Dsv.Internal.Broadword +import Data.Succinct.Dsv.Strict.Cursor.Type +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Prelude + +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Storable.Mutable as DVSM +import qualified Data.Succinct.Dsv.Internal.Char.Word64 as CW + +{- HLINT ignore "Reduce duplication" -} + +makeIndexes :: Word8 -> DVS.Vector Word64 -> (DVS.Vector Word64, DVS.Vector Word64) +makeIndexes delimiter ws = case DVS.createT $ makeIndexes' CW.doubleQuote CW.newline (fillWord64 delimiter) ws of + [markers, newlines] -> (markers, newlines) + _ -> error "This should not happen" + +makeIndexes' :: forall s. + Word64 + -> Word64 + -> Word64 + -> DVS.Vector Word64 + -> ST s [DVS.MVector s Word64] +makeIndexes' rdqs rnls rdls ws = do + (markers :: DVSM.MVector s Word64) <- DVSM.unsafeNew ((DVS.length ws + 7) `div` 8) + (newlines :: DVSM.MVector s Word64) <- DVSM.unsafeNew ((DVS.length ws + 7) `div` 8) + go markers newlines 0 0 + return [markers, newlines] + where go :: DVSM.MVector s Word64 -> DVSM.MVector s Word64 -> Position -> Count -> ST s () + go markers newlines wsi numQuotes = let ui = wsi `div` 8 in if wsi >= 0 && wsi + 8 <= end ws + then do + let w0 = ws !!! wsi + let w0Dqs = testWord8s (w0 .^. rdqs) + let w0Nls = testWord8s (w0 .^. rnls) + let w0Dls = testWord8s (w0 .^. rdls) + let w1 = ws !!! (wsi + 1) + let w1Dqs = testWord8s (w1 .^. rdqs) + let w1Nls = testWord8s (w1 .^. rnls) + let w1Dls = testWord8s (w1 .^. rdls) + let w2 = ws !!! (wsi + 2) + let w2Dqs = testWord8s (w2 .^. rdqs) + let w2Nls = testWord8s (w2 .^. rnls) + let w2Dls = testWord8s (w2 .^. rdls) + let w3 = ws !!! (wsi + 3) + let w3Dqs = testWord8s (w3 .^. rdqs) + let w3Nls = testWord8s (w3 .^. rnls) + let w3Dls = testWord8s (w3 .^. rdls) + let w4 = ws !!! (wsi + 4) + let w4Dqs = testWord8s (w4 .^. rdqs) + let w4Nls = testWord8s (w4 .^. rnls) + let w4Dls = testWord8s (w4 .^. rdls) + let w5 = ws !!! (wsi + 5) + let w5Dqs = testWord8s (w5 .^. rdqs) + let w5Nls = testWord8s (w5 .^. rnls) + let w5Dls = testWord8s (w5 .^. rdls) + let w6 = ws !!! (wsi + 6) + let w6Dqs = testWord8s (w6 .^. rdqs) + let w6Nls = testWord8s (w6 .^. rnls) + let w6Dls = testWord8s (w6 .^. rdls) + let w7 = ws !!! (wsi + 7) + let w7Dqs = testWord8s (w7 .^. rdqs) + let w7Nls = testWord8s (w7 .^. rnls) + let w7Dls = testWord8s (w7 .^. rdls) + let wDqs = (w7Dqs .<. 56) .|. (w6Dqs .<. 48) .|. (w5Dqs .<. 40) .|. (w4Dqs .<. 32) .|. (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs + let wNls = (w7Nls .<. 56) .|. (w6Nls .<. 48) .|. (w5Nls .<. 40) .|. (w4Nls .<. 32) .|. (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls + let wDls = (w7Dls .<. 56) .|. (w6Dls .<. 48) .|. (w5Dls .<. 40) .|. (w4Dls .<. 32) .|. (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls + let numWordQuotes = comp wDqs + let wMask = toggle64 numQuotes numWordQuotes + let newNumQuotes = numQuotes + fromIntegral (popCount numWordQuotes) + DVSM.unsafeWrite markers (fromIntegral ui) (comp (wNls .&. wDls) .&. wMask) + DVSM.unsafeWrite newlines (fromIntegral ui) (comp wNls .&. wMask) + go markers newlines (wsi + 8) newNumQuotes + + else do + let w0 = atIndexOr 0 ws wsi + let w0Dqs = testWord8s (w0 .^. rdqs) + let w0Nls = testWord8s (w0 .^. rnls) + let w0Dls = testWord8s (w0 .^. rdls) + let w1 = atIndexOr 0 ws (wsi + 1) + let w1Dqs = testWord8s (w1 .^. rdqs) + let w1Nls = testWord8s (w1 .^. rnls) + let w1Dls = testWord8s (w1 .^. rdls) + let w2 = atIndexOr 0 ws (wsi + 2) + let w2Dqs = testWord8s (w2 .^. rdqs) + let w2Nls = testWord8s (w2 .^. rnls) + let w2Dls = testWord8s (w2 .^. rdls) + let w3 = atIndexOr 0 ws (wsi + 3) + let w3Dqs = testWord8s (w3 .^. rdqs) + let w3Nls = testWord8s (w3 .^. rnls) + let w3Dls = testWord8s (w3 .^. rdls) + let w4 = atIndexOr 0 ws (wsi + 4) + let w4Dqs = testWord8s (w4 .^. rdqs) + let w4Nls = testWord8s (w4 .^. rnls) + let w4Dls = testWord8s (w4 .^. rdls) + let w5 = atIndexOr 0 ws (wsi + 5) + let w5Dqs = testWord8s (w5 .^. rdqs) + let w5Nls = testWord8s (w5 .^. rnls) + let w5Dls = testWord8s (w5 .^. rdls) + let w6 = atIndexOr 0 ws (wsi + 6) + let w6Dqs = testWord8s (w6 .^. rdqs) + let w6Nls = testWord8s (w6 .^. rnls) + let w6Dls = testWord8s (w6 .^. rdls) + let w7 = atIndexOr 0 ws (wsi + 7) + let w7Dqs = testWord8s (w7 .^. rdqs) + let w7Nls = testWord8s (w7 .^. rnls) + let w7Dls = testWord8s (w7 .^. rdls) + let wDqs = (w7Dqs .<. 56) .|. (w6Dqs .<. 48) .|. (w5Dqs .<. 40) .|. (w4Dqs .<. 32) .|. (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs + let wNls = (w7Nls .<. 56) .|. (w6Nls .<. 48) .|. (w5Nls .<. 40) .|. (w4Nls .<. 32) .|. (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls + let wDls = (w7Dls .<. 56) .|. (w6Dls .<. 48) .|. (w5Dls .<. 40) .|. (w4Dls .<. 32) .|. (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls + let numWordQuotes = comp wDqs + let wMask = toggle64 numQuotes numWordQuotes + DVSM.unsafeWrite markers (fromIntegral ui) (comp (wNls .&. wDls) .&. wMask) + DVSM.unsafeWrite newlines (fromIntegral ui) (comp wNls .&. wMask) + +nextCursor :: (Rank1 s, Select1 s) => DsvCursor t s -> DsvCursor t s +nextCursor cursor = cursor + { dsvCursorPosition = newPos + } + where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1) diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Internal/Reference.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Internal/Reference.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Internal/Reference.hs @@ -0,0 +1,219 @@ +module Data.Succinct.Dsv.Strict.Cursor.Internal.Reference where + +import Data.Bits (popCount) +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Dsv.Internal.Bits +import Data.Succinct.Dsv.Internal.Broadword +import Data.Succinct.Dsv.Strict.Cursor.Type +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Prelude + +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Dsv.Internal.Char.Word64 as CW + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant guard" -} + +unsafeIndex :: DVS.Vector Word64 -> Int -> Word64 +unsafeIndex v i | i < 0 = error $ "Invalid index: " <> show i <> " for vector sized " <> show (DVS.length v) +unsafeIndex v i | fromIntegral i >= DVS.length v = error $ "Invalid index: " <> show i <> " for vector sized " <> show (DVS.length v) +unsafeIndex v i | otherwise = DVS.unsafeIndex v (fromIntegral i) +-- unsafeIndex v i = DVS.unsafeIndex v (fromIntegral i) +{-# INLINE unsafeIndex #-} + +dvsLength :: DVS.Vector Word64 -> Int +dvsLength v = fromIntegral (DVS.length v) +{-# INLINE dvsLength #-} + +atIndexOr2 :: Word64 -> DVS.Vector Word64 -> Int -> Word64 +atIndexOr2 d _ i | i < 0 = d +atIndexOr2 d v i | fromIntegral i >= DVS.length v = d +atIndexOr2 _ v i | otherwise = unsafeIndex v (fromIntegral i) +{-# NOINLINE atIndexOr2 #-} + +-- rdqs: repeated double quotes +-- rnls: repeated new lines +-- rdls: repeated delimiters +-- numQuotes: Number of quotes since beginning +-- n: Number of rank select bit string words since beginning +-- returns: dquote interest bits in high part and other interest bits in low part +mkDsvRawBitsByWord64s :: Word64 -> Word64 -> Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +mkDsvRawBitsByWord64s rdqs rnls rdls v = DVS.generate (((DVS.length v + 7) `div` 8) * 2) go + where go :: Int -> Word64 + go u = let vi = fromIntegral u * 4 in + if dvsLength v - vi >= 4 + then let w0 = unsafeIndex v vi + w0Dqs = testWord8s (w0 .^. rdqs) + w0Nls = testWord8s (w0 .^. rnls) + w0Dls = testWord8s (w0 .^. rdls) + w1 = unsafeIndex v (vi + 1) + w1Dqs = testWord8s (w1 .^. rdqs) + w1Nls = testWord8s (w1 .^. rnls) + w1Dls = testWord8s (w1 .^. rdls) + w2 = unsafeIndex v (vi + 2) + w2Dqs = testWord8s (w2 .^. rdqs) + w2Nls = testWord8s (w2 .^. rnls) + w2Dls = testWord8s (w2 .^. rdls) + w3 = unsafeIndex v (vi + 3) + w3Dqs = testWord8s (w3 .^. rdqs) + w3Nls = testWord8s (w3 .^. rnls) + w3Dls = testWord8s (w3 .^. rdls) + wDqs = (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs + wNls = (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls + wDls = (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls + in (comp (wDqs .<. 32) .&. 0xffffffff00000000) .|. (comp (wNls .&. wDls) .&. 0x00000000ffffffff) + else let w0 = atIndexOr2 0 v vi + w0Dqs = testWord8s (w0 .^. rdqs) + w0Nls = testWord8s (w0 .^. rnls) + w0Dls = testWord8s (w0 .^. rdls) + w1 = atIndexOr2 0 v (vi + 1) + w1Dqs = testWord8s (w1 .^. rdqs) + w1Nls = testWord8s (w1 .^. rnls) + w1Dls = testWord8s (w1 .^. rdls) + w2 = atIndexOr2 0 v (vi + 2) + w2Dqs = testWord8s (w2 .^. rdqs) + w2Nls = testWord8s (w2 .^. rnls) + w2Dls = testWord8s (w2 .^. rdls) + w3 = atIndexOr2 0 v (vi + 3) + w3Dqs = testWord8s (w3 .^. rdqs) + w3Nls = testWord8s (w3 .^. rnls) + w3Dls = testWord8s (w3 .^. rdls) + wDqs = (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs + wNls = (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls + wDls = (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls + in (comp (wDqs .<. 32) .&. 0xffffffff00000000) .|. (comp (wNls .&. wDls) .&. 0x00000000ffffffff) + +mkCummulativeDqPopCount :: DVS.Vector Word64 -> DVS.Vector Word64 +mkCummulativeDqPopCount v = DVS.constructN (DVS.length v `div` 2) go + where go :: DVS.Vector Word64 -> Word64 + go u = let ui = dvsLength u + vi = ui * 2 + in if dvsLength v - vi >= 2 && vi > 0 + then let w0 = unsafeIndex v vi + w1 = unsafeIndex v (vi + 1) + w = (w1 .&. 0xffffffff00000000) .|. (w0 .>. 32) + in unsafeIndex u (ui - 1) + fromIntegral (popCount w) + else let w0 = atIndexOr2 0 v vi + w1 = atIndexOr2 0 v (vi + 1) + w = (w1 .&. 0xffffffff00000000) .|. (w0 .>. 32) + in atIndexOr2 0 u (ui - 1) + fromIntegral (popCount w) + +mkIbVector' :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +mkIbVector' rawBits cpcs v = DVS.generate ((DVS.length v + 7) `div` 8) go + where go :: Int -> Word64 + go u = let ui = fromIntegral u in if ui > 1 + then let vi = ui * 2 + cpc = unsafeIndex cpcs (ui - 1) + w0 = unsafeIndex rawBits vi + w1 = unsafeIndex rawBits (vi + 1) + w = ((w1 .&. 0x00000000ffffffff) .<. 32) .|. ( w0 .&. 0x00000000ffffffff ) + d = ( w1 .&. 0xffffffff00000000 ) .|. ((w0 .&. 0xffffffff00000000) .>. 32) + m = toggle64 cpc d + in w .&. m + else let vi = fromIntegral (ui * 2) + cpc = atIndexOrBeforeOrLast 0 cpcs (fromIntegral (ui - 1)) + w0 = atIndexOr 0 rawBits vi + w1 = atIndexOr 0 rawBits (vi + 1) + w = ((w1 .&. 0x00000000ffffffff) .<. 32) .|. ( w0 .&. 0x00000000ffffffff ) + d = ( w1 .&. 0xffffffff00000000 ) .|. ((w0 .&. 0xffffffff00000000) .>. 32) + m = toggle64 cpc d + in w .&. m + +mkIbVector :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64 +mkIbVector delimiter v = mkIbVector' rawBits cpcs v + where rdqs = CW.doubleQuote + rnls = CW.newline + rdls = fillWord64 delimiter + rawBits = mkDsvRawBitsByWord64s rdqs rnls rdls v + cpcs = mkCummulativeDqPopCount rawBits -- cummulative popcounts + +-- rdqs: repeated double quotes +-- rnls: repeated new lines +-- rdls: repeated delimiters +-- numQuotes: Number of quotes since beginning +-- n: Number of rank select bit string words since beginning +-- returns: dquote interest bits in high part and other interest bits in low part +mkStripes :: Word64 -> Word64 -> Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +mkStripes rdqs rnls rdls v = DVS.generate (((DVS.length v + 7) `div` 8) * 3) go + where stripePatterns = DVS.fromList [rdqs, rnls, rdls] + go :: Int -> Word64 + go u = + let ui = fromIntegral u + si = ui `mod` 3 + vi = (ui `div` 3) * 8 + ws = unsafeIndex stripePatterns si + in if dvsLength v - vi >= 4 + then let w0 = testWord8s (unsafeIndex v (vi + 0) .^. ws) + w1 = testWord8s (unsafeIndex v (vi + 1) .^. ws) + w2 = testWord8s (unsafeIndex v (vi + 2) .^. ws) + w3 = testWord8s (unsafeIndex v (vi + 3) .^. ws) + w4 = testWord8s (unsafeIndex v (vi + 4) .^. ws) + w5 = testWord8s (unsafeIndex v (vi + 5) .^. ws) + w6 = testWord8s (unsafeIndex v (vi + 6) .^. ws) + w7 = testWord8s (unsafeIndex v (vi + 7) .^. ws) + wa = (w7 .<. 56) .|. (w6 .<. 48) .|. (w5 .<. 40) .|. (w4 .<. 32) .|. + (w3 .<. 24) .|. (w2 .<. 16) .|. (w1 .<. 8) .|. w0 + in comp wa + else let w0 = testWord8s (atIndexOr2 0 v (vi + 0) .^. ws) + w1 = testWord8s (atIndexOr2 0 v (vi + 1) .^. ws) + w2 = testWord8s (atIndexOr2 0 v (vi + 2) .^. ws) + w3 = testWord8s (atIndexOr2 0 v (vi + 3) .^. ws) + w4 = testWord8s (atIndexOr2 0 v (vi + 4) .^. ws) + w5 = testWord8s (atIndexOr2 0 v (vi + 5) .^. ws) + w6 = testWord8s (atIndexOr2 0 v (vi + 6) .^. ws) + w7 = testWord8s (atIndexOr2 0 v (vi + 7) .^. ws) + wa = (w7 .<. 56) .|. (w6 .<. 48) .|. (w5 .<. 40) .|. (w4 .<. 32) .|. + (w3 .<. 24) .|. (w2 .<. 16) .|. (w1 .<. 8) .|. w0 + in comp wa + +mkCummulativeDqPopCountFromStriped :: DVS.Vector Word64 -> DVS.Vector Word64 +mkCummulativeDqPopCountFromStriped v = DVS.constructN (DVS.length v `div` 3) go + where go :: DVS.Vector Word64 -> Word64 + go u = let ui = dvsLength u + vi = ui * 3 + w = unsafeIndex v vi + in unsafeIndex u (ui - 1) + fromIntegral (popCount w) + +mkDsvIbNlFromStriped :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +mkDsvIbNlFromStriped sv cpcs = DVS.generate (DVS.length sv `div` 3) go + where go :: Int -> Word64 + go u = let ui = fromIntegral u in if ui > 1 + then let svi = ui * 2 + cpc = unsafeIndex cpcs (ui - 1) + wdq = unsafeIndex sv svi + wnl = unsafeIndex sv (svi + 1) + m = toggle64 cpc wdq + in wnl .&. m + else let svi = fromIntegral (ui * 2) + cpc = atIndexOrBeforeOrLast 0 cpcs (fromIntegral (ui - 1)) + wdq = atIndexOr 0 sv svi + wnl = atIndexOr 0 sv (svi + 1) + m = toggle64 cpc wdq + in wnl .&. m + +mkDsvIbDlFromStriped :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +mkDsvIbDlFromStriped sv cpcs = DVS.generate (DVS.length sv `div` 3) go + where go :: Int -> Word64 + go u = let ui = fromIntegral u in if ui > 1 + then let svi = ui * 2 + cpc = unsafeIndex cpcs (ui - 1) + wdq = unsafeIndex sv svi + wdl = unsafeIndex sv (svi + 2) + m = toggle64 cpc wdq + in wdl .&. m + else let svi = fromIntegral (ui * 2) + cpc = atIndexOrBeforeOrLast 0 cpcs (fromIntegral (ui - 1)) + wdq = atIndexOr 0 sv svi + wdl = atIndexOr 0 sv (svi + 2) + m = toggle64 cpc wdq + in wdl .&. m + +nextCursor :: (Rank1 s, Select1 s) => DsvCursor t s -> DsvCursor t s +nextCursor cursor = cursor + { dsvCursorPosition = newPos + } + where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1) diff --git a/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Type.hs b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Type.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/src/Data/Succinct/Dsv/Strict/Cursor/Type.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE UndecidableInstances #-} + +module Data.Succinct.Dsv.Strict.Cursor.Type + ( DsvCursor(..) + ) where + +import Control.DeepSeq +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Container + +data DsvCursor t s = DsvCursor + { dsvCursorDelimiter :: Elem t + , dsvCursorText :: !t + , dsvCursorMarkers :: !s + , dsvCursorNewlines :: !s + , dsvCursorPosition :: !Word64 + } + deriving Generic + +deriving instance (Eq (Elem t), Eq t, Eq s) => Eq (DsvCursor t s) +deriving instance (Show (Elem t), Show t, Show s) => Show (DsvCursor t s) + +instance (NFData t, NFData (Elem t), NFData s) => NFData (DsvCursor t s) diff --git a/components/succinct-dsv/test/Data/Succinct/Dsv/BroadwordSpec.hs b/components/succinct-dsv/test/Data/Succinct/Dsv/BroadwordSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/test/Data/Succinct/Dsv/BroadwordSpec.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Dsv.BroadwordSpec (spec) where + +import Data.Maybe (fromJust) +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import Data.Succinct.Dsv.Internal.Broadword +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +spec :: Spec +spec = describe "Data.Succinct.Dsv.BroadwordSpec" $ do + it "Case 0" $ requireProperty $ do + let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: Word64 + let expected = fromJust $ bitRead "11000111 11111111 11111111 11111111 11111111 11111111 11111111 11111111" :: Word64 + bitShow actual === bitShow expected + it "Case 1" $ requireProperty $ do + let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64 + let expected = fromJust $ bitRead "11000111 11111000 00000000 00000000 00000000 00000000 00000011 11110000" :: Word64 + bitShow actual === bitShow expected + it "Case 1" $ requireProperty $ do + let actual = toggle64 1 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64 + let expected = fromJust $ bitRead "00111000 00000111 11111111 11111111 11111111 11111111 11111100 00001111" :: Word64 + bitShow actual === bitShow expected + +{- + normal case + ----------- + 00100100 + 11011011 + + 00010000 + 11011011 + + + 11000111 + carry case + ----------- + 00100100 + 11011011 + | | + 10000010 + 11011011 + + 00111000 +-} diff --git a/components/succinct-dsv/test/Data/Succinct/Dsv/Gen.hs b/components/succinct-dsv/test/Data/Succinct/Dsv/Gen.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/test/Data/Succinct/Dsv/Gen.hs @@ -0,0 +1,10 @@ +module Data.Succinct.Dsv.Gen where + +import Hedgehog + +import qualified Data.ByteString as BS +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +bytestring :: MonadGen m => R.Range Int -> m BS.ByteString +bytestring r = BS.pack <$> G.list r (G.word8 R.constantBounded) diff --git a/components/succinct-dsv/test/Data/Succinct/Dsv/Lazy/CursorSpec.hs b/components/succinct-dsv/test/Data/Succinct/Dsv/Lazy/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/test/Data/Succinct/Dsv/Lazy/CursorSpec.hs @@ -0,0 +1,241 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Dsv.Lazy.CursorSpec (spec) where + +import HaskellWorks.Data.Bits.BitShown +import Data.Succinct.Dsv.Internal.Char (comma) +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector as DV +import qualified Data.Succinct.Dsv.Lazy.Cursor as SVL +import qualified Data.Succinct.Dsv.Lazy.Cursor.Lazy as SVLL + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +subjectEmpty, subjectSS, subjectSM, subjectMS, subjectMM :: LBS.ByteString +expectedEmpty, expectedSS, expectedSM, expectedMS, expectedMM :: [DV.Vector LBS.ByteString] +subjectEmpty = "" +expectedEmpty = mkExpected [] +subjectSS = "hello" +expectedSS = mkExpected [["hello"]] +subjectSM = "hello\nyes" +expectedSM = mkExpected [["hello"],["yes"]] +subjectMS = "hello,goodbye" +expectedMS = mkExpected [["hello","goodbye"]] +subjectMM = "hello,goodbye\nyes,no" +expectedMM = mkExpected [["hello","goodbye"],["yes","no"]] + +testToListVector :: LBS.ByteString -> [DV.Vector LBS.ByteString] +testToListVector = SVLL.toListVector . SVL.makeCursor comma + +testToListList :: LBS.ByteString -> [[LBS.ByteString]] +testToListList = fmap DV.toList . testToListVector + +-- Adds a terminal newline to the file +testToListVector' :: LBS.ByteString -> [DV.Vector LBS.ByteString] +testToListVector' = testToListVector . (<> "\n") + +mkExpected :: [[LBS.ByteString]] -> [DV.Vector LBS.ByteString] +mkExpected = fmap DV.fromList + +spec :: Spec +spec = describe "Data.Succinct.Dsv.Lazy.CursorSpec" $ do + -- no terminal newline + it "Case 1" $ requireTest $ do + testToListVector subjectEmpty === expectedEmpty + it "Case 2" $ requireTest $ do + testToListVector subjectSS === expectedSS + it "Case 3" $ requireTest $ do + testToListVector subjectSM === expectedSM + it "Case 4" $ requireTest $ do + testToListVector subjectMS === expectedMS + it "Case 5" $ requireTest $ do + testToListVector subjectMM === expectedMM + -- terminal newline + -- the following test does not pass + --it "Case 6" $ requireTest $ do + --testToListVector' subjectEmpty === expectedEmpty + it "Case 7" $ requireTest $ do + testToListVector' subjectSS === expectedSS + it "Case 8" $ requireTest $ do + testToListVector' subjectSM === expectedSM + it "Case 9" $ requireTest $ do + testToListVector' subjectMS === expectedMS + it "Case 10" $ requireTest $ do + testToListVector' subjectMM === expectedMM + describe "boundaries" $ do + it "513 bytes" $ requireTest $ do + let actual = testToListList $ LBS.intercalate "\n" + [ "id,group_id,arm,first_name,last_name,email,contact_number,start_date,status,dose_smart_id,fitbit_id,glyco_id,sms_reminder,email_reminder,inactive_reminder,starting_weight,starting_bmi,starting_hba1c" + , "10,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,1,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,aaaaaaa,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,2018-01-01 00:00:00 UTC,Active,,,,Never,Weekly,Never,100.01,10.01,1.0e-2" + ] + actual === + [ [ "id" + , "group_id" + , "arm" + , "first_name" + , "last_name" + , "email" + , "contact_number" + , "start_date" + , "status" + , "dose_smart_id" + , "fitbit_id" + , "glyco_id" + , "sms_reminder" + , "email_reminder" + , "inactive_reminder" + , "starting_weight" + , "starting_bmi" + , "starting_hba1c" + ] + , [ "10" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "1" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "aaaaaaa" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "2018-01-01 00:00:00 UTC" + , "Active" + , "" + , "" + , "" + , "Never" + , "Weekly" + , "Never" + , "100.01" + , "10.01" + , "1.0e-2" + ] + ] + it "512 bytes" $ requireTest $ do + let actual = testToListList $ LBS.intercalate "\n" + [ "id,group_id,arm,first_name,last_name,email,contact_number,start_date,status,dose_smart_id,fitbit_id,glyco_id,sms_reminder,email_reminder,inactive_reminder,starting_weight,starting_bmi,starting_hba1c" + , "10,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,1,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,aaaaaaa,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,2018-01-01 00:00:00 UTC,Active,,,,Never,Weekly,Never,100.01,10.01,1.0e-2" + ] + actual === + [ [ "id" + , "group_id" + , "arm" + , "first_name" + , "last_name" + , "email" + , "contact_number" + , "start_date" + , "status" + , "dose_smart_id" + , "fitbit_id" + , "glyco_id" + , "sms_reminder" + , "email_reminder" + , "inactive_reminder" + , "starting_weight" + , "starting_bmi" + , "starting_hba1c" + ] + , [ "10" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "1" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "aaaaaaa" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "2018-01-01 00:00:00 UTC" + , "Active" + , "" + , "" + , "" + , "Never" + , "Weekly" + , "Never" + , "100.01" + , "10.01" + , "1.0e-2" + ] + ] + + it "511 bytes" $ requireTest $ do + let actual = testToListList $ LBS.intercalate "\n" + [ "id,group_id,arm,first_name,last_name,email,contact_number,start_date,status,dose_smart_id,fitbit_id,glyco_id,sms_reminder,email_reminder,inactive_reminder,starting_weight,starting_bmi,starting_hba1c" + , "10,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,1,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,aaaaaaa,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,2018-01-01 00:00:00 UTC,Active,,,,Never,Weekly,Never,100.01,10.01,1.0e-2" + ] + actual === + [ [ "id" + , "group_id" + , "arm" + , "first_name" + , "last_name" + , "email" + , "contact_number" + , "start_date" + , "status" + , "dose_smart_id" + , "fitbit_id" + , "glyco_id" + , "sms_reminder" + , "email_reminder" + , "inactive_reminder" + , "starting_weight" + , "starting_bmi" + , "starting_hba1c" + ] + , [ "10" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "1" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "aaaaaaa" + , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "2018-01-01 00:00:00 UTC" + , "Active" + , "" + , "" + , "" + , "Never" + , "Weekly" + , "Never" + , "100.01" + , "10.01" + , "1.0e-2" + ] + ] + describe "single quoted field with newline at 127-129" $ do + it "newline at 127 bytes" $ requireTest $ do + let newlinePos = 127 + let text = "\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\"" + let expected = [["\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\""]] + let cursor = SVL.makeCursor 44 text + _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorMarkers cursor)) + _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorNewlines cursor)) + let actual = fmap DV.toList (DV.toList (SVLL.toVectorVector cursor)) + LBS.length text === newlinePos + 2 + LBS.index text newlinePos === 10 + actual === expected + it "newline at 128 bytes" $ requireTest $ do + let newlinePos = 128 + let text = "\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\"" + let expected = [["\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\""]] + let cursor = SVL.makeCursor 44 text + _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorMarkers cursor)) + _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorNewlines cursor)) + let actual = fmap DV.toList (DV.toList (SVLL.toVectorVector cursor)) + LBS.length text === newlinePos + 2 + LBS.index text newlinePos === 10 + actual === expected + it "newline at 129 bytes" $ requireTest $ do + let newlinePos = 129 + let text = "\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\"" + let expected = [["\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\""]] + let cursor = SVL.makeCursor 44 text + _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorMarkers cursor)) + _ <- forAll $ pure $ BitShown (head (SVL.dsvCursorNewlines cursor)) + let actual = fmap DV.toList (DV.toList (SVLL.toVectorVector cursor)) + LBS.length text === newlinePos + 2 + LBS.index text newlinePos === 10 + actual === expected diff --git a/components/succinct-dsv/test/Data/Succinct/Dsv/Strict/Cursor/InternalSpec.hs b/components/succinct-dsv/test/Data/Succinct/Dsv/Strict/Cursor/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/test/Data/Succinct/Dsv/Strict/Cursor/InternalSpec.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Dsv.Strict.Cursor.InternalSpec (spec) where + +import Control.Monad +import Control.Monad.IO.Class +import Data.ByteString (ByteString) +import Data.Char +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import Data.Succinct.Dsv.Internal.Char (pipe) +import HaskellWorks.Data.FromByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.Dsv.Strict.Cursor.Internal as SVS +import qualified Data.Succinct.Dsv.Strict.Cursor.Internal.Reference as SVS +import qualified HaskellWorks.Data.FromForeignRegion as IO +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R +import qualified System.Directory as IO + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +spec :: Spec +spec = describe "Data.Succinct.Dsv.Strict.Cursor.InternalSpec" $ do + it "Case 1" $ requireTest $ do + entries <- liftIO $ IO.listDirectory "components/succinct-dsv/data/bench" + let files = ("components/succinct-dsv/data/bench/" ++) <$> (".csv" `L.isSuffixOf`) `filter` entries + forM_ files $ \file -> do + v <- liftIO $ IO.mmapFromForeignRegion file + let !actual = DVS.foldr (\a b -> popCount1 a + b) 0 (fst $ SVS.makeIndexes pipe v) + let !expected = DVS.foldr (\a b -> popCount1 a + b) 0 ( SVS.mkIbVector pipe v) + actual === expected + it "Case 2" $ requireTest $ do + bs :: ByteString <- forAll $ T.encodeUtf8 . T.pack <$> G.string (R.linear 0 128) (G.element (id @String " \"|\n")) + v <- forAll $ pure $ fromByteString bs + let !actual = DVS.foldr (\a b -> popCount1 a + b) 0 (fst $ SVS.makeIndexes pipe v) + let !expected = DVS.foldr (\a b -> popCount1 a + b) 0 ( SVS.mkIbVector pipe v) + actual === expected + it "Case 3" $ requireTest $ do + bs :: ByteString <- forAll $ T.encodeUtf8 . T.pack <$> G.string (R.linear 0 128) (G.element (id @String " \"|\n")) + v <- forAll $ pure $ fromByteString bs + let !actual = DVS.foldr (\a b -> popCount1 a + b) 0 (fst $ SVS.makeIndexes pipe v) + let !expected = DVS.foldr (\a b -> popCount1 a + b) 0 ( SVS.mkIbVector pipe v) + actual === expected + it "Case 4" $ requireTest $ do + bs :: ByteString <- forAll $ T.encodeUtf8 . T.pack <$> G.string (R.linear 0 10000) (G.element (id @String " \"")) + v <- forAll $ pure $ fromByteString bs + numQuotes <- forAll $ pure $ BS.length $ BS.filter (== fromIntegral (ord '"')) bs + u <- forAll $ pure $ fst $ SVS.makeIndexes pipe v + let !pc = DVS.foldr (\a b -> popCount1 a + b) 0 u + pc === fromIntegral numQuotes + it "Case 5" $ requireTest $ do + bs :: ByteString <- forAll $ T.encodeUtf8 . T.pack <$> G.string (R.linear 0 10000) (G.element (id @String " \"")) + v <- forAll $ pure $ fromByteString bs + u <- forAll $ pure $ fst $ SVS.makeIndexes pipe v + let !expected = SVS.mkIbVector pipe v + u === expected + it "Case 6" $ requireTest $ do + entries <- liftIO $ IO.listDirectory "components/succinct-dsv/data/bench" + let files = ("components/succinct-dsv/data/bench/" ++) <$> (".csv" `L.isSuffixOf`) `filter` entries + forM_ files $ \file -> do + v <- liftIO $ IO.mmapFromForeignRegion file + let !actual = fst $ SVS.makeIndexes pipe v + let !expected = SVS.mkIbVector pipe v + annotate $ "file : " <> file + actual === expected diff --git a/components/succinct-dsv/test/Data/Succinct/DsvSpec.hs b/components/succinct-dsv/test/Data/Succinct/DsvSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/test/Data/Succinct/DsvSpec.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.DsvSpec (spec) where + +import HaskellWorks.Data.Bits.BitShow +import Data.Succinct.Dsv.Internal.Char (comma) +import HaskellWorks.Data.FromByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.Dsv.Strict.Cursor.Internal.Reference as SVS + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +spec :: Spec +spec = describe "Data.Succinct.DsvSpec" $ do + it "Parsing Basic DSV" $ requireTest $ do + let bs = "12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz\n\ + \12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz\n\ + \12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz\n\ + \12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz" + + let v = fromByteString bs + let actual = SVS.mkIbVector comma v + + bitShow actual === "00000000 10000000 01000000 10000000 00000000 00000000 00010000 00001000 \ + \00000100 00001000 00000000 00000000 00000001 00000000 10000000 01000000 \ + \10000000 00000000 00000000 00010000 00001000 00000100 00001000 00000000 \ + \00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + it "Parsing Quoted DSV" $ requireTest $ do + let bs = "12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"\n\ + \12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"\n\ + \12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"\n\ + \12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"" + + let v = fromByteString bs + let !actual = SVS.mkIbVector comma v + + bitShow actual === "00000000 10000000 01000000 10000000 00000000 00000000 00010000 00001000 \ + \00000100 00001000 00000000 00000000 00000001 00000000 10000000 01000000 \ + \10000000 00000000 00000000 00010000 00001000 00000100 00001000 00000000 \ + \00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + it "Parsing Quoted DSV" $ requireTest $ do + let bs = "12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"\n\ + \12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"\n\ + \12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"\n\ + \12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"" + + let v = fromByteString bs + let !actual = SVS.mkIbVector comma v + + bitShow actual === "00000000 10000000 01000000 10000000 00000000 00000000 00010000 00001000 \ + \00000100 00001000 00000000 00000000 00000001 00000000 10000000 01000000 \ + \10000000 00000000 00000000 00010000 00001000 00000100 00001000 00000000 \ + \00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + diff --git a/components/succinct-dsv/test/Spec.hs b/components/succinct-dsv/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/succinct-dsv/weigh/Space.hs b/components/succinct-dsv/weigh/Space.hs new file mode 100644 --- /dev/null +++ b/components/succinct-dsv/weigh/Space.hs @@ -0,0 +1,53 @@ +module Main where + +import Data.ByteString (ByteString) +import Data.Vector (Vector) +import Data.Succinct.Dsv.Internal.Char (comma) +import Weigh + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Csv as CSV +import qualified Data.Csv.Streaming as CSS +import qualified Data.Foldable as F +import qualified Data.Vector as DV +import qualified Data.Succinct.Dsv.Lazy.Cursor as SVL +import qualified Data.Succinct.Dsv.Lazy.Cursor.Lazy as SVLL +import qualified Data.Succinct.Dsv.Strict.Cursor as SVS + +{- HLINT ignore "Redundant do" -} + +repeatedly :: (a -> Maybe a) -> a -> [a] +repeatedly f a = a:case f a of + Just b -> repeatedly f b + Nothing -> [] + +loadCsvStrict :: FilePath -> IO (DV.Vector (DV.Vector ByteString)) +loadCsvStrict filePath = do + c <- SVS.mmapCursor comma False filePath + + return $ SVS.toVectorVector c + +loadCsvLazy :: FilePath -> IO [DV.Vector LBS.ByteString] +loadCsvLazy filePath = do + bs <- LBS.readFile filePath + let c = SVL.makeCursor comma bs + + return $ SVLL.toListVector c + +main :: IO () +main = do + let infp = "components/succinct-dsv/data/bench/data-0001000.csv" + mainWith $ do + setColumns [Case, Allocated, Max, Live, GCs] + sequence_ + [ action "cassava strict" $ do + r <- fmap (CSV.decode CSV.HasHeader) (LBS.readFile infp) :: IO (Either String (Vector (Vector ByteString))) + case r of + Left _ -> error "Unexpected parse error" + Right v -> pure v + , action "cassava streaming" $ do + fmap (F.toList . CSS.decode CSS.HasHeader) (LBS.readFile infp) :: IO [Vector ByteString] + , action "hw-dsv strict" (loadCsvStrict infp :: IO (Vector (Vector ByteString))) + , action "hw-dsv lazy" (loadCsvLazy infp :: IO [Vector LBS.ByteString]) + ] + return () diff --git a/components/succinct-json-examples/src/Example1.hs b/components/succinct-json-examples/src/Example1.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-examples/src/Example1.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE BangPatterns #-} + +{-# OPTIONS_GHC -fno-warn-unused-matches #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-unused-local-binds #-} + +module Example1 where + +import Data.Aeson + +import qualified Data.ByteString.Lazy as LBS + +example :: IO () +example = do + !bs <- LBS.readFile "corpus/bench/hospitalisation.json" + let !y = decode bs :: Maybe Value + return () diff --git a/components/succinct-json-examples/src/Example2.hs b/components/succinct-json-examples/src/Example2.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-examples/src/Example2.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE BangPatterns #-} + +{-# OPTIONS_GHC -fno-warn-unused-matches #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-unused-local-binds #-} + +module Example2 where + +import qualified HaskellWorks.Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Fast as JCF + +example :: IO () +example = do + !jsonBs <- BS.mmap "corpus/bench/hospitalisation.json" + let !ibip = JCF.simdToIbBp jsonBs + let !c = JCF.fromBsIbBp jsonBs ibip + return () diff --git a/components/succinct-json-examples/src/Example3.hs b/components/succinct-json-examples/src/Example3.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-examples/src/Example3.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-unused-matches #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-unused-local-binds #-} + +module Example3 where + +import Control.Monad + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Fast as JCF +import qualified HaskellWorks.Data.TreeCursor as TC + +example :: IO () +example = do + let fc = TC.firstChild + let ns = TC.nextSibling + let jsonBs = "[null, {\"field\": 1}]" :: BS.ByteString + let ibip = JCF.simdToIbBp jsonBs + let cursor = JCF.fromBsIbBp jsonBs ibip + let _ = fc cursor + let _ = (fc >=> ns) cursor + return () diff --git a/components/succinct-json-examples/src/Example4.hs b/components/succinct-json-examples/src/Example4.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-examples/src/Example4.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-unused-matches #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-unused-local-binds #-} + +module Example4 where + +import Control.Monad +import Data.Function +import Data.List +import Data.Succinct.Json.PartialValue +import Data.Succinct.Json.Standard.Cursor.Load.Cursor +import Data.Succinct.Json.Standard.Load.Partial +import Data.Succinct.MQuery +import Data.Succinct.MQuery.Micro + +import qualified Data.DList as DL + +{- HLINT ignore "Reduce duplication" -} + +example :: IO () +example = do + !cursor <- loadPartial "corpus/bench/78mb.json" + !cursor <- loadCursorWithIndex "corpus/bench/78mb.json" + !cursor <- loadCursor "corpus/bench/78mb.json" + !cursor <- loadCursorWithCsPoppyIndex "corpus/bench/78mb.json" + let !json = jsonPartialJsonValueAt cursor + let q = MQuery (DL.singleton json) + + putPretty $ q >>= item & limit 10 + putPretty $ q >>= item & page 10 1 + putPretty $ q >>= item >>= hasKV "founded_year" (JsonPartialNumber 2005) & limit 10 + putPretty $ q >>= item >>= entry + putPretty $ q >>= item >>= entry >>= named "name" & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code") + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code") & onList (uniq . sort) + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount") & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & aggregate sum + + putPretty $ q >>= item & limit 10 + putPretty $ q >>= item & page 10 1 + putPretty $ q >>= item >>= entry + putPretty $ q >>= item >>= entry >>= named "name" & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString) & onList (uniq . sort) + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount") & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & limit 10 + putPretty $ q >>= (item >=> entry >=> named "acquisition" >=> having (entry >=> named "price_currency_code" >=> asString >=> valueOf "USD") >=> entry >=> named "price_amount" >=> castAsInteger ) & aggregate sum + + return () diff --git a/components/succinct-json-simd/app/App/Commands.hs b/components/succinct-json-simd/app/App/Commands.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/app/App/Commands.hs @@ -0,0 +1,14 @@ +module App.Commands where + +import App.Commands.Capabilities +import App.Commands.CreateIndex +import Options.Applicative + +commands :: Parser (IO ()) +commands = commandsGeneral + +commandsGeneral :: Parser (IO ()) +commandsGeneral = subparser $ mempty + <> commandGroup "Commands:" + <> cmdCapabilities + <> cmdCreateIndex diff --git a/components/succinct-json-simd/app/App/Commands/Capabilities.hs b/components/succinct-json-simd/app/App/Commands/Capabilities.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/app/App/Commands/Capabilities.hs @@ -0,0 +1,24 @@ +module App.Commands.Capabilities + ( cmdCapabilities + ) where + +import Data.Succinct.Json.Simd.Index.Simple +import Data.Succinct.Json.Simd.Index.Standard +import Options.Applicative hiding (columns) + +import qualified System.IO as IO + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +runCapabilities :: () -> IO () +runCapabilities _ = do + IO.putStrLn "Capabalities:" + IO.putStrLn $ " standard indexing: " <> show enabledMakeStandardJsonIbBps + IO.putStrLn $ " simple indexing: " <> show enabledMakeSimpleJsonIbBps + +optsCapabilities :: Parser () +optsCapabilities = pure () + +cmdCapabilities :: Mod CommandFields (IO ()) +cmdCapabilities = command "capabilities" $ flip info idm $ runCapabilities <$> optsCapabilities diff --git a/components/succinct-json-simd/app/App/Commands/CreateIndex.hs b/components/succinct-json-simd/app/App/Commands/CreateIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/app/App/Commands/CreateIndex.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.CreateIndex + ( cmdCreateIndex + ) where + +import App.Commands.Types +import Control.Lens +import Control.Monad +import Data.Maybe +import Data.Succinct.Json.Simd.Index.Simple +import Data.Succinct.Json.Simd.Index.Standard +import Options.Applicative hiding (columns) + +import qualified App.Lens as L +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +import qualified System.Exit as IO +import qualified System.IO as IO + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +runCreateIndex :: CreateIndexOptions -> IO () +runCreateIndex opts = do + let filePath = opts ^. L.filePath + let outputIbFile = opts ^. L.outputIbFile & fromMaybe (filePath <> ".ib.idx") + let outputBpFile = opts ^. L.outputBpFile & fromMaybe (filePath <> ".bp.idx") + let method = opts ^. L.method + + case method of + "simple" -> do + IO.withFile filePath IO.ReadMode $ \hIn -> do + contents <- LBS.resegmentPadded 512 <$> LBS.hGetContents hIn + let chunks = makeSimpleJsonIbBpsUnsafe contents + IO.withFile outputIbFile IO.WriteMode $ \hIb -> do + IO.withFile outputBpFile IO.WriteMode $ \hBp -> do + forM_ chunks $ \(ibBs, bpBs) -> do + BS.hPut hIb ibBs + BS.hPut hBp bpBs + "standard" -> do + IO.withFile filePath IO.ReadMode $ \hIn -> do + contents <- LBS.resegmentPadded 512 <$> LBS.hGetContents hIn + case makeStandardJsonIbBps contents of + Right chunks -> do + IO.withFile outputIbFile IO.WriteMode $ \hIb -> do + IO.withFile outputBpFile IO.WriteMode $ \hBp -> do + forM_ chunks $ \(ibBs, bpBs) -> do + BS.hPut hIb ibBs + BS.hPut hBp bpBs + Left msg -> do + IO.hPutStrLn IO.stderr $ "Unable to create index: " <> show msg + IO.exitFailure + _ -> do + IO.hPutStrLn IO.stderr $ "Unrecognised method: " <> show method + IO.exitFailure + +optsCreateIndex :: Parser CreateIndexOptions +optsCreateIndex = CreateIndexOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input JSON file" + <> metavar "STRING" + ) + <*> optional + ( strOption + ( long "output-ib-file" + <> help "Filename for output ib index" + <> metavar "STRING" + ) + ) + <*> optional + ( strOption + ( long "output-bp-file" + <> help "Filename for output bp index" + <> metavar "STRING" + ) + ) + <*> strOption + ( long "method" + <> help "Method" + <> value "simple" + <> metavar "STRING" + ) + +cmdCreateIndex :: Mod CommandFields (IO ()) +cmdCreateIndex = command "create-index" $ flip info idm $ runCreateIndex <$> optsCreateIndex diff --git a/components/succinct-json-simd/app/App/Commands/Types.hs b/components/succinct-json-simd/app/App/Commands/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/app/App/Commands/Types.hs @@ -0,0 +1,10 @@ +module App.Commands.Types + ( CreateIndexOptions(..) + ) where + +data CreateIndexOptions = CreateIndexOptions + { _createIndexOptionsFilePath :: FilePath + , _createIndexOptionsOutputIbFile :: Maybe FilePath + , _createIndexOptionsOutputBpFile :: Maybe FilePath + , _createIndexOptionsMethod :: String + } deriving (Eq, Show) diff --git a/components/succinct-json-simd/app/App/Lens.hs b/components/succinct-json-simd/app/App/Lens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/app/App/Lens.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} + +module App.Lens where + +import App.Commands.Types +import Control.Lens + +makeFields ''CreateIndexOptions diff --git a/components/succinct-json-simd/app/Main.hs b/components/succinct-json-simd/app/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/app/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import App.Commands +import Control.Monad +import Options.Applicative + +main :: IO () +main = join $ customExecParser + (prefs $ showHelpOnEmpty <> showHelpOnError) + (info (commands <**> helper) idm) diff --git a/components/succinct-json-simd/cbits/debug.c b/components/succinct-json-simd/cbits/debug.c new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/cbits/debug.c @@ -0,0 +1,1 @@ +#include "debug.h" diff --git a/components/succinct-json-simd/cbits/simd-phi-table-32.c b/components/succinct-json-simd/cbits/simd-phi-table-32.c new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/cbits/simd-phi-table-32.c @@ -0,0 +1,38 @@ +#include "intrinsics.h" + +#include + +uint32_t hw_json_simd_phi_table_32[] = + { 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000007, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000007, 0x00000000, 0x00000007, 0x00000007, 0x00000000 + , 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007 + , 0x00000007, 0x00000007, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007 + , 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007 + , 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007 + , 0x00000007, 0x00000007, 0x00000007, 0x06000006, 0x00000000, 0x01000001, 0x00000000, 0x00000000 + , 0x00000000, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007 + , 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007 + , 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007, 0x00000007 + , 0x00000007, 0x00000007, 0x00000007, 0x06000006, 0x00000000, 0x01000001, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + , 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000, 0x00000000 + }; diff --git a/components/succinct-json-simd/cbits/simd-spliced.c b/components/succinct-json-simd/cbits/simd-spliced.c new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/cbits/simd-spliced.c @@ -0,0 +1,437 @@ +#include "intrinsics.h" + +#include +#include +#include + +#include "simd.h" + +#define W8_BUFFER_SIZE (1024 * 32) +#define W32_BUFFER_SIZE (W8_BUFFER_SIZE / 4) +#define W64_BUFFER_SIZE (W8_BUFFER_SIZE / 8) + +typedef struct hw_json_simd_bp_state { + uint64_t remainder_bits_d; + uint64_t remainder_bits_a; + uint64_t remainder_bits_z; + size_t remainder_len; +} hw_json_simd_bp_state_t; + +int hw_json_simd_main_spliced( + int argc, + char **argv) { + if (argc != 4) { + fprintf(stderr, "./a.out \n"); + exit(1); + } + + char *in_filename = argv[1]; + char *ib_out_filename = argv[2]; + char *bp_out_filename = argv[3]; + + FILE *in = fopen(in_filename, "r"); + + if (!in) { + fprintf(stderr, "Failed to open input file %s\n", in_filename); + exit(1); + } + + FILE *ib_out = fopen(ib_out_filename, "w"); + + if (!ib_out) { + fprintf(stderr, "Failed to open ib output file %s\n", ib_out_filename); + exit(1); + } + + FILE *bp_out = fopen(bp_out_filename, "w"); + + if (!bp_out) { + fprintf(stderr, "Failed to open bp output file %s\n", bp_out_filename); + exit(1); + } + + // align stack buffer on 32 bytes + uint8_t unaligned_buffer[W8_BUFFER_SIZE + 32]; + uint8_t * buffer = unaligned_buffer + ((uintptr_t)unaligned_buffer & (uintptr_t)0x10); + fprintf(stderr, "Buffer is at address %p of size %zu\n", buffer, (size_t) W8_BUFFER_SIZE); + + uint8_t *bits_of_d = malloc(W32_BUFFER_SIZE); memset(bits_of_d, 0, W32_BUFFER_SIZE); + uint8_t *bits_of_a = malloc(W32_BUFFER_SIZE); memset(bits_of_a, 0, W32_BUFFER_SIZE); + uint8_t *bits_of_z = malloc(W32_BUFFER_SIZE); memset(bits_of_z, 0, W32_BUFFER_SIZE); + uint8_t *bits_of_b = malloc(W32_BUFFER_SIZE); memset(bits_of_b, 0, W32_BUFFER_SIZE); + uint8_t *bits_of_e = malloc(W32_BUFFER_SIZE); memset(bits_of_e, 0, W32_BUFFER_SIZE); + uint8_t *bits_of_q = malloc(W32_BUFFER_SIZE); memset(bits_of_q, 0, W32_BUFFER_SIZE); + + uint8_t result_ib[W8_BUFFER_SIZE / 8]; + uint8_t result_a [W8_BUFFER_SIZE / 8]; + uint8_t result_z [W8_BUFFER_SIZE / 8]; + hw_json_simd_bp_state_t bp_state; + + uint64_t accum = 0; + + size_t last_trailing_ones = 0; + size_t total_bytes_read = 0; + uint64_t quote_mask_carry = 0; + size_t quote_odds_carry = 0; + size_t quote_evens_carry = 1; + + uint8_t out_bp_buffer[W32_BUFFER_SIZE * 2]; + + while (1) { + size_t bytes_read = fread(buffer, 1, W8_BUFFER_SIZE, in); + + total_bytes_read += bytes_read; + + if (bytes_read < W8_BUFFER_SIZE) { + if (ferror(in)) { + fprintf(stderr, "Error reading file\n"); + exit(1); + } + + if (bytes_read == 0) { + if (feof(in)) { + break; + } + } + + size_t next_alignment = ((bytes_read + 63) / 64) * 64; + + memset(buffer + bytes_read, 0, next_alignment - bytes_read); + + bytes_read = next_alignment; + } + + accum += hw_json_simd_process_chunk(buffer, bytes_read, + bits_of_d, + bits_of_a, + bits_of_z, + bits_of_q, + bits_of_b, + bits_of_e, + &last_trailing_ones, + "e_odds_carry, + "e_evens_carry, + "e_mask_carry, + result_ib, + result_a, + result_z); + + size_t ib_bytes = (bytes_read + 7) / 8; + + fwrite(result_ib, 1, ib_bytes, ib_out); + + size_t out_bp_bytes = hw_json_simd_write_bp_chunk( + result_ib, + result_a, + result_z, + ib_bytes, + &bp_state, + out_bp_buffer); + + fwrite(out_bp_buffer, out_bp_bytes, sizeof(uint64_t), bp_out); + + fflush(ib_out); + fflush(bp_out); + } + + hw_json_simd_write_bp_chunk_final(&bp_state, out_bp_buffer); + + fwrite(out_bp_buffer, 2, sizeof(uint64_t), bp_out); + + fclose(in); + fclose(ib_out); + + return 0; +} + +void hw_json_simd_init_bp_state( + hw_json_simd_bp_state_t *bp_state) { + memset(bp_state, 0, sizeof(*bp_state)); +} + +size_t hw_json_simd_write_bp_chunk( + uint8_t *result_ib, + uint8_t *result_a, + uint8_t *result_z, + size_t ib_bytes, + hw_json_simd_bp_state_t *bp_state, + uint8_t *out_buffer) { + uint64_t *w64_result_ib = (uint64_t *)result_ib; + uint64_t *w64_result_a = (uint64_t *)result_a; + uint64_t *w64_result_z = (uint64_t *)result_z; + uint64_t *w64_work_bp = (uint64_t *)out_buffer; + + uint64_t w64_len = ib_bytes / 8; + uint64_t remainder_bits_d = (*bp_state).remainder_bits_d; + uint64_t remainder_bits_a = (*bp_state).remainder_bits_a; + uint64_t remainder_bits_z = (*bp_state).remainder_bits_z; + size_t remainder_len = (*bp_state).remainder_len; + size_t w64s_ready = 0; + + for (size_t i = 0; i < w64_len; ++i) { + uint64_t w64_ib = w64_result_ib[i]; + uint64_t w64_a = w64_result_a[i]; + uint64_t w64_z = w64_result_z[i]; + + size_t pc_ib = __builtin_popcountll(w64_ib); + + uint64_t ext_d = _pext_u64(~(w64_a | w64_z) , w64_ib); + uint64_t ext_a = _pext_u64(w64_a , w64_ib); + uint64_t ext_z = _pext_u64(w64_z , w64_ib); + + remainder_bits_d |= (ext_d << remainder_len); + remainder_bits_a |= (ext_a << remainder_len); + remainder_bits_z |= (ext_z << remainder_len); + + if (remainder_len + pc_ib >= 64) { + // Write full word + w64_work_bp[w64s_ready] = + _pdep_u64(remainder_bits_a, 0x5555555555555555) | + _pdep_u64(remainder_bits_a, 0xaaaaaaaaaaaaaaaa) | + _pdep_u64(remainder_bits_d, 0xaaaaaaaaaaaaaaaa); + + w64s_ready += 1; + + remainder_bits_a = remainder_bits_a >> 32; + remainder_bits_z = remainder_bits_z >> 32; + remainder_bits_d = remainder_bits_d >> 32; + + w64_work_bp[w64s_ready] = + _pdep_u64(remainder_bits_a, 0x5555555555555555) | + _pdep_u64(remainder_bits_a, 0xaaaaaaaaaaaaaaaa) | + _pdep_u64(remainder_bits_d, 0xaaaaaaaaaaaaaaaa); + + w64s_ready += 1; + + // Set up for next iteration + remainder_bits_d = ext_d >> (64 - remainder_len); + remainder_bits_a = ext_a >> (64 - remainder_len); + remainder_bits_z = ext_z >> (64 - remainder_len); + + remainder_len = remainder_len + pc_ib - 64; + } else { + remainder_len += pc_ib; + } + } + + (*bp_state).remainder_bits_d = remainder_bits_d; + (*bp_state).remainder_bits_a = remainder_bits_a; + (*bp_state).remainder_bits_z = remainder_bits_z; + (*bp_state).remainder_len = remainder_len; + + return w64s_ready; +} + +size_t hw_json_simd_write_bp_chunk_final( + hw_json_simd_bp_state_t *bp_state, + uint8_t *out_buffer) { + uint64_t *w64_work_bp = (uint64_t *)out_buffer; + + uint64_t remainder_bits_d = (*bp_state).remainder_bits_d; + uint64_t remainder_bits_a = (*bp_state).remainder_bits_a; + uint64_t remainder_bits_z = (*bp_state).remainder_bits_z; + size_t w64s_ready = 0; + + // Write full word + w64_work_bp[w64s_ready] = + _pdep_u64(remainder_bits_a, 0x5555555555555555) | + _pdep_u64(remainder_bits_a, 0xaaaaaaaaaaaaaaaa) | + _pdep_u64(remainder_bits_d, 0xaaaaaaaaaaaaaaaa); + + w64s_ready += 1; + + remainder_bits_a = remainder_bits_a >> 32; + remainder_bits_z = remainder_bits_z >> 32; + remainder_bits_d = remainder_bits_d >> 32; + + w64_work_bp[w64s_ready] = + _pdep_u64(remainder_bits_a, 0x5555555555555555) | + _pdep_u64(remainder_bits_a, 0xaaaaaaaaaaaaaaaa) | + _pdep_u64(remainder_bits_d, 0xaaaaaaaaaaaaaaaa); + + w64s_ready += 1; + + return w64s_ready; +} + +uint8_t hw_json_simd_escape_mask[2][256] = + { { 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xef, 0xed, 0xeb, 0xef, 0xff, 0xfd, 0xef, 0xff + , 0xdf, 0xdd, 0xdb, 0xdf, 0xd7, 0xd5, 0xdf, 0xd7, 0xff, 0xfd, 0xfb, 0xff, 0xdf, 0xdd, 0xff, 0xdf + , 0xbf, 0xbd, 0xbb, 0xbf, 0xb7, 0xb5, 0xbf, 0xb7, 0xaf, 0xad, 0xab, 0xaf, 0xbf, 0xbd, 0xaf, 0xbf + , 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xbf, 0xbd, 0xbb, 0xbf, 0xff, 0xfd, 0xbf, 0xff + , 0x7f, 0x7d, 0x7b, 0x7f, 0x77, 0x75, 0x7f, 0x77, 0x6f, 0x6d, 0x6b, 0x6f, 0x7f, 0x7d, 0x6f, 0x7f + , 0x5f, 0x5d, 0x5b, 0x5f, 0x57, 0x55, 0x5f, 0x57, 0x7f, 0x7d, 0x7b, 0x7f, 0x5f, 0x5d, 0x7f, 0x5f + , 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xef, 0xed, 0xeb, 0xef, 0xff, 0xfd, 0xef, 0xff + , 0x7f, 0x7d, 0x7b, 0x7f, 0x77, 0x75, 0x7f, 0x77, 0xff, 0xfd, 0xfb, 0xff, 0x7f, 0x7d, 0xff, 0x7f + , 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xef, 0xed, 0xeb, 0xef, 0xff, 0xfd, 0xef, 0xff + , 0xdf, 0xdd, 0xdb, 0xdf, 0xd7, 0xd5, 0xdf, 0xd7, 0xff, 0xfd, 0xfb, 0xff, 0xdf, 0xdd, 0xff, 0xdf + , 0xbf, 0xbd, 0xbb, 0xbf, 0xb7, 0xb5, 0xbf, 0xb7, 0xaf, 0xad, 0xab, 0xaf, 0xbf, 0xbd, 0xaf, 0xbf + , 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xbf, 0xbd, 0xbb, 0xbf, 0xff, 0xfd, 0xbf, 0xff + , 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xef, 0xed, 0xeb, 0xef, 0xff, 0xfd, 0xef, 0xff + , 0xdf, 0xdd, 0xdb, 0xdf, 0xd7, 0xd5, 0xdf, 0xd7, 0xff, 0xfd, 0xfb, 0xff, 0xdf, 0xdd, 0xff, 0xdf + , 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xef, 0xed, 0xeb, 0xef, 0xff, 0xfd, 0xef, 0xff + , 0xff, 0xfd, 0xfb, 0xff, 0xf7, 0xf5, 0xff, 0xf7, 0xff, 0xfd, 0xfb, 0xff, 0xff, 0xfd, 0xff, 0xff + } + , { 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xee, 0xef, 0xea, 0xeb, 0xfe, 0xff, 0xee, 0xef + , 0xde, 0xdf, 0xda, 0xdb, 0xd6, 0xd7, 0xde, 0xdf, 0xfe, 0xff, 0xfa, 0xfb, 0xde, 0xdf, 0xfe, 0xff + , 0xbe, 0xbf, 0xba, 0xbb, 0xb6, 0xb7, 0xbe, 0xbf, 0xae, 0xaf, 0xaa, 0xab, 0xbe, 0xbf, 0xae, 0xaf + , 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xbe, 0xbf, 0xba, 0xbb, 0xfe, 0xff, 0xbe, 0xbf + , 0x7e, 0x7f, 0x7a, 0x7b, 0x76, 0x77, 0x7e, 0x7f, 0x6e, 0x6f, 0x6a, 0x6b, 0x7e, 0x7f, 0x6e, 0x6f + , 0x5e, 0x5f, 0x5a, 0x5b, 0x56, 0x57, 0x5e, 0x5f, 0x7e, 0x7f, 0x7a, 0x7b, 0x5e, 0x5f, 0x7e, 0x7f + , 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xee, 0xef, 0xea, 0xeb, 0xfe, 0xff, 0xee, 0xef + , 0x7e, 0x7f, 0x7a, 0x7b, 0x76, 0x77, 0x7e, 0x7f, 0xfe, 0xff, 0xfa, 0xfb, 0x7e, 0x7f, 0xfe, 0xff + , 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xee, 0xef, 0xea, 0xeb, 0xfe, 0xff, 0xee, 0xef + , 0xde, 0xdf, 0xda, 0xdb, 0xd6, 0xd7, 0xde, 0xdf, 0xfe, 0xff, 0xfa, 0xfb, 0xde, 0xdf, 0xfe, 0xff + , 0xbe, 0xbf, 0xba, 0xbb, 0xb6, 0xb7, 0xbe, 0xbf, 0xae, 0xaf, 0xaa, 0xab, 0xbe, 0xbf, 0xae, 0xaf + , 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xbe, 0xbf, 0xba, 0xbb, 0xfe, 0xff, 0xbe, 0xbf + , 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xee, 0xef, 0xea, 0xeb, 0xfe, 0xff, 0xee, 0xef + , 0xde, 0xdf, 0xda, 0xdb, 0xd6, 0xd7, 0xde, 0xdf, 0xfe, 0xff, 0xfa, 0xfb, 0xde, 0xdf, 0xfe, 0xff + , 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xee, 0xef, 0xea, 0xeb, 0xfe, 0xff, 0xee, 0xef + , 0xfe, 0xff, 0xfa, 0xfb, 0xf6, 0xf7, 0xfe, 0xff, 0xfe, 0xff, 0xfa, 0xfb, 0xfe, 0xff, 0xfe, 0xff + } + }; + +void hw_json_simd_summarise( + uint8_t *buffer, + uint32_t *out_mask_d, + uint32_t *out_mask_a, + uint32_t *out_mask_z, + uint32_t *out_mask_q, + uint32_t *out_mask_b) { +#ifdef __AVX2__ + __m256i v_in_data = *(__m256i *)buffer; + __m256i v_bytes_of_comma = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8(',')); + __m256i v_bytes_of_colon = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8(':')); + __m256i v_bytes_of_brace_a = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8('{')); + __m256i v_bytes_of_brace_z = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8('}')); + __m256i v_bytes_of_bracket_a = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8('[')); + __m256i v_bytes_of_bracket_z = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8(']')); + __m256i v_bytes_of_quote = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8('"')); + __m256i v_bytes_of_backslash = _mm256_cmpeq_epi8(v_in_data, _mm256_set1_epi8('\\')); + + uint32_t mask_comma = (uint32_t)_mm256_movemask_epi8(v_bytes_of_comma ); + uint32_t mask_colon = (uint32_t)_mm256_movemask_epi8(v_bytes_of_colon ); + uint32_t mask_brace_a = (uint32_t)_mm256_movemask_epi8(v_bytes_of_brace_a ); + uint32_t mask_brace_z = (uint32_t)_mm256_movemask_epi8(v_bytes_of_brace_z ); + uint32_t mask_bracket_a = (uint32_t)_mm256_movemask_epi8(v_bytes_of_bracket_a ); + uint32_t mask_bracket_z = (uint32_t)_mm256_movemask_epi8(v_bytes_of_bracket_z ); + + *out_mask_d = mask_comma | mask_colon; + *out_mask_a = mask_brace_a | mask_bracket_a; + *out_mask_z = mask_brace_z | mask_bracket_z; + *out_mask_q = (uint32_t)_mm256_movemask_epi8(v_bytes_of_quote ); + *out_mask_b = (uint32_t)_mm256_movemask_epi8(v_bytes_of_backslash); +#elif defined __SSE4_2__ + __m128i v_in_data_0 = *((__m128i *)buffer ); + __m128i v_in_data_1 = *((__m128i *)buffer + 1); + uint16_t *out_w32_mask_d = (uint16_t *)out_mask_d; + uint16_t *out_w32_mask_a = (uint16_t *)out_mask_a; + uint16_t *out_w32_mask_z = (uint16_t *)out_mask_z; + uint16_t *out_w32_mask_q = (uint16_t *)out_mask_q; + uint16_t *out_w32_mask_b = (uint16_t *)out_mask_b; + out_w32_mask_d[0] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)":,", 2, v_in_data_0, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_d[1] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)":,", 2, v_in_data_1, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_a[0] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"{[", 2, v_in_data_0, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_a[1] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"{[", 2, v_in_data_1, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_z[0] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"]}", 2, v_in_data_0, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_z[1] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"]}", 2, v_in_data_1, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_q[0] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"\"", 1, v_in_data_0, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_q[1] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"\"", 1, v_in_data_1, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_b[0] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"\\", 1, v_in_data_0, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); + out_w32_mask_b[1] = _mm_extract_epi16(_mm_cmpestrm(*(__m128i*)"\\", 1, v_in_data_1, 16, _SIDD_CMP_EQUAL_ANY | _SIDD_BIT_MASK), 0); +#else +#error "Require -mavx2 or -msse42 flags to be defined" +#endif +} + +uint64_t hw_json_simd_bitwise_add(uint64_t a, uint64_t b, uint64_t *c) { + uint64_t d = a + b + *c; + + *c = (d <= a) & 1; + + return d; +} + +uint64_t hw_json_simd_process_chunk( + uint8_t *in_buffer, + size_t in_length, + uint8_t *work_bits_of_d, // Working buffer of minimum length ((in_length + 63) / 64) + uint8_t *work_bits_of_a, // Working buffer of minimum length ((in_length + 63) / 64) + uint8_t *work_bits_of_z, // Working buffer of minimum length ((in_length + 63) / 64) + uint8_t *work_bits_of_q, // Working buffer of minimum length ((in_length + 63) / 64) + uint8_t *work_bits_of_b, // Working buffer of minimum length ((in_length + 63) / 64) + uint8_t *work_bits_of_e, // Working buffer of minimum length ((in_length + 63) / 64) + size_t *last_trailing_ones, + size_t *quote_odds_carry, + size_t *quote_evens_carry, + uint64_t *quote_mask_carry, + uint8_t *result_ib, + uint8_t *result_a, + uint8_t *result_z) { + size_t m256_in_len = in_length / 32; + size_t w64_out_len = in_length / 64; + size_t w8_out_len = in_length / 8; + + uint8_t *w8_bits_of_b = (uint8_t *)work_bits_of_b; + + uint32_t *w32_bits_of_d = (uint32_t *)work_bits_of_d; + uint32_t *w32_bits_of_a = (uint32_t *)work_bits_of_a; + uint32_t *w32_bits_of_z = (uint32_t *)work_bits_of_z; + uint32_t *w32_bits_of_q = (uint32_t *)work_bits_of_q; + uint32_t *w32_bits_of_b = (uint32_t *)work_bits_of_b; + + uint64_t *w64_bits_of_d = (uint64_t *)work_bits_of_d; + uint64_t *w64_bits_of_a = (uint64_t *)work_bits_of_a; + uint64_t *w64_bits_of_z = (uint64_t *)work_bits_of_z; + uint64_t *w64_bits_of_q = (uint64_t *)work_bits_of_q; + uint64_t *w64_bits_of_e = (uint64_t *)work_bits_of_e; + + uint64_t *w64_result_ib = (uint64_t *)result_ib; + uint64_t *w64_result_a = (uint64_t *)result_a; + uint64_t *w64_result_z = (uint64_t *)result_z; + + uint64_t accum = 0; + + for (size_t i = 0; i < m256_in_len; ++i) { + hw_json_simd_summarise(in_buffer + (i * 32), + w32_bits_of_d + i, + w32_bits_of_a + i, + w32_bits_of_z + i, + w32_bits_of_q + i, + w32_bits_of_b + i); + } + + for (size_t i = 0; i < w8_out_len; ++i) { + char w8 = w8_bits_of_b[i]; + size_t j = (*last_trailing_ones) % 2; + size_t k = (size_t)(uint8_t)w8; + char w8e = hw_json_simd_escape_mask[j][k]; + work_bits_of_e[i] = w8e; + *last_trailing_ones = _lzcnt_u64(~(int64_t)w8); + } + + for (size_t i = 0; i < w64_out_len; ++i) { + w64_bits_of_q[i] = w64_bits_of_e[i] & w64_bits_of_q[i]; + + uint64_t w64_bits_of_q_word = w64_bits_of_q[i]; + + uint64_t qas = _pdep_u64(0x5555555555555555 << ((*quote_odds_carry ) & 1), w64_bits_of_q_word); + uint64_t qzs = _pdep_u64(0x5555555555555555 << ((*quote_evens_carry) & 1), w64_bits_of_q_word); + + uint64_t quote_mask = hw_json_simd_bitwise_add(qas, ~qzs, quote_mask_carry); + + uint64_t w64_d = quote_mask & w64_bits_of_d[i]; + uint64_t w64_a = quote_mask & w64_bits_of_a[i]; + uint64_t w64_z = quote_mask & w64_bits_of_z[i]; + + w64_result_ib[i] = w64_d | w64_a | w64_z; + w64_result_a[i] = w64_a; + w64_result_z[i] = w64_z; + + size_t pc = __builtin_popcountll(w64_bits_of_q[i]); + *quote_odds_carry += pc; + *quote_evens_carry += pc; + } + + return accum; +} diff --git a/components/succinct-json-simd/cbits/simd-state.c b/components/succinct-json-simd/cbits/simd-state.c new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/cbits/simd-state.c @@ -0,0 +1,150 @@ +#include "debug.h" +#include "intrinsics.h" +#include "simd.h" + +#include +#include +#include +#include + +void +hw_json_simd_sm_process_chunk( + uint8_t *in_buffer, + size_t in_length, + uint32_t *inout_state, + uint32_t *out_phi_buffer) { + __m128i s = _mm_set_epi64x(0, *inout_state); + + for (size_t i = 0; i < in_length; i += 1) { + uint8_t w = in_buffer[i]; + __m128i p = _mm_shuffle_epi8(_mm_set1_epi32(hw_json_simd_phi_table_32[w]), s); + out_phi_buffer[i] = _mm_extract_epi32(p, 0); + s = _mm_shuffle_epi8(_mm_set1_epi32(hw_json_simd_transition_table_32[w]), s); + } + + *inout_state = (uint32_t)_mm_extract_epi32(s, 0); +} + +void +hw_json_simd_sm_make_ib_op_cl_chunks( + uint8_t state, + uint32_t *in_phis, + size_t phi_length, + uint8_t *out_ibs, + uint8_t *out_ops, + uint8_t *out_cls) { + uint32_t state_offset = state * 8; + + uint32_t ib_offset = 5; + uint32_t op_offset = 6; + uint32_t cl_offset = 7; + + for (size_t i = 0; i < phi_length; i += 8) { + __m256i v_8 = *(__m256i *)&in_phis[i]; + __m256i v_ib_8 = _mm256_slli_epi64(_mm256_srli_epi64(v_8, state_offset), ib_offset); + __m256i v_op_8 = _mm256_slli_epi64(_mm256_srli_epi64(v_8, state_offset), op_offset); + __m256i v_cl_8 = _mm256_slli_epi64(_mm256_srli_epi64(v_8, state_offset), cl_offset); + uint8_t all_ibs = (uint8_t)_pext_u32(_mm256_movemask_epi8(v_ib_8), 0x11111111); + uint8_t all_ops = (uint8_t)_pext_u32(_mm256_movemask_epi8(v_op_8), 0x11111111); + uint8_t all_cls = (uint8_t)_pext_u32(_mm256_movemask_epi8(v_cl_8), 0x11111111); + + size_t j = i / 8; + out_ibs[j] = all_ibs; + out_ops[j] = all_ops; + out_cls[j] = all_cls; + } +} + +size_t +hw_json_simd_sm_write_bits( + uint64_t bits, + size_t bits_len, + uint64_t *remaining_bits, + size_t *remaning_bits_len, + uint64_t *out_buffer); + +size_t +hw_json_simd_sm_write_bp_chunk( + uint8_t *result_op, + uint8_t *result_cl, + size_t ib_bytes, + uint64_t *remaining_bits, + size_t *remaning_bits_len, + uint64_t *out_buffer) { + uint64_t *w64_result_op = (uint64_t *)result_op; + uint64_t *w64_result_cl = (uint64_t *)result_cl; + uint64_t *w64_work_bp = (uint64_t *)out_buffer; + + uint64_t w64_len = ib_bytes / 8; + size_t w64s_ready = 0; + + for (size_t i = 0; i < w64_len; ++i) { + uint64_t w64_op = w64_result_op[i]; + uint64_t w64_cl = w64_result_cl[i]; + + uint64_t w64_op_lo = w64_op; + uint64_t w64_op_hi = w64_op >> 32; + + uint64_t w64_cl_lo = w64_cl; + uint64_t w64_cl_hi = w64_cl >> 32; + + uint64_t op_lo = _pdep_u64(w64_op_lo, 0x5555555555555555); + uint64_t cl_lo = _pdep_u64(w64_cl_lo, 0xaaaaaaaaaaaaaaaa); + uint64_t ib_lo = op_lo | cl_lo; + + uint64_t op_hi = _pdep_u64(w64_op_hi, 0x5555555555555555); + uint64_t cl_hi = _pdep_u64(w64_cl_hi, 0xaaaaaaaaaaaaaaaa); + uint64_t ib_hi = op_hi | cl_hi; + + size_t pc_ib_lo = __builtin_popcountll(ib_lo); + size_t pc_ib_hi = __builtin_popcountll(ib_hi); + + uint64_t ext_lo = _pext_u64(op_lo, ib_lo); + uint64_t ext_hi = _pext_u64(op_hi, ib_hi); + + w64s_ready += hw_json_simd_sm_write_bits(ext_lo, pc_ib_lo, remaining_bits, remaning_bits_len, w64_work_bp + w64s_ready); + w64s_ready += hw_json_simd_sm_write_bits(ext_hi, pc_ib_hi, remaining_bits, remaning_bits_len, w64_work_bp + w64s_ready); + } + + return w64s_ready; +} + +size_t +hw_json_simd_sm_write_bits( + uint64_t bits, + size_t bits_len, + uint64_t *remaining_bits, + size_t *remaining_bits_len, + uint64_t *out_buffer) { + *remaining_bits |= (bits << *remaining_bits_len); + + if (*remaining_bits_len + bits_len >= 64) { + *out_buffer = *remaining_bits; + + *remaining_bits = bits >> (64 - *remaining_bits_len); + + *remaining_bits_len = *remaining_bits_len + bits_len - 64; + + return 1; + } else { + *remaining_bits_len += bits_len; + + return 0; + } +} + +size_t +hw_json_simd_sm_write_bp_chunk_final( + uint64_t remaining_bits, + size_t remaining_bits_len, + uint64_t *out_buffer) { + if (remaining_bits_len > 0) { + size_t zero_len = 64 - remaining_bits_len; + + *out_buffer = (remaining_bits << zero_len) >> zero_len; + + return 1; + } else { + return 0; + } +} diff --git a/components/succinct-json-simd/cbits/simd-transition-table-32.c b/components/succinct-json-simd/cbits/simd-transition-table-32.c new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/cbits/simd-transition-table-32.c @@ -0,0 +1,38 @@ +#include "intrinsics.h" + +#include + +uint32_t hw_json_simd_transition_table_32[] = + { 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010001, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x03010103, 0x00010100, 0x03010103, 0x03010103, 0x00010100 + , 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103 + , 0x03010103, 0x03010103, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103 + , 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103 + , 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103 + , 0x03010103, 0x03010103, 0x03010103, 0x00010100, 0x00010200, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103 + , 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103 + , 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103, 0x03010103 + , 0x03010103, 0x03010103, 0x03010103, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + , 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100, 0x00010100 + }; diff --git a/components/succinct-json-simd/cbits/simd.c b/components/succinct-json-simd/cbits/simd.c new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/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 +} diff --git a/components/succinct-json-simd/doctest/DoctestDriver.hs b/components/succinct-json-simd/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-json-simd/doctest/config.json #-} +#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/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Capabilities.hs b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Capabilities.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Capabilities.hs @@ -0,0 +1,16 @@ +module Data.Succinct.Json.Simd.Capabilities where + +import qualified Data.Succinct.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 #-} diff --git a/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Index/Simple.hs b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Index/Simple.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Index/Simple.hs @@ -0,0 +1,145 @@ +module Data.Succinct.Json.Simd.Index.Simple + ( makeSimpleJsonIbBps + , makeSimpleJsonIbBpsUnsafe + , enabledMakeSimpleJsonIbBps + ) where + +import Control.Monad.ST +import Data.Word +import Data.Succinct.Json.Simd.Internal.Index.Simple + +import qualified Control.Monad.ST.Unsafe as ST +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector.Storable.Mutable as DVSM +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 Data.Succinct.Json.Simd.Capabilities as C +import qualified Data.Succinct.Json.Simd.Internal.Foreign as F +import qualified Data.Succinct.Json.Simd.Internal.List as L +import qualified System.IO.Unsafe as IO + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +makeSimpleJsonIbBps :: LBS.ByteString -> Either String [(BS.ByteString, BS.ByteString)] +makeSimpleJsonIbBps lbs = if enabledMakeSimpleJsonIbBps + then Right (makeSimpleJsonIbBpsUnsafe lbs) + else Left "makeSimpleJsonIbBps function is disabled" + +makeSimpleJsonIbBpsUnsafe :: LBS.ByteString -> [(BS.ByteString, BS.ByteString)] +makeSimpleJsonIbBpsUnsafe lbs = L.zipPadded BS.empty BS.empty ibs bps + where chunks = makeIbs lbs + ibs = fmap (\(a, _, _) -> a) chunks + bps = ibsToIndexByteStrings chunks + +makeIbs :: LBS.ByteString -> [(BS.ByteString, BS.ByteString, BS.ByteString)] +makeIbs lbs = F.unsafeLocalState $ do + wb <- allocWorkBuffers (32 * 1024 * 1204) + ws <- allocWorkState + IO.unsafeInterleaveIO $ go wb ws (LBS.toChunks lbs) + where go :: WorkBuffers -> WorkState -> [BS.ByteString] -> IO [(BS.ByteString, BS.ByteString, BS.ByteString)] + go _ _ [] = return [] + go wb ws (bs:bss) = do + let resLen = BS.length bs `div` 8 + resIbFptr <- F.mallocForeignPtrBytes resLen + resAFptr <- F.mallocForeignPtrBytes resLen + resBFptr <- F.mallocForeignPtrBytes resLen + let resIbPtr = F.castPtr (F.unsafeForeignPtrToPtr resIbFptr) + let resAPtr = F.castPtr (F.unsafeForeignPtrToPtr resAFptr ) + let resBPtr = F.castPtr (F.unsafeForeignPtrToPtr resBFptr ) + let (bsFptr, bsOff, bsLen) = BSI.toForeignPtr bs + let bsPtr = F.castPtr (F.unsafeForeignPtrToPtr bsFptr) + _ <- F.processChunk + (F.plusPtr bsPtr bsOff) -- in_buffer: Ptr UInt8 + (fromIntegral bsLen) -- in_length: Size + (workBuffersD wb) -- work_bits_of_d: Ptr UInt8 + (workBuffersA wb) -- work_bits_of_a: Ptr UInt8 + (workBuffersZ wb) -- work_bits_of_z: Ptr UInt8 + (workBuffersQ wb) -- work_bits_of_q: Ptr UInt8 + (workBuffersB wb) -- work_bits_of_b: Ptr UInt8 + (workBuffersE wb) -- work_bits_of_e: Ptr UInt8 + (workStateZ ws) -- last_trailing_ones: Ptr Size + (workStateO ws) -- quote_odds_carry: Ptr Size + (workStateE ws) -- quote_evens_carry: Ptr Size + (workStateM ws) -- quote_mask_carry: Ptr UInt64 + resIbPtr -- result_ibs: Ptr UInt8 + resAPtr -- result_a: Ptr UInt8 + resBPtr -- result_z: Ptr UInt8 + let r = + ( BSI.fromForeignPtr resIbFptr 0 resLen + , BSI.fromForeignPtr resAFptr 0 resLen + , BSI.fromForeignPtr resBFptr 0 resLen + ) + rs <- IO.unsafeInterleaveIO $ go wb ws bss + return (r:rs) + +ibsToIndexByteStrings :: () + => [(BS.ByteString, BS.ByteString, BS.ByteString)] + -> [BS.ByteString] +ibsToIndexByteStrings bits = F.unsafeLocalState $ do + bpState <- emptyBpState + IO.unsafeInterleaveIO $ go bpState (fmap (\(a, b, c) -> mkIndexStep a b c) bits) + where go :: () + => BpState + -> [Step] + -> IO [BS.ByteString] + go s (step:steps) = do + let bp = stepToByteString s step + bps <- IO.unsafeInterleaveIO $ go s steps + return $ bp:bps + go s [] = return [stepToByteString s indexStepFinal] + +mkIndexStep :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Step +mkIndexStep is as zs | isLen == asLen && asLen == zsLen = Step go isLen + where isLen = BS.length is + asLen = BS.length as + zsLen = BS.length zs + (isFptr, _, _) = BSI.toForeignPtr is + (asFptr, _, _) = BSI.toForeignPtr as + (zsFptr, _, _) = BSI.toForeignPtr zs + go :: BpState + -> DVSM.MVector s Word64 + -> ST s Int + go bpState bpvm = fmap fromIntegral . ST.unsafeIOToST $ do + let (outFptr, _, _) = DVSM.unsafeToForeignPtr bpvm + + F.withForeignPtr outFptr $ \outPtr -> + F.withForeignPtr isFptr $ \isPtr -> + F.withForeignPtr asFptr $ \asPtr -> + F.withForeignPtr zsFptr $ \zsPtr -> + F.withForeignPtr (bpStateP bpState) $ \bpStatePtr -> do + F.writeBpChunk + (F.castPtr isPtr) + (F.castPtr asPtr) + (F.castPtr zsPtr) + (fromIntegral (BS.length is)) + (F.castPtr bpStatePtr) + (F.castPtr outPtr) +mkIndexStep _ _ _ = error "Mismatched input size" + +indexStepFinal :: Step +indexStepFinal = Step go 2 + where go :: BpState + -> DVSM.MVector s Word64 + -> ST s Int + go bpState bpvm = fmap fromIntegral . ST.unsafeIOToST $ do + let (outFptr, _, _) = DVSM.unsafeToForeignPtr bpvm + + F.withForeignPtr outFptr $ \outPtr -> + F.withForeignPtr (bpStateP bpState) $ \bpStatePtr -> do + F.writeBpChunkFinal (F.castPtr bpStatePtr) (F.castPtr outPtr) + +stepToByteString :: BpState -> Step -> BS.ByteString +stepToByteString state (Step step size) = F.unsafeLocalState $ do + let bsSize = size * 8 + bpFptr <- BSI.mallocByteString bsSize + let bpVm = DVSM.unsafeFromForeignPtr (F.castForeignPtr bpFptr) 0 size + w64Size <- stToIO $ step state bpVm + return (BSI.PS bpFptr 0 (w64Size * 8)) + +enabledMakeSimpleJsonIbBps :: Bool +enabledMakeSimpleJsonIbBps = C.avx_2 && C.sse_4_2 && C.bmi_2 diff --git a/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Index/Standard.hs b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Index/Standard.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Index/Standard.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Json.Simd.Index.Standard + ( makeStandardJsonIbBps + , makeStandardJsonIbBpsUnsafe + , enabledMakeStandardJsonIbBps + ) where + +import Control.Monad +import Data.Word +import Data.Succinct.Json.Simd.Internal.Index.Standard + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Lazy as LBS +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 Foreign.Storable as F +import qualified Data.Succinct.Json.Simd.Capabilities as C +import qualified Data.Succinct.Json.Simd.Internal.Foreign as F +import qualified System.IO.Unsafe as IO + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +makeStandardJsonIbBps :: LBS.ByteString -> Either String [(BS.ByteString, BS.ByteString)] +makeStandardJsonIbBps lbs = if enabledMakeStandardJsonIbBps + then Right (makeStandardJsonIbBpsUnsafe lbs) + else Left "makeStandardJsonIbBps function is disabled" + +makeStandardJsonIbBpsUnsafe :: LBS.ByteString -> [(BS.ByteString, BS.ByteString)] +makeStandardJsonIbBpsUnsafe lbs = F.unsafeLocalState $ do + wb <- allocWorkBuffers (32 * 1024 * 1204) + ws <- newWorkState 0 + fptrState :: F.ForeignPtr F.UInt32 <- F.mallocForeignPtr + fptrRemBits :: F.ForeignPtr F.UInt64 <- F.mallocForeignPtr + fptrRemBitsLen :: F.ForeignPtr F.Size <- F.mallocForeignPtr + let ptrState = F.unsafeForeignPtrToPtr fptrState + let ptrRemBits = F.unsafeForeignPtrToPtr fptrRemBits + let ptrRemBitsLen = F.unsafeForeignPtrToPtr fptrRemBitsLen + F.poke ptrState 0 + F.poke ptrRemBits 0 + F.poke ptrRemBitsLen 0 + IO.unsafeInterleaveIO $ go wb ws fptrState fptrRemBits fptrRemBitsLen (LBS.toChunks lbs) + where go :: () + => WorkBuffers + -> WorkState + -> F.ForeignPtr F.UInt32 + -> F.ForeignPtr F.UInt64 + -> F.ForeignPtr F.Size + -> [BS.ByteString] + -> IO [(BS.ByteString, BS.ByteString)] + go _ _ _ fptrRemBits fptrRemBitsLen [] = do + resBpFptr <- F.mallocForeignPtrBytes 8 + let resBpPtr = F.castPtr (F.unsafeForeignPtrToPtr resBpFptr ) + let ptrRemBits = F.unsafeForeignPtrToPtr fptrRemBits + let ptrRemBitsLen = F.unsafeForeignPtrToPtr fptrRemBitsLen + remBits <- F.peek ptrRemBits + remBitsLen <- F.peek ptrRemBitsLen + bpByteLen <- F.smWriteBpChunkFinal + remBits -- remaining_bp_bits + remBitsLen -- remaning_bp_bits_len + resBpPtr -- out_buffer + return [ ( BS.empty + , BSI.fromForeignPtr resBpFptr 0 (fromIntegral bpByteLen * 8) + ) + ] + go wb ws fptrState fptrRemBits fptrRemBitsLen (bs:bss) = do + let (!bsFptr, !bsOff, !bsLen) = BSI.toForeignPtr bs + let !idxByteLen = (bsLen + 7) `div` 8 + resIbFptr <- F.mallocForeignPtrBytes idxByteLen + resBpFptr <- F.mallocForeignPtrBytes idxByteLen + let resIbPtr = F.castPtr (F.unsafeForeignPtrToPtr resIbFptr ) + let resBpPtr = F.castPtr (F.unsafeForeignPtrToPtr resBpFptr ) + let bsPtr = F.castPtr (F.unsafeForeignPtrToPtr bsFptr) + let ptrState = F.unsafeForeignPtrToPtr fptrState + let ptrRemBits = F.unsafeForeignPtrToPtr fptrRemBits + let ptrRemBitsLen = F.unsafeForeignPtrToPtr fptrRemBitsLen + s :: Word8 <- fromIntegral <$> F.peek ptrState + void $ F.smProcessChunk + (F.plusPtr bsPtr bsOff) -- in_buffer: Ptr UInt8 + (fromIntegral bsLen) -- in_length: Size + ptrState -- work state: Ptr UInt32 + (workBuffersP wb) -- result_phi: Ptr UInt8 + void $ F.smMakeIbOpClChunks + (fromIntegral s) -- state + (workBuffersP wb) -- in_phis + (fromIntegral bsLen) -- phi_length + resIbPtr -- out_ibs + (workBuffersO wb) -- out_ops + (workBuffersC wb) -- out_cls + bpByteLen <- F.smWriteBpChunk + (workBuffersO wb) -- result_op + (workBuffersC wb) -- result_cl + (fromIntegral idxByteLen) -- ib_bytes + ptrRemBits -- remaining_bp_bits + ptrRemBitsLen -- remaning_bp_bits_len + resBpPtr -- out_buffer + let !r = + ( BSI.fromForeignPtr resIbFptr 0 idxByteLen + , BSI.fromForeignPtr resBpFptr 0 (fromIntegral bpByteLen * 8) + ) + rs <- IO.unsafeInterleaveIO $ go wb ws fptrState fptrRemBits fptrRemBitsLen bss + return (r:rs) + +enabledMakeStandardJsonIbBps :: Bool +enabledMakeStandardJsonIbBps = C.avx_2 && C.sse_4_2 && C.bmi_2 diff --git a/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Foreign.chs b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Foreign.chs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Foreign.chs @@ -0,0 +1,108 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module Data.Succinct.Json.Simd.Internal.Foreign where + +import Foreign + +#include "../../../components/succinct-json-simd/cbits/simd.h" + +type UInt8 = {#type uint8_t #} +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 + -> Ptr UInt8 -- work_bits_of_d + -> Ptr UInt8 -- work_bits_of_a + -> Ptr UInt8 -- work_bits_of_z + -> Ptr UInt8 -- work_bits_of_q + -> Ptr UInt8 -- work_bits_of_b + -> Ptr UInt8 -- work_bits_of_e + -> Ptr Size -- last_trailing_ones + -> Ptr Size -- quote_odds_carry + -> Ptr Size -- quote_evens_carry + -> Ptr UInt64 -- quote_mask_carry + -> Ptr UInt8 -- result_ibs + -> Ptr UInt8 -- result_a + -> Ptr UInt8 -- result_z + -> IO UInt64 +processChunk = do + {#call unsafe hw_json_simd_process_chunk as c_hw_json_simd_process_chunk#} +{-# INLINE processChunk #-} + +initBpState :: () + => Ptr () + -> IO () +initBpState = {#call unsafe hw_json_simd_init_bp_state as c_hw_json_simd_init_bp_state#} +{-# INLINE initBpState #-} + +writeBpChunk :: () + => Ptr UInt8 -- result_ib + -> Ptr UInt8 -- result_a + -> Ptr UInt8 -- result_z + -> Size -- ib_bytes + -> Ptr () -- bp_state + -> Ptr UInt8 -- out_buffer + -> IO Size +writeBpChunk = {#call unsafe hw_json_simd_write_bp_chunk as c_hw_json_simd_write_bp_chunk#} +{-# INLINE writeBpChunk #-} + +writeBpChunkFinal :: () + => Ptr () -- bp_state + -> Ptr UInt8 -- out_buffer + -> IO Size +writeBpChunkFinal = {#call unsafe hw_json_simd_write_bp_chunk_final as c_hw_json_simd_write_bp_chunk_final#} +{-# INLINE writeBpChunkFinal #-} + +smProcessChunk :: () + => Ptr UInt8 -- in_buffer + -> Size -- in_length + -> Ptr UInt32 -- inout_state + -> Ptr UInt32 -- out_phi_buffer + -> IO () +smProcessChunk = {#call unsafe hw_json_simd_sm_process_chunk as c_hw_json_simd_sm_process_chunk#} + +smMakeIbOpClChunks :: () + => UInt8 -- state + -> Ptr UInt32 -- in_phis + -> Size -- phi_length + -> Ptr UInt8 -- out_ibs + -> Ptr UInt8 -- out_ops + -> Ptr UInt8 -- out_cls + -> IO () +smMakeIbOpClChunks = {#call unsafe hw_json_simd_sm_make_ib_op_cl_chunks as c_hw_json_simd_sm_make_ib_op_cl_chunks#} + +smWriteBpChunk :: () + => Ptr UInt8 -- result_op + -> Ptr UInt8 -- result_cl + -> Size -- ib_bytes + -> Ptr UInt64 -- remaining_bp_bits + -> Ptr Size -- remaning_bp_bits_len + -> Ptr UInt64 -- out_buffer + -> IO Size +smWriteBpChunk = {#call unsafe hw_json_simd_sm_write_bp_chunk as c_hw_json_simd_sm_write_bp_chunk#} + +smWriteBpChunkFinal :: () + => UInt64 -- remaining_bits + -> Size -- remaining_bits_len + -> Ptr UInt64 -- out_buffer + -> IO Size +smWriteBpChunkFinal = {#call unsafe hw_json_simd_sm_write_bp_chunk_final as c_hw_json_simd_sm_write_bp_chunk_final#} diff --git a/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Index/Simple.hs b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Index/Simple.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Index/Simple.hs @@ -0,0 +1,79 @@ +module Data.Succinct.Json.Simd.Internal.Index.Simple where + +import Control.Monad.ST +import Data.Word +import Foreign + +import qualified Data.Vector.Storable.Mutable as DVSM +import qualified Foreign as F +import qualified Foreign.ForeignPtr.Unsafe as F +import qualified Data.Succinct.Json.Simd.Internal.Foreign as F + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +data WorkBuffers = WorkBuffers + { workBuffersP :: !(ForeignPtr F.UInt8) + , workBuffersD :: !(Ptr F.UInt8) + , workBuffersA :: !(Ptr F.UInt8) + , workBuffersZ :: !(Ptr F.UInt8) + , workBuffersQ :: !(Ptr F.UInt8) + , workBuffersB :: !(Ptr F.UInt8) + , workBuffersE :: !(Ptr F.UInt8) + } + +data WorkState = WorkState + { workStateZ :: !(Ptr F.Size) + , workStateO :: !(Ptr F.Size) + , workStateE :: !(Ptr F.Size) + , workStateM :: !(Ptr F.UInt64) + , workStateP :: !(ForeignPtr Word8) + } + +newtype BpState = BpState + { bpStateP :: ForeignPtr Word8 + } + +data Step where + Step :: ( forall s + . BpState + -> DVSM.MVector s Word64 + -> ST s Int) + -> Int + -> Step + +emptyBpState :: IO BpState +emptyBpState = do + fptr <- F.mallocForeignPtrBytes 32 + return (BpState (F.castForeignPtr fptr)) + +allocWorkBuffers :: Int -> IO WorkBuffers +allocWorkBuffers n = do + fptr <- F.mallocForeignPtrBytes (6 * n) + let ptr = F.unsafeForeignPtrToPtr fptr + return WorkBuffers + { workBuffersP = fptr + , workBuffersD = ptr `F.plusPtr` 0 + , workBuffersA = ptr `F.plusPtr` n + , workBuffersZ = ptr `F.plusPtr` (n * 2) + , workBuffersQ = ptr `F.plusPtr` (n * 3) + , workBuffersB = ptr `F.plusPtr` (n * 4) + , workBuffersE = ptr `F.plusPtr` (n * 5) + } + +allocWorkState :: IO WorkState +allocWorkState = do + fptr <- F.mallocForeignPtrBytes 256 + let ptr = F.unsafeForeignPtrToPtr fptr + let ws = WorkState + { workStateZ = ptr `F.plusPtr` 0 + , workStateO = ptr `F.plusPtr` 8 + , workStateE = ptr `F.plusPtr` (8 * 2) + , workStateM = ptr `F.plusPtr` (8 * 3) + , workStateP = fptr + } + F.poke (workStateZ ws) 0 + F.poke (workStateO ws) 0 + F.poke (workStateE ws) 1 + F.poke (workStateM ws) 0 + return ws diff --git a/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Index/Standard.hs b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Index/Standard.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/Index/Standard.hs @@ -0,0 +1,51 @@ +module Data.Succinct.Json.Simd.Internal.Index.Standard where + +import Data.Word +import Foreign + +import qualified Foreign as F +import qualified Foreign.ForeignPtr.Unsafe as F +import qualified Data.Succinct.Json.Simd.Internal.Foreign as F +import qualified HaskellWorks.Foreign as F + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +data WorkBuffers = WorkBuffers + { workBuffersF :: !(ForeignPtr F.UInt8) + , workBuffersP :: !(Ptr F.UInt32) + , workBuffersO :: !(Ptr F.UInt8) + , workBuffersC :: !(Ptr F.UInt8) + } + +data WorkState = WorkState + { workStateFptr :: !(ForeignPtr Word8) + , workStateRemBits :: !(Ptr F.UInt64) + , workStateRemBitsLen :: !(Ptr F.Size) + , workStateState :: !(Ptr F.UInt32) + } + +allocWorkBuffers :: Int -> IO WorkBuffers +allocWorkBuffers n = do + (fptr, ptr) <- F.mallocForeignPtrBytesWithAlignedCastPtr 32 (3 * n) + return WorkBuffers + { workBuffersF = fptr + , workBuffersP = ptr `F.plusPtr` 0 + , workBuffersO = ptr `F.plusPtr` n + , workBuffersC = ptr `F.plusPtr` (n * 2) + } + +newWorkState :: Word32 -> IO WorkState +newWorkState initialValue = do + fptr <- F.mallocForeignPtrBytes 256 + let ptr = F.unsafeForeignPtrToPtr fptr + let ws = WorkState + { workStateState = ptr `F.plusPtr` 0 + , workStateRemBits = ptr `F.plusPtr` 8 + , workStateRemBitsLen = ptr `F.plusPtr` 16 + , workStateFptr = fptr + } + F.poke (workStateState ws) (fromIntegral initialValue) + F.poke (workStateRemBits ws) 0 + F.poke (workStateRemBitsLen ws) 0 + return ws diff --git a/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/List.hs b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/List.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/src/Data/Succinct/Json/Simd/Internal/List.hs @@ -0,0 +1,9 @@ +module Data.Succinct.Json.Simd.Internal.List + ( zipPadded + ) where + +zipPadded :: a -> b -> [a] -> [b] -> [(a, b)] +zipPadded a b (c:cs) (d:ds) = (c, d):zipPadded a b cs ds +zipPadded a b [] (d:ds) = (a, d):zipPadded a b [] ds +zipPadded a b (c:cs) [] = (c, b):zipPadded a b cs [] +zipPadded _ _ [] [] = [] diff --git a/components/succinct-json-simd/test/Spec.hs b/components/succinct-json-simd/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simd/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/components/succinct-json-simple-cursor/app/App/Commands.hs b/components/succinct-json-simple-cursor/app/App/Commands.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/app/App/Commands.hs @@ -0,0 +1,12 @@ +module App.Commands where + +import App.Commands.CreateIndex +import Options.Applicative + +commands :: Parser (IO ()) +commands = commandsGeneral + +commandsGeneral :: Parser (IO ()) +commandsGeneral = subparser $ mempty + <> commandGroup "Commands:" + <> cmdCreateIndex diff --git a/components/succinct-json-simple-cursor/app/App/Commands/CreateIndex.hs b/components/succinct-json-simple-cursor/app/App/Commands/CreateIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/app/App/Commands/CreateIndex.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE BangPatterns #-} + +module App.Commands.CreateIndex + ( cmdCreateIndex + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Maybe +import Data.Word +import Foreign +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Succinct.Json.Simple.Cursor.SemiIndex as SISI +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +import qualified System.IO.MMap as IO + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +runCreateIndex :: Z.CreateIndexOptions -> IO () +runCreateIndex opts = do + let filePath = opts ^. the @"filePath" + let outputIbFile = opts ^. the @"outputIbFile" & fromMaybe (filePath <> ".ib.idx") + let outputBpFile = opts ^. the @"outputBpFile" & fromMaybe (filePath <> ".bp.idx") + (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + let SISI.SemiIndex _ ibs bps = SISI.buildSemiIndex bs + LBS.writeFile outputIbFile (LBS.toLazyByteString ibs) + LBS.writeFile outputBpFile (LBS.toLazyByteString bps) + +optsCreateIndex :: Parser Z.CreateIndexOptions +optsCreateIndex = Z.CreateIndexOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input JSON file" + <> metavar "STRING" + ) + <*> strOption + ( long "backend" + <> short 'b' + <> value "standard" + <> help "Backend for creating index" + <> metavar "STRING" + ) + <*> optional + ( strOption + ( long "output-ib-file" + <> help "Filename for output ib index" + <> metavar "STRING" + ) + ) + <*> optional + ( strOption + ( long "output-bp-file" + <> help "Filename for output bp index" + <> metavar "STRING" + ) + ) + +cmdCreateIndex :: Mod CommandFields (IO ()) +cmdCreateIndex = command "create-index" $ flip info idm $ runCreateIndex <$> optsCreateIndex diff --git a/components/succinct-json-simple-cursor/app/App/Commands/Types.hs b/components/succinct-json-simple-cursor/app/App/Commands/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/app/App/Commands/Types.hs @@ -0,0 +1,12 @@ +module App.Commands.Types + ( CreateIndexOptions(..) + ) where + +import GHC.Generics + +data CreateIndexOptions = CreateIndexOptions + { filePath :: FilePath + , backend :: String + , outputIbFile :: Maybe FilePath + , outputBpFile :: Maybe FilePath + } deriving (Eq, Show, Generic) diff --git a/components/succinct-json-simple-cursor/app/Main.hs b/components/succinct-json-simple-cursor/app/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/app/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import App.Commands +import Control.Monad +import Options.Applicative + +main :: IO () +main = join $ customExecParser + (prefs $ showHelpOnEmpty <> showHelpOnError) + (info (commands <**> helper) idm) diff --git a/components/succinct-json-simple-cursor/bench/Main.hs b/components/succinct-json-simple-cursor/bench/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/bench/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Criterion.Main + +main :: IO () +main = do + benchmarks <- fmap mconcat $ sequence $ mempty + defaultMain benchmarks diff --git a/components/succinct-json-simple-cursor/doctest/DoctestDriver.hs b/components/succinct-json-simple-cursor/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-json-simple-cursor/doctest/config.json #-} +#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/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor.hs b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor.hs @@ -0,0 +1,84 @@ +module Data.Succinct.Json.Simple.Cursor + ( JsonCursor(..) + , jsonCursorPos + ) where + +import Data.String +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy +import Data.Word +import HaskellWorks.Data.FromByteString +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.TreeCursor +import Prelude hiding (drop) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Internal as BSI +import qualified Data.Vector.Storable as DVS +import qualified Foreign.ForeignPtr as F +import qualified Data.Succinct.BalancedParens as BP +import qualified Data.Succinct.BalancedParens.RangeMin as RM +import qualified Data.Succinct.Json.Simple.Cursor.SemiIndex as SI + +data JsonCursor t v w = JsonCursor + { cursorText :: !t + , interests :: !v + , balancedParens :: !w + , cursorRank :: !Count + } + deriving (Eq, Show) + +instance FromByteString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromByteString bs = JsonCursor + { cursorText = bs + , interests = ib + , balancedParens = BP.SimpleBalancedParens bp + , cursorRank = 1 + } + where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs + +instance FromByteString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where + fromByteString bs = JsonCursor + { cursorText = bs + , interests = makeCsPoppy ib + , balancedParens = RM.mkRangeMin (makeCsPoppy bp) + , cursorRank = 1 + } + where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs + +instance FromForeignRegion (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) + +instance FromForeignRegion (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) + +instance IsString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromString = fromByteString . BSC.pack + +instance IsString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where + fromString = fromByteString . BSC.pack + +instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where + firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u) + firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + nextSibling :: JsonCursor t v u -> Maybe (JsonCursor t v u) + nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) + + parent :: JsonCursor t v u -> Maybe (JsonCursor t v u) + parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + depth :: JsonCursor t v u -> Maybe Count + depth k = BP.depth (balancedParens k) (cursorRank k) + + subtreeSize :: JsonCursor t v u -> Maybe Count + subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) + +jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position +jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) + where ik = interests k + bpk = balancedParens k diff --git a/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Fast.hs b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Fast.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Fast.hs @@ -0,0 +1,32 @@ +module Data.Succinct.Json.Simple.Cursor.Fast + ( fromByteString + , fromForeignRegion + , fromString + ) where + +import Foreign.ForeignPtr +import Data.Succinct.Json.Simple.Cursor +import Data.Succinct.RankSelect.CsPoppy + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Internal as BSI +import qualified Data.Succinct.BalancedParens.RangeMin as RM +import qualified Data.Succinct.Json.Simple.Cursor.Internal.IbBp as J +import qualified Data.Succinct.Json.Simple.Cursor.Internal.ToIbBp as J +import qualified HaskellWorks.Data.FromForeignRegion as F + +fromByteString :: BS.ByteString -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromByteString bs = JsonCursor + { cursorText = bs + , interests = makeCsPoppy ib + , balancedParens = RM.mkRangeMin (makeCsPoppy bp) + , cursorRank = 1 + } + where J.IbBp ib bp = J.toIbBp bs + +fromForeignRegion :: F.ForeignRegion -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +fromString :: String -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromString = fromByteString . BSC.pack diff --git a/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/IbBp.hs b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/IbBp.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/IbBp.hs @@ -0,0 +1,10 @@ +module Data.Succinct.Json.Simple.Cursor.Internal.IbBp where + +import Data.Word + +import qualified Data.Vector.Storable as DVS + +data IbBp = IbBp + { ib :: DVS.Vector Word64 + , bp :: DVS.Vector Word64 + } diff --git a/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/ToIbBp.hs b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/ToIbBp.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/ToIbBp.hs @@ -0,0 +1,12 @@ +module Data.Succinct.Json.Simple.Cursor.Internal.ToIbBp where + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Simple.Cursor.Internal.IbBp as Z +import qualified Data.Succinct.Json.Simple.Cursor.SemiIndex as J + +class ToIbBp a where + toIbBp :: a -> Z.IbBp + +instance ToIbBp BS.ByteString where + toIbBp bs = Z.IbBp ib bp + where J.SemiIndex _ ib bp = J.buildSemiIndex bs diff --git a/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/Word8.hs b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/Word8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Internal/Word8.hs @@ -0,0 +1,72 @@ +module Data.Succinct.Json.Simple.Cursor.Internal.Word8 where + +import Data.Word +import Data.Word8 hiding (isDigit) + +import qualified Data.Char as C + +isLeadingDigit :: Word8 -> Bool +isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9) + +isTrailingDigit :: Word8 -> Bool +isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e + +isAlphabetic :: Word8 -> Bool +isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z) + +isDigit :: Word8 -> Bool +isDigit w = w >= _0 && w <= _9 + +wIsJsonNumberDigit :: Word8 -> Bool +wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen + +doubleQuote :: Word8 +doubleQuote = fromIntegral (C.ord '"') + +backSlash :: Word8 +backSlash = fromIntegral (C.ord '\\') + +openBrace :: Word8 +openBrace = fromIntegral (C.ord '{') + +closeBrace :: Word8 +closeBrace = fromIntegral (C.ord '}') + +openBracket :: Word8 +openBracket = fromIntegral (C.ord '[') + +closeBracket :: Word8 +closeBracket = fromIntegral (C.ord ']') + +comma :: Word8 +comma = fromIntegral (C.ord ',') + +colon :: Word8 +colon = fromIntegral (C.ord ':') + +isPeriod :: Word8 -> Bool +isPeriod w = w == 46 + +isMinus :: Word8 -> Bool +isMinus w = w == 45 + +isPlus :: Word8 -> Bool +isPlus w = w == 43 + +isValueChar :: Word8 -> Bool +isValueChar c = isAlphabetic c || isDigit c || isPeriod c || isMinus c || isPlus c + +isOpen :: Word8 -> Bool +isOpen c = c == openBracket || c == openBrace + +isClose :: Word8 -> Bool +isClose c = c == closeBracket || c == closeBrace + +isDelim :: Word8 -> Bool +isDelim c = c == comma || c == colon + +isDoubleQuote :: Word8 -> Bool +isDoubleQuote c = c == doubleQuote + +isBackSlash :: Word8 -> Bool +isBackSlash c = c == backSlash diff --git a/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/SemiIndex.hs b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/SemiIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/SemiIndex.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE MultiWayIf #-} + +module Data.Succinct.Json.Simple.Cursor.SemiIndex + ( buildSemiIndex + , SemiIndex(..) + ) where + +import Control.Monad.ST +import Data.Word + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import qualified Data.Succinct.Json.Simple.Cursor.Internal.Word8 as W8 +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.Bits.Writer.Storable as W + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +data Context = InJson | InString | InEscape deriving (Eq, Show) + +data SemiIndex v = SemiIndex + { semiIndexContext :: !Context + , semiIndexIb :: !v + , semiIndexBp :: !v + } deriving (Functor, Traversable, Foldable) + +buildSemiIndex :: BS.ByteString -> SemiIndex (DVS.Vector Word64) +buildSemiIndex bs = DVS.createT $ do + let len = (BS.length bs + 7) `div` 8 + mib <- W.newWriter len + mbp <- W.newWriter (len * 2) + buildFromByteString mib mbp bs 0 InJson +{-# INLINE buildSemiIndex #-} + +buildFromByteString :: W.Writer s -> W.Writer s -> BS.ByteString -> Int -> Context -> ST s (SemiIndex (DVS.MVector s Word64)) +buildFromByteString ib bp bs i context = if i < BS.length bs + then do + let c = BSU.unsafeIndex bs i + case context of + InJson -> if + | c == W8.openBracket || c == W8.openBrace -> do + W.unsafeWriteBit bp 1 + W.unsafeWriteBit bp 1 + W.unsafeWriteBit ib 1 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.closeBracket || c == W8.closeBrace -> do + W.unsafeWriteBit bp 0 + W.unsafeWriteBit bp 0 + W.unsafeWriteBit ib 1 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.comma || c == W8.colon -> do + W.unsafeWriteBit bp 0 + W.unsafeWriteBit bp 1 + W.unsafeWriteBit ib 1 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.doubleQuote -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InString + | otherwise -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InJson + InString -> do + W.unsafeWriteBit ib 0 + let newContext = if + | c == W8.doubleQuote -> InJson + | c == W8.backSlash -> InEscape + | otherwise -> InString + buildFromByteString ib bp bs (i + 1) newContext + InEscape -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InString + else do + ibv <- W.written ib + bpv <- W.written bp + return (SemiIndex context ibv bpv) +{-# INLINE buildFromByteString #-} diff --git a/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Snippet.hs b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Snippet.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/src/Data/Succinct/Json/Simple/Cursor/Snippet.hs @@ -0,0 +1,32 @@ +module Data.Succinct.Json.Simple.Cursor.Snippet + ( snippetPos + , snippet + ) where + +import Data.Maybe +import Data.Succinct.Json.Simple.Cursor +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy +import HaskellWorks.Data.Positioning + +import qualified Data.ByteString as BS +import qualified Data.Succinct.BalancedParens as BP +import qualified Data.Succinct.BalancedParens.RangeMin as RM + +snippetPos :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> (Count, Count) +snippetPos k = (kpa, kpz) + where kpa = select1 kib kta + km + kpz = select1 kib ktz - km + kib = interests k + kbp = balancedParens k + kra = cursorRank k + krz = fromMaybe maxBound (BP.findClose kbp kra) + ksa = kra + 1 + ksz = krz + 1 + kta = ksa `div` 2 + ktz = ksz `div` 2 + km = ksa `mod` 2 + +snippet :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> BS.ByteString +snippet k = let (a, z) = snippetPos k in BS.take (fromIntegral (z - a + 1)) (BS.drop (fromIntegral (a - 1)) kt) + where kt = cursorText k diff --git a/components/succinct-json-simple-cursor/test/Data/Succinct/Json/Simple/CursorSpec.hs b/components/succinct-json-simple-cursor/test/Data/Succinct/Json/Simple/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/test/Data/Succinct/Json/Simple/CursorSpec.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Simple.CursorSpec + ( spec + ) where + +import Control.Monad +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.Json.Simple.Cursor as Z +import qualified Data.Succinct.Json.Simple.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Simple.Cursor.Snippet as S +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Reduce duplication" -} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "Data.Succinct.Json.Backend.Simple.CursorSpec" $ do + describe "Json cursor" $ do + describe "For sample Json" $ do + let k = FAST.fromByteString "[[11],[22]]" + -- [ [ 1 1 ] , [ 2 2 ] ] + -- (( (( )) )( (( )) )) + it "can navigate" $ requireTest $ do + (Z.cursorRank <$> Just k) === Just 1 + (Z.cursorRank <$> ns k) === Nothing + (Z.cursorRank <$> fc k) === Just 2 + (Z.cursorRank <$> (fc >=> ns ) k) === Just 8 + (Z.cursorRank <$> (fc >=> ns >=> fc ) k) === Just 9 + (Z.cursorRank <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc ) k) === Just 10 + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (Z.cursorRank <$> (fc >=> fc ) k) === Just 3 + (Z.cursorRank <$> (fc >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> fc >=> fc ) k) === Just 4 + (Z.cursorRank <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can snippet pos" $ requireTest $ do + (S.snippetPos <$> Just k) === Just (1, 11) + (S.snippetPos <$> ns k) === Nothing + (S.snippetPos <$> fc k) === Just (2, 5) + (S.snippetPos <$> (fc >=> ns ) k) === Just (7, 10) + (S.snippetPos <$> (fc >=> ns >=> fc ) k) === Just (7, 10) + (S.snippetPos <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (S.snippetPos <$> (fc >=> ns >=> fc >=> fc ) k) === Just (8, 9) + (S.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (S.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (S.snippetPos <$> (fc >=> fc ) k) === Just (2, 5) + (S.snippetPos <$> (fc >=> fc >=> ns ) k) === Nothing + (S.snippetPos <$> (fc >=> fc >=> fc ) k) === Just (3, 4) + (S.snippetPos <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (S.snippetPos <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can snippet" $ requireTest $ do + (S.snippet <$> Just k) === Just "[[11],[22]]" + (S.snippet <$> ns k) === Nothing + (S.snippet <$> fc k) === Just "[11]" + (S.snippet <$> (fc >=> ns ) k) === Just "[22]" + (S.snippet <$> (fc >=> ns >=> fc ) k) === Just "[22]" + (S.snippet <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (S.snippet <$> (fc >=> ns >=> fc >=> fc ) k) === Just "22" + (S.snippet <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (S.snippet <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (S.snippet <$> (fc >=> fc ) k) === Just "[11]" + (S.snippet <$> (fc >=> fc >=> ns ) k) === Nothing + (S.snippet <$> (fc >=> fc >=> fc ) k) === Just "11" + (S.snippet <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (S.snippet <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing diff --git a/components/succinct-json-simple-cursor/test/Spec.hs b/components/succinct-json-simple-cursor/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-simple-cursor/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/succinct-json-standard-cursor/bench/Main.hs b/components/succinct-json-standard-cursor/bench/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/bench/Main.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +import Control.Monad +import Criterion.Main +import Data.List +import Data.Succinct.Json.Standard.Cursor.Internal.Blank +import Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex +import Data.Word +import Foreign +import System.IO.MMap + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW +import qualified System.Directory as IO + +setupEnvJson :: FilePath -> IO BS.ByteString +setupEnvJson filepath = do + (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + return bs + +jsonToInterestBits3 :: [BS.ByteString] -> [BS.ByteString] +jsonToInterestBits3 = blankedJsonToInterestBits . blankJson + +makeBenchBlankJson :: IO [Benchmark] +makeBenchBlankJson = do + entries <- IO.listDirectory "components/succinct-json-standard-cursor/corpus/bench" + let files = ("components/succinct-json-standard-cursor/corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return + [ env (setupEnvJson file) $ \bs -> bgroup file + [ bench "Run blankJson" (whnf (BS.concat . blankJson) [bs]) + ] + ] + + return (join benchmarks) + +makeBenchJsonToInterestBits :: IO [Benchmark] +makeBenchJsonToInterestBits = do + entries <- IO.listDirectory "components/succinct-json-standard-cursor/corpus/bench" + let files = ("components/succinct-json-standard-cursor/corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return + [ env (setupEnvJson file) $ \bs -> bgroup file + [ bench "Run blankJson" (whnf (BS.concat . jsonToInterestBits3) [bs]) + ] + ] + + return (join benchmarks) + +makeBenchMakeCursor :: IO [Benchmark] +makeBenchMakeCursor = do + entries <- IO.listDirectory "components/succinct-json-standard-cursor/corpus/bench" + let files = ("components/succinct-json-standard-cursor/corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return + [ env (setupEnvJson file) $ \bs -> bgroup file + [ bench "Run slow make cursor" (whnf SLOW.fromByteString bs) + , bench "Run fast make cursor" (whnf FAST.fromByteString bs) + ] + ] + + return (join benchmarks) + +main :: IO () +main = do + benchmarks <- fmap mconcat $ sequence $ mempty + <> [makeBenchBlankJson] + <> [makeBenchJsonToInterestBits] + <> [makeBenchMakeCursor] + defaultMain benchmarks diff --git a/components/succinct-json-standard-cursor/doctest/DoctestDriver.hs b/components/succinct-json-standard-cursor/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-json-standard-cursor/doctest/config.json #-} +#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/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor.hs @@ -0,0 +1,3 @@ +module Data.Succinct.Json.Standard.Cursor + ( + ) where diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Fast.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Fast.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Fast.hs @@ -0,0 +1,62 @@ +module Data.Succinct.Json.Standard.Cursor.Fast + ( Cursor + , fromByteString + , fromByteStringViaBlanking + , fromByteStringViaSimd + , fromForeignRegion + , fromString + , fromBsIbBp + , simdToIbBp + ) where + +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.IbBp +import Data.Succinct.Json.Standard.Cursor.Specific +import Data.Succinct.RankSelect.CsPoppy1 +import Foreign.ForeignPtr + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Internal as BSI +import qualified Data.Succinct.BalancedParens.RangeMin as RM +import qualified Data.Succinct.Json.Standard.Cursor.IbBp as J +import qualified HaskellWorks.Data.FromForeignRegion as F + +data Fast + +instance SpecificCursor Fast where + type CursorOf Fast = Cursor + +type Cursor = GenericCursor BS.ByteString CsPoppy1 (RM.RangeMin CsPoppy1) + +fromBsIbBp :: BS.ByteString -> IbBp -> Cursor +fromBsIbBp bs ibBp = GenericCursor + { cursorText = bs + , interests = makeCsPoppy ibPart + , balancedParens = RM.mkRangeMin (makeCsPoppy bpPart) + , cursorRank = 1 + } + where J.IbBp ibPart bpPart = ibBp + +-- | Load a 'Cursor' from a 'ByteString' +fromByteString :: BS.ByteString -> Cursor +fromByteString = fromByteStringViaBlanking +{-# DEPRECATED fromByteString "Use one of the other fromByteString* functions" #-} + +-- | Load a 'Cursor' from a 'ByteString' via the blanking process. +-- This has reasonable performance, but uses a lot of memory due to +-- the lack of streaming +fromByteStringViaBlanking :: BS.ByteString -> Cursor +fromByteStringViaBlanking bs = fromBsIbBp bs (J.slowToIbBp bs) + +-- | Load a 'Cursor' from a 'ByteString' via the blanking via `simd` +-- This has fast performance and streaming, but is only available +-- recent x86 platforms +fromByteStringViaSimd :: BS.ByteString -> Cursor +fromByteStringViaSimd jsonBs = fromBsIbBp jsonBs (simdToIbBp jsonBs) + +fromForeignRegion :: F.ForeignRegion -> Cursor +fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +fromString :: String -> Cursor +fromString = fromByteString . BSC.pack diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Generic.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Generic.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Generic.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Standard.Cursor.Generic + ( GenericCursor(..) + , jsonCursorPos + ) where + +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import GHC.Generics +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.TreeCursor +import Prelude hiding (drop) + +import qualified Data.Succinct.BalancedParens as BP + +data GenericCursor t v w = GenericCursor + { cursorText :: !t + , interests :: !v + , balancedParens :: !w + , cursorRank :: !Count + } + deriving (Eq, Generic, Show) + +instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (GenericCursor t v u) where + firstChild :: GenericCursor t v u -> Maybe (GenericCursor t v u) + firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + nextSibling :: GenericCursor t v u -> Maybe (GenericCursor t v u) + nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) + + parent :: GenericCursor t v u -> Maybe (GenericCursor t v u) + parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + depth :: GenericCursor t v u -> Maybe Count + depth k = BP.depth (balancedParens k) (cursorRank k) + + subtreeSize :: GenericCursor t v u -> Maybe Count + subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) + +jsonCursorPos :: (Rank1 w, Select1 v) => GenericCursor s v w -> Position +jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) + where ik = interests k + bpk = balancedParens k diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/IbBp.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/IbBp.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/IbBp.hs @@ -0,0 +1,47 @@ +module Data.Succinct.Json.Standard.Cursor.IbBp + ( IbBp(..) + , slowToIbBp + , simdToIbBp + ) where + +import Control.Monad +import Control.Monad.ST (ST) +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Vector.AsVector64 + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Succinct.Json.Simd.Index.Standard as STSI +import qualified Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.ToBalancedParens64 as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.ToInterestBits64 as J +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Storable.Mutable as DVSM +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.Vector.Storable as DVS + +data IbBp = IbBp + { ib :: DVS.Vector Word64 + , bp :: DVS.Vector Word64 + } deriving Generic + +slowToIbBp :: BS.ByteString -> IbBp +slowToIbBp bs = IbBp + { ib = J.toInterestBits64 blankedJson + , bp = J.toBalancedParens64 blankedJson + } + where blankedJson = J.toBlankedJsonTyped bs + +simdToIbBp :: BS.ByteString -> IbBp +simdToIbBp bs = case STSI.makeStandardJsonIbBps (LBS.rechunkPadded chunkSize (LBS.fromStrict bs)) of + Left msg -> error msg + Right chunks -> uncurry IbBp $ DVS.construct2N maxSize (go . fst) maxSize (go . snd) chunks + where chunkSize = 16384 + maxSize = (BS.length bs + chunkSize - 1) `div` 8 + go :: BS.ByteString -> DVSM.MVector s Word64 -> ST s Int + go bytes mv = do + let source = asVector64 bytes + let target = DVSM.take (DVS.length source) mv + when (DVS.length source > 0) $ DVS.copy target source + return (DVS.length source) diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Index.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Index.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Index.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Json.Standard.Cursor.Index + ( indexJson + ) where + +import Data.Word +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.Json.Standard.Cursor.Generic + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.ByteString as BS + +indexJson :: String -> IO () +indexJson filename = do + bs <- BS.mmap filename + -- We use the SLOW reference implementation because we are writing to a file and will never query. + let GenericCursor _ !ib (SimpleBalancedParens !bp) _ = SLOW.fromByteString bs + let wib = DVS.unsafeCast ib :: DVS.Vector Word8 + let wbp = DVS.unsafeCast bp :: DVS.Vector Word8 + BS.writeFile (filename ++ ".ib.idx") (BS.toByteString wib) + BS.writeFile (filename ++ ".bp.idx") (BS.toByteString wbp) diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/Blank.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/Blank.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/Blank.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Json.Standard.Cursor.Internal.Blank + ( blankJson + ) where + +import Data.ByteString (ByteString) +import Data.Succinct.Json.Standard.Cursor.Internal.Word8 +import Data.Word +import Data.Word8 +import GHC.Generics +import Prelude as P + +import qualified Data.ByteString as BS + +data BlankState + = Escaped + | InJson + | InString + | InNumber + | InIdent + deriving Generic + +blankJson :: [BS.ByteString] -> [BS.ByteString] +blankJson = blankJson' InJson + +blankJson' :: BlankState -> [BS.ByteString] -> [BS.ByteString] +blankJson' lastState as = case as of + (bs:bss) -> + let (!cs, Just (!nextState, _)) = BS.unfoldrN (BS.length bs) blankByteString (lastState, bs) in + cs:blankJson' nextState bss + [] -> [] + where + blankByteString :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString)) + blankByteString (InJson, bs) = case BS.uncons bs of + Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs)) + Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs)) + Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs)) + Just (!c, !cs) -> Just (c , (InJson , cs)) + Nothing -> Nothing + blankByteString (InString, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _backslash -> Just (_space , (Escaped , cs)) + Just (!c, !cs) | c == _quotedbl -> Just (_parenright , (InJson , cs)) + Just (_ , !cs) -> Just (_space , (InString , cs)) + Nothing -> Nothing + blankByteString (Escaped, bs) = case BS.uncons bs of + Just (_, !cs) -> Just (_space, (InString, cs)) + Nothing -> Nothing + blankByteString (InNumber, bs) = case BS.uncons bs of + Just (!c, !cs) | isTrailingDigit c -> Just (_0 , (InNumber , cs)) + Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs)) + Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs)) + Just (!c, !cs) -> Just (c , (InJson , cs)) + Nothing -> Nothing + blankByteString (InIdent, bs) = case BS.uncons bs of + Just (!c, !cs) | isAlphabetic c -> Just (_underscore , (InIdent , cs)) + Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs)) + Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs)) + Just (!c, !cs) -> Just (c , (InJson , cs)) + Nothing -> Nothing diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/BlankedJson.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/BlankedJson.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/BlankedJson.hs @@ -0,0 +1,23 @@ +module Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson + ( BlankedJson(..) + , ToBlankedJson(..) + , toBlankedJsonTyped + ) where + +import Data.Succinct.Json.Standard.Cursor.Internal.Blank +import HaskellWorks.Data.ByteString + +import qualified Data.ByteString as BS + +newtype BlankedJson = BlankedJson + { unBlankedJson :: [BS.ByteString] + } deriving (Eq, Show) + +class ToBlankedJson a where + toBlankedJson :: a -> [BS.ByteString] + +instance ToBlankedJson BS.ByteString where + toBlankedJson bs = blankJson (chunkedBy 4096 bs) + +toBlankedJsonTyped :: ToBlankedJson a => a -> BlankedJson +toBlankedJsonTyped = BlankedJson . toBlankedJson diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/MakeIndex.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/MakeIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/MakeIndex.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex + ( blankedJsonToInterestBits + , byteStringToBits + , blankedJsonToBalancedParens + , compressWordAsBit + , interestingWord8s + ) where + +import Control.Monad +import Data.Array.Unboxed ((!)) +import Data.ByteString (ByteString) +import Data.Int +import Data.Word +import Data.Word8 +import GHC.Generics +import HaskellWorks.Data.Bits.BitWise +import Prelude as P + +import qualified Data.Array.Unboxed as A +import qualified Data.Bits as BITS +import qualified Data.ByteString as BS + +interestingWord8s :: A.UArray Word8 Word8 +interestingWord8s = A.array (0, 255) [ + (w, if w == _bracketleft || w == _braceleft || w == _parenleft || w == _t || w == _f || w == _n || w == _1 + then 1 + else 0) + | w <- [0 .. 255]] + +blankedJsonToInterestBits :: [BS.ByteString] -> [BS.ByteString] +blankedJsonToInterestBits = blankedJsonToInterestBits' "" + +padRight :: Word8 -> Int -> BS.ByteString -> BS.ByteString +padRight w n bs = if BS.length bs >= n then bs else fst (BS.unfoldrN n gen bs) + where gen :: ByteString -> Maybe (Word8, ByteString) + gen cs = case BS.uncons cs of + Just (c, ds) -> Just (c, ds) + Nothing -> Just (w, BS.empty) + +blankedJsonToInterestBits' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString] +blankedJsonToInterestBits' rs as = case as of + (bs:bss) -> + let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs in + let lencs = BS.length cs in + let q = lencs + 7 `quot` 8 in + let (ds, es) = BS.splitAt (q * 8) cs in + let (fs, _) = BS.unfoldrN q gen ds in + fs:blankedJsonToInterestBits' es bss + [] -> [] + where gen :: ByteString -> Maybe (Word8, ByteString) + gen ds = if BS.length ds == 0 + then Nothing + else Just ( BS.foldr (\b m -> (interestingWord8s ! b) .|. (m .<. 1)) 0 (padRight 0 8 (BS.take 8 ds)) + , BS.drop 8 ds + ) + +repartitionMod8 :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString) +repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS) + where abBS = BS.concat [aBS, bBS] + abLen = BS.length abBS + cLen = (abLen `div` 8) * 8 + +compressWordAsBit :: [BS.ByteString] -> [BS.ByteString] +compressWordAsBit = compressWordAsBit' BS.empty + +compressWordAsBit' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString] +compressWordAsBit' aBS as = case as of + (bBS:bBSs) -> + let (cBS, dBS) = repartitionMod8 aBS bBS in + let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS in + cs:compressWordAsBit' dBS bBSs + [] -> do + let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS + [cs] + where gen :: ByteString -> Maybe (Word8, ByteString) + gen xs = if BS.length xs == 0 + then Nothing + else Just ( BS.foldr (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (padRight 0 8 (BS.take 8 xs)) + , BS.drop 8 xs + ) + +blankedJsonToBalancedParens :: [BS.ByteString] -> [BS.ByteString] +blankedJsonToBalancedParens as = case as of + (bs:bss) -> + let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs) in + cs:blankedJsonToBalancedParens bss + [] -> [] + where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString)) + gen (Just True , bs) = Just (0xFF, (Nothing, bs)) + gen (Just False , bs) = Just (0x00, (Nothing, bs)) + gen (Nothing , bs) = case BS.uncons bs of + Just (c, cs) -> case balancedParensOf c of + MiniN -> gen (Nothing , cs) + MiniT -> Just (0xFF, (Nothing , cs)) + MiniF -> Just (0x00, (Nothing , cs)) + MiniTF -> Just (0xFF, (Just False , cs)) + Nothing -> Nothing + +data MiniBP = MiniN | MiniT | MiniF | MiniTF deriving Generic + +balancedParensOf :: Word8 -> MiniBP +balancedParensOf c = case c of + d | d == _braceleft -> MiniT + d | d == _braceright -> MiniF + d | d == _bracketleft -> MiniT + d | d == _bracketright -> MiniF + d | d == _parenleft -> MiniT + d | d == _parenright -> MiniF + d | d == _t -> MiniTF + d | d == _f -> MiniTF + d | d == _1 -> MiniTF + d | d == _n -> MiniTF + _ -> MiniN + +yieldBitsOfWord8 :: Word8 -> [Bool] -> [Bool] +yieldBitsOfWord8 w = + (((w .&. BITS.bit 0) /= 0):) . + (((w .&. BITS.bit 1) /= 0):) . + (((w .&. BITS.bit 2) /= 0):) . + (((w .&. BITS.bit 3) /= 0):) . + (((w .&. BITS.bit 4) /= 0):) . + (((w .&. BITS.bit 5) /= 0):) . + (((w .&. BITS.bit 6) /= 0):) . + (((w .&. BITS.bit 7) /= 0):) + +yieldBitsofWord8s :: [Word8] -> [Bool] -> [Bool] +yieldBitsofWord8s = P.foldr ((>>) . yieldBitsOfWord8) id + +byteStringToBits :: [BS.ByteString] -> [Bool] -> [Bool] +byteStringToBits as = case as of + (bs:bss) -> yieldBitsofWord8s (BS.unpack bs) . byteStringToBits bss + [] -> id diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/StateMachine.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/StateMachine.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/StateMachine.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Standard.Cursor.Internal.StateMachine + ( lookupPhiTable + , lookupTransitionTable + , phiTable + , phiTableSimd + , transitionTable + , transitionTableSimd + , IntState(..) + , State(..) + ) where + +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Bits.BitWise + +import qualified Data.Succinct.Json.Standard.Cursor.Internal.Word8 as W8 +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Reduce guard" -} + +newtype IntState = IntState Int deriving (Eq, Ord, Show, Num, Generic) + +data State = InJson | InString | InEscape | InValue deriving (Eq, Enum, Bounded, Show, Generic) + +phiTable :: DV.Vector (DVS.Vector Word8) +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.generate (4 * fromIntegral iLen) go + where iLen = 256 :: Int + 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 +lookupPhiTable (IntState s) w = DVS.unsafeIndex phiTable2 (s * 256 + fromIntegral w) +{-# INLINE lookupPhiTable #-} + +phiTableSimd :: DVS.Vector Word32 +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 vj +{-# NOINLINE phiTableSimd #-} + +transitionTable :: DV.Vector (DVS.Vector Word8) +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.generate (4 * fromIntegral iLen) go + where iLen = 256 :: Int + 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 +lookupTransitionTable (IntState s) w = fromIntegral (DVS.unsafeIndex transitionTable2 (s * 256 + fromIntegral w)) +{-# INLINE lookupTransitionTable #-} + +transitionTableSimd :: DVS.Vector Word64 +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 vj +{-# NOINLINE transitionTableSimd #-} + +stateMachine :: Word8 -> State -> (State, Word32) +stateMachine c InJson | W8.isOpen c = (InJson , 0b110) +stateMachine c InJson | W8.isClose c = (InJson , 0b001) +stateMachine c InJson | W8.isDelim c = (InJson , 0b000) +stateMachine c InJson | W8.isValueChar c = (InValue , 0b111) +stateMachine c InJson | W8.isDoubleQuote c = (InString, 0b111) +stateMachine _ InJson | otherwise = (InJson , 0b000) +stateMachine c InString | W8.isDoubleQuote c = (InJson , 0b000) +stateMachine c InString | W8.isBackSlash c = (InEscape, 0b000) +stateMachine _ InString | otherwise = (InString, 0b000) +stateMachine _ InEscape | otherwise = (InString, 0b000) +stateMachine c InValue | W8.isOpen c = (InJson , 0b110) +stateMachine c InValue | W8.isClose c = (InJson , 0b001) +stateMachine c InValue | W8.isDelim c = (InJson , 0b000) +stateMachine c InValue | W8.isValueChar c = (InValue , 0b000) +stateMachine _ InValue | otherwise = (InJson , 0b000) +{-# INLINE stateMachine #-} diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/ToBalancedParens64.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/ToBalancedParens64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/ToBalancedParens64.hs @@ -0,0 +1,23 @@ +module Data.Succinct.Json.Standard.Cursor.Internal.ToBalancedParens64 + ( ToBalancedParens64(..) + ) where + +import Control.Applicative +import Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex +import Data.Word + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified Data.Vector.Storable as DVS + +genBitWordsForever :: LBS.ByteString -> Maybe (Word8, LBS.ByteString) +genBitWordsForever bs = LBS.uncons bs <|> Just (0, bs) +{-# INLINE genBitWordsForever #-} + +class ToBalancedParens64 a where + toBalancedParens64 :: a -> DVS.Vector Word64 + +instance ToBalancedParens64 J.BlankedJson where + toBalancedParens64 (J.BlankedJson bj) = DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS) + where bpBS = LBS.fromChunks (compressWordAsBit (blankedJsonToBalancedParens bj)) + newLen = fromIntegral ((LBS.length bpBS + 7) `div` 8 * 8) diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/ToInterestBits64.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/ToInterestBits64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/ToInterestBits64.hs @@ -0,0 +1,26 @@ +module Data.Succinct.Json.Standard.Cursor.Internal.ToInterestBits64 + ( ToInterestBits64(..) + ) where + +import Control.Applicative +import Data.ByteString.Internal +import Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex +import Data.Word + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified Data.Vector.Storable as DVS + +class ToInterestBits64 a where + toInterestBits64 :: a -> DVS.Vector Word64 + +instance ToInterestBits64 J.BlankedJson where + toInterestBits64 bj = DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS) + where interestBS = blankedJsonBssToInterestBitsBs (J.unBlankedJson bj) + newLen = (BS.length interestBS + 7) `div` 8 * 8 + +blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString +blankedJsonBssToInterestBitsBs bss = BS.concat $ blankedJsonToInterestBits bss + +genInterestForever :: ByteString -> Maybe (Word8, ByteString) +genInterestForever bs = BS.uncons bs <|> Just (0, bs) diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/Word8.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/Word8.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Internal/Word8.hs @@ -0,0 +1,72 @@ +module Data.Succinct.Json.Standard.Cursor.Internal.Word8 where + +import Data.Word +import Data.Word8 hiding (isDigit) + +import qualified Data.Char as C + +isLeadingDigit :: Word8 -> Bool +isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9) + +isTrailingDigit :: Word8 -> Bool +isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e + +isAlphabetic :: Word8 -> Bool +isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z) + +isDigit :: Word8 -> Bool +isDigit w = w >= _0 && w <= _9 + +wIsJsonNumberDigit :: Word8 -> Bool +wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen + +doubleQuote :: Word8 +doubleQuote = fromIntegral (C.ord '"') + +backSlash :: Word8 +backSlash = fromIntegral (C.ord '\\') + +openBrace :: Word8 +openBrace = fromIntegral (C.ord '{') + +closeBrace :: Word8 +closeBrace = fromIntegral (C.ord '}') + +openBracket :: Word8 +openBracket = fromIntegral (C.ord '[') + +closeBracket :: Word8 +closeBracket = fromIntegral (C.ord ']') + +comma :: Word8 +comma = fromIntegral (C.ord ',') + +colon :: Word8 +colon = fromIntegral (C.ord ':') + +isPeriod :: Word8 -> Bool +isPeriod w = w == 46 + +isMinus :: Word8 -> Bool +isMinus w = w == 45 + +isPlus :: Word8 -> Bool +isPlus w = w == 43 + +isValueChar :: Word8 -> Bool +isValueChar c = isAlphabetic c || isDigit c || isPeriod c || isMinus c || isPlus c + +isOpen :: Word8 -> Bool +isOpen c = c == openBracket || c == openBrace + +isClose :: Word8 -> Bool +isClose c = c == closeBracket || c == closeBrace + +isDelim :: Word8 -> Bool +isDelim c = c == comma || c == colon + +isDoubleQuote :: Word8 -> Bool +isDoubleQuote c = c == doubleQuote + +isBackSlash :: Word8 -> Bool +isBackSlash c = c == backSlash diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Load/Cursor.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Load/Cursor.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Load/Cursor.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Json.Standard.Cursor.Load.Cursor + ( loadCursor + , loadCursorWithIndex + , loadCursorWithCsPoppyIndex + , loadCursorWithCsPoppyIndex2 + ) where + +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.Load.Raw +import Data.Succinct.RankSelect.CsPoppy1 +import Data.Word + +import qualified Data.ByteString.Internal as BSI +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.ByteString as BS + +loadCursor :: String -> IO FAST.Cursor +loadCursor path = do + bs <- BS.mmap path + let !cursor = FAST.fromByteStringViaBlanking bs + return cursor + +loadCursorWithIndex :: String -> IO (GenericCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))) +loadCursorWithIndex filename = do + (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename + let cursor = GenericCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1 + return cursor + +loadCursorWithCsPoppyIndex :: String -> IO (GenericCursor BSI.ByteString CsPoppy1 (SimpleBalancedParens (DVS.Vector Word64))) +loadCursorWithCsPoppyIndex filename = do + (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename + let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 + return cursor + +loadCursorWithCsPoppyIndex2 :: String -> IO (GenericCursor BSI.ByteString CsPoppy1 (SimpleBalancedParens CsPoppy1)) +loadCursorWithCsPoppyIndex2 filename = do + (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename + let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens (makeCsPoppy jsonBp)) 1 + :: GenericCursor BSI.ByteString CsPoppy1 (SimpleBalancedParens CsPoppy1) + return cursor diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Load/Raw.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Load/Raw.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Load/Raw.hs @@ -0,0 +1,20 @@ +module Data.Succinct.Json.Standard.Cursor.Load.Raw + ( loadRawWithIndex + ) where + +import Data.Word +import HaskellWorks.Data.FromForeignRegion +import System.IO.MMap + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS + +loadRawWithIndex :: String -> IO (BS.ByteString, DVS.Vector Word64, DVS.Vector Word64) +loadRawWithIndex filename = do + jsonFr <- mmapFileForeignPtr filename ReadOnly Nothing + jsonIbFr <- mmapFileForeignPtr (filename ++ ".ib.idx") ReadOnly Nothing + jsonBpFr <- mmapFileForeignPtr (filename ++ ".bp.idx") ReadOnly Nothing + let jsonBS = fromForeignRegion jsonFr :: BS.ByteString + let jsonIb = fromForeignRegion jsonIbFr :: DVS.Vector Word64 + let jsonBp = fromForeignRegion jsonBpFr :: DVS.Vector Word64 + return (jsonBS, jsonIb, jsonBp) diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/SemiIndex.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/SemiIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/SemiIndex.hs @@ -0,0 +1,264 @@ +{-# LANGUAGE MultiWayIf #-} + +module Data.Succinct.Json.Standard.Cursor.SemiIndex + ( semiIndexBuilder + , SemiIndex(..) + , PreSiChunk(..) + , SiChunk(..) + , buildSemiIndex + , State(..) + , buildFromByteString2 + , buildFromByteString3 + , toIbBpBuilders + ) where + +import Control.Monad.ST +import Data.Bits.Pdep +import Data.Bits.Pext +import Data.Succinct.Json.Standard.Cursor.Internal.StateMachine (IntState (..), State (..)) +import Data.Word +import Foreign.Storable (Storable (..)) +import GHC.Generics +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Vector.AsVector64 + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Unsafe as BSU +import qualified Data.Succinct.Json.Standard.Cursor.Internal.Blank as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.StateMachine as SM +import qualified Data.Succinct.Json.Standard.Cursor.Internal.ToBalancedParens64 as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.Word8 as W8 +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Storable.Mutable as DVSM +import qualified HaskellWorks.Data.Bits.Writer.Storable as W +import qualified HaskellWorks.Data.ByteString as BS + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +data PreSiChunk v = PreSiChunk + { preSiChunkIb :: !v -- interest bits + , preSiChunkBpOp :: !v -- balanced parens interest bits + , preSiChunkBpCl :: !v -- balanced parens open close + } deriving (Functor, Traversable, Foldable, Generic) + +data SiChunk v = SiChunk + { siChunkIb :: !v -- interest bits + , siChunkBp :: !v -- balanced parens open close + } deriving (Functor, Traversable, Foldable, Generic) + +data SemiIndex v = SemiIndex + { semiIndexIb :: !v + , semiIndexBp :: !v + } deriving (Functor, Traversable, Foldable, Generic) + +semiIndexBuilder :: LBS.ByteString -> SemiIndex B.Builder +semiIndexBuilder lbs = SemiIndex (B.lazyByteString ibs) (B.byteString (BS.toByteString bps)) + where blankedJson = J.blankJson (LBS.toChunks lbs) + ibs = LBS.fromChunks (J.blankedJsonToInterestBits blankedJson) + bps = J.toBalancedParens64 (J.BlankedJson blankedJson) +{-# INLINE semiIndexBuilder #-} + +buildSemiIndex :: BS.ByteString -> SemiIndex (DVS.Vector Word64) +buildSemiIndex bs = DVS.createT $ do + let len = (BS.length bs + 7) `div` 8 + mib <- W.newWriter len + mbp <- W.newWriter (len * 2) + buildFromByteString mib mbp bs 0 InJson +{-# INLINE buildSemiIndex #-} + +buildFromByteString :: W.Writer s -> W.Writer s -> BS.ByteString -> Int -> State -> ST s (SemiIndex (DVS.MVector s Word64)) +buildFromByteString ib bp bs i = go + where go state = if i < BS.length bs + then do + let c = BSU.unsafeIndex bs i + case state of + InJson -> if + | c == W8.openBracket || c == W8.openBrace -> do + W.unsafeWriteBit ib 1 + W.unsafeWriteBit bp 1 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.closeBracket || c == W8.closeBrace -> do + W.unsafeWriteBit bp 0 + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.comma || c == W8.colon -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InJson + | W8.isAlphabetic c || W8.isDigit c || W8.isPeriod c || W8.isMinus c || W8.isPlus c -> do + W.unsafeWriteBit ib 1 + W.unsafeWriteBit bp 1 + W.unsafeWriteBit bp 0 + buildFromByteString ib bp bs (i + 1) InValue + | c == W8.doubleQuote -> do + W.unsafeWriteBit ib 1 + W.unsafeWriteBit bp 1 + W.unsafeWriteBit bp 0 + buildFromByteString ib bp bs (i + 1) InString + | otherwise -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InJson + InString -> do + W.unsafeWriteBit ib 0 + let newContext = if + | c == W8.doubleQuote -> InJson + | c == W8.backSlash -> InEscape + | otherwise -> InString + buildFromByteString ib bp bs (i + 1) newContext + InEscape -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InString + InValue -> if + | W8.isAlphabetic c || W8.isDigit c || W8.isPeriod c || W8.isMinus c || W8.isPlus c -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InValue + | otherwise -> go InJson + else do + ibv <- W.written ib + bpv <- W.written bp + return (SemiIndex ibv bpv) +{-# INLINE buildFromByteString #-} + +constructSI :: forall a s. Storable a => Int -> (Int -> s -> (s, a)) -> s -> (s, DVS.Vector a) +constructSI n f state = DVS.createT $ do + mv <- DVSM.unsafeNew n + state' <- go 0 state mv + return (state', mv) + where go :: Int -> s -> DVSM.MVector t a -> ST t s + go i s mv = if i < DVSM.length mv + then do + let (s', a) = f i s + DVSM.unsafeWrite mv i a + go (i + 1) s' mv + else return s +{-# INLINE constructSI #-} + +buildFromByteString2 :: [BS.ByteString] -> [DVS.Vector Word64] +buildFromByteString2 = go (IntState (fromEnum InJson)) + where go :: IntState -> [BS.ByteString] -> [DVS.Vector Word64] + go s (bs:bss) = v:go s' bss + where (s', v) = constructSI (BS.length bs `div` 16) f s -- TODO adjust length + f :: Int -> IntState -> (IntState, Word64) + f i s'' = let j = i * 16 in transition16 s'' + (BSU.unsafeIndex bs j ) + (BSU.unsafeIndex bs (j + 1)) + (BSU.unsafeIndex bs (j + 2)) + (BSU.unsafeIndex bs (j + 3)) + (BSU.unsafeIndex bs (j + 4)) + (BSU.unsafeIndex bs (j + 5)) + (BSU.unsafeIndex bs (j + 6)) + (BSU.unsafeIndex bs (j + 7)) + (BSU.unsafeIndex bs (j + 8)) + (BSU.unsafeIndex bs (j + 9)) + (BSU.unsafeIndex bs (j + 10)) + (BSU.unsafeIndex bs (j + 11)) + (BSU.unsafeIndex bs (j + 12)) + (BSU.unsafeIndex bs (j + 13)) + (BSU.unsafeIndex bs (j + 14)) + (BSU.unsafeIndex bs (j + 15)) + go _ [] = [] +{-# INLINE buildFromByteString2 #-} + +transition16 :: IntState + -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 + -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 + -> (IntState, Word64) +transition16 s a b c d e f g h i j k l m n o p = (sp, w) + where (sa, wa) = transition1 s a + (sb, wb) = transition1 sa b + (sc, wc) = transition1 sb c + (sd, wd) = transition1 sc d + (se, we) = transition1 sd e + (sf, wf) = transition1 se f + (sg, wg) = transition1 sf g + (sh, wh) = transition1 sg h + (si, wi) = transition1 sh i + (sj, wj) = transition1 si j + (sk, wk) = transition1 sj k + (sl, wl) = transition1 sk l + (sm, wm) = transition1 sl m + (sn, wn) = transition1 sm n + (so, wo) = transition1 sn o + (sp, wp) = transition1 so p + w = (fromIntegral wa ) .|. + (fromIntegral wb .<. 4) .|. + (fromIntegral wc .<. 8) .|. + (fromIntegral wd .<. 12) .|. + (fromIntegral we .<. 16) .|. + (fromIntegral wf .<. 20) .|. + (fromIntegral wg .<. 24) .|. + (fromIntegral wh .<. 28) .|. + (fromIntegral wi .<. 32) .|. + (fromIntegral wj .<. 36) .|. + (fromIntegral wk .<. 40) .|. + (fromIntegral wl .<. 44) .|. + (fromIntegral wm .<. 48) .|. + (fromIntegral wn .<. 52) .|. + (fromIntegral wo .<. 56) .|. + (fromIntegral wp .<. 60) +{-# INLINE transition16 #-} + +transition1 :: IntState -> Word8 -> (IntState, Word64) +transition1 s a = (s', w) + where s' = SM.lookupTransitionTable s (fromIntegral a) + w = fromIntegral $ SM.lookupPhiTable s (fromIntegral a) +{-# INLINE transition1 #-} + +buildFromByteString3 :: [BS.ByteString] -> [PreSiChunk (DVS.Vector Word64)] +buildFromByteString3 bss = makePreSiChunk <$> buildFromByteString2 bss + 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.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.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 + where go :: Word64 -> Word64 -> [PreSiChunk (DVS.Vector Word64)] -> [SiChunk (DVS.Vector Word64)] + go b n (PreSiChunk ib bpOp bpCl:cs) = SiChunk ib bp: go b' n' cs + where ((b', n'), bp) = mkBp b n (DVS.unsafeCast bpOp) (DVS.unsafeCast bpCl) + go b _ [] = [SiChunk DVS.empty (DVS.singleton b)] + mkBp :: Word64 -> Word64 -> DVS.Vector Word32 -> DVS.Vector Word32 -> ((Word64, Word64), DVS.Vector Word64) + mkBp b n bpOp bpCl = DVS.createT $ do + mv <- DVSM.unsafeNew (DVS.length bpOp) + mkBpGo b n bpOp bpCl mv 0 0 + mkBpGo :: Word64 -> Word64 -> DVS.Vector Word32 -> DVS.Vector Word32 -> DVS.MVector s Word64 -> Int -> Int -> ST s ((Word64, Word64), DVS.MVector s Word64) + mkBpGo b n bpOp bpCl mv vi mvi = if vi < DVS.length bpOp + then do + let op = DVS.unsafeIndex bpOp vi + let cl = DVS.unsafeIndex bpCl vi + let (slo, mlo) = compress op cl -- slo: source lo, mlo: mask lo + let wb = pext slo mlo + let wn = popCount1 mlo + let tb = (wb .<. n) .|. b + let tn = n + wn + if tn < 64 + then do + mkBpGo tb tn bpOp bpCl mv (vi + 1) mvi + else do + DVSM.unsafeWrite mv mvi tb + let ub = wb .>. (64 - n) + let un = tn - 64 + mkBpGo ub un bpOp bpCl mv (vi + 1) (mvi + 1) + else return ((b, n), DVSM.take mvi mv) + compress :: Word32 -> Word32 -> (Word64, Word64) + compress op cl = (sw, mw) + where iop = pdep (fromIntegral op :: Word64) 0x5555555555555555 -- interleaved open + icl = pdep (fromIntegral cl :: Word64) 0xaaaaaaaaaaaaaaaa -- interleaved close + ioc = iop .|. icl -- interleaved open/close + sw = pext iop ioc + pc = popCount1 ioc + mw = (1 .<. pc) - 1 diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Slow.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Slow.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Slow.hs @@ -0,0 +1,46 @@ +module Data.Succinct.Json.Standard.Cursor.Slow + ( Cursor + , fromBsIbBp + , fromByteString + , fromForeignRegion + , fromString + ) where + +import Data.Word +import Foreign.ForeignPtr +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.IbBp +import Data.Succinct.Json.Standard.Cursor.Specific + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Internal as BSI +import qualified Data.Succinct.BalancedParens as BP +import qualified Data.Succinct.Json.Standard.Cursor.IbBp as J +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.FromForeignRegion as F + +data Slow + +instance SpecificCursor Slow where + type CursorOf Slow = Cursor + +type Cursor = GenericCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64)) + +fromBsIbBp :: BS.ByteString -> IbBp -> Cursor +fromBsIbBp bs ibBp = GenericCursor + { cursorText = bs + , interests = ibPart + , balancedParens = BP.SimpleBalancedParens bpPart + , cursorRank = 1 + } + where J.IbBp ibPart bpPart = ibBp + +fromByteString :: BS.ByteString -> Cursor +fromByteString bs = fromBsIbBp bs (J.slowToIbBp bs) + +fromForeignRegion :: F.ForeignRegion -> Cursor +fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +fromString :: String -> Cursor +fromString = fromByteString . BSC.pack diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Specific.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Specific.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Specific.hs @@ -0,0 +1,9 @@ +module Data.Succinct.Json.Standard.Cursor.Specific + ( SpecificCursor(..) + , jsonCursorPos + ) where + +import Data.Succinct.Json.Standard.Cursor.Generic + +class SpecificCursor w where + type CursorOf w diff --git a/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Type.hs b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Type.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/src/Data/Succinct/Json/Standard/Cursor/Type.hs @@ -0,0 +1,68 @@ +module Data.Succinct.Json.Standard.Cursor.Type + ( JsonType(..) + , JsonTypeAt(..) + ) where + +import Data.Char +import Data.String +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.Internal.Word8 +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Word8 +import GHC.Generics +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Positioning +import Prelude hiding (drop) + +import qualified Data.ByteString as BS +import qualified Data.Succinct.BalancedParens as BP + +{- HLINT ignore "Reduce duplication" -} + +data JsonType + = JsonTypeArray + | JsonTypeBool + | JsonTypeNull + | JsonTypeNumber + | JsonTypeObject + | JsonTypeString + deriving (Eq, Show, Generic) + +class JsonTypeAt a where + jsonTypeAtPosition :: Position -> a -> Maybe JsonType + jsonTypeAt :: a -> Maybe JsonType + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor String v w) where + jsonTypeAtPosition p k = case drop (toCount p) (cursorText k) of + c:_ | fromIntegral (ord c) == _bracketleft -> Just JsonTypeArray + c:_ | fromIntegral (ord c) == _f -> Just JsonTypeBool + c:_ | fromIntegral (ord c) == _t -> Just JsonTypeBool + c:_ | fromIntegral (ord c) == _n -> Just JsonTypeNull + c:_ | wIsJsonNumberDigit (fromIntegral (ord c)) -> Just JsonTypeNumber + c:_ | fromIntegral (ord c) == _braceleft -> Just JsonTypeObject + c:_ | fromIntegral (ord c) == _quotedbl -> Just JsonTypeString + _ -> Nothing + + jsonTypeAt k = jsonTypeAtPosition p k + where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + ik = interests k + bpk = balancedParens k + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor BS.ByteString v w) where + jsonTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of + Just (c, _) | c == _bracketleft -> Just JsonTypeArray + Just (c, _) | c == _f -> Just JsonTypeBool + Just (c, _) | c == _t -> Just JsonTypeBool + Just (c, _) | c == _n -> Just JsonTypeNull + Just (c, _) | wIsJsonNumberDigit c -> Just JsonTypeNumber + Just (c, _) | c == _braceleft -> Just JsonTypeObject + Just (c, _) | c == _quotedbl -> Just JsonTypeString + _ -> Nothing + + jsonTypeAt k = jsonTypeAtPosition p k + where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + ik = interests k + bpk = balancedParens k diff --git a/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/CorpusSpec.hs b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/CorpusSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/CorpusSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Standard.CorpusSpec(spec) where + +import Control.Monad.IO.Class +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Bits.FromBitTextByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import System.FilePath +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +spec :: Spec +spec = describe "Data.Succinct.Json.Corpus" $ do + let base = "components/succinct-json/corpus" + it "Corpus 5000B loads properly" $ requireTest $ do + inJsonBS <- liftIO $ BS.readFile $ base "5000B.json" + inInterestBitsBS <- liftIO $ BS.readFile $ base "5000B.json.ib.idx" + inInterestBalancedParensBS <- liftIO $ BS.readFile $ base "5000B.json.bp.idx" + let inInterestBits = fromBitTextByteString inInterestBitsBS + let inInterestBalancedParens = fromBitTextByteString inInterestBalancedParensBS + let !cursor = SLOW.fromByteString inJsonBS + let text = cursorText cursor + let ib = interests cursor + let SimpleBalancedParens bp = balancedParens cursor + text === inJsonBS + ib === inInterestBits + bp === inInterestBalancedParens + it "issue-0001 loads properly" $ requireTest $ do + inJsonBS <- liftIO $ BS.readFile $ base "issue-0001.json" + inInterestBitsBS <- liftIO $ BS.readFile $ base "issue-0001.json.ib.idx" + inInterestBalancedParensBS <- liftIO $ BS.readFile $ base "issue-0001.json.bp.idx" + let inInterestBits = fromBitTextByteString inInterestBitsBS + let inInterestBalancedParens = fromBitTextByteString inInterestBalancedParensBS + let !cursor = SLOW.fromByteString inJsonBS + let text = cursorText cursor + let ib = interests cursor + let SimpleBalancedParens bp = balancedParens cursor + text === inJsonBS + ib === inInterestBits + bp === inInterestBalancedParens diff --git a/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/BalancedParensSpec.hs b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/BalancedParensSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/BalancedParensSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Standard.Cursor.BalancedParensSpec + ( spec + ) where + +import Data.String +import Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex +import Data.Word +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified Data.Succinct.Json.Standard.Cursor.SemiIndex as SI +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Redundant do" -} + +balancedParensOf2 :: BS.ByteString -> DVS.Vector Word64 +balancedParensOf2 bs = let SI.SemiIndex _ bp = SI.buildSemiIndex bs in bp + +spec :: Spec +spec = describe "Data.Succinct.Json.Cursor.InterestBitsSpec" $ do + it "Evaluating interest bits 2" $ requireTest $ do + bitShow (balancedParensOf2 "" ) === "" + bitShow (balancedParensOf2 " \n \r \t ") === "" + bitShow (balancedParensOf2 "1234 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "-1.1e-1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "false " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "true " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "\"\\\"\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "{ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "} " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "[ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "] " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 ": " ) === "" + bitShow (balancedParensOf2 ", " ) === "" + bitShow (balancedParensOf2 "{{}}" ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 " { { } } " ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + it "Blanking JSON should not contain strange characters 1" $ requireTest $ do + let blankedJson = J.BlankedJson ["[ [],", "[]]"] + let bp = BitShown $ BS.concat (blankedJsonToBalancedParens (J.unBlankedJson blankedJson)) + bp === fromString "11111111 11111111 00000000 11111111 00000000 00000000" + it "Blanking JSON should not contain strange characters 2" $ requireTest $ do + let blankedJson = J.BlankedJson ["[ [],", "[]]"] + let bp = BitShown $ BS.concat ((compressWordAsBit . blankedJsonToBalancedParens) (J.unBlankedJson blankedJson)) + bp === fromString "11010000" diff --git a/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/InterestBitsSpec.hs b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/InterestBitsSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/InterestBitsSpec.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Standard.Cursor.InterestBitsSpec(spec) where + +import Data.String +import Data.Word +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.ToInterestBits64 as J +import qualified Data.Succinct.Json.Standard.Cursor.SemiIndex as SI +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Redundant do" -} + +interestBitsOf :: BS.ByteString -> DVS.Vector Word64 +interestBitsOf bs = J.toInterestBits64 (J.toBlankedJsonTyped bs) + +interestBitsOf2 :: BS.ByteString -> DVS.Vector Word64 +interestBitsOf2 bs = let SI.SemiIndex ib _ = SI.buildSemiIndex bs in ib + +spec :: Spec +spec = describe "Data.Succinct.Json.Cursor.InterestBitsSpec" $ do + it "Evaluating interest bits" $ requireTest $ do + BitShown (interestBitsOf "" ) === fromString "" + BitShown (interestBitsOf " \n \r \t ") === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "1234 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "1.1 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "-1.1e-2 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "false " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "true " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "\"hello\" " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "\"\\\"\" " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "{ " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "} " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "[ " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "] " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf ": " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf ", " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "{{}}" ) === fromString "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf " { { } } " ) === fromString "01010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + it "Evaluating interest bits 2" $ requireTest $ do + bitShow (interestBitsOf2 "" ) === "" + bitShow (interestBitsOf2 " \n \r \t ") === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "1234 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "-1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "-1.1e-2 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "false " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "true " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "\"\\\"\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "{ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "} " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "[ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "] " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 ": " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 ", " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "{{}}" ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 " { { } } " ) === "01010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" diff --git a/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/Internal/BlankSpec.hs b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/Internal/BlankSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/Internal/BlankSpec.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Standard.Cursor.Internal.BlankSpec (spec) where + +import Data.Succinct.Json.Standard.Cursor.Internal.Blank +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS + +{- HLINT ignore "Redundant do" -} + +whenBlankedJsonShouldBe :: BS.ByteString -> BS.ByteString -> Spec +whenBlankedJsonShouldBe original expected = do + it (show original ++ " when blanked json should be " ++ show expected) $ requireTest $ do + BS.concat (blankJson [original]) === expected + +spec :: Spec +spec = describe "Data.Succinct.Json.Internal.BlankSpec" $ do + describe "Can blank json" $ do + "\"\"" `whenBlankedJsonShouldBe` "()" + "\"\\\\\"" `whenBlankedJsonShouldBe` "( )" + "\"\\\\\\\"" `whenBlankedJsonShouldBe` "( " + "\" \\\\\\\"" `whenBlankedJsonShouldBe` "( " + "\" \\n\\\\\"" `whenBlankedJsonShouldBe` "( )" + "" `whenBlankedJsonShouldBe` "" + "\"\"" `whenBlankedJsonShouldBe` "()" + "\" \"" `whenBlankedJsonShouldBe` "( )" + "\" a \"" `whenBlankedJsonShouldBe` "( )" + " \"a \" x" `whenBlankedJsonShouldBe` " ( ) x" + " \"\"\"\" " `whenBlankedJsonShouldBe` " ()() " + " [][] " `whenBlankedJsonShouldBe` " [][] " + " {}{} " `whenBlankedJsonShouldBe` " {}{} " + " \"a\"b\"c\"d" `whenBlankedJsonShouldBe` " ( )b( )d" + "" `whenBlankedJsonShouldBe` "" + "1" `whenBlankedJsonShouldBe` "1" + "11" `whenBlankedJsonShouldBe` "10" + "00" `whenBlankedJsonShouldBe` "10" + "00" `whenBlankedJsonShouldBe` "10" + "-0.12e+34" `whenBlankedJsonShouldBe` "100000000" + "10.12E-34 " `whenBlankedJsonShouldBe` "100000000 " + "10.12E-34 12" `whenBlankedJsonShouldBe` "100000000 10" + " 10.12E-34 -1" `whenBlankedJsonShouldBe` " 100000000 10" + "" `whenBlankedJsonShouldBe` "" + "a" `whenBlankedJsonShouldBe` "a" + "z" `whenBlankedJsonShouldBe` "z" + " Aaa " `whenBlankedJsonShouldBe` " A__ " + " Za def " `whenBlankedJsonShouldBe` " Z_ d__ " + "" `whenBlankedJsonShouldBe` "" + " { \"ff\": 1.0, [\"\", true], null}" `whenBlankedJsonShouldBe` " { ( ): 100, [(), t___], n___}" diff --git a/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/TypeSpec.hs b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/TypeSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/Cursor/TypeSpec.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Standard.Cursor.TypeSpec (spec) where + +import Control.Monad +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.Type +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "Data.Succinct.Json.Succinct.CursorSpec" $ do + genSpec "DVS.Vector Word64" SLOW.fromString + genSpec "CsPoppy1" FAST.fromString + +genSpec :: forall t u. + ( Eq t + , Show t + , Select1 t + , Eq u + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () +genSpec t makeCursor = do + describe ("Json cursor of type " ++ t) $ do + let forJson s f = describe ("of value " ++ show s) (f (makeCursor s)) + forJson "{}" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeObject + forJson " {}" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeObject + forJson "1234" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeNumber + forJson "\"Hello\"" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeString + forJson "[]" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeArray + forJson "true" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeBool + forJson "false" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeBool + forJson "null" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeNull + forJson "[null]" $ \cursor -> do + it "should have correct type" $ requireTest $ (fc >=> jsonTypeAt) cursor === Just JsonTypeNull + forJson "[null, {\"field\": 1}]" $ \cursor -> do + it "cursor can navigate to second child of array" $ requireTest $ do + (fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeObject + it "cursor can navigate to first child of object at second child of array" $ requireTest $ do + (fc >=> ns >=> fc >=> jsonTypeAt) cursor === Just JsonTypeString + it "cursor can navigate to first child of object at second child of array" $ requireTest $ do + (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeNumber + describe "For empty json array" $ do + let cursor = makeCursor "[null]" + it "can navigate down and forwards" $ requireTest $ do + ( jsonTypeAt) cursor === Just JsonTypeArray + (fc >=> jsonTypeAt) cursor === Just JsonTypeNull + (fc >=> ns >=> jsonTypeAt) cursor === Nothing + (fc >=> ns >=> ns >=> jsonTypeAt) cursor === Nothing + describe "For sample Json" $ do + let cursor = makeCursor "{ \ + \ \"widget\": { \ + \ \"debug\": \"on\", \ + \ \"window\": { \ + \ \"name\": \"main_window\", \ + \ \"dimensions\": [500, 600.01e-02, true, false, null] \ + \ } \ + \ } \ + \}" :: GenericCursor BS.ByteString t u + it "can navigate down and forwards" $ requireTest $ do + ( jsonTypeAt) cursor === Just JsonTypeObject + (fc >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeObject + (fc >=> ns >=> fc >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeObject + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeArray diff --git a/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/CursorSpec.hs b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/CursorSpec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Standard.CursorSpec(spec) where + +import Data.Succinct.Json.Standard.GenCursorTest +import Test.Hspec + +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +spec :: Spec +spec = describe "Data.Succinct.Json.Succinct.CursorSpec" $ do + genTest "DVS.Vector Word64" SLOW.fromString + genTest "CsPoppy1" FAST.fromString diff --git a/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/GenCursorTest.hs b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/GenCursorTest.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Data/Succinct/Json/Standard/GenCursorTest.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Standard.GenCursorTest(genTest) where + +import Control.Monad +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +fc = TC.firstChild +ns = TC.nextSibling +pn = TC.parent +ss = TC.subtreeSize + +strAt :: forall t u. + ( Eq t + , Show t + , Select1 t + , Eq u + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => Int + -> GenericCursor BS.ByteString t u + -> Maybe BS.ByteString +strAt n k = if balancedParens k .?. lastPositionOf (cursorRank k) + then Just (BS.take n (BS.drop (fromIntegral (toCount (jsonCursorPos k))) (cursorText k))) + else Nothing + +genTest :: forall t u. + ( Eq t + , Show t + , Select1 t + , Eq u + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () +genTest t mkCursor = do + describe ("Json cursor of type " ++ t) $ do + describe "For empty json array" $ do + let cursor = mkCursor "[null]" + it "can navigate down and forwards" $ requireTest $ do + strAt 1 cursor === Just "[" + describe "For sample Json" $ do + let cursor = mkCursor "\ + \{ \ + \ \"widget\": { \ + \ \"debug\": \"on\", \ + \ \"window\": { \ + \ \"name\": \"main_window\", \ + \ \"dimensions\": [500, 600.01e-02, true, false, null] \ + \ } \ + \ } \ + \}" + it "can navigate up" $ requireTest $ do + ( pn) cursor === Nothing + (fc >=> pn) cursor === Just cursor + (fc >=> ns >=> pn) cursor === Just cursor + (fc >=> ns >=> fc >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + it "can get subtree size" $ requireTest $ do + ( ss) cursor === Just 16 + (fc >=> ss) cursor === Just 1 + (fc >=> ns >=> ss) cursor === Just 14 + (fc >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 10 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6 + it "can get token at cursor" $ requireTest $ do + ( strAt 1) cursor === Just "{" + (fc >=> strAt 8) cursor === Just "\"widget\"" + (fc >=> ns >=> strAt 1) cursor === Just "{" + (fc >=> ns >=> fc >=> strAt 7) cursor === Just "\"debug\"" + (fc >=> ns >=> fc >=> ns >=> strAt 4) cursor === Just "\"on\"" + (fc >=> ns >=> fc >=> ns >=> ns >=> strAt 8) cursor === Just "\"window\"" + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> strAt 1) cursor === Just "{" + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> strAt 6) cursor === Just "\"name\"" + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> strAt 13) cursor === Just "\"main_window\"" + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> strAt 12) cursor === Just "\"dimensions\"" + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> strAt 1) cursor === Just "[" diff --git a/components/succinct-json-standard-cursor/test/Spec.hs b/components/succinct-json-standard-cursor/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json-standard-cursor/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/succinct-json/app/App/Commands.hs b/components/succinct-json/app/App/Commands.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/app/App/Commands.hs @@ -0,0 +1,20 @@ +module App.Commands where + +import App.Commands.Count +import App.Commands.CountAeson +import App.Commands.CreateIndex +import App.Commands.Demo +import Options.Applicative + +{- HLINT ignore "Monoid law, left identity" -} + +commands :: Parser (IO ()) +commands = commandsGeneral + +commandsGeneral :: Parser (IO ()) +commandsGeneral = subparser $ mempty + <> commandGroup "Commands:" + <> cmdCreateIndex + <> cmdCount + <> cmdCountAeson + <> cmdDemo diff --git a/components/succinct-json/app/App/Commands/Count.hs b/components/succinct-json/app/App/Commands/Count.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/app/App/Commands/Count.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.Count + ( cmdCount + ) where + +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Word +import HaskellWorks.Data.FromForeignRegion +import Data.Succinct.Json.LightJson +import Data.Succinct.Json.Query +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.MQuery +import Data.Succinct.MQuery.Micro +import Data.Succinct.RankSelect.CsPoppy1 +import HaskellWorks.Data.TreeCursor +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.DList as DL +import qualified Data.Vector.Storable as DVS +import qualified Data.Succinct.BalancedParens.RangeMin as RM +import qualified Data.Succinct.Json.Standard.Cursor.Fast as JCF +import qualified System.IO.MMap as IO + +siblings :: GenericCursor BSI.ByteString CsPoppy1 (RM.RangeMin CsPoppy1) -> [GenericCursor BSI.ByteString CsPoppy1 (RM.RangeMin CsPoppy1)] +siblings c = c:maybe [] siblings (nextSibling c) + +runCount :: Z.CountOptions -> IO () +#if aarch64_HOST_ARCH +runCount = undefined +#else +runCount opts = do + let inputFile = opts ^. the @"inputFile" + let expression = opts ^. the @"expression" + jsonFr <- IO.mmapFileForeignPtr inputFile IO.ReadOnly Nothing + let jsonBs = fromForeignRegion jsonFr :: BS.ByteString + + cursor <- case opts ^. the @"indexes" of + Just indexes -> do + let ibIndex = indexes ^. the @"ibIndex" + let bpIndex = indexes ^. the @"bpIndex" + jsonIbFr <- IO.mmapFileForeignPtr ibIndex IO.ReadOnly Nothing + jsonBpFr <- IO.mmapFileForeignPtr bpIndex IO.ReadOnly Nothing + let jsonIb = fromForeignRegion jsonIbFr :: DVS.Vector Word64 + let jsonBp = fromForeignRegion jsonBpFr :: DVS.Vector Word64 + + return $ GenericCursor jsonBs (makeCsPoppy jsonIb) (RM.mkRangeMin (makeCsPoppy jsonBp)) 1 + Nothing -> do + let !ibip = JCF.simdToIbBp jsonBs + let !c = JCF.fromBsIbBp jsonBs ibip + return c + + let q = MQuery (DL.fromList $ fmap lightJsonAt (siblings cursor)) + + putPretty $ q >>= (entry >=> named expression) & count + + return () +#endif + +optsFileIndex :: Parser Z.FileIndexes +optsFileIndex = Z.FileIndexes + <$> strOption + ( long "ib-index" + <> help "IB index" + <> metavar "FILE" + ) + <*> strOption + ( long "bp-index" + <> help "BP index" + <> metavar "FILE" + ) + +optsCount :: Parser Z.CountOptions +optsCount = Z.CountOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input JSON file" + <> metavar "FILE" + ) + <*> optional optsFileIndex + <*> strOption + ( long "expression" + <> help "JSON expression" + <> metavar "EXPRESSION" + ) + +cmdCount :: Mod CommandFields (IO ()) +cmdCount = command "count" $ flip info idm $ runCount <$> optsCount diff --git a/components/succinct-json/app/App/Commands/CountAeson.hs b/components/succinct-json/app/App/Commands/CountAeson.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/app/App/Commands/CountAeson.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.CountAeson + ( cmdCountAeson + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.Aeson as J +import qualified Data.Aeson.Key as J +import qualified Data.Aeson.KeyMap as J +import qualified Data.ByteString.Lazy as LBS +import qualified System.IO as IO + +runCountAeson :: Z.CountAesonOptions -> IO () +runCountAeson opts = do + let inputFile = opts ^. the @"inputFile" + let expression = opts ^. the @"expression" + + lbs <- LBS.readFile inputFile + + let lbsLines = LBS.split 10 lbs + + let count :: Int = sum $ flip fmap lbsLines $ \lbsLine -> case J.decode lbsLine of + Just (J.Object v) -> if J.member (J.fromText expression) v then 1 else 0 + _ -> 0 + + IO.putStrLn $ "Count: " <> show count + + return () + +optsCountAeson :: Parser Z.CountAesonOptions +optsCountAeson = Z.CountAesonOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input JSON file" + <> metavar "FILE" + ) + <*> strOption + ( long "expression" + <> help "JSON expression" + <> metavar "EXPRESSION" + ) + +cmdCountAeson :: Mod CommandFields (IO ()) +cmdCountAeson = command "count-aeson" $ flip info idm $ runCountAeson <$> optsCountAeson diff --git a/components/succinct-json/app/App/Commands/CreateIndex.hs b/components/succinct-json/app/App/Commands/CreateIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/app/App/Commands/CreateIndex.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} + +module App.Commands.CreateIndex + ( cmdCreateIndex + ) where + +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Maybe +import Data.Word +import Foreign +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +#if x86_64_HOST_ARCH +import qualified Data.Succinct.Json.Simd.Index.Standard as STSI +#endif +import qualified Data.Succinct.Json.Simple.Cursor.SemiIndex as SISI +import qualified Data.Succinct.Json.Standard.Cursor.Internal.Blank as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex as J +import qualified Data.Succinct.Json.Standard.Cursor.Internal.ToBalancedParens64 as J +import qualified Data.Succinct.Json.Standard.Cursor.SemiIndex as STSI +import qualified System.Exit as IO +import qualified System.IO as IO +import qualified System.IO.MMap as IO + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant do" -} + +runCreateIndexStandard :: Z.CreateIndexOptions -> IO () +#if x86_64_HOST_ARCH +runCreateIndexStandard opts = do + let filePath = opts ^. the @"filePath" + let outputIbFile = opts ^. the @"outputIbFile" & fromMaybe (filePath <> ".ib.idx") + let outputBpFile = opts ^. the @"outputBpFile" & fromMaybe (filePath <> ".bp.idx") + case opts ^. the @"method" of + "original" -> do + (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + let blankedJson = J.blankJson [bs] + let ibs = LBS.fromChunks (J.blankedJsonToInterestBits blankedJson) + let bps = J.toBalancedParens64 (J.BlankedJson blankedJson) + LBS.writeFile outputIbFile ibs + LBS.writeFile outputBpFile (LBS.toLazyByteString bps) + "alternate" -> do + (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + let STSI.SemiIndex ib bp = STSI.buildSemiIndex bs + BS.writeFile outputIbFile (BS.toByteString ib) + BS.writeFile outputBpFile (BS.toByteString bp) + "tabular" -> do + lbs <- LBS.readFile filePath + let siChunks = STSI.toIbBpBuilders (STSI.buildFromByteString3 (BS.resegmentPadded 64 (LBS.toChunks lbs))) + IO.withFile outputIbFile IO.WriteMode $ \hIb -> + IO.withFile outputBpFile IO.WriteMode $ \hBp -> + forM_ siChunks $ \(STSI.SiChunk ib bp) -> do + LBS.hPut hIb (LBS.toLazyByteString ib) + LBS.hPut hBp (LBS.toLazyByteString bp) + "simd" -> do + IO.withFile filePath IO.ReadMode $ \hIn -> do + contents <- LBS.resegmentPadded 512 <$> LBS.hGetContents hIn + case STSI.makeStandardJsonIbBps contents of + Right chunks -> do + IO.withFile outputIbFile IO.WriteMode $ \hIb -> do + IO.withFile outputBpFile IO.WriteMode $ \hBp -> do + forM_ chunks $ \(ibBs, bpBs) -> do + BS.hPut hIb ibBs + BS.hPut hBp bpBs + Left msg -> IO.hPutStrLn IO.stderr $ "Unable to create index: " <> show msg + "sum" -> do + lbs <- LBS.resegmentPadded 64 <$> LBS.readFile filePath + IO.putStrLn $ "Sum: " <> show (sum (BS.foldl (\a b -> a + fromIntegral b) (0 :: Word64) <$> LBS.toChunks lbs)) + unknown -> do + IO.hPutStrLn IO.stderr $ "Unknown method " <> show unknown + IO.exitFailure +#else +runCreateIndexStandard opts = undefined +#endif + +runCreateIndexSimple :: Z.CreateIndexOptions -> IO () +#if x86_64_HOST_ARCH +runCreateIndexSimple opts = do + let filePath = opts ^. the @"filePath" + let outputIbFile = opts ^. the @"outputIbFile" & fromMaybe (filePath <> ".ib.idx") + let outputBpFile = opts ^. the @"outputBpFile" & fromMaybe (filePath <> ".bp.idx") + (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + let SISI.SemiIndex _ ibs bps = SISI.buildSemiIndex bs + LBS.writeFile outputIbFile (LBS.toLazyByteString ibs) + LBS.writeFile outputBpFile (LBS.toLazyByteString bps) +#else +runCreateIndexSimple opts = undefined +#endif + +runCreateIndex :: Z.CreateIndexOptions -> IO () +runCreateIndex opts = case opts ^. the @"backend" of + "standard" -> runCreateIndexStandard opts + "simple" -> runCreateIndexSimple opts + unknown -> IO.hPutStrLn IO.stderr $ "Unknown backend " <> show unknown + +optsCreateIndex :: Parser Z.CreateIndexOptions +optsCreateIndex = Z.CreateIndexOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input JSON file" + <> metavar "STRING" + ) + <*> strOption + ( long "backend" + <> short 'b' + <> value "standard" + <> help "Backend for creating index" + <> metavar "STRING" + ) + <*> strOption + ( long "method" + <> short 'm' + <> value "original" + <> help "Method for creating index" + <> metavar "STRING" + ) + <*> optional + ( strOption + ( long "output-ib-file" + <> help "Filename for output ib index" + <> metavar "STRING" + ) + ) + <*> optional + ( strOption + ( long "output-bp-file" + <> help "Filename for output bp index" + <> metavar "STRING" + ) + ) + +cmdCreateIndex :: Mod CommandFields (IO ()) +cmdCreateIndex = command "create-index" $ flip info idm $ runCreateIndex <$> optsCreateIndex diff --git a/components/succinct-json/app/App/Commands/Demo.hs b/components/succinct-json/app/App/Commands/Demo.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/app/App/Commands/Demo.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.Demo + ( cmdDemo + ) where + +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Word +import Foreign.ForeignPtr +import Data.Succinct.Json.LightJson +import Data.Succinct.Json.Query +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.Load.Cursor +import Data.Succinct.MQuery +import Data.Succinct.MQuery.Micro +import Data.Succinct.RankSelect.CsPoppy +import HaskellWorks.Data.Vector.Storable +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Lazy as LBS +import qualified Data.DList as DL +import qualified Data.Succinct.BalancedParens.RangeMin as RM +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +#if x86_64_HOST_ARCH +import qualified Data.Succinct.Json.Simd.Index.Standard as S +#endif +import qualified Options.Applicative as OA +import qualified System.IO as IO +import qualified System.IO.MMap as IO + +{- HLINT ignore "Reduce duplication" -} + +runDemo :: Z.DemoOptions -> IO () +#if x86_64_HOST_ARCH +runDemo opts = do + let filePath = opts ^. the @"filePath" + case opts ^. the @"method" of + "original" -> do + !cursor <- loadCursor (opts ^. the @"filePath") + let !json = lightJsonAt cursor + let q = MQuery (DL.singleton json) + + putPretty $ q >>= (entry >=> named "meta" >=> entry >=> named "view" >=> entry >=> named "columns" >=> item >=> entry >=> named "id") & count + "simd" -> do + (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + case S.makeStandardJsonIbBps (LBS.resegmentPadded 512 (LBS.fromStrict bs)) of + Right ibBps -> do + let (!ib, !bp) = construct64UnzipN size ibBps + let !cursor = GenericCursor bs (makeCsPoppy ib) (RM.mkRangeMin bp) 1 + let !json = lightJsonAt cursor + let q = MQuery (DL.singleton json) + + putPretty $ q >>= (entry >=> named "meta" >=> entry >=> named "view" >=> entry >=> named "columns" >=> item >=> entry >=> named "id") & count + Left msg -> IO.hPutStrLn IO.stderr $ "Unable to create semi-index: " <> show msg + m -> IO.hPutStrLn IO.stderr $ "Unrecognised method: " <> show m +#else +runDemo opts = undefined +#endif + +optsDemo :: Parser Z.DemoOptions +optsDemo = Z.DemoOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input DSV file" + <> metavar "STRING" + ) + <*> strOption + ( long "method" + <> short 'm' + <> help "Method (original|simd)" + <> metavar "STRING" + <> OA.value "original" + ) + +cmdDemo :: Mod CommandFields (IO ()) +cmdDemo = command "demo" $ flip info idm $ runDemo <$> optsDemo diff --git a/components/succinct-json/app/App/Commands/Types.hs b/components/succinct-json/app/App/Commands/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/app/App/Commands/Types.hs @@ -0,0 +1,39 @@ +module App.Commands.Types + ( CountAesonOptions(..) + , CountOptions(..) + , CreateIndexOptions(..) + , DemoOptions(..) + , FileIndexes(..) + ) where + +import Data.Text (Text) +import GHC.Generics + +data CreateIndexOptions = CreateIndexOptions + { filePath :: FilePath + , backend :: String + , method :: String + , outputIbFile :: Maybe FilePath + , outputBpFile :: Maybe FilePath + } deriving (Eq, Show, Generic) + +data DemoOptions = DemoOptions + { filePath :: FilePath + , method :: FilePath + } deriving (Eq, Show, Generic) + +data CountOptions = CountOptions + { inputFile :: FilePath + , indexes :: Maybe FileIndexes + , expression :: Text + } deriving (Eq, Show, Generic) + +data CountAesonOptions = CountAesonOptions + { inputFile :: FilePath + , expression :: Text + } deriving (Eq, Show, Generic) + +data FileIndexes = FileIndexes + { ibIndex :: FilePath + , bpIndex :: FilePath + } deriving (Eq, Show, Generic) diff --git a/components/succinct-json/app/Main.hs b/components/succinct-json/app/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/app/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import App.Commands +import Control.Monad +import Options.Applicative + +main :: IO () +main = join $ customExecParser + (prefs $ showHelpOnEmpty <> showHelpOnError) + (info (commands <**> helper) idm) diff --git a/components/succinct-json/bench/Main.hs b/components/succinct-json/bench/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/bench/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Criterion.Main + +main :: IO () +main = do + benchmarks <- mconcat <$> sequence mempty + defaultMain benchmarks diff --git a/components/succinct-json/corpus/5000B.json b/components/succinct-json/corpus/5000B.json new file mode 100644 --- /dev/null +++ b/components/succinct-json/corpus/5000B.json @@ -0,0 +1,1 @@ +[ { "_id" : { "$oid" : "52cdef7c4bab8bd675297d8a" }, "name" : "Wetpaint", "permalink" : "abc2", "crunchbase_url" : "http://www.crunchbase.com/company/wetpaint", "homepage_url" : "http://wetpaint-inc.com", "blog_url" : "http://digitalquarters.net/", "blog_feed_url" : "http://digitalquarters.net/feed/", "twitter_username" : "BachelrWetpaint", "category_code" : "web", "number_of_employees" : 47, "founded_year" : 2005, "founded_month" : 10, "founded_day" : 17, "deadpooled_year" : 1, "tag_list" : "wiki, seattle, elowitz, media-industry, media-platform, social-distribution-system", "alias_list" : "", "email_address" : "info@wetpaint.com", "phone_number" : "206.859.6300", "description" : "Technology Platform Company", "created_at" : { "$date" : 1180075887000 }, "updated_at" : "Sun Dec 08 07:15:44 UTC 2013", "overview" : "

Wetpaint is a technology platform company that uses its proprietary state-of-the-art technology and expertise in social media to build and monetize audiences for digital publishers. Wetpaint's own online property, Wetpaint Entertainment, an entertainment news site that attracts more than 12 million unique visitors monthly and has over 2 million Facebook fans, is a proof point to the company's success in building and engaging audiences. Media companies can license Wetpaint's platform which includes a dynamic playbook tailored to their individual needs and comprehensive training. Founded by Internet pioneer Ben Elowitz, and with offices in New York and Seattle, Wetpaint is backed by Accel Partners, the investors behind Facebook.

", "image" : { "available_sizes" : [ [ [ 150, 75 ], "assets/images/resized/0000/3604/3604v14-max-150x150.jpg" ], [ [ 250, 125 ], "assets/images/resized/0000/3604/3604v14-max-250x250.jpg" ], [ [ 450, 225 ], "assets/images/resized/0000/3604/3604v14-max-450x450.jpg" ] ] }, "products" : [ { "name" : "Wikison Wetpaint", "permalink" : "wetpaint-wiki" }, { "name" : "Wetpaint Social Distribution System", "permalink" : "wetpaint-social-distribution-system" } ], "relationships" : [ { "is_past" : false, "title" : "Co-Founder and VP, Social and Audience Development", "person" : { "first_name" : "Michael", "last_name" : "Howell", "permalink" : "michael-howell" } }, { "is_past" : false, "title" : "Co-Founder/CEO/Board of Directors", "person" : { "first_name" : "Ben", "last_name" : "Elowitz", "permalink" : "ben-elowitz" } }, { "is_past" : false, "title" : "COO/Board of Directors", "person" : { "first_name" : "Rob", "last_name" : "Grady", "permalink" : "rob-grady" } }, { "is_past" : false, "title" : "SVP, Strategy and Business Development", "person" : { "first_name" : "Chris", "last_name" : "Kollas", "permalink" : "chris-kollas" } }, { "is_past" : false, "title" : "Board", "person" : { "first_name" : "Theresia", "last_name" : "Ranzetta", "permalink" : "theresia-ranzetta" } }, { "is_past" : false, "title" : "Board Member", "person" : { "first_name" : "Gus", "last_name" : "Tai", "permalink" : "gus-tai" } }, { "is_past" : false, "title" : "Board", "person" : { "first_name" : "Len", "last_name" : "Jordan", "permalink" : "len-jordan" } }, { "is_past" : false, "title" : "Head of Technology and Product", "person" : { "first_name" : "Alex", "last_name" : "Weinstein", "permalink" : "alex-weinstein" } }, { "is_past" : true, "title" : "CFO", "person" : { "first_name" : "Bert", "last_name" : "Hogue", "permalink" : "bert-hogue" } }, { "is_past" : true, "title" : "CFO/ CRO", "person" : { "first_name" : "Brian", "last_name" : "Watkins", "permalink" : "brian-watkins" } }, { "is_past" : true, "title" : "Senior Vice President, Marketing", "person" : { "first_name" : "Rob", "last_name" : "Grady", "permalink" : "rob-grady" } }, { "is_past" : true, "title" : "VP, Technology and Product", "person" : { "first_name" : "Werner", "last_name" : "Koepf", "permalink" : "werner-koepf" } }, { "is_past" : true, "title" : "VP Marketing", "person" : { "first_name" : "Kevin", "last_name" : "Flaherty", "permalink" : "kevin-flaherty" } }, { "is_past" : true, "title" : "VP User Experience", "person" : { "first_name" : "Alex", "last_name" : "Berg", "permalink" : "alex-berg" } }, { "is_past" : true, "title" : "VP Engineering", "person" : { "first_name" : "Steve", "last_name" : "McQuade", "permalink" : "steve-mcquade" } }, { "is_past" : true, "title" : "Executive Editor", "person" : { "first_name" : "Susan", "last_name" : "Mulcahy", "permalink" : "susan-mulcahy" } }, { "is_past" : true, "title" : "VP Business Development", "person" : { "first_name" : "Chris", "last_name" : "Kollas", "permalink" : "chris-kollas" } } ], "competitions" : [ { "competitor" : { "name" : "Wikia", "permalink" : "wikia" } }, { "competitor" : { "name" : "JotSpot", "permalink" : "jotspot" } }, { "competitor" : { "name" : "Socialtext", "permalink" : "socialtext" } }, { "competitor" : { "name" : "Ning by Glam Media", "permalink" : "ning" } }, { "competitor" : { "name" : "Soceeo", "permalink" : "soceeo" } }, { "competitor" : { "n" : "Y", "" : 1234567}}]}] diff --git a/components/succinct-json/corpus/5000B.json.bp.idx b/components/succinct-json/corpus/5000B.json.bp.idx new file mode 100644 --- /dev/null +++ b/components/succinct-json/corpus/5000B.json.bp.idx @@ -0,0 +1,1 @@ +111011010010101010101010101010101010101010101010101010101010101010101010101010101010110100101010101011011110100100111010010011101001000010111010101001101010100010111010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010001101010101011010101010100011010101010110101010101000110101010101101010101010000101110110101010001101101010100011011010101000110110101010001101101010100011011010101000000 diff --git a/components/succinct-json/corpus/5000B.json.ib.idx b/components/succinct-json/corpus/5000B.json.ib.idx new file mode 100644 --- /dev/null +++ b/components/succinct-json/corpus/5000B.json.ib.idx @@ -0,0 +1,1 @@ +10101000000010100000000100000000000000000000000000000100000000100000000000100000000000001000000010000000000000000001000000000000000000000000000000000000000000000100000000000000001000000000000000000000000001000000000000100000000000000000000000000000010000000000000000010000000000000000000000000000000000010000000000000000000010000000000000000001000000000000000001000000100000000000000000000000100010000000000000000100000100000000000000000100010000000000000001000100000000000000000001001000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000000001000100000000000000000100000000000000000000100000000000000001000000000000000100000000000000010000000000000000000000000000001000000000000001010000000001000000000000000010000000000000010000000000000000000000000000000100000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001010000000000000000000101010100001000001000000000000000000000000000000000000000000000000000000000000101010000100000010000000000000000000000000000000000000000000000000000000000001010100001000000100000000000000000000000000000000000000000000000000000000000000001000000000000101010000000010000000000000000000100000000000001000000000000000000101000000001000000000000000000000000000000000000001000000000000010000000000000000000000000000000000000000001000000000000000001010100000000000100000010000000001000000000000000000000000000000000000000000000000000001000000000010100000000000000100000000001000000000000010000000001000000000000010000000000000000000001010000000000010000001000000000100000000000000000000000000000000000010000000000101000000000000001000000100000000000001000000000010000000000000100000000000000000010100000000000100000010000000001000000000000000000000000010000000000101000000000000001000000100000000000001000000001000000000000010000000000000000101000000000001000000100000000010000000000000000000000000000000000000000010000000000101000000000000001000000001000000000000010000000001000000000000010000000000000000000101000000000001000000100000000010000000010000000000101000000000000001000000000001000000000000010000000000010000000000000100000000000000000000000010100000000000100000010000000001000000000000000100000000001010000000000000010000001000000000000010000001000000000000010000000000000010100000000000100000010000000001000000001000000000010100000000000000100000010000000000000100000000010000000000000100000000000000000101000000000001000000100000000010000000000000000000000000000000001000000000010100000000000000100000001000000000000010000000000001000000000000010000000000000000000001010000000000010000010000000001000000100000000001010000000000000010000000100000000000001000000001000000000000010000000000000000010100000000000100000100000000010000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000000000000000000001000000000010100000000000000100000010000000000000100000000100000000000001000000000000000010100000000000100000100000000010000000000000000000000000000010000000000101000000000000001000000000100000000000001000000001000000000000010000000000000000000101000000000001000001000000000100000000000000010000000000101000000000000001000000001000000000000010000000000010000000000000100000000000000000000010100000000000100000100000000010000000000000000000001000000000010100000000000000100000001000000000000010000000100000000000001000000000000000010100000000000100000100000000010000000000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000010000000000101000000000000001000000001000000000000010000000000100000000000001000000000000000000001010000000000010000010000000001000000000000000000000000001000000000010100000000000000100000000100000000000001000000000100000000000001000000000000000000000100000000000000001010100000000000000101000000001000000001000000000000010000000000001010000000000000010100000000100000000001000000000000010000000000000010100000000000000101000000001000000000000010000000000000100000000000000000101000000000000001010000000010000000000000000000001000000000000010000000000010100000000000000101000000001000000000100000000000001000000000000010100000000000000101000001000010000100000 diff --git a/components/succinct-json/corpus/issue-0001.json b/components/succinct-json/corpus/issue-0001.json new file mode 100644 --- /dev/null +++ b/components/succinct-json/corpus/issue-0001.json @@ -0,0 +1,1 @@ +[ { "total_money_raised" : "$39.8M", "funding_rounds" : [], "investments" : [], "acquisition" : { "price_amount" : 30000000, "price_currency_code" : "USD", "term_code" : "cash_and_stock", "source_url" : "http://allthingsd.com/20131216/viggle-tries-to-bulk-up-its-social-tv-business-by-buying-wetpaint/?mod=atdtweet", "source_description" : " Viggle Tries to Bulk Up Its Social TV Business by Buying Wetpaint", "acquired_year" : 2013, "acquired_month" : 12, "acquired_day" : 16, "acquiring_company" : { "name" : "Viggle", "permalink" : "viggle" } }, "acquisitions" : [], "offices" : [ { "description" : "", "address1" : "710 - 2nd Avenue", "address2" : "Suite 1100", "zip_code" : "98104", "city" : "Seattle", "state_code" : "WA", "country_code" : "USA", "latitude" : 47.603122, "longitude" : -122.333253 }, { "description" : "", "address1" : "270 Lafayette Street", "address2" : "Suite 505", "zip_code" : "10012", "city" : "New York", "state_code" : "NY", "country_code" : "USA", "latitude" : 40.7237306, "longitude" : -73.9964312 } ], "milestones" : [ { "id" : 5869, "description" : "Wetpaint named in Lead411's Hottest Seattle Companies list", "stoned_year" : 2010, "stoned_month" : 6, "stoned_day" : 8, "source_url" : "http://www.lead411.com/seattle-companies.html", "source_text" : null, "source_description" : "LEAD411 LAUNCHES \"HOTTEST SEATTLE COMPANIES\" AWARDS", "stoneable_type" : "Company", "stoned_value" : null, "stoned_value_type" : null, "stoned_acquirer" : null, "stoneable" : { "name" : "Wetpaint", "permalink" : "wetpaint" } }, { "id" : 8702, "description" : "Site-Builder Wetpaint Makes One For Itself, Using the Demand Media Playbook", "stoned_year" : 2010, "stoned_month" : 9, "stoned_day" : 6, "source_url" : "http://mediamemo.allthingsd.com/20100906/site-builder-wetpaint-makes-one-for-itself-using-the-demand-media-playbook/", "source_text" : null, "source_description" : "All Things D", "stoneable_type" : "Company", "stoned_value" : null, "stoned_value_type" : null, "stoned_acquirer" : null, "stoneable" : { "name" : "Wetpaint", "permalink" : "wetpaint" } } ], "video_embeds" : [], "screenshots" : [ { "available_sizes" : [ [ [ 150, 86 ], "assets/images/resized/0016/0929/160929v2-max-150x150.png" ], [ [ 250, 143 ], "assets/images/resized/0016/0929/160929v2-max-250x250.png" ], [ [ 450, 258 ], "assets/images/resized/0016/0929/160929v2-max-450x450.png" ] ], "attribution" : null } ], "external_links" : [ { "external_url" : "http://www.geekwire.com/2011/rewind-ben-elowitz-wetpaint-ceo-building-type-media-company", "title" : "GeekWire interview: Rewind - Ben Elowitz, Wetpaint CEO, on building a new type of media company" }, { "external_url" : "http://techcrunch.com/2012/06/17/search-and-social-how-two-will-soon-become-one/", "title" : "Guest post by CEO Ben Elowitz in TechCrunch" }, { "external_url" : "http://allthingsd.com/20120516/what-to-expect-when-facebook-is-expecting-five-predictions-for-facebooks-first-public-year/", "title" : "Guest post by CEO Ben Elowitz in AllThingsD" }, { "external_url" : "http://adage.com/article/digitalnext/facebook-biggest-player-advertising-s-540-billion-world/235708/", "title" : "Guest post by CEO Ben Elowitz in AdAge" }, { "external_url" : "http://www.businessinsider.com/facebook-captures-14-percent-of-our-online-attention-but-only-4-percent-of-ad-spending-online-2012-6", "title" : "Guest post by CEO Ben Elowitz in Business Insider" }, { "external_url" : "http://allfacebook.com/wetpaint-media-data_b75963", "title" : "AllFacebook coverage of Wetpaint" }, { "external_url" : "http://adage.com/article/digital/celeb-site-wetpaint-shows-media-profit-facebook/237828/", "title" : "Profile of Wetpaint in Ad Age" }, { "external_url" : "http://allthingsd.com/20121018/how-to-boost-your-facebook-traffic-tips-and-tricks-from-wetpaint/", "title" : "Interview with Wetpaint CEO Ben Elowitz in All Things D" }, { "external_url" : "http://www.xconomy.com/seattle/2012/10/19/wetpaint-starts-licensing-its-facebook-based-media-distribution-tech/", "title" : "Profile of Wetpaint in Xconomy" } ]}, {}] diff --git a/components/succinct-json/corpus/issue-0001.json.bp.idx b/components/succinct-json/corpus/issue-0001.json.bp.idx new file mode 100644 --- /dev/null +++ b/components/succinct-json/corpus/issue-0001.json.bp.idx @@ -0,0 +1,1 @@ +111010101010101011010101010101010101010101010101010110101010001010101110101010101010101010101010101010101001101010101010101010101010101010101010001011101010101010101010101010101010101010101010101010101101010100011010101010101010101010101010101010101010101010101011010101000010101011101111010010011101001001110100100010100010111010101001101010100110101010011010101001101010100110101010011010101001101010100110101010000100 diff --git a/components/succinct-json/corpus/issue-0001.json.ib.idx b/components/succinct-json/corpus/issue-0001.json.ib.idx new file mode 100644 --- /dev/null +++ b/components/succinct-json/corpus/issue-0001.json.ib.idx @@ -0,0 +1,1 @@ +1010100000000000000000000001000000000100000000000000000010001000000000000000100010000000000000001010000000000000000100000000010000000000000000000000010000001000000000000010000000000000000010000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000000000000100000000000000000000000000000000000000000000000000000000000000000000010000000000000000010000010000000000000000001000100000000000000001000100000000000000000000010100000000100000000010000000000000100000000000001000000000000000010001000000000001010100000000000000010001000000000000100000000000000000001000000000000100000000000001000000000000100000000100000000100000000001000000000000001000001000000000000000010000001000000000000100000000001000000000000010000000000000010100000000000000010001000000000000100000000000000000000000100000000000010000000000001000000000000100000000100000000100000000000100000000000000100000100000000000000001000000100000000000010000000000010000000000000100000000000000001000000000000001010100000010000010000000000000001000000000000000000000000000000000000000000000000000000000000010000000000000001000001000000000000000010010000000000000010010000000000000010000000000000000000000000000000000000000000000001000000000000000100000100000000000000000000001000000000000000000000000000000000000000000000000000000001000000000000000000100000000001000000000000000010000010000000000000000000001000001000000000000000000010000010000000000000101000000001000000000001000000000000010000000000000001010000001000001000000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000001000001000000000000000010010000000000000010010000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000001000001000000000000000000000010000000000000001000000000000000000100000000001000000000000000010000010000000000000000000001000001000000000000000000010000010000000000000101000000001000000000001000000000000010000000000000000010000000000000000100010000000000000001010100000000000000000001010101000010000010000000000000000000000000000000000000000000000000000000000000101010000100000010000000000000000000000000000000000000000000000000000000000000101010000100000010000000000000000000000000000000000000000000000000000000000000001000000000000000100000000010000000000000000001010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000100000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000100000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000100000000000000000000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000010100000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100000000010000000000000000000000000000000000000000000000000000000000001010000000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000001000000000000000000000000000000000000001000000000000000000000000000000 diff --git a/components/succinct-json/corpus/issue-0001.md b/components/succinct-json/corpus/issue-0001.md new file mode 100644 --- /dev/null +++ b/components/succinct-json/corpus/issue-0001.md @@ -0,0 +1,9 @@ +In this issue, there is a missing open close at the end of the JSON document. + +Erroneous balance parens calculated: + + |<---------------------- last 64-bits ------------------------>| + 011010101001101010100110101010000100 + 0110101010011010101001101010100000000000000000000000000000000000 + ^ + +---- missing bit diff --git a/components/succinct-json/doctest/DoctestDriver.hs b/components/succinct-json/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-json/doctest/config.json #-} +#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/components/succinct-json/src/Data/Succinct/Json/DecodeError.hs b/components/succinct-json/src/Data/Succinct/Json/DecodeError.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/DecodeError.hs @@ -0,0 +1,3 @@ +module Data.Succinct.Json.DecodeError where + +newtype DecodeError = DecodeError String deriving (Eq, Show) diff --git a/components/succinct-json/src/Data/Succinct/Json/FromValue.hs b/components/succinct-json/src/Data/Succinct/Json/FromValue.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/FromValue.hs @@ -0,0 +1,58 @@ +module Data.Succinct.Json.FromValue where + +import Data.Text (Text) +import Data.Succinct.Json.DecodeError +import Data.Succinct.Json.Value + +import qualified Data.Text as T + +class FromJsonValue a where + fromJsonValue :: JsonValue -> Either DecodeError a + +instance FromJsonValue JsonValue where + fromJsonValue = Right + +instance FromJsonValue String where + fromJsonValue v = case v of + JsonString r -> Right (T.unpack r) + _ -> Left (DecodeError "Not a string") + +instance FromJsonValue Text where + fromJsonValue v = case v of + JsonString r -> Right r + _ -> Left (DecodeError "Not a string") + +instance FromJsonValue Int where + fromJsonValue v = case v of + JsonNumber r -> Right (floor r) + _ -> Left (DecodeError "Not an integer") + +instance FromJsonValue Double where + fromJsonValue v = case v of + JsonNumber r -> Right r + _ -> Left (DecodeError "Not a double") + +instance FromJsonValue Bool where + fromJsonValue v = case v of + JsonBool r -> Right r + _ -> Left (DecodeError "Not a boolean") + +instance FromJsonValue a => FromJsonValue [a] where + fromJsonValue v = case v of + JsonArray xs -> mapM fromJsonValue xs + _ -> Left (DecodeError "Not an array") + +instance (FromJsonValue a, FromJsonValue b) => FromJsonValue (a, b) where + fromJsonValue v = case v of + JsonArray (a:b:_) -> (,) <$> fromJsonValue a <*> fromJsonValue b + _ -> Left (DecodeError "Not a 2-tuple") + +instance (FromJsonValue a, FromJsonValue b, FromJsonValue c) => FromJsonValue (a, b, c) where + fromJsonValue v = case v of + JsonArray (a:b:c:_) -> (,,) <$> fromJsonValue a <*> fromJsonValue b <*> fromJsonValue c + _ -> Left (DecodeError "Not a 3-tuple") + +instance (FromJsonValue a, FromJsonValue b, FromJsonValue c, FromJsonValue d) => FromJsonValue (a, b, c, d) where + fromJsonValue v = case v of + JsonArray (a:b:c:d:_) -> (,,,) <$> fromJsonValue a <*> fromJsonValue b <*> fromJsonValue c <*> fromJsonValue d + _ -> Left (DecodeError "Not a 4-tuple") diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/CharLike.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/CharLike.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/CharLike.hs @@ -0,0 +1,23 @@ +module Data.Succinct.Json.Internal.CharLike where + +import Data.Word +import Data.Word8 +import Data.Succinct.Json.Standard.Cursor.Internal.Word8 + +class JsonCharLike c where + isLeadingDigit2 :: c -> Bool + isQuotDbl :: c -> Bool + isChar_t :: c -> Bool + isChar_f :: c -> Bool + isChar_n :: c -> Bool + isBraceLeft :: c -> Bool + isBracketLeft :: c -> Bool + +instance JsonCharLike Word8 where + isLeadingDigit2 = isLeadingDigit + isQuotDbl = (== _quotedbl) + isChar_t = (== _t) + isChar_f = (== _f) + isChar_n = (== _n) + isBraceLeft = (== _braceleft) + isBracketLeft = (== _bracketleft) diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Doc.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Doc.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Doc.hs @@ -0,0 +1,27 @@ +module Data.Succinct.Json.Internal.Doc + ( hEncloseSep, + text, + red, + dullgreen, + cyan, + ) where + +import Prettyprinter + +hEncloseSep :: Doc a -> Doc a -> Doc a -> [Doc a] -> Doc a +hEncloseSep l r s ds = case ds of + [] -> l <> r + [d] -> l <> d <> r + _ -> hcat (zipWith (<>) (l : repeat s) ds) <> r + +text :: String -> Doc a +text = pretty + +red :: Doc a -> Doc a +red = id + +dullgreen :: Doc a -> Doc a +dullgreen = id + +cyan :: Doc a -> Doc a +cyan = id diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Index.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Index.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Index.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Json.Internal.Index where + +import Control.Arrow +import Control.Monad +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import Data.Succinct.Json.DecodeError +import Data.Succinct.Json.Internal.CharLike +import Data.Succinct.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Data.TreeCursor +import HaskellWorks.Data.Uncons +import Prelude hiding (drop) + +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified Data.Succinct.BalancedParens as BP + +data JsonIndex + = JsonIndexString BS.ByteString + | JsonIndexNumber BS.ByteString + | JsonIndexObject [(BS.ByteString, JsonIndex)] + | JsonIndexArray [JsonIndex] + | JsonIndexBool Bool + | JsonIndexNull + deriving (Eq, Show) + +class JsonIndexAt a where + jsonIndexAt :: a -> Either DecodeError JsonIndex + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (GenericCursor BS.ByteString v w) where + jsonIndexAt k = case uncons remainder of + Just (!c, _) | isLeadingDigit2 c -> Right (JsonIndexNumber remainder) + Just (!c, _) | isQuotDbl c -> Right (JsonIndexString remainder) + Just (!c, _) | isChar_t c -> Right (JsonIndexBool True) + Just (!c, _) | isChar_f c -> Right (JsonIndexBool False) + Just (!c, _) | isChar_n c -> Right JsonIndexNull + Just (!c, _) | isBraceLeft c -> JsonIndexObject <$> mapValuesFrom (firstChild k) + Just (!c, _) | isBracketLeft c -> JsonIndexArray <$> arrayValuesFrom (firstChild k) + Just _ -> Left (DecodeError "Invalid Json Type") + Nothing -> Left (DecodeError "End of data" ) + where ik = interests k + bpk = balancedParens k + p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + remainder = drop (toCount p) (cursorText k) + arrayValuesFrom j = sequence (L.unfoldr (fmap (jsonIndexAt &&& nextSibling)) j) + mapValuesFrom j = (pairwise >=> asField) <$> arrayValuesFrom j + pairwise (a:b:rs) = (a, b) : pairwise rs + pairwise _ = [] + asField (a, b) = case a of + JsonIndexString s -> [(s, b)] + _ -> [] diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/PartialIndex.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/PartialIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/PartialIndex.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Internal.PartialIndex where + +import Control.Arrow +import Control.Monad +import Data.String +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import Data.Succinct.Json.Internal.CharLike +import Data.Succinct.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Data.TreeCursor +import HaskellWorks.Data.Uncons +import Prelude hiding (drop) + +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified Data.Succinct.BalancedParens as BP + +data JsonPartialIndex + = JsonPartialIndexString BS.ByteString + | JsonPartialIndexNumber BS.ByteString + | JsonPartialIndexObject [(BS.ByteString, JsonPartialIndex)] + | JsonPartialIndexArray [JsonPartialIndex] + | JsonPartialIndexBool Bool + | JsonPartialIndexNull + | JsonPartialIndexError String + deriving (Eq, Show) + +class JsonPartialIndexAt a where + jsonPartialIndexAt :: a -> JsonPartialIndex + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (GenericCursor BS.ByteString v w) where + jsonPartialIndexAt k = case uncons remainder of + Just (!c, _) | isLeadingDigit2 c -> JsonPartialIndexNumber remainder + Just (!c, _) | isQuotDbl c -> JsonPartialIndexString remainder + Just (!c, _) | isChar_t c -> JsonPartialIndexBool True + Just (!c, _) | isChar_f c -> JsonPartialIndexBool False + Just (!c, _) | isChar_n c -> JsonPartialIndexNull + Just (!c, _) | isBraceLeft c -> JsonPartialIndexObject (mapValuesFrom (firstChild k)) + Just (!c, _) | isBracketLeft c -> JsonPartialIndexArray (arrayValuesFrom (firstChild k)) + Just _ -> JsonPartialIndexError "Invalid Json Type" + Nothing -> JsonPartialIndexError "End of data" + where ik = interests k + bpk = balancedParens k + p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + remainder = drop (toCount p) (cursorText k) + arrayValuesFrom :: Maybe (GenericCursor BS.ByteString v w) -> [JsonPartialIndex] + arrayValuesFrom = L.unfoldr (fmap (jsonPartialIndexAt &&& nextSibling)) + mapValuesFrom j = pairwise (arrayValuesFrom j) >>= asField + pairwise (a:b:rs) = (a, b) : pairwise rs + pairwise _ = [] + asField (a, b) = case a of + JsonPartialIndexString s -> [(s, b)] + _ -> [] + diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Slurp.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Slurp.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Slurp.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Json.Internal.Slurp + ( JsonState(..) + , slurpText + , slurpNumber + ) where + +import Data.Text +import Data.Word +import Data.Word8 +import Data.Succinct.Json.Standard.Cursor.Internal.Word8 +import Prelude hiding (drop) + +import qualified Data.Aeson.Parser.Internal as AP +import qualified Data.Attoparsec.ByteString as PBS +import qualified Data.ByteString as BS +import qualified Data.Text as T + +data JsonState + = Escaped + | InJson + | InString + | InNumber + | InIdent + +-- | Slurp a JSON string +-- +-- Examples: +-- +-- >>> :set -XOverloadedStrings +-- >>> slurpText "\"Hello\"" +-- Right "Hello" +-- >>> slurpText "123" +-- Left "34: Failed reading: satisfy" +slurpText :: BS.ByteString -> Either Text Text +slurpText bs = case PBS.parseOnly AP.jstring bs of + Right t -> Right t + Left e -> Left (T.pack e) + +-- | Slurp a JSON number +-- +-- Examples: +-- +-- >>> :set -XOverloadedStrings +-- >>> slurpNumber "123, true" +-- "123" +-- >>> slurpNumber "\"Hello\"" +-- "\"Hello\"" +slurpNumber :: BS.ByteString -> BS.ByteString +slurpNumber bs = let (!cs, _) = BS.unfoldrN (BS.length bs) genNumber (InJson, bs) in cs + where genNumber :: (JsonState, BS.ByteString) -> Maybe (Word8, (JsonState, BS.ByteString)) + genNumber (InJson, cs) = case BS.uncons cs of + Just (!d, !ds) | isLeadingDigit d -> Just (d , (InNumber , ds)) + Just (!d, !ds) -> Just (d , (InJson , ds)) + Nothing -> Nothing + genNumber (InNumber, cs) = case BS.uncons cs of + Just (!d, !ds) | isTrailingDigit d -> Just (d , (InNumber , ds)) + Just (!d, !ds) | d == _quotedbl -> Just (_parenleft , (InString , ds)) + _ -> Nothing + genNumber (_, _) = Nothing diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Standard/Cursor/Token.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Standard/Cursor/Token.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Standard/Cursor/Token.hs @@ -0,0 +1,23 @@ +module Data.Succinct.Json.Internal.Standard.Cursor.Token + ( jsonTokenAt + ) where + +import Data.ByteString.Internal as BSI +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import Data.Succinct.Json.Internal.Standard.Token.Tokenize +import Data.Succinct.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Prelude hiding (drop) + +import qualified Data.Attoparsec.ByteString.Char8 as ABC + +jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => GenericCursor ByteString v w -> Maybe (JsonToken String Double) +jsonTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k) + then case ABC.parse parseJsonToken (drop (toCount (jsonCursorPos k)) (cursorText k)) of + ABC.Fail {} -> error "Failed to parse token in cursor" + ABC.Partial _ -> error "Failed to parse token in cursor" + ABC.Done _ r -> Just r + else Nothing diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Standard/Token/Tokenize.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Standard/Token/Tokenize.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Standard/Token/Tokenize.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Internal.Standard.Token.Tokenize + ( IsChar(..) + , JsonToken(..) + , ParseJson(..) + ) where + +import Control.Applicative +import Data.Bits +import Data.Char +import Data.Word +import Data.Word8 +import HaskellWorks.Data.Char.IsChar +import Data.Succinct.Json.Internal.Token.Types +import Data.Succinct.Parser (()) + +import qualified Data.Attoparsec.ByteString.Char8 as BC +import qualified Data.Attoparsec.Combinator as AC +import qualified Data.Attoparsec.Types as T +import qualified Data.ByteString as BS +import qualified Data.Succinct.Parser as P + +{- HLINT ignore "Reduce duplication" -} + +hexDigitNumeric :: P.Parser t u => T.Parser t Int +hexDigitNumeric = do + c <- P.satisfyChar (\c -> '0' <= c && c <= '9') + return $ ord c - ord '0' + +hexDigitAlphaLower :: P.Parser t u => T.Parser t Int +hexDigitAlphaLower = do + c <- P.satisfyChar (\c -> 'a' <= c && c <= 'z') + return $ ord c - ord 'a' + 10 + +hexDigitAlphaUpper :: P.Parser t u => T.Parser t Int +hexDigitAlphaUpper = do + c <- P.satisfyChar (\c -> 'A' <= c && c <= 'Z') + return $ ord c - ord 'A' + 10 + +hexDigit :: P.Parser t u => T.Parser t Int +hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper + +class ParseJson t s d where + parseJsonTokenString :: T.Parser t (JsonToken s d) + parseJsonToken :: T.Parser t (JsonToken s d) + parseJsonTokenBraceL :: T.Parser t (JsonToken s d) + parseJsonTokenBraceR :: T.Parser t (JsonToken s d) + parseJsonTokenBracketL :: T.Parser t (JsonToken s d) + parseJsonTokenBracketR :: T.Parser t (JsonToken s d) + parseJsonTokenComma :: T.Parser t (JsonToken s d) + parseJsonTokenColon :: T.Parser t (JsonToken s d) + parseJsonTokenWhitespace :: T.Parser t (JsonToken s d) + parseJsonTokenNull :: T.Parser t (JsonToken s d) + parseJsonTokenBoolean :: T.Parser t (JsonToken s d) + parseJsonTokenDouble :: T.Parser t (JsonToken s d) + + parseJsonToken = + parseJsonTokenString <|> + parseJsonTokenBraceL <|> + parseJsonTokenBraceR <|> + parseJsonTokenBracketL <|> + parseJsonTokenBracketR <|> + parseJsonTokenComma <|> + parseJsonTokenColon <|> + parseJsonTokenWhitespace <|> + parseJsonTokenNull <|> + parseJsonTokenBoolean <|> + parseJsonTokenDouble + +instance ParseJson BS.ByteString String Double where + parseJsonTokenBraceL = P.string "{" >> return JsonTokenBraceL + parseJsonTokenBraceR = P.string "}" >> return JsonTokenBraceR + parseJsonTokenBracketL = P.string "[" >> return JsonTokenBracketL + parseJsonTokenBracketR = P.string "]" >> return JsonTokenBracketR + parseJsonTokenComma = P.string "," >> return JsonTokenComma + parseJsonTokenColon = P.string ":" >> return JsonTokenColon + parseJsonTokenNull = P.string "null" >> return JsonTokenNull + parseJsonTokenDouble = JsonTokenNumber <$> P.rational + + parseJsonTokenString = do + _ <- P.string "\"" + value <- many (verbatimChar <|> escapedChar <|> escapedCode) + _ <- P.string "\"" + return $ JsonTokenString value + where + verbatimChar = P.satisfyChar (BC.notInClass "\"\\") "invalid string character" + escapedChar = do + _ <- P.string "\\" + ( P.char '"' >> return '"' ) <|> + ( P.char 'b' >> return '\b' ) <|> + ( P.char 'n' >> return '\n' ) <|> + ( P.char 'f' >> return '\f' ) <|> + ( P.char 'r' >> return '\r' ) <|> + ( P.char 't' >> return '\t' ) <|> + ( P.char '\\' >> return '\\' ) <|> + ( P.char '\'' >> return '\'' ) <|> + ( P.char '/' >> return '/' ) + escapedCode = do + _ <- P.string "\\u" + a <- hexDigit + b <- hexDigit + c <- hexDigit + d <- hexDigit + return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d + + parseJsonTokenWhitespace = do + _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"] + return JsonTokenWhitespace + + parseJsonTokenBoolean = true <|> false + where true = P.string "true" >> return (JsonTokenBoolean True) + false = P.string "false" >> return (JsonTokenBoolean False) + +instance ParseJson BS.ByteString BS.ByteString Double where + parseJsonTokenBraceL = P.string "{" >> return JsonTokenBraceL + parseJsonTokenBraceR = P.string "}" >> return JsonTokenBraceR + parseJsonTokenBracketL = P.string "[" >> return JsonTokenBracketL + parseJsonTokenBracketR = P.string "]" >> return JsonTokenBracketR + parseJsonTokenComma = P.string "," >> return JsonTokenComma + parseJsonTokenColon = P.string ":" >> return JsonTokenColon + parseJsonTokenNull = P.string "null" >> return JsonTokenNull + parseJsonTokenDouble = JsonTokenNumber <$> P.rational + + parseJsonTokenString = do + _ <- P.string "\"" + value <- many (verbatimChar <|> escapedChar <|> escapedCode) + _ <- P.string "\"" + return $ JsonTokenString $ BS.pack value + where + word :: Word8 -> T.Parser BS.ByteString Word8 + word w = P.satisfy (== w) + verbatimChar :: T.Parser BS.ByteString Word8 + verbatimChar = P.satisfy (\w -> w /= _quotedbl && w /= _backslash) -- "invalid string character" + escapedChar :: T.Parser BS.ByteString Word8 + escapedChar = do + _ <- P.string "\\" + ( word _quotedbl >> return _quotedbl ) <|> + ( word _b >> return 0x08 ) <|> + ( word _n >> return _lf ) <|> + ( word _f >> return _np ) <|> + ( word _r >> return _cr ) <|> + ( word _t >> return _tab ) <|> + ( word _backslash >> return _backslash ) <|> + ( word _quotesingle >> return _quotesingle ) <|> + ( word _slash >> return _slash ) + escapedCode :: T.Parser BS.ByteString Word8 + escapedCode = do + _ <- P.string "\\u" + a <- hexDigit + b <- hexDigit + c <- hexDigit + d <- hexDigit + return $ fromIntegral $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d + + parseJsonTokenWhitespace = do + _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"] + return JsonTokenWhitespace + + parseJsonTokenBoolean = true <|> false + where + true = P.string "true" >> return (JsonTokenBoolean True) + false = P.string "false" >> return (JsonTokenBoolean False) diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Token.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Token.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Token.hs @@ -0,0 +1,5 @@ +module Data.Succinct.Json.Internal.Token + ( module X + ) where + +import Data.Succinct.Json.Internal.Standard.Token.Tokenize as X diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Token/Types.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Token/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Token/Types.hs @@ -0,0 +1,15 @@ +module Data.Succinct.Json.Internal.Token.Types (JsonToken(..)) where + +data JsonToken s d + = JsonTokenBraceL + | JsonTokenBraceR + | JsonTokenBracketL + | JsonTokenBracketR + | JsonTokenComma + | JsonTokenColon + | JsonTokenWhitespace + | JsonTokenString s + | JsonTokenBoolean Bool + | JsonTokenNumber d + | JsonTokenNull + deriving (Eq, Show) diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Value.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Value.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Value.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Internal.Value where + +import Control.Applicative +import Data.Bits +import Data.Char +import Data.String +import Data.Succinct.Parser as P + +import qualified Data.Attoparsec.ByteString.Char8 as ABC +import qualified Data.Attoparsec.Types as T + +parseHexDigitNumeric :: P.Parser t u => T.Parser t Int +parseHexDigitNumeric = do + c <- satisfyChar (\c -> '0' <= c && c <= '9') + return $ ord c - ord '0' + +parseHexDigitAlphaLower :: P.Parser t u => T.Parser t Int +parseHexDigitAlphaLower = do + c <- satisfyChar (\c -> 'a' <= c && c <= 'z') + return $ ord c - ord 'a' + 10 + +parseHexDigitAlphaUpper :: P.Parser t u => T.Parser t Int +parseHexDigitAlphaUpper = do + c <- satisfyChar (\c -> 'A' <= c && c <= 'Z') + return $ ord c - ord 'A' + 10 + +parseHexDigit :: P.Parser t u => T.Parser t Int +parseHexDigit = parseHexDigitNumeric <|> parseHexDigitAlphaLower <|> parseHexDigitAlphaUpper + +parseJsonString :: (P.Parser t u, IsString t) => T.Parser t String +parseJsonString = do + _ <- string "\"" + value <- many (verbatimChar <|> escapedChar <|> escapedCode) + _ <- string "\"" + return value + where + verbatimChar = satisfyChar (ABC.notInClass "\"\\") "invalid string character" + escapedChar = do + _ <- string "\\" + ( char '"' >> return '"' ) <|> + ( char 'b' >> return '\b' ) <|> + ( char 'n' >> return '\n' ) <|> + ( char 'f' >> return '\f' ) <|> + ( char 'r' >> return '\r' ) <|> + ( char 't' >> return '\t' ) <|> + ( char '\\' >> return '\\' ) <|> + ( char '\'' >> return '\'' ) <|> + ( char '/' >> return '/' ) + escapedCode = do + _ <- string "\\u" + a <- parseHexDigit + b <- parseHexDigit + c <- parseHexDigit + d <- parseHexDigit + let res = a `shift` 12 .|. b `shift` 8 .|. c `shift` 4 .|. d + return $ if res <= 0x10FFFF + then chr res + else '�' diff --git a/components/succinct-json/src/Data/Succinct/Json/Internal/Word64.hs b/components/succinct-json/src/Data/Succinct/Json/Internal/Word64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Internal/Word64.hs @@ -0,0 +1,29 @@ +module Data.Succinct.Json.Internal.Word64 where + +import Data.Word + +import qualified Data.Succinct.Json.Standard.Cursor.Internal.Word8 as W8 + +doubleQuote :: Word64 +doubleQuote = 0x0101010101010101 * fromIntegral W8.doubleQuote + +backSlack :: Word64 +backSlack = 0x0101010101010101 * fromIntegral W8.backSlash + +openBrace :: Word64 +openBrace = 0x0101010101010101 * fromIntegral W8.openBrace + +closeBrace :: Word64 +closeBrace = 0x0101010101010101 * fromIntegral W8.closeBrace + +openBracket :: Word64 +openBracket = 0x0101010101010101 * fromIntegral W8.openBracket + +closeBracket :: Word64 +closeBracket = 0x0101010101010101 * fromIntegral W8.closeBracket + +comma :: Word64 +comma = 0x0101010101010101 * fromIntegral W8.comma + +colon :: Word64 +colon = 0x0101010101010101 * fromIntegral W8.colon diff --git a/components/succinct-json/src/Data/Succinct/Json/LightJson.hs b/components/succinct-json/src/Data/Succinct/Json/LightJson.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/LightJson.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.LightJson where + +import Control.Arrow +import Control.Monad +import Data.String +import Data.Text (Text) +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import Data.Succinct.Json.Internal.CharLike +import Data.Succinct.Json.Internal.Doc +import Data.Succinct.Json.Internal.Slurp +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.MQuery +import Data.Succinct.MQuery.AtLeastSize +import Data.Succinct.MQuery.Entry +import Data.Succinct.MQuery.Micro +import Data.Succinct.MQuery.Mini +import Data.Succinct.MQuery.Row +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Data.TreeCursor +import HaskellWorks.Data.Uncons +import Prelude hiding (drop) +import Prettyprinter + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Succinct.BalancedParens as BP +import qualified Data.Succinct.Json.Simple.Cursor as JSC + +data LightJson c + = LightJsonString Text + | LightJsonNumber BS.ByteString + | LightJsonObject [(Text, c)] + | LightJsonArray [c] + | LightJsonBool Bool + | LightJsonNull + | LightJsonError Text + deriving Show + +instance LightJsonAt c => Eq (LightJson c) where + (==) (LightJsonString a) (LightJsonString b) = a == b + (==) (LightJsonNumber a) (LightJsonNumber b) = a == b + (==) (LightJsonBool a) (LightJsonBool b) = a == b + (==) (LightJsonObject a) (LightJsonObject b) = fmap (fmap lightJsonAt) a == fmap (fmap lightJsonAt) b + (==) (LightJsonArray a) (LightJsonArray b) = fmap lightJsonAt a == fmap lightJsonAt b + (==) LightJsonNull LightJsonNull = True + (==) (LightJsonError a) (LightJsonError b) = a == b + (==) _ _ = False + +data LightJsonField c = LightJsonField Text (LightJson c) + +class LightJsonAt a where + lightJsonAt :: a -> LightJson a + +instance LightJsonAt c => Pretty (LightJsonField c) where + pretty (LightJsonField k v) = text (show k) <> text ": " <> pretty v + +instance LightJsonAt c => Pretty (LightJson c) where + pretty c = case c of + LightJsonString s -> dullgreen (text (show s)) + LightJsonNumber n -> cyan (text (show n)) + LightJsonObject [] -> text "{}" + LightJsonObject kvs -> hEncloseSep (text "{") (text "}") (text ",") ((pretty . toLightJsonField . second lightJsonAt) `map` kvs) + LightJsonArray vs -> hEncloseSep (text "[") (text "]") (text ",") ((pretty . lightJsonAt) `map` vs) + LightJsonBool w -> red (text (show w)) + LightJsonNull -> text "null" + LightJsonError s -> text " text (T.unpack s) <> text ">" + where toLightJsonField :: (Text, LightJson c) -> LightJsonField c + toLightJsonField (k, v) = LightJsonField k v + +instance Pretty (Micro (LightJson c)) where + pretty (Micro (LightJsonString s )) = dullgreen (text (show s)) + pretty (Micro (LightJsonNumber n )) = cyan (text (show n)) + pretty (Micro (LightJsonObject [])) = text "{}" + pretty (Micro (LightJsonObject _ )) = text "{..}" + pretty (Micro (LightJsonArray [] )) = text "[]" + pretty (Micro (LightJsonArray _ )) = text "[..]" + pretty (Micro (LightJsonBool w )) = red (text (show w)) + pretty (Micro LightJsonNull ) = text "null" + pretty (Micro (LightJsonError s )) = text " text (T.unpack s) <> text ">" + +instance Pretty (Micro (String, LightJson c)) where + pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) + +instance Pretty (Micro (Text, LightJson c)) where + pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) + +instance LightJsonAt c => Pretty (Mini (LightJson c)) where + pretty mjpv = case mjpv of + Mini (LightJsonString s ) -> dullgreen (text (show s)) + Mini (LightJsonNumber n ) -> cyan (text (show n)) + Mini (LightJsonObject kvs ) -> case kvs of + (_:_:_:_:_:_:_:_:_:_:_:_:_) -> text "{" <> prettyKvs (map (second lightJsonAt) kvs) <> text ", ..}" + [] -> text "{}" + _ -> text "{" <> prettyKvs (map (second lightJsonAt) kvs) <> text "}" + Mini (LightJsonArray [] ) -> text "[]" + Mini (LightJsonArray vs ) | vs `atLeastSize` 11 -> text "[" <> nest 2 (prettyVs ((Micro . lightJsonAt) `map` take 10 vs)) <> text ", ..]" + Mini (LightJsonArray vs ) | vs `atLeastSize` 1 -> text "[" <> nest 2 (prettyVs ((Micro . lightJsonAt) `map` take 10 vs)) <> text "]" + Mini (LightJsonArray _ ) -> text "[]" + Mini (LightJsonBool w ) -> red (text (show w)) + Mini LightJsonNull -> text "null" + Mini (LightJsonError s ) -> text " text (T.unpack s) <> text ">" + +instance LightJsonAt c => Pretty (Mini (String, LightJson c)) where + pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv) + +instance LightJsonAt c => Pretty (Mini (Text, LightJson c)) where + pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv) + +instance LightJsonAt c => Pretty (MQuery (LightJson c)) where + pretty = pretty . Row 120 . mQuery + +instance LightJsonAt c => Pretty (MQuery (Entry String (LightJson c))) where + pretty (MQuery das) = pretty (Row 120 das) + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (GenericCursor BS.ByteString v w) where + lightJsonAt k = case uncons remainder of + Just (!c, _) | isLeadingDigit2 c -> LightJsonNumber (slurpNumber remainder) + Just (!c, _) | isQuotDbl c -> either LightJsonError LightJsonString (slurpText remainder) + Just (!c, _) | isChar_t c -> LightJsonBool True + Just (!c, _) | isChar_f c -> LightJsonBool False + Just (!c, _) | isChar_n c -> LightJsonNull + Just (!c, _) | isBraceLeft c -> LightJsonObject (mapValuesFrom (firstChild k)) + Just (!c, _) | isBracketLeft c -> LightJsonArray (arrayValuesFrom (firstChild k)) + Just _ -> LightJsonError "Invalid Json Type" + Nothing -> LightJsonError "End of data" + where ik = interests k + bpk = balancedParens k + p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + remainder = drop (toCount p) (cursorText k) + arrayValuesFrom = L.unfoldr (fmap (id &&& nextSibling)) + mapValuesFrom j = pairwise (arrayValuesFrom j) >>= asField + pairwise (a:b:rs) = (a, b) : pairwise rs + pairwise _ = [] + asField (a, b) = case lightJsonAt a of + LightJsonString s -> [(s, b)] + _ -> [] + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (JSC.JsonCursor BS.ByteString v w) where + lightJsonAt k = if kra `mod` 2 == 1 + then let i = fromIntegral (kpa - 1) :: Int in + if i < BS.length kt + then case BSU.unsafeIndex kt i of + 91 -> LightJsonArray [] + 123 -> LightJsonObject [] + _ -> LightJsonError "Invalid collection character" + else LightJsonError "Index out of bounds" + else LightJsonError "Unaligned cursor" + where kpa = select1 kib kta + km + kib = JSC.interests k + kra = JSC.cursorRank k + ksa = kra + 1 + kta = ksa `div` 2 + km = ksa `mod` 2 + kt = JSC.cursorText k diff --git a/components/succinct-json/src/Data/Succinct/Json/PartialValue.hs b/components/succinct-json/src/Data/Succinct/Json/PartialValue.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/PartialValue.hs @@ -0,0 +1,223 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.PartialValue + ( JsonPartialValue(..) + , JsonPartialValueAt(..) + , asInteger + , asString + , asText + , castAsInteger + , entry + , hasKey + , hasKV + , item + , jsonKeys + , jsonSize + , named + ) where + +import Control.Arrow +import Data.String +import Data.Text (Text) +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Json.Internal.Doc +import Data.Succinct.Json.Internal.PartialIndex +import Data.Succinct.Json.Internal.Value +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.MQuery +import Data.Succinct.MQuery.AtLeastSize +import Data.Succinct.MQuery.Entry +import Data.Succinct.MQuery.Micro +import Data.Succinct.MQuery.Mini +import Data.Succinct.MQuery.Row +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Prelude hiding (drop) +import Prettyprinter + +import qualified Data.Attoparsec.ByteString.Char8 as ABC +import qualified Data.ByteString as BS +import qualified Data.DList as DL +import qualified Data.Text as T +import qualified Data.Succinct.BalancedParens as BP + +-- | Partial JSON type. +-- +-- This data type has an additional 'JsonPartialError' data constructor to indicate parsing +-- errors. This allows parsing to be more lazy because parsing errors may now be expressed +-- anywhere in the parsed document so the parser no longer needs to make a verdict about whether +-- there are any parsing errors in the entire document. +-- +-- See 'jsonPartialJsonValueAt' on how to parse JSON text into this datatype. +-- +-- Although this data type allows for lazier parsing it doesn't allow for sub-trees to be +-- garbage collected if a reference to an ancestor node is held. To avoid holding onto +-- sub-trees that are no longer needed without having to drop references to ancestors use +-- 'Data.Succinct.Json.LightJson.LightJson' instead. +data JsonPartialValue + = JsonPartialString Text + | JsonPartialNumber Double + | JsonPartialObject [(Text, JsonPartialValue)] + | JsonPartialArray [JsonPartialValue] + | JsonPartialBool Bool + | JsonPartialNull + | JsonPartialError Text + deriving (Eq, Show, Ord) + +class JsonPartialValueAt a where + -- | Get a JSON partial value from another type + -- + -- This function can always "succeed" because the data type it returns allows for the document value + -- to contain an arbitrary number of errors. This means errors can be reported in document nodes + -- as parsing occurs lazily. + -- + -- There are garbage collection implementations you may want to consider. If you would like to be + -- able to hold onto ancestor nodes and still be able to garbage collect visited sub-trees, then + -- consider using 'Data.Succinct.Json.LightJson.lightJsonAt' instead. + jsonPartialJsonValueAt :: a -> JsonPartialValue + +data JsonPartialField = JsonPartialField Text JsonPartialValue + +jsonPartialValueString :: JsonPartialValue -> Text +jsonPartialValueString pjv = case pjv of + JsonPartialString s -> s + _ -> "" + +instance JsonPartialValueAt JsonPartialIndex where + jsonPartialJsonValueAt i = case i of + JsonPartialIndexString s -> case ABC.parse parseJsonString s of + ABC.Fail {} -> JsonPartialError ("Invalid string: '" <> T.pack (show (BS.take 20 s)) <> "...'") + ABC.Partial _ -> JsonPartialError "Unexpected end of string" + ABC.Done _ r -> JsonPartialString (T.pack r) -- TODO optimise + JsonPartialIndexNumber s -> case ABC.parse ABC.rational s of + ABC.Fail {} -> JsonPartialError ("Invalid number: '" <> T.pack (show (BS.take 20 s)) <> "...'") + ABC.Partial f -> case f " " of + ABC.Fail {} -> JsonPartialError ("Invalid number: '" <> T.pack (show (BS.take 20 s)) <> "...'") + ABC.Partial _ -> JsonPartialError "Unexpected end of number" + ABC.Done _ r -> JsonPartialNumber r + ABC.Done _ r -> JsonPartialNumber r + JsonPartialIndexObject fs -> JsonPartialObject (map ((jsonPartialValueString . parseString) *** jsonPartialJsonValueAt) fs) + JsonPartialIndexArray es -> JsonPartialArray (map jsonPartialJsonValueAt es) + JsonPartialIndexBool v -> JsonPartialBool v + JsonPartialIndexNull -> JsonPartialNull + JsonPartialIndexError s -> JsonPartialError (T.pack s) -- TODO optimise + where parseString bs = case ABC.parse parseJsonString bs of + ABC.Fail {} -> JsonPartialError ("Invalid field: '" <> T.pack (show (BS.take 20 bs)) <> "...'") + ABC.Partial _ -> JsonPartialError "Unexpected end of field" + ABC.Done _ s -> JsonPartialString (T.pack s) -- TODO optimise + +toJsonPartialField :: (Text, JsonPartialValue) -> JsonPartialField +toJsonPartialField (k, v) = JsonPartialField k v + +instance Pretty JsonPartialField where + pretty (JsonPartialField k v) = text (show k) <> text ": " <> pretty v + +instance Pretty JsonPartialValue where + pretty mjpv = case mjpv of + JsonPartialString s -> dullgreen (text (show s)) + JsonPartialNumber n -> cyan (text (show n)) + JsonPartialObject [] -> text "{}" + JsonPartialObject kvs -> hEncloseSep (text "{") (text "}") (text ",") ((pretty . toJsonPartialField) `map` kvs) + JsonPartialArray vs -> hEncloseSep (text "[") (text "]") (text ",") (pretty `map` vs) + JsonPartialBool w -> red (text (show w)) + JsonPartialNull -> text "null" + JsonPartialError s -> text " text (T.unpack s) <> text ">" + +instance Pretty (Micro JsonPartialValue) where + pretty (Micro (JsonPartialString s )) = dullgreen (text (show s)) + pretty (Micro (JsonPartialNumber n )) = cyan (text (show n)) + pretty (Micro (JsonPartialObject [])) = text "{}" + pretty (Micro (JsonPartialObject _ )) = text "{..}" + pretty (Micro (JsonPartialArray [] )) = text "[]" + pretty (Micro (JsonPartialArray _ )) = text "[..]" + pretty (Micro (JsonPartialBool w )) = red (text (show w)) + pretty (Micro JsonPartialNull ) = text "null" + pretty (Micro (JsonPartialError s )) = text " text (T.unpack s) <> text ">" + +instance Pretty (Micro (String, JsonPartialValue)) where + pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) + +instance Pretty (Micro (Text, JsonPartialValue)) where + pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) + +instance Pretty (Mini JsonPartialValue) where + pretty mjpv = case mjpv of + Mini (JsonPartialString s ) -> dullgreen (text (show s)) + Mini (JsonPartialNumber n ) -> cyan (text (show n)) + Mini (JsonPartialObject kvs ) -> case kvs of + [] -> text "{}" + (_:_:_:_:_:_:_:_:_:_:_:_:_) -> text "{" <> prettyKvs kvs <> text ", ..}" + _ -> text "{" <> prettyKvs kvs <> text "}" + Mini (JsonPartialArray [] ) -> text "[]" + Mini (JsonPartialArray vs ) | vs `atLeastSize` 11 -> text "[" <> nest 2 (prettyVs (Micro `map` take 10 vs)) <> text ", ..]" + Mini (JsonPartialArray vs ) | vs `atLeastSize` 1 -> text "[" <> nest 2 (prettyVs (Micro `map` take 10 vs)) <> text "]" + Mini (JsonPartialArray _ ) -> text "[]" + Mini (JsonPartialBool w ) -> red (text (show w)) + Mini JsonPartialNull -> text "null" + Mini (JsonPartialError s ) -> text " text (T.unpack s) <> text ">" + +instance Pretty (Mini (Text, JsonPartialValue)) where + pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv) + +instance Pretty (MQuery JsonPartialValue) where + pretty = pretty . Row 120 . mQuery + +instance Pretty (MQuery (Entry Text JsonPartialValue)) where + pretty (MQuery das) = pretty (Row 120 das) + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialValueAt (GenericCursor BS.ByteString v w) where + jsonPartialJsonValueAt = jsonPartialJsonValueAt . jsonPartialIndexAt + +hasKV :: Text -> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue +hasKV k v (JsonPartialObject xs) = if (k, v) `elem` xs then MQuery (DL.singleton (JsonPartialObject xs)) else MQuery DL.empty +hasKV _ _ _ = MQuery DL.empty + +item :: JsonPartialValue -> MQuery JsonPartialValue +item jpv = case jpv of + JsonPartialArray es -> MQuery $ DL.fromList es + _ -> MQuery DL.empty + +entry :: JsonPartialValue -> MQuery (Entry Text JsonPartialValue) +entry jpv = case jpv of + JsonPartialObject fs -> MQuery $ DL.fromList (uncurry Entry `map` fs) + _ -> MQuery DL.empty + +asString :: JsonPartialValue -> MQuery String +asString jpv = case jpv of + JsonPartialString s -> MQuery $ DL.singleton (T.unpack s) + _ -> MQuery DL.empty + +asText :: JsonPartialValue -> MQuery Text +asText jpv = case jpv of + JsonPartialString s -> MQuery $ DL.singleton s + _ -> MQuery DL.empty + +asInteger :: JsonPartialValue -> MQuery Integer +asInteger jpv = case jpv of + JsonPartialNumber n -> MQuery $ DL.singleton (floor n) + _ -> MQuery DL.empty + +castAsInteger :: JsonPartialValue -> MQuery Integer +castAsInteger jpv = case jpv of + JsonPartialString n -> MQuery $ DL.singleton (read (T.unpack n)) + JsonPartialNumber n -> MQuery $ DL.singleton (floor n) + _ -> MQuery DL.empty + +named :: Text -> Entry Text JsonPartialValue -> MQuery JsonPartialValue +named fieldName (Entry fieldName' jpv) | fieldName == fieldName' = MQuery $ DL.singleton jpv +named _ _ = MQuery DL.empty + +jsonKeys :: JsonPartialValue -> [Text] +jsonKeys jpv = case jpv of + JsonPartialObject fs -> fst `map` fs + _ -> [] + +hasKey :: Text -> JsonPartialValue -> Bool +hasKey fieldName jpv = fieldName `elem` jsonKeys jpv + +jsonSize :: JsonPartialValue -> MQuery JsonPartialValue +jsonSize jpv = case jpv of + JsonPartialArray es -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es)))) + JsonPartialObject es -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es)))) + _ -> MQuery (DL.singleton (JsonPartialNumber 0)) diff --git a/components/succinct-json/src/Data/Succinct/Json/Query.hs b/components/succinct-json/src/Data/Succinct/Json/Query.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Query.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Query where + +import Control.Arrow +import Data.Text (Text) +import Data.Succinct.Json.LightJson +import Data.Succinct.MQuery +import Data.Succinct.MQuery.Entry +import Prelude hiding (drop) + +import qualified Data.Attoparsec.ByteString.Char8 as ABC +import qualified Data.DList as DL +import qualified Data.Text as T + +item :: LightJsonAt c => LightJson c -> MQuery (LightJson c) +item jpv = case jpv of + LightJsonArray es -> MQuery $ DL.fromList (lightJsonAt `map` es) + _ -> MQuery DL.empty + +entry :: LightJsonAt c => LightJson c -> MQuery (Entry Text (LightJson c)) +entry jpv = case jpv of + LightJsonObject fs -> MQuery $ DL.fromList ((uncurry Entry . second lightJsonAt) `map` fs) + _ -> MQuery DL.empty + +asString :: LightJson c -> MQuery Text +asString jpv = case jpv of + LightJsonString s -> MQuery $ DL.singleton s + _ -> MQuery DL.empty + +asDouble :: LightJson c -> MQuery Double +asDouble jpv = case jpv of + LightJsonNumber sn -> case ABC.parse ABC.rational sn of + ABC.Fail {} -> MQuery DL.empty + ABC.Partial f -> case f " " of + ABC.Fail {} -> MQuery DL.empty + ABC.Partial _ -> MQuery DL.empty + ABC.Done _ r -> MQuery (DL.singleton r) + ABC.Done _ r -> MQuery (DL.singleton r) + _ -> MQuery DL.empty + +asInteger :: LightJson c -> MQuery Integer +asInteger jpv = do + d <- asDouble jpv + return (floor d) + +castAsInteger :: LightJson c -> MQuery Integer +castAsInteger jpv = case jpv of + LightJsonString n -> MQuery $ DL.singleton (read (T.unpack n)) -- TODO Optimise + LightJsonNumber _ -> asInteger jpv + _ -> MQuery DL.empty + +named :: Text -> Entry Text (LightJson c) -> MQuery (LightJson c) +named fieldName (Entry fieldName' jpv) | fieldName == fieldName' = MQuery $ DL.singleton jpv +named _ _ = MQuery DL.empty + +jsonKeys :: LightJson c -> [Text] +jsonKeys jpv = case jpv of + LightJsonObject fs -> fst `map` fs + _ -> [] + +hasKey :: Text -> LightJson c -> Bool +hasKey fieldName jpv = fieldName `elem` jsonKeys jpv + +jsonSize :: LightJson c -> MQuery Integer +jsonSize jpv = case jpv of + LightJsonArray es -> MQuery (DL.singleton (fromIntegral (length es))) + LightJsonObject es -> MQuery (DL.singleton (fromIntegral (length es))) + _ -> MQuery (DL.singleton 0) + diff --git a/components/succinct-json/src/Data/Succinct/Json/Simple/Value.hs b/components/succinct-json/src/Data/Succinct/Json/Simple/Value.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Simple/Value.hs @@ -0,0 +1,42 @@ +module Data.Succinct.Json.Simple.Value where + +import Data.Maybe +import Data.Succinct.Json.Simple.Cursor +import HaskellWorks.Data.Positioning +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy + +import qualified Data.ByteString as BS +import qualified Data.Succinct.BalancedParens as BP +import qualified Data.Succinct.BalancedParens.RangeMin as RM + +data JsonValue + = JsonValues JsonValues + | JsonNull + | JsonNumber Double + | JsonString String + | JsonBoolean Bool + deriving (Eq, Show) + +data JsonValues + = JsonArray [JsonValue] + | JsonObject [(String, JsonValue)] + deriving (Eq, Show) + +snippetPos :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> (Count, Count) +snippetPos k = (kpa, kpz) + where kpa = select1 kib kta + km + kpz = select1 kib ktz - km + kib = interests k + kbp = balancedParens k + kra = cursorRank k + krz = fromMaybe maxBound (BP.findClose kbp kra) + ksa = kra + 1 + ksz = krz + 1 + kta = ksa `div` 2 + ktz = ksz `div` 2 + km = ksa `mod` 2 + +snippet :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> BS.ByteString +snippet k = let (a, z) = snippetPos k in BS.take (fromIntegral (z - a + 1)) (BS.drop (fromIntegral (a - 1)) kt) + where kt = cursorText k diff --git a/components/succinct-json/src/Data/Succinct/Json/Standard/Load/Partial.hs b/components/succinct-json/src/Data/Succinct/Json/Standard/Load/Partial.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Standard/Load/Partial.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Json.Standard.Load.Partial + ( loadPartial + , loadPartialWithCsPoppyIndex + , loadPartialWithIndex + ) where + +import Data.Succinct.BalancedParens.Simple +import HaskellWorks.Data.Bits.BitShown +import Data.Succinct.Json.Internal.PartialIndex +import Data.Succinct.Json.PartialValue +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.Load.Raw +import Data.Succinct.RankSelect.CsPoppy + +loadPartialWithIndex :: String -> IO JsonPartialValue +loadPartialWithIndex filename = do + (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename + let cursor = GenericCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1 + let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) + return jsonResult + +loadPartialWithCsPoppyIndex :: String -> IO JsonPartialValue +loadPartialWithCsPoppyIndex filename = do + (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename + let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 + let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) + return jsonResult + +loadPartial :: String -> IO JsonPartialValue +loadPartial = loadPartialWithCsPoppyIndex diff --git a/components/succinct-json/src/Data/Succinct/Json/Value.hs b/components/succinct-json/src/Data/Succinct/Json/Value.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/src/Data/Succinct/Json/Value.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Value where + +import Data.Text (Text) +import Data.Succinct.Json.DecodeError +import Data.Succinct.Json.Internal.Index +import Data.Succinct.Json.Internal.Value + +import qualified Data.Attoparsec.ByteString.Char8 as ABC +import qualified Data.ByteString as BS +import qualified Data.Text as T + +-- | Traditional JSON type. +-- +-- This type has the a constructor per JSON data type as is typical for JSON in most libraries. +-- +-- See 'jsonValueAt' on how to parse JSON text into this datatype. +-- +-- Although Haskell data types are lazy by default, you will not get a fully lazy data structure +-- when parsing to this type because there is no way to express parsing errors in this datatype. +-- +-- For a data type that gives you lazier behaviour, see other alternatives such as +-- 'Data.Succinct.Json.PartialValue.JsonPartialValue' or 'Data.Succinct.Json.LightJson.LightJson'. +data JsonValue + = JsonString Text + | JsonNumber Double + | JsonObject [(Text, JsonValue)] + | JsonArray [JsonValue] + | JsonBool Bool + | JsonNull + deriving (Eq, Show) + +class JsonValueAt a where + -- | Get a JSON value from another type + -- + -- The @hw-json@ library does not do full JSON validation for efficiency reasons, but parsing can + -- fail if the JSON is malformed. When parsing fails, then 'Left' will be returned. + -- + -- If 'Right' is returned then that means there are no parsing failures, which implies "knowing" + -- that there parsing failures in the entire document, which implies that pattern matching on + -- 'Right' evaluates the entire document. + -- + -- This limits the laziness of the JSON parsing. For lazier alternatives, see + -- 'Data.Succinct.Json.PartialValue.jsonPartialJsonValueAt' or 'Data.Succinct.Json.LightJson.lightJsonAt'. + jsonValueAt :: a -> Either DecodeError JsonValue + +instance JsonValueAt JsonIndex where + jsonValueAt i = case i of + JsonIndexString s -> case ABC.parse parseJsonString s of + ABC.Fail {} -> Left (DecodeError ("Invalid string: '" ++ show (BS.take 20 s) ++ "...'")) + ABC.Partial _ -> Left (DecodeError "Unexpected end of string") + ABC.Done _ r -> Right (JsonString (T.pack r)) -- TODO optimise + JsonIndexNumber s -> case ABC.parse ABC.rational s of + ABC.Fail {} -> Left (DecodeError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")) + ABC.Partial f -> case f " " of + ABC.Fail {} -> Left (DecodeError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")) + ABC.Partial _ -> Left (DecodeError "Unexpected end of number") + ABC.Done _ r -> Right (JsonNumber r) + ABC.Done _ r -> Right (JsonNumber r) + JsonIndexObject fs -> JsonObject <$> mapM (\f -> (,) <$> parseText (fst f) <*> jsonValueAt (snd f)) fs + JsonIndexArray es -> JsonArray <$> mapM jsonValueAt es + JsonIndexBool v -> Right (JsonBool v) + JsonIndexNull -> Right JsonNull + where parseText bs = T.pack <$> parseString bs -- TODO optimise + parseString bs = case ABC.parse parseJsonString bs of + ABC.Fail {} -> Left (DecodeError ("Invalid field: '" ++ show (BS.take 20 bs) ++ "...'")) + ABC.Partial _ -> Left (DecodeError "Unexpected end of field") + ABC.Done _ s -> Right s diff --git a/components/succinct-json/test/Data/Succinct/Json/LightJsonSpec.hs b/components/succinct-json/test/Data/Succinct/Json/LightJsonSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Data/Succinct/Json/LightJsonSpec.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.LightJsonSpec (spec) where + +import Control.Monad +import Data.Text +import Data.Succinct.BalancedParens.BalancedParens +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Json.DecodeError +import Data.Succinct.Json.LightJson +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Value +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Aeson.Parser.Internal as AP +import qualified Data.Attoparsec.ByteString as PBS +import qualified Data.ByteString as BS +import qualified Data.Scientific as S +import qualified Data.Text as T +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Redundant do" -} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "Data.Succinct.Json.LightJsonSpec" $ do + genSpec "DVS.Vector Word64" SLOW.fromString + genSpec "CsPoppy" FAST.fromString + +jsonValueVia :: forall t u. + ( BalancedParens u + , Rank0 u + , Rank1 u + , Select1 t + , TestBit u) + => Maybe (GenericCursor BS.ByteString t u) + -> Either DecodeError JsonValue +jsonValueVia mk = case mk of + Just k -> case lightJsonAt k of + LightJsonString t -> Right (JsonString t) + LightJsonNumber bs -> case PBS.parseOnly AP.scientific bs of + Right s -> Right (JsonNumber (S.toRealFloat s)) + Left msg -> Left (DecodeError msg) + LightJsonObject ps -> fmap JsonObject (traverse fields ps) + LightJsonArray cs -> fmap JsonArray (traverse elements cs) + LightJsonBool v -> Right (JsonBool v) + LightJsonNull -> Right JsonNull + LightJsonError msg -> Left (DecodeError (T.unpack msg)) + Nothing -> Left (DecodeError "No such element") + where fields :: (Text, GenericCursor BS.ByteString t u) -> Either DecodeError (Text, JsonValue) + fields (f, c) = (f,) <$> jsonValueVia (Just c) + elements :: GenericCursor BS.ByteString t u -> Either DecodeError JsonValue + elements c = jsonValueVia (Just c) + +genSpec :: forall t u. + ( Eq t + , Show t + , Select1 t + , Eq u + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () +genSpec t makeCursor = do + describe ("Json cursor of type " ++ t) $ do + let forJson s f = describe ("of value " ++ show s) (f (makeCursor s)) + forJson "{}" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject []) + forJson " {}" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject []) + forJson "1234" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonNumber 1234) + forJson "\"Hello\"" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonString "Hello") + forJson "[]" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray []) + forJson "true" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool True) + forJson "false" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool False) + forJson "null" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right JsonNull + forJson "[null]" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray [JsonNull]) + it "should have correct value" $ requireTest $ jsonValueVia (fc cursor) === Right JsonNull + forJson "\"codepoint\\u2019s\"" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonString "codepoint’s") + forJson "[null, {\"field\": 1}]" $ \cursor -> do + it "cursor can navigate to second child of array" $ requireTest $ do + jsonValueVia ((fc >=> ns) cursor) === Right ( JsonObject [("field", JsonNumber 1)] ) + jsonValueVia (Just cursor) === Right (JsonArray [JsonNull, JsonObject [("field", JsonNumber 1)]]) + describe "For empty json array" $ do + let cursor = makeCursor "[]" + it "can navigate down and forwards" $ requireTest $ do + jsonValueVia (Just cursor) === Right (JsonArray []) + describe "For empty json array" $ do + let cursor = makeCursor "[null]" + it "can navigate down and forwards" $ requireTest $ do + jsonValueVia (Just cursor) === Right (JsonArray [JsonNull]) + describe "For sample Json" $ do + let cursor = makeCursor "{ \ + \ \"widget\": { \ + \ \"debug\": \"on\", \ + \ \"window\": { \ + \ \"name\": \"main_window\", \ + \ \"dimensions\": [500, 600.01e-02, true, false, null] \ + \ } \ + \ } \ + \}" :: GenericCursor BS.ByteString t u + it "can navigate down and forwards" $ requireTest $ do + let array = JsonArray [JsonNumber 500, JsonNumber 600.01e-02, JsonBool True, JsonBool False, JsonNull] :: JsonValue + let object1 = JsonObject ([("name", JsonString "main_window"), ("dimensions", array)]) :: JsonValue + let object2 = JsonObject ([("debug", JsonString "on"), ("window", object1)]) :: JsonValue + let object3 = JsonObject ([("widget", object2)]) :: JsonValue + jsonValueVia (Just cursor) === Right object3 + jsonValueVia ((fc ) cursor) === Right (JsonString "widget" ) + jsonValueVia ((fc >=> ns ) cursor) === Right (object2 ) + jsonValueVia ((fc >=> ns >=> fc ) cursor) === Right (JsonString "debug" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns ) cursor) === Right (JsonString "on" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonString "window" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (object1 ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) === Right (JsonString "name" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) === Right (JsonString "main_window" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonString "dimensions" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (array ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) === Right (JsonNumber 500 ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) === Right (JsonNumber 600.01e-02 ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonBool True ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (JsonBool False ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns) cursor) === Right JsonNull diff --git a/components/succinct-json/test/Data/Succinct/Json/Simple/CursorSpec.hs b/components/succinct-json/test/Data/Succinct/Json/Simple/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Data/Succinct/Json/Simple/CursorSpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Simple.CursorSpec + ( spec + ) where + +import Control.Monad +import Data.Succinct.Json.LightJson +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.Json.Simple.Cursor as Z +import qualified Data.Succinct.Json.Simple.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Simple.Value as V +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Redundant do" -} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "Data.Succinct.Json.Backend.Simple.CursorSpec" $ do + describe "Json cursor" $ do + describe "For sample Json" $ do + let k = FAST.fromByteString "[[11],[22]]" + -- [ [ 1 1 ] , [ 2 2 ] ] + -- (( (( )) )( (( )) )) + it "can navigate" $ requireTest $ do + (Z.cursorRank <$> Just k) === Just 1 + (Z.cursorRank <$> ns k) === Nothing + (Z.cursorRank <$> fc k) === Just 2 + (Z.cursorRank <$> (fc >=> ns ) k) === Just 8 + (Z.cursorRank <$> (fc >=> ns >=> fc ) k) === Just 9 + (Z.cursorRank <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc ) k) === Just 10 + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (Z.cursorRank <$> (fc >=> fc ) k) === Just 3 + (Z.cursorRank <$> (fc >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> fc >=> fc ) k) === Just 4 + (Z.cursorRank <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can snippet pos" $ requireTest $ do + (V.snippetPos <$> Just k) === Just (1, 11) + (V.snippetPos <$> ns k) === Nothing + (V.snippetPos <$> fc k) === Just (2, 5) + (V.snippetPos <$> (fc >=> ns ) k) === Just (7, 10) + (V.snippetPos <$> (fc >=> ns >=> fc ) k) === Just (7, 10) + (V.snippetPos <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (V.snippetPos <$> (fc >=> ns >=> fc >=> fc ) k) === Just (8, 9) + (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (V.snippetPos <$> (fc >=> fc ) k) === Just (2, 5) + (V.snippetPos <$> (fc >=> fc >=> ns ) k) === Nothing + (V.snippetPos <$> (fc >=> fc >=> fc ) k) === Just (3, 4) + (V.snippetPos <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (V.snippetPos <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can snippet" $ requireTest $ do + (V.snippet <$> Just k) === Just "[[11],[22]]" + (V.snippet <$> ns k) === Nothing + (V.snippet <$> fc k) === Just "[11]" + (V.snippet <$> (fc >=> ns ) k) === Just "[22]" + (V.snippet <$> (fc >=> ns >=> fc ) k) === Just "[22]" + (V.snippet <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (V.snippet <$> (fc >=> ns >=> fc >=> fc ) k) === Just "22" + (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (V.snippet <$> (fc >=> fc ) k) === Just "[11]" + (V.snippet <$> (fc >=> fc >=> ns ) k) === Nothing + (V.snippet <$> (fc >=> fc >=> fc ) k) === Just "11" + (V.snippet <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (V.snippet <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can lightJsonAt" $ requireTest $ do + lightJsonAt k === LightJsonArray [] diff --git a/components/succinct-json/test/Data/Succinct/Json/Standard/CursorSpec.hs b/components/succinct-json/test/Data/Succinct/Json/Standard/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Data/Succinct/Json/Standard/CursorSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Standard.CursorSpec(spec) where + +import Data.Succinct.Json.Standard.GenCursorTest +import Test.Hspec + +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Redundant do" -} + +spec :: Spec +spec = describe "Data.Succinct.Json.Succinct.CursorSpec" $ do + genTest "DVS.Vector Word64" SLOW.fromString + genTest "CsPoppy" FAST.fromString diff --git a/components/succinct-json/test/Data/Succinct/Json/Standard/GenCursorTest.hs b/components/succinct-json/test/Data/Succinct/Json/Standard/GenCursorTest.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Data/Succinct/Json/Standard/GenCursorTest.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.Standard.GenCursorTest(genTest) where + +import Control.Monad +import Data.Succinct.BalancedParens.BalancedParens +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Json.Internal.Index +import Data.Succinct.Json.Internal.Standard.Cursor.Token +import Data.Succinct.Json.Internal.Token +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Redundant do" -} + +fc = TC.firstChild +ns = TC.nextSibling +pn = TC.parent +ss = TC.subtreeSize + +genTest :: forall t u. + ( Eq t + , Show t + , Select1 t + , Eq u + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () +genTest t mkCursor = do + describe ("Json cursor of type " ++ t) $ do + describe "For empty json array" $ do + let cursor = mkCursor "[null]" + it "can navigate down and forwards" $ requireTest $ do + jsonIndexAt cursor === Right (JsonIndexArray [JsonIndexNull]) + describe "For sample Json" $ do + let cursor = mkCursor "\ + \{ \ + \ \"widget\": { \ + \ \"debug\": \"on\", \ + \ \"window\": { \ + \ \"name\": \"main_window\", \ + \ \"dimensions\": [500, 600.01e-02, true, false, null] \ + \ } \ + \ } \ + \}" + it "can navigate up" $ requireTest $ do + ( pn) cursor === Nothing + (fc >=> pn) cursor === Just cursor + (fc >=> ns >=> pn) cursor === Just cursor + (fc >=> ns >=> fc >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + it "can get subtree size" $ requireTest $ do + ( ss) cursor === Just 16 + (fc >=> ss) cursor === Just 1 + (fc >=> ns >=> ss) cursor === Just 14 + (fc >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 10 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6 + it "can get token at cursor" $ requireTest $ do + (jsonTokenAt ) cursor === Just (JsonTokenBraceL ) + (fc >=> jsonTokenAt) cursor === Just (JsonTokenString "widget" ) + (fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBraceL ) + (fc >=> ns >=> fc >=> jsonTokenAt) cursor === Just (JsonTokenString "debug" ) + (fc >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "on" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBraceL ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTokenAt) cursor === Just (JsonTokenString "name" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "main_window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "dimensions" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBracketL ) diff --git a/components/succinct-json/test/Data/Succinct/Json/Token/TokenizeSpec.hs b/components/succinct-json/test/Data/Succinct/Json/Token/TokenizeSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Data/Succinct/Json/Token/TokenizeSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Json.Token.TokenizeSpec (spec) where + +import Data.ByteString (ByteString) +import Data.Succinct.Json.Internal.Standard.Token.Tokenize +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Attoparsec.ByteString.Char8 as BC + +{- HLINT ignore "Redundant do" -} + +parseJsonToken' :: ByteString -> Either String (JsonToken String Double) +parseJsonToken' = BC.parseOnly parseJsonToken + +spec :: Spec +spec = describe "Data.Succinct.Json.Token.TokenizeSpec" $ do + describe "When parsing single token at beginning of text" $ do + it "Empty Json should produce no bits" $ requireTest $ + parseJsonToken' "" === Left "not enough input" + it "Json with one space should produce whitespace token" $ requireTest $ + parseJsonToken' " " === Right JsonTokenWhitespace + it "Json with two spaces should produce whitespace token" $ requireTest $ + parseJsonToken' " " === Right JsonTokenWhitespace + it "Spaces and newlines should produce no bits" $ requireTest $ + parseJsonToken' " \n \r \t " === Right JsonTokenWhitespace + it "`null` at beginning should produce one bit" $ requireTest $ + parseJsonToken' "null " === Right JsonTokenNull + it "number at beginning should produce one bit" $ requireTest $ + parseJsonToken' "1234 " === Right (JsonTokenNumber 1234) + it "false at beginning should produce one bit" $ requireTest $ + parseJsonToken' "false " === Right (JsonTokenBoolean False) + it "true at beginning should produce one bit" $ requireTest $ + parseJsonToken' "true " === Right (JsonTokenBoolean True) + it "string at beginning should produce one bit" $ requireTest $ + parseJsonToken' "\"hello\" " === Right (JsonTokenString "hello") + it "quoted string should parse" $ requireTest $ + parseJsonToken' "\"\\\"\" " === Right (JsonTokenString "\"") + it "left brace at beginning should produce one bit" $ requireTest $ + parseJsonToken' "{ " === Right JsonTokenBraceL + it "right brace at beginning should produce one bit" $ requireTest $ + parseJsonToken' "} " === Right JsonTokenBraceR + it "left bracket at beginning should produce one bit" $ requireTest $ + parseJsonToken' "[ " === Right JsonTokenBracketL + it "right bracket at beginning should produce one bit" $ requireTest $ + parseJsonToken' "] " === Right JsonTokenBracketR + it "right bracket at beginning should produce one bit" $ requireTest $ + parseJsonToken' ": " === Right JsonTokenColon + it "right bracket at beginning should produce one bit" $ requireTest $ + parseJsonToken' ", " === Right JsonTokenComma diff --git a/components/succinct-json/test/Data/Succinct/Json/TypeSpec.hs b/components/succinct-json/test/Data/Succinct/Json/TypeSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Data/Succinct/Json/TypeSpec.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.TypeSpec (spec) where + +import Control.Monad +import Data.Succinct.BalancedParens.BalancedParens +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Standard.Cursor.Type +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Redundant do" -} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "Data.Succinct.Json.Succinct.CursorSpec" $ do + genSpec "DVS.Vector Word64" SLOW.fromString + genSpec "CsPoppy" FAST.fromString + +genSpec :: forall t u. + ( Select1 t + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () +genSpec t makeCursor = do + describe ("Json cursor of type " ++ t) $ do + let forJson s f = describe ("of value " ++ show s) (f (makeCursor s)) + forJson "{}" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeObject + forJson " {}" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeObject + forJson "1234" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeNumber + forJson "\"Hello\"" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeString + forJson "[]" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeArray + forJson "true" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeBool + forJson "false" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeBool + forJson "null" $ \cursor -> do + it "should have correct type" $ requireTest $ jsonTypeAt cursor === Just JsonTypeNull + forJson "[null]" $ \cursor -> do + it "should have correct type" $ requireTest $ (fc >=> jsonTypeAt) cursor === Just JsonTypeNull + forJson "[null, {\"field\": 1}]" $ \cursor -> do + it "cursor can navigate to second child of array" $ requireTest $ do + (fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeObject + it "cursor can navigate to first child of object at second child of array" $ requireTest $ do + (fc >=> ns >=> fc >=> jsonTypeAt) cursor === Just JsonTypeString + it "cursor can navigate to first child of object at second child of array" $ requireTest $ do + (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeNumber + describe "For empty json array" $ do + let cursor = makeCursor "[null]" + it "can navigate down and forwards" $ requireTest $ do + ( jsonTypeAt) cursor === Just JsonTypeArray + (fc >=> jsonTypeAt) cursor === Just JsonTypeNull + (fc >=> ns >=> jsonTypeAt) cursor === Nothing + (fc >=> ns >=> ns >=> jsonTypeAt) cursor === Nothing + describe "For sample Json" $ do + let cursor = makeCursor "{ \ + \ \"widget\": { \ + \ \"debug\": \"on\", \ + \ \"window\": { \ + \ \"name\": \"main_window\", \ + \ \"dimensions\": [500, 600.01e-02, true, false, null] \ + \ } \ + \ } \ + \}" :: GenericCursor BS.ByteString t u + it "can navigate down and forwards" $ requireTest $ do + ( jsonTypeAt) cursor === Just JsonTypeObject + (fc >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeObject + (fc >=> ns >=> fc >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeObject + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor === Just JsonTypeArray diff --git a/components/succinct-json/test/Data/Succinct/Json/ValueSpec.hs b/components/succinct-json/test/Data/Succinct/Json/ValueSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Data/Succinct/Json/ValueSpec.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Json.ValueSpec (spec) where + +import Control.Monad +import Data.Succinct.BalancedParens.BalancedParens +import HaskellWorks.Data.Bits.BitWise +import Data.Succinct.Json.DecodeError +import Data.Succinct.Json.Internal.Index +import Data.Succinct.Json.Standard.Cursor.Generic +import Data.Succinct.Json.Value +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Json.Standard.Cursor.Fast as FAST +import qualified Data.Succinct.Json.Standard.Cursor.Slow as SLOW +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Redundant do" -} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "Data.Succinct.Json.ValueSpec" $ do + genSpec "DVS.Vector Word64" SLOW.fromString + genSpec "CsPoppy" FAST.fromString + +jsonValueVia :: + ( BalancedParens u + , Rank0 u + , Rank1 u + , Select1 t + , TestBit u) + => Maybe (GenericCursor BS.ByteString t u) -> Either DecodeError JsonValue +jsonValueVia mk = case mk of + Just k -> (jsonIndexAt >=> jsonValueAt) k + Nothing -> Left (DecodeError "No such element") + +genSpec :: forall t u. + ( Select1 t + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () +genSpec t makeCursor = do + describe ("Json cursor of type " ++ t) $ do + let forJson s f = describe ("of value " ++ show s) (f (makeCursor s)) + forJson "{}" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject []) + forJson " {}" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonObject []) + forJson "1234" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonNumber 1234) + forJson "\"Hello\"" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonString "Hello") + forJson "[]" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray []) + forJson "true" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool True) + forJson "false" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonBool False) + forJson "null" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right JsonNull + forJson "[null]" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonArray [JsonNull]) + it "should have correct value" $ requireTest $ jsonValueVia (fc cursor) === Right JsonNull + it "should have correct value" $ requireTest $ jsonValueVia (fc cursor) === Right JsonNull + forJson "\"codepoint\\u2019s\"" $ \cursor -> do + it "should have correct value" $ requireTest $ jsonValueVia (Just cursor) === Right (JsonString "codepoint’s") + forJson "[null, {\"field\": 1}]" $ \cursor -> do + it "cursor can navigate to second child of array" $ requireTest $ do + jsonValueVia ((fc >=> ns) cursor) === Right ( JsonObject [("field", JsonNumber 1)] ) + jsonValueVia (Just cursor) === Right (JsonArray [JsonNull, JsonObject [("field", JsonNumber 1)]]) + describe "For empty json array" $ do + let cursor = makeCursor "[]" + it "can navigate down and forwards" $ requireTest $ do + jsonValueVia (Just cursor) === Right (JsonArray []) + describe "For empty json array" $ do + let cursor = makeCursor "[null]" + it "can navigate down and forwards" $ requireTest $ do + jsonValueVia (Just cursor) === Right (JsonArray [JsonNull]) + describe "For sample Json" $ do + let cursor = makeCursor "{ \ + \ \"widget\": { \ + \ \"debug\": \"on\", \ + \ \"window\": { \ + \ \"name\": \"main_window\", \ + \ \"dimensions\": [500, 600.01e-02, true, false, null] \ + \ } \ + \ } \ + \}" :: GenericCursor BS.ByteString t u + it "can navigate down and forwards" $ requireTest $ do + let array = JsonArray [JsonNumber 500, JsonNumber 600.01e-02, JsonBool True, JsonBool False, JsonNull] :: JsonValue + let object1 = JsonObject ([("name", JsonString "main_window"), ("dimensions", array)]) :: JsonValue + let object2 = JsonObject ([("debug", JsonString "on"), ("window", object1)]) :: JsonValue + let object3 = JsonObject ([("widget", object2)]) :: JsonValue + jsonValueVia (Just cursor) === Right object3 + jsonValueVia ((fc ) cursor) === Right (JsonString "widget" ) + jsonValueVia ((fc >=> ns ) cursor) === Right (object2 ) + jsonValueVia ((fc >=> ns >=> fc ) cursor) === Right (JsonString "debug" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns ) cursor) === Right (JsonString "on" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonString "window" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (object1 ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) === Right (JsonString "name" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) === Right (JsonString "main_window" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonString "dimensions" ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (array ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) === Right (JsonNumber 500 ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) === Right (JsonNumber 600.01e-02 ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) === Right (JsonBool True ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) === Right (JsonBool False ) + jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns) cursor) === Right JsonNull diff --git a/components/succinct-json/test/Spec.hs b/components/succinct-json/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-json/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/succinct-simd/bench/Main.hs b/components/succinct-simd/bench/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/bench/Main.hs @@ -0,0 +1,70 @@ +module Main where + +import Control.Monad +import Criterion.Main +import Data.Char +import Data.Word +import HaskellWorks.Data.Vector.AsVector64s + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as L +import qualified Data.Succinct.Simd.Capabilities as CAP +import qualified Data.Succinct.Simd.Comparison.Avx2 as AVX2 +import qualified Data.Succinct.Simd.Comparison.Stock as STOCK +import qualified Data.Succinct.Simd.Logical.Avx2 as AVX2 +import qualified Data.Succinct.Simd.Logical.Stock as STOCK +import qualified Data.Vector.Storable as DVS +import qualified System.Directory as IO + +runCmpEqWord8sAvx2 :: LBS.ByteString -> IO [DVS.Vector Word64] +runCmpEqWord8sAvx2 bs = do + let vs = asVector64s 64 bs + return $ if CAP.avx2Enabled + then AVX2.cmpEqWord8s (fromIntegral (ord '8')) <$> vs + else [] + +runCmpEqWord8sStock :: LBS.ByteString -> IO [DVS.Vector Word64] +runCmpEqWord8sStock bs = do + let vs = asVector64s 64 bs + return $ STOCK.cmpEqWord8s (fromIntegral (ord '8')) <$> vs + +runAndBitsAvx2 :: LBS.ByteString -> IO [DVS.Vector Word64] +runAndBitsAvx2 bs = do + let vs = asVector64s 64 bs + return $ (\v -> AVX2.andBits v v) <$> vs + +runAndBitsStock :: LBS.ByteString -> IO [DVS.Vector Word64] +runAndBitsStock bs = do + let vs = asVector64s 64 bs + return $ (\v -> STOCK.andBits v v) <$> vs + +benchcmpEqWord8s :: IO [Benchmark] +benchcmpEqWord8s = do + entries <- IO.listDirectory "components/succinct-simd/data/bench" + let files = ("components/succinct-simd/data/bench/" ++) <$> (".csv" `L.isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return $ + [ env (LBS.readFile file) $ \bs -> bgroup file + [ bench ("hw-simd/cmpEqWord8s/avx2/" <> file) (nfIO (runCmpEqWord8sAvx2 bs)) + , bench ("hw-simd/cmpEqWord8s/stock/" <> file) (nfIO (runCmpEqWord8sStock bs)) + ] + ] + return (join benchmarks) + +benchAndBits :: IO [Benchmark] +benchAndBits = do + entries <- IO.listDirectory "components/succinct-simd/data/bench" + let files = ("components/succinct-simd/data/bench/" ++) <$> (".csv" `L.isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return $ + [ env (LBS.readFile file) $ \bs -> bgroup file + [ bench ("hw-simd/andBits/avx2/" <> file) (nfIO (runAndBitsAvx2 bs)) + , bench ("hw-simd/andBits/stock/" <> file) (nfIO (runAndBitsStock bs)) + ] + ] + return (join benchmarks) + +main :: IO () +main = do + benchmarks <- (mconcat <$>) $ sequence $ mempty + <> [benchcmpEqWord8s] + <> [benchAndBits] + defaultMain benchmarks diff --git a/components/succinct-simd/cbits/simd_avx2.c b/components/succinct-simd/cbits/simd_avx2.c new file mode 100644 --- /dev/null +++ b/components/succinct-simd/cbits/simd_avx2.c @@ -0,0 +1,167 @@ +#include "simd.h" + +#include +#include +#include +#include +#include +#include +#include +#include + +void avx2_memcpy( + uint8_t *target, + uint8_t *source, + size_t len) { +#if defined(AVX2_ENABLED) + size_t aligned_len = (len / 32) * 32; + size_t remaining_len = len - aligned_len; + + size_t i; + + for (i = 0; i < aligned_len; i += 32) { + __m128i v0 = *(__m128i*)(source + i ); + __m128i v1 = *(__m128i*)(source + i + 16); + + *(__m128i*)(target + i ) = v0; + *(__m128i*)(target + i + 16 ) = v1; + } + + memcpy(target + aligned_len, source + aligned_len, remaining_len); +#endif +} + +void avx2_cmpeq8( + uint8_t byte, + uint8_t *target, + size_t target_length, + uint8_t *source) { +#if defined(AVX2_ENABLED) + uint32_t *target32 = (uint32_t *)target; + + __m256i v_comparand = _mm256_set1_epi8(byte); + + uint32_t *out_mask = (uint32_t*)target; + + size_t i; + + for (i = 0; i < target_length * 2; ++i) { + __m256i v_data_a = *(__m256i *)(source + (i * 32)); + __m256i v_results_a = _mm256_cmpeq_epi8(v_data_a, v_comparand); + uint32_t mask = (uint32_t)_mm256_movemask_epi8(v_results_a); + target32[i] = mask; + } +#endif +} + +void avx2_cmpeq8_para( + uint8_t *bytes, + size_t bytes_length, + uint8_t **targets, + size_t targets_length, + uint8_t *source) { +#if defined(AVX2_ENABLED) + size_t i; + + for (i = 0; i < targets_length * 2; ++i) { + size_t j; + + __m256i v_data_a = *(__m256i *)(source + (i * 32)); + + for (j = 0; j < bytes_length; ++j) { + uint8_t *target = targets[j]; + uint32_t *target32 = (uint32_t *)target; + __m256i v_comparand = _mm256_set1_epi8(bytes[j]); + uint32_t *out_mask = (uint32_t*)target; + __m256i v_results_a = _mm256_cmpeq_epi8(v_data_a, v_comparand); + uint32_t mask = (uint32_t)_mm256_movemask_epi8(v_results_a); + target32[i] = mask; + } + } +#endif +} + +void avx2_and_bits( + uint8_t *target, + size_t target_length, + uint8_t *source_a, + uint8_t *source_b) { +#if defined(AVX2_ENABLED) + size_t i; + + for (i = 0; i < target_length; i += 32) { + __m256i v_data_a = *(__m256i *)(source_a + i); + __m256i v_data_b = *(__m256i *)(source_b + i); + __m256i v_results = _mm256_and_si256(v_data_a, v_data_b); + *(__m256i *)(target + i) = v_results; + } +#endif +} + +void avx2_and_not_bits( + uint8_t *target, + size_t target_length, + uint8_t *source_a, + uint8_t *source_b) { +#if defined(AVX2_ENABLED) + size_t i; + + for (i = 0; i < target_length; i += 32) { + __m256i v_data_a = *(__m256i *)(source_a + i); + __m256i v_data_b = *(__m256i *)(source_b + i); + __m256i v_results = _mm256_andnot_si256(v_data_a, v_data_b); + *(__m256i *)(target + i) = v_results; + } +#endif +} + +void avx2_not_bits( + uint8_t *target, + size_t target_length, + uint8_t *source) { +#if defined(AVX2_ENABLED) + __m256i ones = _mm256_set1_epi8(0xff); + + size_t i; + + for (i = 0; i < target_length; i += 32) { + __m256i v_data = *(__m256i *)(source + i); + __m256i v_results = _mm256_xor_si256(v_data, ones); + *(__m256i *)(target + i) = v_results; + } +#endif +} + +void avx2_or_bits( + uint8_t *target, + size_t target_length, + uint8_t *source_a, + uint8_t *source_b) { +#if defined(AVX2_ENABLED) + size_t i; + + for (i = 0; i < target_length; i += 32) { + __m256i v_data_a = *(__m256i *)(source_a + i); + __m256i v_data_b = *(__m256i *)(source_b + i); + __m256i v_results = _mm256_or_si256(v_data_a, v_data_b); + *(__m256i *)(target + i) = v_results; + } +#endif +} + +void avx2_xor_bits( + uint8_t *target, + size_t target_length, + uint8_t *source_a, + uint8_t *source_b) { +#if defined(AVX2_ENABLED) + size_t i; + + for (i = 0; i < target_length; i += 32) { + __m256i v_data_a = *(__m256i *)(source_a + i); + __m256i v_data_b = *(__m256i *)(source_b + i); + __m256i v_results = _mm256_xor_si256(v_data_a, v_data_b); + *(__m256i *)(target + i) = v_results; + } +#endif +} diff --git a/components/succinct-simd/cbits/simd_sse2.c b/components/succinct-simd/cbits/simd_sse2.c new file mode 100644 --- /dev/null +++ b/components/succinct-simd/cbits/simd_sse2.c @@ -0,0 +1,30 @@ +#include "simd.h" + +#include +#include +#include +#include +#include +#include +#include +#include + +void sse_cmpeq8( + uint8_t byte, + uint64_t *target, + size_t target_length, + uint8_t *source) { + uint16_t *target16 = (uint16_t *)target; + + __m128i v_comparand = _mm_set1_epi8(byte); + + uint16_t *out_mask = (uint16_t*)target; + size_t i; + + for (i = 0; i < target_length * 4; ++i) { + __m128i v_data_a = *(__m128i*)(source + (i * 16)); + __m128i v_results_a = _mm_cmpeq_epi8(v_data_a, v_comparand); + uint16_t mask = (uint16_t)_mm_movemask_epi8(v_results_a); + target16[i] = mask; + } +} diff --git a/components/succinct-simd/doctest/DoctestDriver.hs b/components/succinct-simd/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-simd/doctest/config.json #-} +#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/components/succinct-simd/src/Data/Succinct/Simd/Capabilities.hs b/components/succinct-simd/src/Data/Succinct/Simd/Capabilities.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Capabilities.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Data.Succinct.Simd.Capabilities where + +requireAvx2 :: a -> a +requireAvx2 a = if avx2Enabled then a else error "AVX2 not enabled" +{-# INLINE requireAvx2 #-} + +avx2Enabled :: Bool +#if defined(AVX2_ENABLED) +avx2Enabled = True +#else +avx2Enabled = False +#endif +{-# INLINE avx2Enabled #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/ChunkString.hs b/components/succinct-simd/src/Data/Succinct/Simd/ChunkString.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/ChunkString.hs @@ -0,0 +1,14 @@ +module Data.Succinct.Simd.ChunkString + ( ChunkString + , ToChunkString(..) + , hGetContents + ) where + +import Data.Succinct.Simd.Internal.ChunkString + +import qualified HaskellWorks.Data.ByteString as BS +import qualified System.IO as IO + +hGetContents :: IO.Handle -> IO ChunkString +hGetContents = (ChunkString <$>) . BS.hGetContentsChunkedBy chunkSize +{-# INLINE hGetContents #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Comparison.hs b/components/succinct-simd/src/Data/Succinct/Simd/Comparison.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Comparison.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE MultiWayIf #-} + +module Data.Succinct.Simd.Comparison + ( CmpEqWord8s(..) + ) where + +import Data.Succinct.Simd.Capabilities +import Data.Word + +import qualified Data.Succinct.Simd.Comparison.Avx2 as AVX2 +import qualified Data.Succinct.Simd.Comparison.Stock as STOCK +import qualified Data.Vector.Storable as DVS + +class CmpEqWord8s a where + cmpEqWord8s :: Word8 -> a -> a + +instance CmpEqWord8s (DVS.Vector Word64) where + cmpEqWord8s w bs = if + | avx2Enabled -> AVX2.cmpEqWord8s w bs + | True -> STOCK.cmpEqWord8s w bs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s (DVS.Vector Word8) where + cmpEqWord8s w bs = if + | avx2Enabled -> AVX2.cmpEqWord8s w bs + | True -> STOCK.cmpEqWord8s w bs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [DVS.Vector Word64] where + cmpEqWord8s w bs = if + | avx2Enabled -> AVX2.cmpEqWord8s w bs + | True -> STOCK.cmpEqWord8s w bs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [DVS.Vector Word8] where + cmpEqWord8s w bs = if + | avx2Enabled -> AVX2.cmpEqWord8s w bs + | True -> STOCK.cmpEqWord8s w bs + {-# INLINE cmpEqWord8s #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Comparison/Avx2.hs b/components/succinct-simd/src/Data/Succinct/Simd/Comparison/Avx2.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Comparison/Avx2.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE CPP #-} + +module Data.Succinct.Simd.Comparison.Avx2 where + +import Control.Monad +import Data.Word + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Simd.ChunkString as CS +import qualified Data.Succinct.Simd.Internal.Foreign as F +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified Foreign.ForeignPtr as F +import qualified Foreign.Marshal.Unsafe as F +import qualified Foreign.Ptr as F +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.Vector.AsVector8 as V +import qualified HaskellWorks.Data.Vector.Storable as DVS + +{- HLINT ignore "Redundant do" -} + +class CmpEqWord8s a where + type Target a + cmpEqWord8s :: Word8 -> a -> Target a + +instance CmpEqWord8s (DVS.Vector Word8) where + type Target (DVS.Vector Word8) = DVS.Vector Word8 + cmpEqWord8s w8 v = F.unsafeLocalState $ do + tgtFptr <- F.mallocForeignPtrBytes bufLen + F.withForeignPtr srcFptr $ \srcPtr -> do + F.withForeignPtr tgtFptr $ \tgtPtr -> do + _ <- F.avx2Cmpeq8 (fromIntegral w8) (F.castPtr tgtPtr) (fromIntegral w64sLen) (srcPtr `F.plusPtr` srcOffset) + when (disalignment /= 0) $ do + let ending = DVS.padded ((DVS.length v + 63) `div` 64) (DVS.drop alignment v) + let (endFptr, _, _) = DVS.unsafeToForeignPtr ending + F.withForeignPtr endFptr $ \endPtr -> do + void $ F.avx2Cmpeq8 (fromIntegral w8) (tgtPtr `F.plusPtr` (w64sLen * 8)) (fromIntegral disalignment) (F.castPtr endPtr) + + return $ DVS.unsafeFromForeignPtr tgtFptr 0 tgtLen + where (srcFptr, srcOffset, srcLen) = DVS.unsafeToForeignPtr v + bufLen = (srcLen + 63) `div` 8 + tgtLen = (srcLen + 7) `div` 8 + w64sLen = srcLen `div` 64 + alignment = w64sLen * 64 + disalignment = srcLen - alignment + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s (DVS.Vector Word64) where + type Target (DVS.Vector Word64) = DVS.Vector Word64 + cmpEqWord8s w8 v = case DVS.unsafeCast v :: DVS.Vector Word8 of + u -> case DVS.unsafeToForeignPtr u of + (srcFptr, srcOffset, srcLength) -> if disalignment == 0 + then F.unsafeLocalState $ do + targetFptr <- F.mallocForeignPtrBytes srcLength + F.withForeignPtr srcFptr $ \srcPtr -> do + F.withForeignPtr targetFptr $ \targetPtr -> do + _ <- F.avx2Cmpeq8 + (fromIntegral w8) + (F.castPtr targetPtr) + (fromIntegral w64sLen) + (F.castPtr srcPtr `F.plusPtr` srcOffset) + return $ DVS.unsafeFromForeignPtr targetFptr 0 w64sLen + else error $ "Unaligned byte string: " <> show disalignment + where w64sLen = srcLength `div` 64 + disalignment = srcLength - w64sLen * 64 + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [DVS.Vector Word64] where + type Target [DVS.Vector Word64] = [DVS.Vector Word64] + cmpEqWord8s w8 vs = cmpEqWord8s w8 <$> vs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [DVS.Vector Word8] where + type Target [DVS.Vector Word8] = [DVS.Vector Word8] + cmpEqWord8s w8 vs = cmpEqWord8s w8 <$> vs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [BS.ByteString] where + type Target [BS.ByteString] = [BS.ByteString] + cmpEqWord8s w8 vs = BS.toByteString . cmpEqWord8s w8 . V.asVector8 <$> vs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s CS.ChunkString where + type Target CS.ChunkString = CS.ChunkString + cmpEqWord8s w8 = CS.toChunkString . cmpEqWord8s w8 . BS.toByteStrings + {-# INLINE cmpEqWord8s #-} + +class CmpEqWord8sPara a where + type CmpEqWord8sParaTarget a + cmpEqWord8sPara :: DVS.Vector Word8 -> a -> CmpEqWord8sParaTarget a + +instance CmpEqWord8sPara (DVS.Vector Word64) where + type CmpEqWord8sParaTarget (DVS.Vector Word64) = DV.Vector (DVS.Vector Word64) + cmpEqWord8sPara w8s v = case DVS.unsafeCast v :: DVS.Vector Word8 of + u -> case DVS.unsafeToForeignPtr u of + (srcFptr, srcOffset, srcLength) -> if disalignment == 0 + then F.unsafeLocalState $ do + tgtFptr <- F.mallocForeignPtrBytes (srcLength * DVS.length w8s) + F.withForeignPtr srcFptr $ \srcPtr -> do + F.withForeignPtr tgtFptr $ \tgtPtr -> do + let tgtsPtrsV :: DVS.Vector (F.Ptr Word8) = DVS.constructN (DVS.length w8s) $ \t -> + tgtPtr `F.plusPtr` (DVS.length t * DVS.length v) + let (w8sFptr, _, w8sLen) = DVS.unsafeToForeignPtr w8s + let (tgtsPtrsFptr, _, _) = DVS.unsafeToForeignPtr tgtsPtrsV + F.withForeignPtr w8sFptr $ \w8sPtr -> do + F.withForeignPtr tgtsPtrsFptr $ \tgtsPtrsPtr -> do + F.avx2Cmpeq8Para (F.castPtr w8sPtr) (fromIntegral w8sLen) (F.castPtr tgtsPtrsPtr) (fromIntegral w64sLen) (srcPtr `F.plusPtr` srcOffset) + + let tgtV = DVS.unsafeFromForeignPtr tgtFptr 0 (w64sLen * DVS.length w8s) + return $ DV.constructN (DVS.length w8s) $ \t -> DVS.take w64sLen (DVS.drop (DV.length t * w64sLen) tgtV) + + else error $ "Unaligned byte string: " <> show disalignment + where w64sLen = srcLength `div` 64 + disalignment = srcLength - w64sLen * 64 + {-# INLINE cmpEqWord8sPara #-} + diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Comparison/Stock.hs b/components/succinct-simd/src/Data/Succinct/Simd/Comparison/Stock.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Comparison/Stock.hs @@ -0,0 +1,81 @@ +module Data.Succinct.Simd.Comparison.Stock + ( CmpEqWord8s(..) + ) where + +import Data.Succinct.Simd.Internal.Bits +import Data.Succinct.Simd.Internal.Broadword +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Simd.ChunkString as CS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.Vector.AsVector8 as V + +class CmpEqWord8s a where + cmpEqWord8s :: Word8 -> a -> a + +instance CmpEqWord8s (DVS.Vector Word8) where + cmpEqWord8s w8 v = DVS.unsafeCast (cmpEqWord8s w8 (DVS.unsafeCast v :: DVS.Vector Word64)) + +instance CmpEqWord8s (DVS.Vector Word64) where + cmpEqWord8s w8 v = DVS.constructN ((DVS.length v + 7) `div` 8) go + where iw = fillWord64 w8 + go :: DVS.Vector Word64 -> Word64 + go u = let ui = end u in + if ui * 8 + 8 < end v + then let vi = ui * 8 + w0 = testWord8s ((v !!! (vi + 0)) .^. iw) + w1 = testWord8s ((v !!! (vi + 1)) .^. iw) + w2 = testWord8s ((v !!! (vi + 2)) .^. iw) + w3 = testWord8s ((v !!! (vi + 3)) .^. iw) + w4 = testWord8s ((v !!! (vi + 4)) .^. iw) + w5 = testWord8s ((v !!! (vi + 5)) .^. iw) + w6 = testWord8s ((v !!! (vi + 6)) .^. iw) + w7 = testWord8s ((v !!! (vi + 7)) .^. iw) + w = (w7 .<. 56) .|. + (w6 .<. 48) .|. + (w5 .<. 40) .|. + (w4 .<. 32) .|. + (w3 .<. 24) .|. + (w2 .<. 16) .|. + (w1 .<. 8) .|. + w0 + in comp w + else let vi = ui * 8 + w0 = testWord8s (atIndexOr 0 v (vi + 0) .^. iw) + w1 = testWord8s (atIndexOr 0 v (vi + 1) .^. iw) + w2 = testWord8s (atIndexOr 0 v (vi + 2) .^. iw) + w3 = testWord8s (atIndexOr 0 v (vi + 3) .^. iw) + w4 = testWord8s (atIndexOr 0 v (vi + 4) .^. iw) + w5 = testWord8s (atIndexOr 0 v (vi + 5) .^. iw) + w6 = testWord8s (atIndexOr 0 v (vi + 6) .^. iw) + w7 = testWord8s (atIndexOr 0 v (vi + 7) .^. iw) + w = (w7 .<. 56) .|. + (w6 .<. 48) .|. + (w5 .<. 40) .|. + (w4 .<. 32) .|. + (w3 .<. 24) .|. + (w2 .<. 16) .|. + (w1 .<. 8) .|. + w0 + in comp w + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [DVS.Vector Word64] where + cmpEqWord8s w8 vs = cmpEqWord8s w8 <$> vs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [DVS.Vector Word8] where + cmpEqWord8s w8 vs = cmpEqWord8s w8 <$> vs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s [BS.ByteString] where + cmpEqWord8s w8 vs = BS.toByteString . cmpEqWord8s w8 . V.asVector8 <$> vs + {-# INLINE cmpEqWord8s #-} + +instance CmpEqWord8s CS.ChunkString where + cmpEqWord8s w8 = CS.toChunkString . cmpEqWord8s w8 . BS.toByteStrings + {-# INLINE cmpEqWord8s #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Internal/Bits.hs b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Bits.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Bits.hs @@ -0,0 +1,49 @@ +module Data.Succinct.Simd.Internal.Bits where + +import Data.Bits.Pext +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +import qualified Data.Vector.Storable as DVS + +testWord8s :: Word64 -> Word64 +testWord8s w = let w8s = w + w4s = w8s .|. (w8s .>. 4) + w2s = w4s .|. (w4s .>. 2) + w1s = w2s .|. (w2s .>. 1) + in pext w1s 0x0101010101010101 +{-# INLINE testWord8s #-} + +zipOr :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +zipOr as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go + where go :: DVS.Vector Word64 -> Word64 + go u = + let ui = DVS.length u + in if ui < DVS.length as && ui < DVS.length bs + then DVS.unsafeIndex as ui .|. DVS.unsafeIndex bs ui + else error "Different sized vectors" +{-# INLINE zipOr #-} + +zip2Or :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] +zip2Or (a:as) (b:bs) = zipOr a b:zip2Or as bs +zip2Or (a:as) [] = a:zip2Or as [] +zip2Or [] (b:bs) = b:zip2Or [] bs +zip2Or [] [] = [] +{-# INLINE zip2Or #-} + +zipAnd :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +zipAnd as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go + where go :: DVS.Vector Word64 -> Word64 + go u = + let ui = DVS.length u + in if ui < DVS.length as && ui < DVS.length bs + then DVS.unsafeIndex as ui .&. DVS.unsafeIndex bs ui + else error "Different sized vectors" +{-# INLINE zipAnd #-} + +zip2And :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] +zip2And (a:as) (b:bs) = zipAnd a b:zip2And as bs +zip2And (a:as) [] = a:zip2And as [] +zip2And [] (b:bs) = b:zip2And [] bs +zip2And [] [] = [] +{-# INLINE zip2And #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Internal/Broadword.hs b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Broadword.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Broadword.hs @@ -0,0 +1,19 @@ +module Data.Succinct.Simd.Internal.Broadword where + +import Data.Bits.Pdep +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +class FillWord64 a where + fillWord64 :: a -> Word64 + +instance FillWord64 Word8 where + fillWord64 w = 0x0101010101010101 * fromIntegral w + {-# INLINE fillWord64 #-} + +toggle64 :: Word64 -> Word64 -> Word64 +toggle64 carry w = + let c = carry .&. 0x1 + in let addend = pdep (0x5555555555555555 .<. c) w + in ((addend .<. 1) .|. c) + comp w +{-# INLINE toggle64 #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Internal/ChunkString.hs b/components/succinct-simd/src/Data/Succinct/Simd/Internal/ChunkString.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Internal/ChunkString.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP #-} + +module Data.Succinct.Simd.Internal.ChunkString where + +import Data.Word +import HaskellWorks.Data.ByteString +import HaskellWorks.Data.ByteString.Lazy + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.ByteString as BS + +newtype ChunkString = ChunkString + { chunks :: [BS.ByteString] + } deriving (Eq, Show) + +instance ToLazyByteString ChunkString where + toLazyByteString (ChunkString cs) = LBS.fromChunks cs + +instance ToByteStrings ChunkString where + toByteStrings (ChunkString bss) = bss + +class ToChunkString a where + toChunkString :: a -> ChunkString + +instance ToChunkString LBS.ByteString where + toChunkString = toChunkString . LBS.toChunks + +instance ToChunkString [BS.ByteString] where + toChunkString = ChunkString . BS.rechunk chunkSize + +instance ToChunkString [DVS.Vector Word8] where + toChunkString = toChunkString . (toByteString <$>) + +instance ToChunkString [DVS.Vector Word16] where + toChunkString = toChunkString . (toByteString <$>) + +instance ToChunkString [DVS.Vector Word32] where + toChunkString = toChunkString . (toByteString <$>) + +instance ToChunkString [DVS.Vector Word64] where + toChunkString = toChunkString . (toByteString <$>) + +instance ToChunkString (DVS.Vector Word8) where + toChunkString v = toChunkString [toByteString v] + +instance ToChunkString (DVS.Vector Word16) where + toChunkString v = toChunkString [toByteString v] + +instance ToChunkString (DVS.Vector Word32) where + toChunkString v = toChunkString [toByteString v] + +instance ToChunkString (DVS.Vector Word64) where + toChunkString v = toChunkString [toByteString v] + +#if 0 +instance BitWise ChunkString where + ChunkString (a:as) .&. ChunkString (b:bs) = ChunkString (c:cs) + where len = end a `min` end b + c = toByteString $ DVS.constructN (fromIntegral len) go + ChunkString cs = ChunkString as .&. ChunkString bs + go u = let ui = end u in (a !!! ui) .&. (b !!! ui) + ChunkString _ .&. ChunkString _ = ChunkString [] + {-# INLINE (.&.) #-} + + ChunkString (a:as) .|. ChunkString (b:bs) = ChunkString (c:cs) + where len = end a `min` end b + c = toByteString $ DVS.constructN (fromIntegral len) go + ChunkString cs = ChunkString as .|. ChunkString bs + go u = let ui = end u in (a !!! ui) .&. (b !!! ui) + ChunkString _ .|. ChunkString _ = ChunkString [] + {-# INLINE (.|.) #-} + + ChunkString (a:as) .^. ChunkString (b:bs) = ChunkString (c:cs) + where len = end a `min` end b + c = toByteString $ DVS.constructN (fromIntegral len) go + ChunkString cs = ChunkString as .^. ChunkString bs + go u = let ui = end u in (a !!! ui) .&. (b !!! ui) + ChunkString _ .^. ChunkString _ = ChunkString [] + {-# INLINE (.^.) #-} + + comp (ChunkString (a:as)) = ChunkString (c:cs) + where c = toByteString $ DVS.constructN (fromIntegral (end a)) go + ChunkString cs = comp (ChunkString as) + go u = let ui = end u in comp (a !!! ui) + comp (ChunkString _) = ChunkString [] + {-# INLINE comp #-} + + all0s = ChunkString $ repeat $ toByteString $ DVS.replicate chunkSize (0x00 :: Word8) + {-# INLINE all0s #-} + + all1s = ChunkString $ repeat $ toByteString $ DVS.replicate chunkSize (0xff :: Word8) + {-# INLINE all1s #-} +#endif + +chunkSize :: Int +chunkSize = 32 * 1024 - 64 +{-# INLINE chunkSize #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Internal/Foreign.chs b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Foreign.chs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Foreign.chs @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} + +module Data.Succinct.Simd.Internal.Foreign where + +import Foreign +import Data.Succinct.Simd.Capabilities + +#include "simd.h" + +type UInt8 = {#type uint8_t#} +type UInt64 = {#type uint64_t#} +type Size = {#type size_t#} + +avx2Memcpy :: Ptr UInt8 -> Ptr UInt8 -> Size -> IO () +avx2Memcpy target source len = requireAvx2 $ do + {#call unsafe avx2_memcpy as c_build_ibs#} target source len +{-# INLINE avx2Memcpy #-} + +avx2Cmpeq8 :: UInt8 -> Ptr UInt8 -> Size -> Ptr UInt8 -> IO () +avx2Cmpeq8 byte target targetLength source = requireAvx2 $ do + {#call unsafe avx2_cmpeq8 as c_cmpeq8#} byte target targetLength source +{-# INLINE avx2Cmpeq8 #-} + +avx2Cmpeq8Para :: Ptr UInt8 -> Size -> Ptr (Ptr UInt8) -> Size -> Ptr UInt8 -> IO () +avx2Cmpeq8Para bytes bytes_length target targetLength source = requireAvx2 $ do + {#call unsafe avx2_cmpeq8_para as c_cmpeq8_para#} bytes bytes_length target targetLength source +{-# INLINE avx2Cmpeq8Para #-} + +avx2AndBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO () +avx2AndBits target targetLength source_a source_b = requireAvx2 $ do + {#call unsafe avx2_and_bits as c_avx2_and_bits#} target targetLength source_a source_b +{-# INLINE avx2AndBits #-} + +avx2AndNotBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO () +avx2AndNotBits target targetLength source_a source_b = requireAvx2 $ do + {#call unsafe avx2_and_not_bits as c_avx2_and_not_bits#} target targetLength source_a source_b +{-# INLINE avx2AndNotBits #-} + +avx2NotBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> IO () +avx2NotBits target targetLength source = requireAvx2 $ do + {#call unsafe avx2_not_bits as c_avx2_not_bits#} target targetLength source +{-# INLINE avx2NotBits #-} + +avx2OrBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO () +avx2OrBits target targetLength source_a source_b = requireAvx2 $ do + {#call unsafe avx2_or_bits as c_avx2_or_bits#} target targetLength source_a source_b +{-# INLINE avx2OrBits #-} + +avx2XorBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO () +avx2XorBits target targetLength source_a source_b = requireAvx2 $ do + {#call unsafe avx2_xor_bits as c_avx2_xor_bits#} target targetLength source_a source_b +{-# INLINE avx2XorBits #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Internal/Marshal.hs b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Marshal.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Internal/Marshal.hs @@ -0,0 +1,17 @@ +module Data.Succinct.Simd.Internal.Marshal where + +import Data.Word + +import qualified Data.Vector.Storable as DVS +import qualified Foreign.ForeignPtr as F + +{- HLINT ignore "Redundant do" -} + +unsafeToElemSizedForeignPtr :: Int -> DVS.Vector Word64 -> (F.ForeignPtr Word8, Int, Int) +unsafeToElemSizedForeignPtr elemSize v = case DVS.unsafeCast v :: DVS.Vector Word8 of + au -> case DVS.unsafeToForeignPtr au of + t@(_, _, srcALength) -> if sizeMismatch == 0 + then t + else error $ "Byte string with mismatched element size: " <> show sizeMismatch + where w64sLen = srcALength `div` elemSize + sizeMismatch = srcALength - w64sLen * elemSize diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Logical.hs b/components/succinct-simd/src/Data/Succinct/Simd/Logical.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Logical.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE MultiWayIf #-} + +module Data.Succinct.Simd.Logical + ( XorBits(..) + , OrBits(..) + , AndBits(..) + , AndNotBits(..) + , NotBits(..) + ) where + +import Data.Succinct.Simd.Capabilities +import Data.Word + +import qualified Data.Succinct.Simd.Logical.Avx2 as AVX2 +import qualified Data.Succinct.Simd.Logical.Stock as STOCK +import qualified Data.Vector.Storable as DVS + +class XorBits a where + xorBits :: a -> a -> a + +instance XorBits (DVS.Vector Word64) where + xorBits a b = if + | avx2Enabled -> AVX2.xorBits a b + | True -> STOCK.xorBits a b + {-# INLINE xorBits #-} + +class OrBits a where + orBits :: a -> a -> a + +instance OrBits (DVS.Vector Word64) where + orBits a b = if + | avx2Enabled -> AVX2.orBits a b + | True -> STOCK.orBits a b + {-# INLINE orBits #-} + +class AndBits a where + andBits :: a -> a -> a + +instance AndBits (DVS.Vector Word64) where + andBits a b = if + | avx2Enabled -> AVX2.andBits a b + | True -> STOCK.andBits a b + {-# INLINE andBits #-} + +class AndNotBits a where + andNotBits :: a -> a -> a + +instance AndNotBits (DVS.Vector Word64) where + andNotBits a b = if + | avx2Enabled -> AVX2.andNotBits a b + | True -> STOCK.andNotBits a b + {-# INLINE andNotBits #-} + +class NotBits a where + notBits :: a -> a + +instance NotBits (DVS.Vector Word64) where + notBits a = if + | avx2Enabled -> AVX2.notBits a + | True -> STOCK.notBits a + {-# INLINE notBits #-} + diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Logical/Avx2.hs b/components/succinct-simd/src/Data/Succinct/Simd/Logical/Avx2.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Logical/Avx2.hs @@ -0,0 +1,125 @@ +module Data.Succinct.Simd.Logical.Avx2 where + +import Data.Succinct.Simd.Internal.Marshal +import Data.Word + +import qualified Data.Succinct.Simd.Internal.Foreign as F +import qualified Data.Vector.Storable as DVS +import qualified Foreign.ForeignPtr as F +import qualified Foreign.Marshal.Unsafe as F +import qualified Foreign.Ptr as F + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +class XorBits a where + xorBits :: a -> a -> a + +instance XorBits (DVS.Vector Word64) where + xorBits a b = F.unsafeLocalState $ do + let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a + let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b + targetFptr <- F.mallocForeignPtrBytes srcALength + F.withForeignPtr srcAFptr $ \srcAPtr -> do + F.withForeignPtr srcBFptr $ \srcBPtr -> do + F.withForeignPtr targetFptr $ \targetPtr -> do + _ <- F.avx2XorBits + (F.castPtr targetPtr) + (fromIntegral (srcALength `min` srcBLength)) + (F.castPtr srcAPtr `F.plusPtr` srcAOffset) + (F.castPtr srcBPtr `F.plusPtr` srcBOffset) + return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8) + {-# INLINE xorBits #-} + +instance XorBits [DVS.Vector Word64] where + xorBits = zipWith xorBits + {-# INLINE xorBits #-} + +class OrBits a where + orBits :: a -> a -> a + +instance OrBits (DVS.Vector Word64) where + orBits a b = F.unsafeLocalState $ do + let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a + let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b + targetFptr <- F.mallocForeignPtrBytes srcALength + F.withForeignPtr srcAFptr $ \srcAPtr -> do + F.withForeignPtr srcBFptr $ \srcBPtr -> do + F.withForeignPtr targetFptr $ \targetPtr -> do + _ <- F.avx2OrBits + (F.castPtr targetPtr) + (fromIntegral (srcALength `min` srcBLength)) + (F.castPtr srcAPtr `F.plusPtr` srcAOffset) + (F.castPtr srcBPtr `F.plusPtr` srcBOffset) + return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8) + {-# INLINE orBits #-} + +instance OrBits [DVS.Vector Word64] where + orBits = zipWith orBits + {-# INLINE orBits #-} + +class AndBits a where + andBits :: a -> a -> a + +instance AndBits (DVS.Vector Word64) where + andBits a b = F.unsafeLocalState $ do + let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a + let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b + targetFptr <- F.mallocForeignPtrBytes srcALength + F.withForeignPtr srcAFptr $ \srcAPtr -> do + F.withForeignPtr srcBFptr $ \srcBPtr -> do + F.withForeignPtr targetFptr $ \targetPtr -> do + _ <- F.avx2AndBits + (F.castPtr targetPtr) + (fromIntegral (srcALength `min` srcBLength)) + (F.castPtr srcAPtr `F.plusPtr` srcAOffset) + (F.castPtr srcBPtr `F.plusPtr` srcBOffset) + return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8) + {-# INLINE andBits #-} + +instance AndBits [DVS.Vector Word64] where + andBits = zipWith andBits + {-# INLINE andBits #-} + +class AndNotBits a where + andNotBits :: a -> a -> a + +instance AndNotBits (DVS.Vector Word64) where + andNotBits a b = F.unsafeLocalState $ do + let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a + let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b + targetFptr <- F.mallocForeignPtrBytes srcALength + F.withForeignPtr srcAFptr $ \srcAPtr -> do + F.withForeignPtr srcBFptr $ \srcBPtr -> do + F.withForeignPtr targetFptr $ \targetPtr -> do + _ <- F.avx2AndNotBits + (F.castPtr targetPtr) + (fromIntegral (srcALength `min` srcBLength)) + (F.castPtr srcAPtr `F.plusPtr` srcAOffset) + (F.castPtr srcBPtr `F.plusPtr` srcBOffset) + return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8) + {-# INLINE andNotBits #-} + +instance AndNotBits [DVS.Vector Word64] where + andNotBits = zipWith andBits + {-# INLINE andNotBits #-} + +class NotBits a where + notBits :: a -> a + +instance NotBits (DVS.Vector Word64) where + notBits a = F.unsafeLocalState $ do + let (srcFptr, srcOffset, srcLength) = unsafeToElemSizedForeignPtr 64 a + targetFptr <- F.mallocForeignPtrBytes srcLength + F.withForeignPtr srcFptr $ \srcPtr -> do + F.withForeignPtr targetFptr $ \targetPtr -> do + _ <- F.avx2NotBits + (F.castPtr targetPtr) + (fromIntegral srcLength) + (F.castPtr srcPtr `F.plusPtr` srcOffset) + return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcLength :: DVS.Vector Word8) + {-# INLINE notBits #-} + +instance NotBits [DVS.Vector Word64] where + notBits = fmap notBits + {-# INLINE notBits #-} diff --git a/components/succinct-simd/src/Data/Succinct/Simd/Logical/Stock.hs b/components/succinct-simd/src/Data/Succinct/Simd/Logical/Stock.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/src/Data/Succinct/Simd/Logical/Stock.hs @@ -0,0 +1,72 @@ +module Data.Succinct.Simd.Logical.Stock where + +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise + +import qualified Data.Vector.Storable as DVS + +class XorBits a where + xorBits :: a -> a -> a + +instance XorBits (DVS.Vector Word64) where + xorBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go + where go v = (a !!! i) .^. (b !!! i) + where i = end v + {-# INLINE xorBits #-} + +instance XorBits [DVS.Vector Word64] where + xorBits = zipWith xorBits + {-# INLINE xorBits #-} + +class OrBits a where + orBits :: a -> a -> a + +instance OrBits (DVS.Vector Word64) where + orBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go + where go v = (a !!! i) .|. (b !!! i) + where i = end v + {-# INLINE orBits #-} + +instance OrBits [DVS.Vector Word64] where + orBits = zipWith orBits + {-# INLINE orBits #-} + +class AndBits a where + andBits :: a -> a -> a + +instance AndBits (DVS.Vector Word64) where + andBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go + where go v = (a !!! i) .&. (b !!! i) + where i = end v + {-# INLINE andBits #-} + +instance AndBits [DVS.Vector Word64] where + andBits = zipWith andBits + {-# INLINE andBits #-} + +class AndNotBits a where + andNotBits :: a -> a -> a + +instance AndNotBits (DVS.Vector Word64) where + andNotBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go + where go v = (a !!! i) .&. comp (b !!! i) + where i = end v + {-# INLINE andNotBits #-} + +instance AndNotBits [DVS.Vector Word64] where + andNotBits = zipWith andBits + {-# INLINE andNotBits #-} + +class NotBits a where + notBits :: a -> a + +instance NotBits (DVS.Vector Word64) where + notBits a = DVS.constructN (DVS.length a) go + where go v = comp (a !!! i) + where i = end v + {-# INLINE notBits #-} + +instance NotBits [DVS.Vector Word64] where + notBits = fmap notBits + {-# INLINE notBits #-} diff --git a/components/succinct-simd/test/Data/Succinct/Simd/ComparisonSpec.hs b/components/succinct-simd/test/Data/Succinct/Simd/ComparisonSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/test/Data/Succinct/Simd/ComparisonSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Simd.ComparisonSpec (spec) where + +import Control.Lens +import Control.Monad +import Data.Word +import Data.Succinct.Simd.Capabilities +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.Simd.Comparison.Avx2 as AVX +import qualified Data.Succinct.Simd.Comparison.Stock as STK +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Hedgehog.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Simd.ComparisonSpec" $ do + when avx2Enabled $ do + describe "cmpEqWord8s" $ do + it "AVX2" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + vs :: [DVS.Vector Word64] <- forAll + $ G.list (R.linear 0 5) + $ (\g -> G.list (R.linear 0 4) g <&> join <&> DVS.fromList) + $ G.list (R.linear 8 8) + $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded]) + AVX.cmpEqWord8s w vs === STK.cmpEqWord8s w vs + vs === vs + it "AVX2 Para 1" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + vs :: DVS.Vector Word64 <- forAll + $ G.storableVector (R.singleton 8) + $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded]) + DV.head (AVX.cmpEqWord8sPara (DVS.singleton w) vs) === AVX.cmpEqWord8s w vs + it "AVX2 Para 2" $ requireProperty $ do + len <- forAll $ (* 8) <$> G.int (R.linear 0 8) + w0 <- forAll $ G.word8 R.constantBounded + w1 <- forAll $ G.word8 R.constantBounded + vs :: DVS.Vector Word64 <- forAll + $ G.storableVector (R.singleton len) + $ G.word8x8 (G.choice [pure w0, pure w1, G.word8 R.constantBounded]) + let actual = AVX.cmpEqWord8sPara (DVS.fromList [w0, w1]) vs + (actual DV.! 0) === AVX.cmpEqWord8s w0 vs + (actual DV.! 1) === AVX.cmpEqWord8s w1 vs + diff --git a/components/succinct-simd/test/Data/Succinct/Simd/Internal/BroadwordSpec.hs b/components/succinct-simd/test/Data/Succinct/Simd/Internal/BroadwordSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/test/Data/Succinct/Simd/Internal/BroadwordSpec.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Simd.Internal.BroadwordSpec (spec) where + +import Data.Maybe (fromJust) +import Data.Succinct.Simd.Internal.Broadword +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Simd.Internal.BroadwordSpec" $ do + it "Case 0" $ requireProperty $ do + let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: Word64 + let expected = fromJust $ bitRead "11000111 11111111 11111111 11111111 11111111 11111111 11111111 11111111" :: Word64 + bitShow actual === bitShow expected + it "Case 1" $ requireProperty $ do + let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64 + let expected = fromJust $ bitRead "11000111 11111000 00000000 00000000 00000000 00000000 00000011 11110000" :: Word64 + bitShow actual === bitShow expected + it "Case 1" $ requireProperty $ do + let actual = toggle64 1 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64 + let expected = fromJust $ bitRead "00111000 00000111 11111111 11111111 11111111 11111111 11111100 00001111" :: Word64 + bitShow actual === bitShow expected + +{- + normal case + ----------- + 00100100 + 11011011 + + 00010000 + 11011011 + + + 11000111 + carry case + ----------- + 00100100 + 11011011 + | | + 10000010 + 11011011 + + 00111000 +-} diff --git a/components/succinct-simd/test/Data/Succinct/Simd/LogicalSpec.hs b/components/succinct-simd/test/Data/Succinct/Simd/LogicalSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/test/Data/Succinct/Simd/LogicalSpec.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Simd.LogicalSpec (spec) where + +import Control.Monad +import Data.Succinct.Simd.Capabilities +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Succinct.Simd.Logical.Avx2 as AVX +import qualified Data.Succinct.Simd.Logical.Stock as STK +import qualified HaskellWorks.Hedgehog.Gen as G +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Simd.LogicalSpec" $ do + when avx2Enabled $ do + describe "xorBits" $ do + it "AVX2" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + (us, vs) <- forAll $ do + listLength <- G.int (R.linear 0 5) + blockCount <- G.int (R.linear 0 4) + blockSize <- G.int (R.singleton 8) + G.tuple2 + $ G.list (R.singleton listLength) + $ G.storableVector (R.singleton (blockCount * blockSize)) + $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded]) + AVX.xorBits us vs === STK.xorBits us vs + describe "orBits" $ do + it "AVX2" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + (us, vs) <- forAll $ do + listLength <- G.int (R.linear 0 5) + blockCount <- G.int (R.linear 0 4) + blockSize <- G.int (R.singleton 8) + G.tuple2 + $ G.list (R.singleton listLength) + $ G.storableVector (R.singleton (blockCount * blockSize)) + $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded]) + AVX.orBits us vs === STK.orBits us vs + describe "andBits" $ do + it "AVX2" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + (us, vs) <- forAll $ do + listLength <- G.int (R.linear 0 5) + blockCount <- G.int (R.linear 0 4) + blockSize <- G.int (R.singleton 8) + G.tuple2 + $ G.list (R.singleton listLength) + $ G.storableVector (R.singleton (blockCount * blockSize)) + $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded]) + AVX.andBits us vs === STK.andBits us vs + describe "andNotBits" $ do + it "AVX2" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + (us, vs) <- forAll $ do + listLength <- G.int (R.linear 0 5) + blockCount <- G.int (R.linear 0 4) + blockSize <- G.int (R.singleton 8) + G.tuple2 + $ G.list (R.singleton listLength) + $ G.storableVector (R.singleton (blockCount * blockSize)) + $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded]) + AVX.andNotBits us vs === STK.andNotBits us vs + describe "notBits" $ do + it "AVX2" $ requireProperty $ do + w <- forAll $ G.word8 R.constantBounded + vs <- forAll $ do + listLength <- G.int (R.linear 0 5) + blockCount <- G.int (R.linear 0 4) + blockSize <- G.int (R.singleton 8) + G.list (R.singleton listLength) + $ G.storableVector (R.singleton (blockCount * blockSize)) + $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded]) + AVX.notBits vs === STK.notBits vs diff --git a/components/succinct-simd/test/Spec.hs b/components/succinct-simd/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-simd/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/succinct-xml/app/App/Commands.hs b/components/succinct-xml/app/App/Commands.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands.hs @@ -0,0 +1,22 @@ +module App.Commands where + +import App.Commands.Count +import App.Commands.CreateBlankedXml +import App.Commands.CreateBpIndex +import App.Commands.CreateIbIndex +import App.Commands.CreateIndex +import App.Commands.Demo +import Options.Applicative + +commands :: Parser (IO ()) +commands = commandsGeneral + +commandsGeneral :: Parser (IO ()) +commandsGeneral = subparser $ mempty + <> commandGroup "Commands:" + <> cmdCount + <> cmdCreateIndex + <> cmdCreateBlankedXml + <> cmdCreateIbIndex + <> cmdCreateBpIndex + <> cmdDemo diff --git a/components/succinct-xml/app/App/Commands/Count.hs b/components/succinct-xml/app/App/Commands/Count.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands/Count.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.Count + ( cmdCount + ) where + +import App.Options +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Succinct.Xml.DecodeResult +import Data.Succinct.Xml.RawDecode +import Data.Succinct.Xml.RawValue +import Data.Succinct.Xml.Succinct.Cursor.Load +import Data.Succinct.Xml.Succinct.Cursor.MMap +import Data.Succinct.Xml.Succinct.Index +import Data.Succinct.Xml.Value +import Data.Text (Text) +import GHC.Generics +import HaskellWorks.Data.TreeCursor +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified App.Naive as NAIVE +import qualified App.XPath.Parser as XPP +import qualified System.Exit as IO +import qualified System.IO as IO + +-- | Document model. This does not need to be able to completely represent all +-- the data in the XML document. In fact, having a smaller model may improve +-- Count performance. +data Plant = Plant + { common :: String + , price :: String + } deriving (Eq, Show, Generic) + +newtype Catalog = Catalog + { plants :: [Plant] + } deriving (Eq, Show, Generic) + +tags :: Value -> Text -> [Value] +tags xml@(XmlElement n _ _) elemName = if n == elemName + then [xml] + else [] +tags _ _ = [] + +kids :: Value -> [Value] +kids (XmlElement _ _ cs) = cs +kids _ = [] + +countAtPath :: [Text] -> Value -> DecodeResult Int +countAtPath [] _ = return 0 +countAtPath [t] xml = return (length (tags xml t)) +countAtPath (t:ts) xml = do + counts <- forM (tags xml t >>= kids) $ countAtPath ts + return (sum counts) + +runCount :: Z.CountOptions -> IO () +runCount opt = do + let input = opt ^. the @"input" + let xpath = opt ^. the @"xpath" + let method = opt ^. the @"method" + + IO.putStrLn $ "XPath: " <> show xpath + + cursorResult <- case method of + "mmap" -> Right <$> mmapFastCursor input + "memory" -> Right <$> loadFastCursor input + "naive" -> Right <$> NAIVE.loadFastCursor input + unknown -> return (Left ("Unknown method " <> show unknown)) + + case cursorResult of + Right !cursor -> do + -- Skip the XML declaration to get to the root element cursor + case nextSibling cursor of + Just rootCursor -> do + -- Get the root raw XML value at the root element cursor + let rootValue = rawValueAt (xmlIndexAt rootCursor) + -- Show what we have at this cursor + putStrLn $ "Raw value: " <> take 100 (show rootValue) + -- Decode the raw XML value + case countAtPath (xpath ^. the @"path") (rawDecode rootValue) of + DecodeOk count -> putStrLn $ "Count: " <> show count + DecodeFailed msg -> putStrLn $ "Error: " <> show msg + Nothing -> do + putStrLn "Could not read XML" + return () + Left msg -> do + IO.putStrLn $ "Error: " <> msg + IO.exitFailure + +optsCount :: Parser Z.CountOptions +optsCount = Z.CountOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + ) + <*> optionParser XPP.path + ( long "xpath" + <> help "XPath expression" + <> metavar "XPATH" + ) + <*> textOption + ( long "method" + <> help "Read method" + <> metavar "METHOD" + ) + +cmdCount :: Mod CommandFields (IO ()) +cmdCount = command "count" $ flip info idm $ runCount <$> optsCount diff --git a/components/succinct-xml/app/App/Commands/CreateBlankedXml.hs b/components/succinct-xml/app/App/Commands/CreateBlankedXml.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands/CreateBlankedXml.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.CreateBlankedXml + ( cmdCreateBlankedXml + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString.Lazy as LBS + +runCreateBlankedXml :: Z.CreateBlankedXmlOptions -> IO () +runCreateBlankedXml opt = do + let input = opt ^. the @"input" + let output = opt ^. the @"output" + + lbs <- LBS.readFile input + let blankedXml = lbsToBlankedXml lbs + LBS.writeFile output (LBS.fromChunks (blankedXml ^. the @1)) + + return () + +optsCreateBlankedXml :: Parser Z.CreateBlankedXmlOptions +optsCreateBlankedXml = Z.CreateBlankedXmlOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + ) + <*> strOption + ( long "output" + <> help "Blanked XML output" + <> metavar "FILE" + ) + +cmdCreateBlankedXml :: Mod CommandFields (IO ()) +cmdCreateBlankedXml = command "create-blanked-xml" $ flip info idm $ runCreateBlankedXml <$> optsCreateBlankedXml diff --git a/components/succinct-xml/app/App/Commands/CreateBpIndex.hs b/components/succinct-xml/app/App/Commands/CreateBpIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands/CreateBpIndex.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.CreateBpIndex + ( cmdCreateBpIndex + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Succinct.Xml.Internal.ToIbBp64 +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString.Lazy as LBS + +runCreateBpIndex :: Z.CreateBpIndexOptions -> IO () +runCreateBpIndex opt = do + let input = opt ^. the @"input" + let output = opt ^. the @"output" + + lbs <- LBS.readFile input + let blankedXml = lbsToBlankedXml lbs + let ib = toBalancedParens64 blankedXml + LBS.writeFile output (LBS.fromChunks ib) + + return () + +optsCreateBpIndex :: Parser Z.CreateBpIndexOptions +optsCreateBpIndex = Z.CreateBpIndexOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + ) + <*> strOption + ( long "output" + <> help "Balanced parens output" + <> metavar "FILE" + ) + +cmdCreateBpIndex :: Mod CommandFields (IO ()) +cmdCreateBpIndex = command "create-bp-index" $ flip info idm $ runCreateBpIndex <$> optsCreateBpIndex diff --git a/components/succinct-xml/app/App/Commands/CreateIbIndex.hs b/components/succinct-xml/app/App/Commands/CreateIbIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands/CreateIbIndex.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.CreateIbIndex + ( cmdCreateIbIndex + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Succinct.Xml.Internal.ToIbBp64 +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString.Lazy as LBS + +runCreateIbIndex :: Z.CreateIbIndexOptions -> IO () +runCreateIbIndex opt = do + let input = opt ^. the @"input" + let output = opt ^. the @"output" + + lbs <- LBS.readFile input + let blankedXml = lbsToBlankedXml lbs + let ib = toInterestBits64 blankedXml + LBS.writeFile output (LBS.fromChunks ib) + +optsCreateIbIndex :: Parser Z.CreateIbIndexOptions +optsCreateIbIndex = Z.CreateIbIndexOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + ) + <*> strOption + ( long "output" + <> help "Interest Bits output" + <> metavar "FILE" + ) + +cmdCreateIbIndex :: Mod CommandFields (IO ()) +cmdCreateIbIndex = command "create-ib-index" $ flip info idm $ runCreateIbIndex <$> optsCreateIbIndex diff --git a/components/succinct-xml/app/App/Commands/CreateIndex.hs b/components/succinct-xml/app/App/Commands/CreateIndex.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands/CreateIndex.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.CreateIndex + ( cmdCreateIndex + ) where + +import App.Options +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Succinct.Xml.Internal.ToIbBp64 +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Data.Succinct.Xml.Succinct.Cursor.MMap +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text.IO as TIO +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +import qualified Options.Applicative as OA +import qualified System.Exit as IO +import qualified System.IO as IO + +runCreateIndex :: Z.CreateIndexOptions -> IO () +runCreateIndex opt = do + let input = opt ^. the @"input" + let ibOutput = opt ^. the @"ibOutput" + let bpOutput = opt ^. the @"bpOutput" + let method = opt ^. the @"method" + + case method of + "memory" -> do + cursor <- mmapSlowCursor input + + LBS.writeFile ibOutput (LBS.toLazyByteString (cursor ^. the @"interests" . the @1)) + LBS.writeFile bpOutput (LBS.toLazyByteString (cursor ^. the @"balancedParens" . the @1)) + "stream" -> do + lbs <- LBS.readFile input + let blankedXml = lbsToBlankedXml lbs + let ibBp = toIbBp64 blankedXml + + hIbOutput <- IO.openFile ibOutput IO.WriteMode + hBpOutput <- IO.openFile bpOutput IO.WriteMode + + forM_ ibBp $ \(ib, bp) -> do + BS.hPut hIbOutput ib + BS.hPut hBpOutput bp + + IO.hClose hIbOutput + IO.hClose hBpOutput + + return () + unknown -> do + TIO.hPutStrLn IO.stderr $ "Unsupported method: " <> unknown + IO.exitFailure + +optsCreateIndex :: Parser Z.CreateIndexOptions +optsCreateIndex = Z.CreateIndexOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + ) + <*> strOption + ( long "ib-output" + <> help "Interest Bits output" + <> metavar "FILE" + ) + <*> strOption + ( long "bp-output" + <> help "Balanced Parens output" + <> metavar "FILE" + ) + <*> textOption + ( long "method" + <> help "Method" + <> metavar "METHOD" + <> OA.value "memory" + ) + +cmdCreateIndex :: Mod CommandFields (IO ()) +cmdCreateIndex = command "create-index" $ flip info idm $ runCreateIndex <$> optsCreateIndex diff --git a/components/succinct-xml/app/App/Commands/Demo.hs b/components/succinct-xml/app/App/Commands/Demo.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands/Demo.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Commands.Demo + ( cmdDemo + ) where + +import Data.Foldable +import Data.Maybe +import Data.Succinct.Xml.Decode +import Data.Succinct.Xml.DecodeResult +import Data.Succinct.Xml.RawDecode +import Data.Succinct.Xml.RawValue +import Data.Succinct.Xml.Succinct.Cursor.Load +import Data.Succinct.Xml.Succinct.Index +import Data.Succinct.Xml.Value +import Data.Text (Text) +import HaskellWorks.Data.TreeCursor +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z + +-- | Parse the text of an XML node. +class ParseText a where + parseText :: Value -> DecodeResult a + +instance ParseText Text where + parseText (XmlText text) = DecodeOk text + parseText (XmlCData text) = DecodeOk text + parseText (XmlElement _ _ cs) = DecodeOk $ mconcat $ mconcat $ toList . parseText <$> cs + parseText _ = DecodeOk "" + +-- | Convert a decode result to a maybe +decodeResultToMaybe :: DecodeResult a -> Maybe a +decodeResultToMaybe (DecodeOk a) = Just a +decodeResultToMaybe _ = Nothing + +-- | Document model. This does not need to be able to completely represent all +-- the data in the XML document. In fact, having a smaller model may improve +-- query performance. +data Plant = Plant + { common :: Text + , price :: Text + } deriving (Eq, Show) + +newtype Catalog = Catalog + { plants :: [Plant] + } deriving (Eq, Show) + +-- | Decode plant element +decodePlant :: Value -> DecodeResult Plant +decodePlant xml = do + aCommon <- xml /> "common" >>= parseText + aPrice <- xml /> "price" >>= parseText + return $ Plant aCommon aPrice + +-- | Decode catalog element +decodeCatalog :: Value -> DecodeResult Catalog +decodeCatalog xml = do + aPlantXmls <- xml />> "plant" + let aPlants = catMaybes (decodeResultToMaybe . decodePlant <$> aPlantXmls) + return $ Catalog aPlants + +runDemo :: Z.DemoOptions -> IO () +runDemo _ = do + -- Read XML into memory as a query-optimised cursor + !cursor <- loadFastCursor "components/succinct-xml/data/catalog.xml" + -- Skip the XML declaration to get to the root element cursor + case nextSibling cursor of + Just rootCursor -> do + -- Get the root raw XML value at the root element cursor + let rootValue = rawValueAt (xmlIndexAt rootCursor) + -- Show what we have at this cursor + putStrLn $ "Raw value: " <> take 100 (show rootValue) + -- Decode the raw XML value + case decodeCatalog (rawDecode rootValue) of + DecodeOk catalog -> putStrLn $ "Catalog: " <> show catalog + DecodeFailed msg -> putStrLn $ "Error: " <> show msg + Nothing -> do + putStrLn "Could not read XML" + return () + +optsDemo :: Parser Z.DemoOptions +optsDemo = pure Z.DemoOptions + +cmdDemo :: Mod CommandFields (IO ()) +cmdDemo = command "demo" $ flip info idm $ runDemo <$> optsDemo diff --git a/components/succinct-xml/app/App/Commands/Types.hs b/components/succinct-xml/app/App/Commands/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Commands/Types.hs @@ -0,0 +1,42 @@ +module App.Commands.Types + ( CountOptions(..) + , CreateBlankedXmlOptions(..) + , CreateBpIndexOptions(..) + , CreateIbIndexOptions(..) + , CreateIndexOptions(..) + , DemoOptions(..) + ) where + +import App.XPath.Types (XPath) +import Data.Text (Text) +import GHC.Generics + +data DemoOptions = DemoOptions deriving (Eq, Show, Generic) + +data CountOptions = CountOptions + { input :: FilePath + , xpath :: XPath + , method :: Text + } deriving (Eq, Show, Generic) + +data CreateIndexOptions = CreateIndexOptions + { input :: FilePath + , ibOutput :: FilePath + , bpOutput :: FilePath + , method :: Text + } deriving (Eq, Show, Generic) + +data CreateBlankedXmlOptions = CreateBlankedXmlOptions + { input :: FilePath + , output :: FilePath + } deriving (Eq, Show, Generic) + +data CreateIbIndexOptions = CreateIbIndexOptions + { input :: FilePath + , output :: FilePath + } deriving (Eq, Show, Generic) + +data CreateBpIndexOptions = CreateBpIndexOptions + { input :: FilePath + , output :: FilePath + } deriving (Eq, Show, Generic) diff --git a/components/succinct-xml/app/App/Naive.hs b/components/succinct-xml/app/App/Naive.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Naive.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module App.Naive + ( loadSlowCursor + , loadFastCursor + ) where + +import Data.Succinct.BalancedParens.RangeMin2 +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.RankSelect.CsPoppy1 +import Data.Succinct.Xml.Succinct.Cursor +import Data.Succinct.Xml.Succinct.Cursor.MMap +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.FromByteString + +import qualified Data.ByteString as BS + +-- | Load an XML file into memory and return a raw cursor initialised to the +-- start of the XML document. +loadSlowCursor :: FilePath -> IO SlowCursor +loadSlowCursor path = do + !bs <- BS.readFile path + let !cursor = fromByteString bs :: SlowCursor + return cursor + +-- | Load an XML file into memory and return a query-optimised cursor initialised +-- to the start of the XML document. +loadFastCursor :: FilePath -> IO FastCursor +loadFastCursor filename = do + -- Load the XML file into memory as a raw cursor. + -- The raw XML data is `text`, and `ib` and `bp` are the indexes. + -- `ib` and `bp` can be persisted to an index file for later use to avoid + -- re-parsing the file. + XmlCursor !text (BitShown !ib) (SimpleBalancedParens !bp) _ <- loadSlowCursor filename + let !bpCsPoppy = makeCsPoppy bp + let !rangeMinMax = mkRangeMin2 bpCsPoppy + let !ibCsPoppy = makeCsPoppy ib + return $ XmlCursor text ibCsPoppy rangeMinMax 1 diff --git a/components/succinct-xml/app/App/Options.hs b/components/succinct-xml/app/App/Options.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Options.hs @@ -0,0 +1,16 @@ +module App.Options + ( optionParser + , textOption + ) where + +import Data.Text (Text) + +import qualified Data.Attoparsec.Text as AT +import qualified Data.Text as T +import qualified Options.Applicative as OA + +optionParser :: AT.Parser a -> OA.Mod OA.OptionFields a -> OA.Parser a +optionParser p = OA.option (OA.eitherReader (AT.parseOnly p . T.pack)) + +textOption :: OA.Mod OA.OptionFields String -> OA.Parser Text +textOption = fmap T.pack . OA.strOption diff --git a/components/succinct-xml/app/App/Show.hs b/components/succinct-xml/app/App/Show.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/Show.hs @@ -0,0 +1,10 @@ +module App.Show + ( tshow + ) where + +import Data.Text (Text) + +import qualified Data.Text as T + +tshow :: Show a => a -> Text +tshow = T.pack . show diff --git a/components/succinct-xml/app/App/XPath/Parser.hs b/components/succinct-xml/app/App/XPath/Parser.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/XPath/Parser.hs @@ -0,0 +1,19 @@ +module App.XPath.Parser + ( path + ) where + +import Control.Applicative +import Data.Attoparsec.Text +import Data.Text (Text) + +import qualified App.XPath.Types as XP +import qualified Data.Text as T + +tag :: Parser Text +tag = T.cons <$> letter <*> tagTail + +tagTail :: Parser Text +tagTail = T.pack <$> many (letter <|> digit <|> char '-' <|> char '_') + +path :: Parser XP.XPath +path = XP.XPath <$> sepBy1 tag (char '/') diff --git a/components/succinct-xml/app/App/XPath/Types.hs b/components/succinct-xml/app/App/XPath/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/App/XPath/Types.hs @@ -0,0 +1,8 @@ +module App.XPath.Types where + +import Data.Text (Text) +import GHC.Generics + +newtype XPath = XPath + { path :: [Text] + } deriving (Eq, Show, Generic) diff --git a/components/succinct-xml/app/Main.hs b/components/succinct-xml/app/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/app/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import App.Commands +import Control.Monad +import Options.Applicative + +main :: IO () +main = join $ customExecParser + (prefs $ showHelpOnEmpty <> showHelpOnError) + (info (commands <**> helper) idm) diff --git a/components/succinct-xml/bench/Main.hs b/components/succinct-xml/bench/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/bench/Main.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE BangPatterns #-} + +{- HLINT ignore "Use ++" -} + +module Main where + +import Criterion.Main +import Data.ByteString (ByteString) +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.Xml.Internal.Blank +import Data.Succinct.Xml.Internal.List +import Data.Succinct.Xml.Internal.Tables +import Data.Succinct.Xml.Succinct.Cursor +import Data.Word +import Foreign +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.FromByteString +import System.IO.MMap + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.Vector.Storable as DVS + +setupEnvXml :: FilePath -> IO ByteString +setupEnvXml filepath = do + (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + return bs + +loadXml :: ByteString -> XmlCursor ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) +loadXml bs = fromByteString bs :: XmlCursor ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) + +xmlToInterestBits3 :: [ByteString] -> [ByteString] +xmlToInterestBits3 = blankedXmlToInterestBits . blankXml + +runCon :: ([i] -> [ByteString]) -> i -> ByteString +runCon con bs = BS.concat $ con [bs] + +benchRankXmlCatalogLists :: [Benchmark] +benchRankXmlCatalogLists = + [ env (setupEnvXml "components/succinct-xml/data/catalog.xml") $ \bs -> bgroup "catalog.xml" + [ bench "Run blankXml" (whnf (runCon blankXml ) bs) + , bench "Run xmlToInterestBits3" (whnf (runCon xmlToInterestBits3) bs) + , bench "loadXml" (whnf loadXml bs) + ] + ] + +setupInterestingWord8s :: IO () +setupInterestingWord8s = do + let !_ = interestingWord8s + return () + +benchIsInterestingWord8 :: [Benchmark] +benchIsInterestingWord8 = + [ env setupInterestingWord8s $ \_ -> bgroup "Interesting Word8 lookup" + [ bench "isInterestingWord8" (whnf isInterestingWord8 0) + ] + ] + +main :: IO () +main = defaultMain $ concat + [ benchIsInterestingWord8 + , benchRankXmlCatalogLists + ] diff --git a/components/succinct-xml/doctest/DoctestDriver.hs b/components/succinct-xml/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover -optF components/succinct-xml/doctest/config.json #-} +#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/components/succinct-xml/src/Data/Succinct/Xml.hs b/components/succinct-xml/src/Data/Succinct/Xml.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml.hs @@ -0,0 +1,8 @@ +module Data.Succinct.Xml + ( module X + ) where + +import Data.Succinct.Xml.Decode as X +import Data.Succinct.Xml.DecodeError as X +import Data.Succinct.Xml.Succinct as X +import Data.Succinct.Xml.Token as X diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Blank.hs b/components/succinct-xml/src/Data/Succinct/Xml/Blank.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Blank.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Blank + ( blankXml + ) where + +import Data.ByteString (ByteString) +import Data.Succinct.Xml.Internal.Words +import Data.Word +import Data.Word8 +import Prelude + +import qualified Data.ByteString as BS + +type ExpectedChar = Word8 + +data BlankState + = InXml + | InTag + | InAttrList + | InCloseTag + | InClose + | InBang Int + | InString ExpectedChar + | InText + | InMeta + | InCdataTag + | InCdata Int + | InRem Int + | InIdent + deriving (Eq, Show) + +data ByteStringP = BSP Word8 ByteString | EmptyBSP deriving Show + +blankXml :: BS.ByteString -> BS.ByteString +blankXml as = fst (BS.unfoldrN (BS.length as) go (InXml, as)) + where go :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString)) + go (InXml, bs) = case BS.uncons bs of + Just (!c, !cs) | isMetaStart c cs -> Just (_bracketleft , (InMeta , cs)) + Just (!c, !cs) | isEndTag c cs -> Just (_space , (InCloseTag , cs)) + Just (!c, !cs) | isTextStart c -> Just (_t , (InText , cs)) + Just (!c, !cs) | c == _less -> Just (_less , (InTag , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InXml , cs)) + Just ( _, !cs) -> Just (_space , (InXml , cs)) + Nothing -> Nothing + go (InTag, bs) = case BS.uncons bs of + Just (!c, !cs) | isSpace c -> Just (_parenleft , (InAttrList , cs)) + Just (!c, !cs) | isTagClose c cs -> Just (_space , (InClose , cs)) + Just (!c, !cs) | c == _greater -> Just (_space , (InXml , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InTag , cs)) + Just ( _, !cs) -> Just (_space , (InTag , cs)) + Nothing -> Nothing + go (InCloseTag, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _greater -> Just (_greater , (InXml , cs)) + Just ( _, !cs) -> Just (_space , (InCloseTag , cs)) + Nothing -> Nothing + go (InAttrList, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _greater -> Just (_parenright , (InXml , cs)) + Just (!c, !cs) | isTagClose c cs -> Just (_parenright , (InClose , cs)) + Just (!c, !cs) | isNameStartChar c -> Just (_a , (InIdent , cs)) + Just (!c, !cs) | isQuote c -> Just (_v , (InString c , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InAttrList , cs)) + Just ( _, !cs) -> Just (_space , (InAttrList , cs)) + Nothing -> Nothing + go (InClose, bs) = case BS.uncons bs of + Just (_, !cs) -> Just (_greater , (InXml , cs)) + Nothing -> Nothing + go (InIdent, bs) = case BS.uncons bs of + Just (!c, !cs) | isNameChar c -> Just (_space , (InIdent , cs)) + Just (!c, !cs) | isSpace c -> Just (_space , (InAttrList , cs)) + Just (!c, !cs) | c == _equal -> Just (_space , (InAttrList , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InAttrList , cs)) + Just ( _, !cs) -> Just (_space , (InAttrList , cs)) + Nothing -> Nothing + go (InString q, bs) = case BS.uncons bs of + Just (!c, !cs) | c == q -> Just (_space , (InAttrList , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InString q , cs)) + Just ( _, !cs) -> Just (_space , (InString q , cs)) + Nothing -> Nothing + go (InText, bs) = case BS.uncons bs of + Just (!c, !cs) | isEndTag c cs -> Just (_space , (InCloseTag , cs)) + Just ( _, !cs) | headIs (== _less) cs -> Just (_space , (InXml , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InText , cs)) + Just ( _, !cs) -> Just (_space , (InText , cs)) + Nothing -> Nothing + go (InMeta, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _exclam -> Just (_space , (InMeta , cs)) + Just (!c, !cs) | c == _hyphen -> Just (_space , (InRem 0 , cs)) + Just (!c, !cs) | c == _bracketleft -> Just (_space , (InCdataTag , cs)) + Just (!c, !cs) | c == _greater -> Just (_bracketright, (InXml , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InBang 1 , cs)) + Just ( _, !cs) -> Just (_space , (InBang 1 , cs)) + Nothing -> Nothing + go (InCdataTag, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _bracketleft -> Just (_space , (InCdata 0 , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InCdataTag , cs)) + Just ( _, !cs) -> Just (_space , (InCdataTag , cs)) + Nothing -> Nothing + go (InCdata n, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _greater && n >= 2 -> Just (_bracketright, (InXml , cs)) + Just (!c, !cs) | isCdataEnd c cs && n > 0 -> Just (_space , (InCdata (n+1), cs)) + Just (!c, !cs) | c == _bracketright -> Just (_space , (InCdata (n+1), cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InCdata 0 , cs)) + Just ( _, !cs) -> Just (_space , (InCdata 0 , cs)) + Nothing -> Nothing + go (InRem n, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _greater && n >= 2 -> Just (_bracketright, (InXml , cs)) + Just (!c, !cs) | c == _hyphen -> Just (_space , (InRem (n+1) , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InRem 0 , cs)) + Just ( _, !cs) -> Just (_space , (InRem 0 , cs)) + Nothing -> Nothing + go (InBang n, bs) = case BS.uncons bs of + Just (!c, !cs) | c == _less -> Just (_bracketleft , (InBang (n+1) , cs)) + Just (!c, !cs) | c == _greater && n == 1 -> Just (_bracketright, (InXml , cs)) + Just (!c, !cs) | c == _greater -> Just (_bracketright, (InBang (n-1) , cs)) + Just (!c, !cs) | isSpace c -> Just (c , (InBang n , cs)) + Just ( _, !cs) -> Just (_space , (InBang n , cs)) + Nothing -> Nothing + +isEndTag :: Word8 -> ByteString -> Bool +isEndTag c cs = c == _less && headIs (== _slash) cs +{-# INLINE isEndTag #-} + +isTagClose :: Word8 -> ByteString -> Bool +isTagClose c cs = (c == _slash) || ((c == _slash || c == _question) && headIs (== _greater) cs) +{-# INLINE isTagClose #-} + +isMetaStart :: Word8 -> ByteString -> Bool +isMetaStart c cs = c == _less && headIs (== _exclam) cs +{-# INLINE isMetaStart #-} + +isCdataEnd :: Word8 -> ByteString -> Bool +isCdataEnd c cs = c == _bracketright && headIs (== _greater) cs +{-# INLINE isCdataEnd #-} + +headIs :: (Word8 -> Bool) -> ByteString -> Bool +headIs p bs = case BS.uncons bs of + Just (!c, _) -> p c + Nothing -> False +{-# INLINE headIs #-} diff --git a/components/succinct-xml/src/Data/Succinct/Xml/CharLike.hs b/components/succinct-xml/src/Data/Succinct/Xml/CharLike.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/CharLike.hs @@ -0,0 +1,22 @@ +module Data.Succinct.Xml.CharLike where + +import Data.Word +import Data.Word8 as W + +class XmlCharLike c where + isElementStart :: c -> Bool + isExclam :: c -> Bool + isHyphen :: c -> Bool + isOpenBracket :: c -> Bool + isQuestion :: c -> Bool + isQuote :: c -> Bool + isSpace :: c -> Bool + +instance XmlCharLike Word8 where + isElementStart = (== _less) + isExclam = (== _exclam) + isHyphen = (== _hyphen) + isOpenBracket = (== _bracketleft) + isQuestion = (== _question) + isQuote c = c == _quotedbl || c == _quotesingle + isSpace = W.isSpace diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Decode.hs b/components/succinct-xml/src/Data/Succinct/Xml/Decode.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Decode.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Decode where + +import Control.Applicative +import Control.Lens +import Control.Monad +import Data.Foldable +import Data.Succinct.Xml.DecodeError +import Data.Succinct.Xml.DecodeResult +import Data.Succinct.Xml.Internal.Show +import Data.Succinct.Xml.Value +import Data.Text (Text) + +class Decode a where + decode :: Value -> DecodeResult a + +instance Decode Value where + decode = DecodeOk + {-# INLINE decode #-} + +failDecode :: Text -> DecodeResult a +failDecode = DecodeFailed . DecodeError + +(@>) :: Value -> Text -> DecodeResult Text +(@>) (XmlElement _ as _) n = case find (\v -> fst v == n) as of + Just (_, text) -> DecodeOk text + Nothing -> failDecode $ "No such attribute " <> tshow n +(@>) _ n = failDecode $ "Not an element whilst looking up attribute " <> tshow n + +(/>) :: Value -> Text -> DecodeResult Value +(/>) (XmlElement _ _ cs) n = go cs + where go [] = failDecode $ "Unable to find element " <> tshow n + go (r:rs) = case r of + e@(XmlElement n' _ _) | n' == n -> DecodeOk e + _ -> go rs +(/>) _ n = failDecode $ "Expecting parent of element " <> tshow n + +(?>) :: Value -> (Value -> DecodeResult Value) -> DecodeResult Value +(?>) v f = f v <|> pure v + +(~>) :: Value -> Text -> DecodeResult Value +(~>) e@(XmlElement n' _ _) n | n' == n = DecodeOk e +(~>) _ n = failDecode $ "Expecting parent of element " <> tshow n + +(/>>) :: Value -> Text -> DecodeResult [Value] +(/>>) v n = v ^. childNodes <&> (~> n) <&> toList & join & pure + +-- Contextful + +() :: DecodeResult Value -> Text -> DecodeResult Value +() ma n = ma >>= (/> n) + +(<@>) :: DecodeResult Value -> Text -> DecodeResult Text +(<@>) ma n = ma >>= (@> n) + +() :: DecodeResult Value -> (Value -> DecodeResult Value) -> DecodeResult Value +() ma f = ma >>= (?> f) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/DecodeError.hs b/components/succinct-xml/src/Data/Succinct/Xml/DecodeError.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/DecodeError.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.Xml.DecodeError where + +import Control.DeepSeq +import Data.Text (Text) +import GHC.Generics + +newtype DecodeError = DecodeError Text deriving (Eq, Show, Generic, NFData) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/DecodeResult.hs b/components/succinct-xml/src/Data/Succinct/Xml/DecodeResult.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/DecodeResult.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.DecodeResult where + +import Control.Applicative +import Data.Succinct.Xml.DecodeError + +data DecodeResult a + = DecodeOk a + | DecodeFailed DecodeError + deriving (Eq, Show, Functor) + +instance Applicative DecodeResult where + pure = DecodeOk + {-# INLINE pure #-} + + (<*>) (DecodeOk f ) (DecodeOk a) = DecodeOk (f a) + (<*>) (DecodeOk _ ) (DecodeFailed e) = DecodeFailed e + (<*>) (DecodeFailed e) _ = DecodeFailed e + {-# INLINE (<*>) #-} + +instance Monad DecodeResult where + (>>=) (DecodeOk a) f = f a + (>>=) (DecodeFailed e) _ = DecodeFailed e + {-# INLINE (>>=) #-} + +instance Alternative DecodeResult where + empty = DecodeFailed (DecodeError "Failed decode") + (<|>) (DecodeOk a) _ = DecodeOk a + (<|>) _ (DecodeOk b) = DecodeOk b + (<|>) _ (DecodeFailed e) = DecodeFailed e + {-# INLINE (<|>) #-} + +instance Foldable DecodeResult where + foldr f z (DecodeOk a) = f a z + foldr _ z (DecodeFailed _) = z + +instance Traversable DecodeResult where + traverse _ (DecodeFailed e) = pure (DecodeFailed e) + traverse f (DecodeOk x) = DecodeOk <$> f x + +toEither :: DecodeResult a -> Either DecodeError a +toEither (DecodeOk a) = Right a +toEither (DecodeFailed e) = Left e + +isOk :: DecodeResult a -> Bool +isOk (DecodeOk _) = True +isOk _ = False + +isFailed :: DecodeResult a -> Bool +isFailed (DecodeFailed _) = True +isFailed _ = False diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Grammar.hs b/components/succinct-xml/src/Data/Succinct/Xml/Grammar.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Grammar.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Grammar where + +import Control.Applicative +import Data.Char +import Data.String +import Data.Succinct.Parser +import Data.Text (Text) +import Data.Word + +import qualified Data.Attoparsec.Types as T +import qualified Data.Succinct.Parser as P +import qualified Data.Text as T + +data XmlElementType + = XmlElementTypeDocument + | XmlElementTypeElement Text + | XmlElementTypeComment + | XmlElementTypeCData + | XmlElementTypeMeta Text + +parseXmlString :: (P.Parser t Word8) => T.Parser t Text +parseXmlString = do + q <- satisfyChar (=='"') <|> satisfyChar (=='\'') + T.pack <$> many (satisfyChar (/= q)) + +parseXmlElement :: (P.Parser t Word8, IsString t) => T.Parser t XmlElementType +parseXmlElement = comment <|> cdata <|> doc <|> meta <|> element + where + comment = const XmlElementTypeComment <$> string "!--" + cdata = const XmlElementTypeCData <$> string "![CDATA[" + meta = XmlElementTypeMeta <$> (string "!" >> parseXmlToken) + doc = const XmlElementTypeDocument <$> string "?xml" + element = XmlElementTypeElement <$> parseXmlToken + +parseXmlToken :: (P.Parser t Word8) => T.Parser t Text +parseXmlToken = T.pack <$> many (satisfyChar isNameChar "invalid string character") + +parseXmlAttributeName :: (P.Parser t Word8) => T.Parser t Text +parseXmlAttributeName = parseXmlToken + +isNameStartChar :: Char -> Bool +isNameStartChar w = + let iw = ord w + in w == '_' || w == ':' || isAlpha w + || (iw >= 0xc0 && iw <= 0xd6) + || (iw >= 0xd8 && iw <= 0xf6) + || (iw >= 0xf8 && iw <= 0xff) + +isNameChar :: Char -> Bool +isNameChar w = isNameStartChar w || w == '-' || w == '.' + || ord w == 0xb7 || isNumber w diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Index.hs b/components/succinct-xml/src/Data/Succinct/Xml/Index.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Index.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DeriveAnyClass #-} + +module Data.Succinct.Xml.Index + ( Index(..) + , indexVersion + ) where + +import Control.DeepSeq +import Data.Serialize +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Bits.BitShown + +import qualified Data.Vector.Storable as DVS + +indexVersion :: String +indexVersion = "1.0" + +data Index = Index + { xiVersion :: String + , xiInterests :: BitShown (DVS.Vector Word64) + , xiBalancedParens :: BitShown (DVS.Vector Word64) + } deriving (Eq, Show, Generic, NFData) + +putBitShownVector :: Putter (BitShown (DVS.Vector Word64)) +putBitShownVector = putVector . bitShown + +getBitShownVector :: Get (BitShown (DVS.Vector Word64)) +getBitShownVector = BitShown <$> getVector + +putVector :: DVS.Vector Word64 -> Put +putVector v = do + let len = DVS.length v + put len + DVS.forM_ v put + +getVector :: Get (DVS.Vector Word64) +getVector = do + len <- get + DVS.generateM len (const get) + +instance Serialize Index where + put xi = do + put $ xiVersion xi + putBitShownVector $ xiInterests xi + putBitShownVector $ xiBalancedParens xi + + get = do + version <- get + ib <- getBitShownVector + bp <- getBitShownVector + return $ Index version ib bp diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/BalancedParens.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/BalancedParens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/BalancedParens.hs @@ -0,0 +1,42 @@ +module Data.Succinct.Xml.Internal.BalancedParens + ( blankedXmlToBalancedParens + ) where + +import Data.ByteString (ByteString) +import Data.Word +import Data.Word8 + +import qualified Data.ByteString as BS + +data MiniBP = MiniN | MiniT | MiniF | MiniTF + +blankedXmlToBalancedParens :: [ByteString] -> [ByteString] +blankedXmlToBalancedParens is = case is of + (bs:bss) -> do + let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs) + cs:blankedXmlToBalancedParens bss + [] -> [] + where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString)) + gen (Just True , bs) = Just (0xFF, (Nothing, bs)) + gen (Just False , bs) = Just (0x00, (Nothing, bs)) + gen (Nothing , bs) = case BS.uncons bs of + Just (c, cs) -> case balancedParensOf c of + MiniN -> gen (Nothing , cs) + MiniT -> Just (0xFF, (Nothing , cs)) + MiniF -> Just (0x00, (Nothing , cs)) + MiniTF -> Just (0xFF, (Just False , cs)) + Nothing -> Nothing + +balancedParensOf :: Word8 -> MiniBP +balancedParensOf c = case c of + d | d == _less -> MiniT + d | d == _greater -> MiniF + d | d == _bracketleft -> MiniT + d | d == _bracketright -> MiniF + d | d == _parenleft -> MiniT + d | d == _parenright -> MiniF + d | d == _t -> MiniTF + d | d == _a -> MiniTF + d | d == _v -> MiniTF + _ -> MiniN + diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/Blank.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Blank.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Blank.hs @@ -0,0 +1,156 @@ +{-# OPTIONS_GHC-funbox-strict-fields #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Internal.Blank + ( blankXml + , BlankData(..) + ) where + +import Data.ByteString (ByteString) +import Data.Succinct.Xml.Internal.Words +import Data.Word +import Data.Word8 +import Prelude + +import qualified Data.ByteString as BS + +type ExpectedChar = Word8 + +data BlankState + = InXml + | InTag + | InAttrList + | InCloseTag + | InClose + | InBang !Int + | InString !ExpectedChar + | InText + | InMeta + | InCdataTag + | InCdata !Int + | InRem !Int + | InIdent + +data BlankData = BlankData + { blankState :: !BlankState + , blankA :: !Word8 + , blankB :: !Word8 + , blankC :: !ByteString + } + +blankXml :: [ByteString] -> [ByteString] +blankXml = blankXmlPlan1 BS.empty InXml + +blankXmlPlan1 :: ByteString -> BlankState -> [ByteString] -> [ByteString] +blankXmlPlan1 as lastState is = case is of + (bs:bss) -> do + let cs = as <> bs + case BS.uncons cs of + Just (d, ds) -> case BS.uncons ds of + Just (e, es) -> blankXmlRun False d e es lastState bss + Nothing -> blankXmlPlan1 cs lastState bss + Nothing -> blankXmlPlan1 cs lastState bss + [] -> [BS.map (const _space) as] + +blankXmlPlan2 :: Word8 -> Word8 -> BlankState -> [ByteString] -> [ByteString] +blankXmlPlan2 a b lastState is = case is of + (cs:css) -> blankXmlRun False a b cs lastState css + [] -> blankXmlRun True a b (BS.pack [_space, _space]) lastState [] + +blankXmlRun :: Bool -> Word8 -> Word8 -> ByteString -> BlankState -> [ByteString] -> [ByteString] +blankXmlRun done a b cs lastState is = do + let (!ds, mState) = BS.unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs) + case mState of + Just (BlankData !nextState _ _ _) -> do + let (yy, zz) = case BS.unsnoc cs of + Just (ys, z) -> case BS.unsnoc ys of + Just (_, y) -> (y, z) + Nothing -> (b, z) + Nothing -> (a, b) + if done + then [ds] + else ds:blankXmlPlan2 yy zz nextState is + Nothing -> error "No state: blankXmlRun" + +mkNext :: Word8 -> BlankState -> Word8 -> ByteString -> Maybe (Word8, BlankData) +mkNext w s a bs = case BS.uncons bs of + Just (b, cs) -> Just (w, BlankData s a b cs) + Nothing -> error "This should never happen" +{-# INLINE mkNext #-} + +blankByteString :: BlankData -> Maybe (Word8, BlankData) +blankByteString (BlankData InXml a b cs) | isMetaStart a b = mkNext _bracketleft InMeta b cs +blankByteString (BlankData InXml a b cs) | isEndTag a b = mkNext _space InCloseTag b cs +blankByteString (BlankData InXml a b cs) | isTextStart a = mkNext _t InText b cs +blankByteString (BlankData InXml a b cs) | a == _less = mkNext _less InTag b cs +blankByteString (BlankData InXml a b cs) | isSpace a = mkNext a InXml b cs +blankByteString (BlankData InXml _ b cs) = mkNext _space InXml b cs +blankByteString (BlankData InTag a b cs) | isSpace a = mkNext _parenleft InAttrList b cs +blankByteString (BlankData InTag a b cs) | isTagClose a b = mkNext _space InClose b cs +blankByteString (BlankData InTag a b cs) | a == _greater = mkNext _space InXml b cs +blankByteString (BlankData InTag a b cs) | isSpace a = mkNext a InTag b cs +blankByteString (BlankData InTag _ b cs) = mkNext _space InTag b cs +blankByteString (BlankData InCloseTag a b cs) | a == _greater = mkNext _greater InXml b cs +blankByteString (BlankData InCloseTag a b cs) | isSpace a = mkNext a InCloseTag b cs +blankByteString (BlankData InCloseTag _ b cs) = mkNext _space InCloseTag b cs +blankByteString (BlankData InAttrList a b cs) | a == _greater = mkNext _parenright InXml b cs +blankByteString (BlankData InAttrList a b cs) | isTagClose a b = mkNext _parenright InClose b cs +blankByteString (BlankData InAttrList a b cs) | isNameStartChar a = mkNext _a InIdent b cs +blankByteString (BlankData InAttrList a b cs) | isQuote a = mkNext _v (InString a) b cs +blankByteString (BlankData InAttrList a b cs) | isSpace a = mkNext a InAttrList b cs +blankByteString (BlankData InAttrList _ b cs) = mkNext _space InAttrList b cs +blankByteString (BlankData InClose _ b cs) = mkNext _greater InXml b cs +blankByteString (BlankData InIdent a b cs) | isNameChar a = mkNext _space InIdent b cs +blankByteString (BlankData InIdent a b cs) | isSpace a = mkNext _space InAttrList b cs +blankByteString (BlankData InIdent a b cs) | a == _equal = mkNext _space InAttrList b cs +blankByteString (BlankData InIdent a b cs) | isSpace a = mkNext a InAttrList b cs +blankByteString (BlankData InIdent _ b cs) = mkNext _space InAttrList b cs +blankByteString (BlankData (InString q ) a b cs) | a == q = mkNext _space InAttrList b cs +blankByteString (BlankData (InString q ) a b cs) | isSpace a = mkNext a (InString q) b cs +blankByteString (BlankData (InString q ) _ b cs) = mkNext _space (InString q) b cs +blankByteString (BlankData InText a b cs) | isEndTag a b = mkNext _space InCloseTag b cs +blankByteString (BlankData InText _ b cs) | b == _less = mkNext _space InXml b cs +blankByteString (BlankData InText a b cs) | isSpace a = mkNext a InText b cs +blankByteString (BlankData InText _ b cs) = mkNext _space InText b cs +blankByteString (BlankData InMeta a b cs) | a == _exclam = mkNext _space InMeta b cs +blankByteString (BlankData InMeta a b cs) | a == _hyphen = mkNext _space (InRem 0) b cs +blankByteString (BlankData InMeta a b cs) | a == _bracketleft = mkNext _space InCdataTag b cs +blankByteString (BlankData InMeta a b cs) | a == _greater = mkNext _bracketright InXml b cs +blankByteString (BlankData InMeta a b cs) | isSpace a = mkNext a (InBang 1) b cs +blankByteString (BlankData InMeta _ b cs) = mkNext _space (InBang 1) b cs +blankByteString (BlankData InCdataTag a b cs) | a == _bracketleft = mkNext _space (InCdata 0) b cs +blankByteString (BlankData InCdataTag a b cs) | isSpace a = mkNext a InCdataTag b cs +blankByteString (BlankData InCdataTag _ b cs) = mkNext _space InCdataTag b cs +blankByteString (BlankData (InCdata n ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright InXml b cs +blankByteString (BlankData (InCdata n ) a b cs) | isCdataEnd a b && n > 0 = mkNext _space (InCdata (n+1)) b cs +blankByteString (BlankData (InCdata n ) a b cs) | a == _bracketright = mkNext _space (InCdata (n+1)) b cs +blankByteString (BlankData (InCdata _ ) a b cs) | isSpace a = mkNext a (InCdata 0) b cs +blankByteString (BlankData (InCdata _ ) _ b cs) = mkNext _space (InCdata 0) b cs +blankByteString (BlankData (InRem n ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright InXml b cs +blankByteString (BlankData (InRem n ) a b cs) | a == _hyphen = mkNext _space (InRem (n+1)) b cs +blankByteString (BlankData (InRem _ ) a b cs) | isSpace a = mkNext a (InRem 0) b cs +blankByteString (BlankData (InRem _ ) _ b cs) = mkNext _space (InRem 0) b cs +blankByteString (BlankData (InBang n ) a b cs) | a == _less = mkNext _bracketleft (InBang (n+1)) b cs +blankByteString (BlankData (InBang n ) a b cs) | a == _greater && n == 1 = mkNext _bracketright InXml b cs +blankByteString (BlankData (InBang n ) a b cs) | a == _greater = mkNext _bracketright (InBang (n-1)) b cs +blankByteString (BlankData (InBang n ) a b cs) | isSpace a = mkNext a (InBang n) b cs +blankByteString (BlankData (InBang n ) _ b cs) = mkNext _space (InBang n) b cs +{-# INLINE blankByteString #-} + +isEndTag :: Word8 -> Word8 -> Bool +isEndTag a b = a == _less && b == _slash +{-# INLINE isEndTag #-} + +isTagClose :: Word8 -> Word8 -> Bool +isTagClose a b = a == _slash || ((a == _slash || a == _question) && b == _greater) +{-# INLINE isTagClose #-} + +isMetaStart :: Word8 -> Word8 -> Bool +isMetaStart a b = a == _less && b == _exclam +{-# INLINE isMetaStart #-} + +isCdataEnd :: Word8 -> Word8 -> Bool +isCdataEnd a b = a == _bracketright && b == _greater +{-# INLINE isCdataEnd #-} diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/ByteString.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/ByteString.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/ByteString.hs @@ -0,0 +1,14 @@ +module Data.Succinct.Xml.Internal.ByteString + ( repartitionMod8 + ) where + +import Data.ByteString (ByteString) + +import qualified Data.ByteString as BS + +repartitionMod8 :: ByteString -> ByteString -> (ByteString, ByteString) +repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS) + where abBS = BS.concat [aBS, bBS] + abLen = BS.length abBS + cLen = (abLen `div` 8) * 8 +{-# INLINE repartitionMod8 #-} diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/List.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/List.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/List.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Internal.List + ( blankedXmlToInterestBits + , compressWordAsBit + ) where + +import Data.ByteString (ByteString) +import Data.Succinct.Xml.Internal.ByteString +import Data.Succinct.Xml.Internal.Tables +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import Prelude + +import qualified Data.ByteString as BS + +blankedXmlToInterestBits :: [ByteString] -> [ByteString] +blankedXmlToInterestBits = blankedXmlToInterestBits' "" + +blankedXmlToInterestBits' :: ByteString -> [ByteString] -> [ByteString] +blankedXmlToInterestBits' rs is = case is of + (bs:bss) -> do + let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs + let lencs = BS.length cs + let q = lencs `quot` 8 + let (ds, es) = BS.splitAt (q * 8) cs + let (fs, _) = BS.unfoldrN q gen ds + fs:blankedXmlToInterestBits' es bss + [] -> do + let lenrs = BS.length rs + let q = lenrs + 7 `quot` 8 + [fst (BS.unfoldrN q gen rs)] + where gen :: ByteString -> Maybe (Word8, ByteString) + gen as = if BS.length as == 0 + then Nothing + else Just ( BS.foldr' (\b m -> isInterestingWord8 b .|. (m .<. 1)) 0 (BS.take 8 as) + , BS.drop 8 as + ) + +compressWordAsBit :: [ByteString] -> [ByteString] +compressWordAsBit = compressWordAsBit' BS.empty + +compressWordAsBit' :: ByteString -> [ByteString] -> [ByteString] +compressWordAsBit' aBS iBS = case iBS of + (bBS:bBSs) -> do + let (cBS, dBS) = repartitionMod8 aBS bBS + let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS + cs:compressWordAsBit' dBS bBSs + [] -> do + let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS + [cs] + where gen :: ByteString -> Maybe (Word8, ByteString) + gen xs = if BS.length xs == 0 + then Nothing + else Just ( BS.foldr' (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (BS.take 8 xs) + , BS.drop 8 xs + ) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/Show.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Show.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Show.hs @@ -0,0 +1,10 @@ +module Data.Succinct.Xml.Internal.Show + ( tshow + ) where + +import Data.Text (Text) + +import qualified Data.Text as T + +tshow :: Show a => a -> Text +tshow = T.pack . show diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/Tables.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Tables.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Tables.hs @@ -0,0 +1,32 @@ +module Data.Succinct.Xml.Internal.Tables + ( interestingWord8s + , isInterestingWord8 + ) where + +import Data.Word +import Data.Word8 +import HaskellWorks.Data.AtIndex ((!!!)) +import Prelude as P + +import qualified Data.Vector.Storable as DVS + +interestingWord8s :: DVS.Vector Word8 +interestingWord8s = DVS.constructN 256 go + where go :: DVS.Vector Word8 -> Word8 + go v = if w == _bracketleft + || w == _braceleft + || w == _parenleft + || w == _bracketleft + || w == _less + || w == _a + || w == _v + || w == _t + then 1 + else 0 + where w :: Word8 + w = fromIntegral (DVS.length v) +{-# NOINLINE interestingWord8s #-} + +isInterestingWord8 :: Word8 -> Word8 +isInterestingWord8 b = fromIntegral (interestingWord8s !!! fromIntegral b) +{-# INLINABLE isInterestingWord8 #-} diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/ToIbBp64.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/ToIbBp64.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/ToIbBp64.hs @@ -0,0 +1,19 @@ +module Data.Succinct.Xml.Internal.ToIbBp64 + ( toBalancedParens64 + , toInterestBits64 + , toIbBp64 + ) where + +import Data.ByteString (ByteString) +import Data.Succinct.Xml.Internal.BalancedParens +import Data.Succinct.Xml.Internal.List +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml (BlankedXml (..)) + +toBalancedParens64 :: BlankedXml -> [ByteString] +toBalancedParens64 (BlankedXml bj) = compressWordAsBit (blankedXmlToBalancedParens bj) + +toInterestBits64 :: BlankedXml -> [ByteString] +toInterestBits64 (BlankedXml bj) = blankedXmlToInterestBits bj + +toIbBp64 :: BlankedXml -> [(ByteString, ByteString)] +toIbBp64 bj = zip (toInterestBits64 bj) (toBalancedParens64 bj) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Internal/Words.hs b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Words.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Internal/Words.hs @@ -0,0 +1,36 @@ +module Data.Succinct.Xml.Internal.Words where + +import Data.Word +import Data.Word8 + +isLeadingDigit :: Word8 -> Bool +isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9) + +isTrailingDigit :: Word8 -> Bool +isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e + +isAlphabetic :: Word8 -> Bool +isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z) + +isQuote :: Word8 -> Bool +isQuote w = w == _quotedbl || w == _quotesingle + +isNameStartChar :: Word8 -> Bool +isNameStartChar w = w == _underscore || w == _colon || isAlphabetic w + || w `isIn` (0xc0, 0xd6) + || w `isIn` (0xd8, 0xf6) + || w `isIn` (0xf8, 0xff) + +isNameChar :: Word8 -> Bool +isNameChar w = isNameStartChar w || w == _hyphen || w == _period + || w == 0xb7 || w `isIn` (0, 9) + +isXml :: Word8 -> Bool +isXml w = w == _less || w == _greater + +isTextStart :: Word8 -> Bool +isTextStart w = not (isSpace w) && w /= _less && w /= _greater + +isIn :: Word8 -> (Word8, Word8) -> Bool +isIn w (s, e) = w >= s && w <= e +{-# INLINE isIn #-} diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Lens.hs b/components/succinct-xml/src/Data/Succinct/Xml/Lens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Lens.hs @@ -0,0 +1,12 @@ +module Data.Succinct.Xml.Lens where + +import Control.Lens +import Data.Succinct.Xml.Value +import Data.Text (Text) + +isTagNamed :: Text -> Value -> Bool +isTagNamed a (XmlElement b _ _) | a == b = True +isTagNamed _ _ = False + +tagNamed :: (Applicative f, Choice p) => Text -> Optic' p f Value Value +tagNamed = filtered . isTagNamed diff --git a/components/succinct-xml/src/Data/Succinct/Xml/RawDecode.hs b/components/succinct-xml/src/Data/Succinct/Xml/RawDecode.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/RawDecode.hs @@ -0,0 +1,10 @@ +module Data.Succinct.Xml.RawDecode where + +import Data.Succinct.Xml.RawValue + +class RawDecode a where + rawDecode :: RawValue -> a + +instance RawDecode RawValue where + rawDecode = id + {-# INLINE rawDecode #-} diff --git a/components/succinct-xml/src/Data/Succinct/Xml/RawValue.hs b/components/succinct-xml/src/Data/Succinct/Xml/RawValue.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/RawValue.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.RawValue + ( RawValue(..) + , RawValueAt(..) + ) where + +import Data.ByteString (ByteString) +import Data.List +import Data.Succinct.Xml.Grammar +import Data.Succinct.Xml.Internal.Show +import Data.Succinct.Xml.Succinct.Index +import Data.Text (Text) +import Prettyprinter + +import qualified Data.Attoparsec.ByteString.Char8 as ABC +import qualified Data.ByteString as BS +import qualified Data.Text as T + +data RawValue + = RawDocument [RawValue] + | RawText Text + | RawElement Text [RawValue] + | RawCData Text + | RawComment Text + | RawMeta Text [RawValue] + | RawAttrName Text + | RawAttrValue Text + | RawAttrList [RawValue] + | RawError Text + deriving (Eq, Show) + +-- TODO use colors and styles + +red :: Doc ann -> Doc ann +red = id + +dullwhite :: Doc ann -> Doc ann +dullwhite = id + +bold :: Doc ann -> Doc ann +bold = id + +dullgreen :: Doc ann -> Doc ann +dullgreen = id + +instance Pretty RawValue where + pretty mjpv = case mjpv of + RawText s -> ctext $ pretty (T.unpack s) + RawAttrName s -> pretty (T.unpack s) + RawAttrValue s -> (ctext . dquotes . pretty) (T.unpack s) + RawAttrList ats -> formatAttrs ats + RawComment s -> pretty $ "" + RawElement s xs -> formatElem (T.unpack s) xs + RawDocument xs -> formatMeta "?" "xml" xs + RawError s -> red $ "[error " <> pretty (T.unpack s) <> "]" + RawCData s -> cangle " ctag "[CDATA[" <> pretty (T.unpack s) <> cangle "]]>" + RawMeta s xs -> formatMeta "!" (T.unpack s) xs + where + formatAttr at = case at of + RawAttrName a -> " " <> pretty (RawAttrName a) + RawAttrValue a -> "=" <> pretty (RawAttrValue a) + RawAttrList _ -> red "ATTRS" + _ -> red "booo" + formatAttrs ats = hcat (formatAttr <$> ats) + formatElem s xs = + let (ats, es) = partition isAttrL xs + in cangle langle <> ctag (pretty s) + <> hcat (pretty <$> ats) + <> cangle rangle + <> hcat (pretty <$> es) + <> cangle " ctag (pretty s) <> cangle rangle + formatMeta b s xs = + let (ats, es) = partition isAttr xs + in cangle (langle <> pretty @String b) <> ctag (pretty @String s) + <> hcat (pretty <$> ats) + <> cangle rangle + <> hcat (pretty <$> es) + +class RawValueAt a where + rawValueAt :: a -> RawValue + +instance RawValueAt XmlIndex where + rawValueAt i = case i of + XmlIndexCData s -> parseTextUntil "]]>" s `as` (RawCData . T.pack) + XmlIndexComment s -> parseTextUntil "-->" s `as` (RawComment . T.pack) + XmlIndexMeta s cs -> RawMeta s (rawValueAt <$> cs) + XmlIndexElement s cs -> RawElement s (rawValueAt <$> cs) + XmlIndexDocument cs -> RawDocument (rawValueAt <$> cs) + XmlIndexAttrName cs -> parseAttrName cs `as` RawAttrName + XmlIndexAttrValue cs -> parseString cs `as` RawAttrValue + XmlIndexAttrList cs -> RawAttrList (rawValueAt <$> cs) + XmlIndexValue s -> parseTextUntil "<" s `as` (RawText . T.pack) + XmlIndexError s -> RawError s + --unknown -> XmlError ("Not yet supported: " <> show unknown) + where + parseUntil s = ABC.manyTill ABC.anyChar (ABC.string s) + + parseTextUntil :: ByteString -> ByteString -> Either Text [Char] + parseTextUntil s bs = case ABC.parse (parseUntil s) bs of + ABC.Fail {} -> decodeErr ("Unable to find " <> tshow s <> ".") bs + ABC.Partial _ -> decodeErr ("Unexpected end, expected " <> tshow s <> ".") bs + ABC.Done _ r -> Right r + parseString :: ByteString -> Either Text Text + parseString bs = case ABC.parse parseXmlString bs of + ABC.Fail {} -> decodeErr "Unable to parse string" bs + ABC.Partial _ -> decodeErr "Unexpected end of string, expected" bs + ABC.Done _ r -> Right r + parseAttrName :: ByteString -> Either Text Text + parseAttrName bs = case ABC.parse parseXmlAttributeName bs of + ABC.Fail {} -> decodeErr "Unable to parse attribute name" bs + ABC.Partial _ -> decodeErr "Unexpected end of attr name, expected" bs + ABC.Done _ r -> Right r + +cangle :: Doc ann -> Doc ann +cangle = dullwhite + +ctag :: Doc ann -> Doc ann +ctag = bold + +ctext :: Doc ann -> Doc ann +ctext = dullgreen + +isAttrL :: RawValue -> Bool +isAttrL (RawAttrList _) = True +isAttrL _ = False + +isAttr :: RawValue -> Bool +isAttr v = case v of + RawAttrName _ -> True + RawAttrValue _ -> True + RawAttrList _ -> True + _ -> False + +as :: Either Text a -> (a -> RawValue) -> RawValue +as = flip $ either RawError + +decodeErr :: Text -> BS.ByteString -> Either Text a +decodeErr reason bs = Left $ reason <> " (" <> tshow (BS.take 20 bs) <> "...)" diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct.hs @@ -0,0 +1,5 @@ +module Data.Succinct.Xml.Succinct + ( module X + ) where + +import Data.Succinct.Xml.Succinct.Cursor as X diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor.hs @@ -0,0 +1,6 @@ +module Data.Succinct.Xml.Succinct.Cursor + ( module X + ) where + +import Data.Succinct.Xml.Succinct.Cursor.Internal as X +import Data.Succinct.Xml.Succinct.Cursor.Token as X diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/BalancedParens.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/BalancedParens.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/BalancedParens.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.Xml.Succinct.Cursor.BalancedParens + ( XmlBalancedParens(..) + , getXmlBalancedParens + ) where + +import Control.Applicative +import Control.DeepSeq +import Data.Succinct.BalancedParens +import Data.Succinct.Xml.Internal.BalancedParens +import Data.Succinct.Xml.Internal.List +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Data.Word +import GHC.Generics + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS + +newtype XmlBalancedParens a = XmlBalancedParens a deriving (Eq, Show, Generic, NFData) + +getXmlBalancedParens :: XmlBalancedParens a -> a +getXmlBalancedParens (XmlBalancedParens a) = a + +genBitWordsForever :: BS.ByteString -> Maybe (Word8, BS.ByteString) +genBitWordsForever bs = BS.uncons bs <|> Just (0, bs) +{-# INLINABLE genBitWordsForever #-} + +instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where + fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS))) + where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj))) + newLen = (BS.length interestBS + 7) `div` 8 * 8 + +instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where + fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS))) + where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj))) + newLen = (BS.length interestBS + 7) `div` 8 * 8 + +instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where + fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS))) + where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj))) + newLen = (BS.length interestBS + 7) `div` 8 * 8 + +instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where + fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS))) + where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj))) + newLen = (BS.length interestBS + 7) `div` 8 * 8 diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/BlankedXml.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/BlankedXml.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/BlankedXml.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.Xml.Succinct.Cursor.BlankedXml + ( BlankedXml(..) + , FromBlankedXml(..) + , getBlankedXml + , bsToBlankedXml + , lbsToBlankedXml + ) where + +import Control.DeepSeq +import Data.Succinct.Xml.Internal.Blank +import GHC.Generics + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS + +newtype BlankedXml = BlankedXml + { unblankedXml :: [BS.ByteString] + } deriving (Eq, Show, Generic, NFData) + +getBlankedXml :: BlankedXml -> [BS.ByteString] +getBlankedXml (BlankedXml bs) = bs + +class FromBlankedXml a where + fromBlankedXml :: BlankedXml -> a + +bsToBlankedXml :: BS.ByteString -> BlankedXml +bsToBlankedXml bs = BlankedXml (blankXml [bs]) + +lbsToBlankedXml :: LBS.ByteString -> BlankedXml +lbsToBlankedXml lbs = BlankedXml (blankXml (LBS.toChunks lbs)) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Create.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Create.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Create.hs @@ -0,0 +1,36 @@ +module Data.Succinct.Xml.Succinct.Cursor.Create + ( byteStringAsFastCursor + , byteStringAsSlowCursor + ) where + +import Data.Coerce +import Data.Succinct.BalancedParens.RangeMin2 +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.RankSelect.CsPoppy1 +import Data.Succinct.Xml.Succinct.Cursor +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Data.Succinct.Xml.Succinct.Cursor.Types +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Vector.Storable + +import qualified Data.ByteString as BS +import qualified Data.Succinct.Xml.Internal.ToIbBp64 as I + +byteStringAsSlowCursor :: BS.ByteString -> SlowCursor +byteStringAsSlowCursor bs = XmlCursor + { cursorText = bs + , interests = BitShown ib + , balancedParens = SimpleBalancedParens bp + , cursorRank = 1 + } + where blankedXml = bsToBlankedXml bs + bsLen = BS.length bs + idxLen = (bsLen + 7) `div` 8 + (ib, bp) = construct64UnzipN idxLen (I.toIbBp64 blankedXml) + +byteStringAsFastCursor :: BS.ByteString -> FastCursor +byteStringAsFastCursor bs = XmlCursor bs ibCsPoppy rangeMinMax r + where XmlCursor _ ib bp r = byteStringAsSlowCursor bs + bpCsPoppy = makeCsPoppy (coerce bp) + rangeMinMax = mkRangeMin2 bpCsPoppy + ibCsPoppy = makeCsPoppy (coerce ib) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/InterestBits.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/InterestBits.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/InterestBits.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.Succinct.Xml.Succinct.Cursor.InterestBits + ( XmlInterestBits(..) + , getXmlInterestBits + , blankedXmlToInterestBits + , blankedXmlBssToInterestBitsBs + , genInterestForever + ) where + +import Control.Applicative +import Control.DeepSeq +import Data.ByteString.Internal +import Data.Succinct.RankSelect.Poppy512 +import Data.Succinct.Xml.Internal.List +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Data.Word +import GHC.Generics +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.FromByteString + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS + +newtype XmlInterestBits a = XmlInterestBits a deriving (Eq, Show, Generic, NFData) + +getXmlInterestBits :: XmlInterestBits a -> a +getXmlInterestBits (XmlInterestBits a) = a + +blankedXmlBssToInterestBitsBs :: [ByteString] -> ByteString +blankedXmlBssToInterestBitsBs bss = BS.concat $ blankedXmlToInterestBits bss + +genInterest :: ByteString -> Maybe (Word8, ByteString) +genInterest = BS.uncons + +genInterestForever :: ByteString -> Maybe (Word8, ByteString) +genInterestForever bs = BS.uncons bs <|> Just (0, bs) + +instance FromBlankedXml (XmlInterestBits (BitShown [Bool])) where + fromBlankedXml = XmlInterestBits . fromByteString . BS.concat . blankedXmlToInterestBits . getBlankedXml + +instance FromBlankedXml (XmlInterestBits (BitShown BS.ByteString)) where + fromBlankedXml = XmlInterestBits . BitShown . BS.unfoldr genInterest . blankedXmlBssToInterestBitsBs . getBlankedXml + +instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word8))) where + fromBlankedXml = XmlInterestBits . BitShown . DVS.unfoldr genInterest . blankedXmlBssToInterestBitsBs . getBlankedXml + +instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word16))) where + fromBlankedXml bj = XmlInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS))) + where interestBS = blankedXmlBssToInterestBitsBs (getBlankedXml bj) + newLen = (BS.length interestBS + 1) `div` 2 * 2 + +instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word32))) where + fromBlankedXml bj = XmlInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS))) + where interestBS = blankedXmlBssToInterestBitsBs (getBlankedXml bj) + newLen = (BS.length interestBS + 3) `div` 4 * 4 + +instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word64))) where + fromBlankedXml bj = XmlInterestBits (BitShown (DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS))) + where interestBS = blankedXmlBssToInterestBitsBs (getBlankedXml bj) + newLen = (BS.length interestBS + 7) `div` 8 * 8 + +instance FromBlankedXml (XmlInterestBits Poppy512) where + fromBlankedXml = XmlInterestBits . makePoppy512 . bitShown . getXmlInterestBits . fromBlankedXml diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Internal.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Internal.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Internal.hs @@ -0,0 +1,101 @@ +module Data.Succinct.Xml.Succinct.Cursor.Internal + ( XmlCursor(..) + , xmlCursorPos + ) where + +import Control.DeepSeq (NFData (..)) +import Data.String +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.Poppy512 +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Data.Succinct.Xml.Succinct.Cursor.InterestBits +import Data.Word +import Foreign.ForeignPtr +import GHC.Generics +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.FromByteString +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.TreeCursor + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Internal as BSI +import qualified Data.Succinct.BalancedParens as BP +import qualified Data.Succinct.Xml.Succinct.Cursor.BalancedParens as CBP +import qualified Data.Vector.Storable as DVS + +data XmlCursor t v w = XmlCursor + { cursorText :: !t + , interests :: !v + , balancedParens :: !w + , cursorRank :: !Count + } + deriving (Eq, Show, Generic) + +instance (NFData t, NFData v, NFData w) => NFData (XmlCursor t v w) where + rnf (XmlCursor a b c d) = rnf (a, b, c, d) + +instance (FromBlankedXml (XmlInterestBits a), FromBlankedXml (CBP.XmlBalancedParens b)) + => FromByteString (XmlCursor BS.ByteString a b) where + fromByteString bs = XmlCursor + { cursorText = bs + , interests = getXmlInterestBits (fromBlankedXml blankedXml) + , balancedParens = CBP.getXmlBalancedParens (fromBlankedXml blankedXml) + , cursorRank = 1 + } + where blankedXml :: BlankedXml + blankedXml = bsToBlankedXml bs + +instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where + fromString = fromByteString . BSC.pack + +instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where + fromString = fromByteString . BSC.pack + +instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where + fromString = fromByteString . BSC.pack + +instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromString = fromByteString . BSC.pack + +instance IsString (XmlCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromString = fromByteString . BSC.pack + +instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +instance FromForeignRegion (XmlCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (XmlCursor t v u) where + firstChild :: XmlCursor t v u -> Maybe (XmlCursor t v u) + firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + nextSibling :: XmlCursor t v u -> Maybe (XmlCursor t v u) + nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) + + parent :: XmlCursor t v u -> Maybe (XmlCursor t v u) + parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + depth :: XmlCursor t v u -> Maybe Count + depth k = BP.depth (balancedParens k) (cursorRank k) + + subtreeSize :: XmlCursor t v u -> Maybe Count + subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) + +xmlCursorPos :: (Rank1 w, Select1 v) => XmlCursor s v w -> Position +xmlCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) + where ik = interests k + bpk = balancedParens k diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Load.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Load.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Load.hs @@ -0,0 +1,19 @@ +module Data.Succinct.Xml.Succinct.Cursor.Load + ( loadSlowCursor + , loadFastCursor + ) where + +import Data.Succinct.Xml.Succinct.Cursor.Create +import Data.Succinct.Xml.Succinct.Cursor.Types + +import qualified Data.ByteString as BS + +-- | Load an XML file into memory and return a raw cursor initialised to the +-- start of the XML document. +loadSlowCursor :: FilePath -> IO SlowCursor +loadSlowCursor = fmap byteStringAsSlowCursor . BS.readFile + +-- | Load an XML file into memory and return a query-optimised cursor initialised +-- to the start of the XML document. +loadFastCursor :: FilePath -> IO FastCursor +loadFastCursor = fmap byteStringAsFastCursor . BS.readFile diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/MMap.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/MMap.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/MMap.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE BangPatterns #-} + +module Data.Succinct.Xml.Succinct.Cursor.MMap + ( SlowCursor + , FastCursor + , mmapSlowCursor + , mmapFastCursor + ) where + +import Data.Succinct.BalancedParens.RangeMin2 +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.RankSelect.CsPoppy1 +import Data.Succinct.Xml.Succinct.Cursor +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Data.Succinct.Xml.Succinct.Cursor.Types +import Data.Word +import Foreign.ForeignPtr +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Vector.Storable + +import qualified Data.ByteString.Internal as BSI +import qualified Data.Succinct.Xml.Internal.ToIbBp64 as I +import qualified System.IO.MMap as IO + +mmapSlowCursor :: FilePath -> IO SlowCursor +mmapSlowCursor filePath = do + (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + let blankedXml = bsToBlankedXml bs + let (ib, bp) = construct64UnzipN (fromIntegral size) (I.toIbBp64 blankedXml) + let !cursor = XmlCursor + { cursorText = bs + , interests = BitShown ib + , balancedParens = SimpleBalancedParens bp + , cursorRank = 1 + } + + return cursor + +mmapFastCursor :: FilePath -> IO FastCursor +mmapFastCursor filename = do + -- Load the XML file into memory as a raw cursor. + -- The raw XML data is `text`, and `ib` and `bp` are the indexes. + -- `ib` and `bp` can be persisted to an index file for later use to avoid + -- re-parsing the file. + XmlCursor !text (BitShown !ib) (SimpleBalancedParens !bp) _ <- mmapSlowCursor filename + let !bpCsPoppy = makeCsPoppy bp + let !rangeMinMax = mkRangeMin2 bpCsPoppy + let !ibCsPoppy = makeCsPoppy ib + return $ XmlCursor text ibCsPoppy rangeMinMax 1 diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Token.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Token.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Token.hs @@ -0,0 +1,23 @@ +module Data.Succinct.Xml.Succinct.Cursor.Token + ( xmlTokenAt + ) where + +import Data.ByteString (ByteString) +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.Xml.Succinct.Cursor.Internal +import Data.Succinct.Xml.Token.Tokenize +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Positioning +import Prelude hiding (drop) + +import qualified Data.Attoparsec.ByteString.Char8 as ABC + +xmlTokenAt :: (Rank1 w, Select1 v, TestBit w) => XmlCursor ByteString v w -> Maybe (XmlToken String Double) +xmlTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k) + then case ABC.parse parseXmlToken (drop (toCount (xmlCursorPos k)) (cursorText k)) of + ABC.Fail {} -> error "Failed to parse token in cursor" + ABC.Partial _ -> error "Failed to parse token in cursor" + ABC.Done _ r -> Just r + else Nothing diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Types.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Cursor/Types.hs @@ -0,0 +1,18 @@ +module Data.Succinct.Xml.Succinct.Cursor.Types + ( SlowCursor + , FastCursor + ) where + +import Data.Succinct.BalancedParens.RangeMin2 +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.RankSelect.CsPoppy1 +import Data.Succinct.Xml.Succinct.Cursor +import Data.Word +import HaskellWorks.Data.Bits.BitShown + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS + +type SlowCursor = XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) + +type FastCursor = XmlCursor BS.ByteString CsPoppy1 (RangeMin2 CsPoppy1) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Index.hs b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Index.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Succinct/Index.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Succinct.Index +( XmlIndex(..) +, XmlIndexAt(..) +) +where + +import Control.Arrow +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.Xml.CharLike +import Data.Succinct.Xml.Grammar +import Data.Succinct.Xml.Succinct +import Data.Text (Text) +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.TreeCursor +import HaskellWorks.Data.Uncons +import Prelude hiding (drop) + +import qualified Data.Attoparsec.ByteString.Char8 as ABC +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified Data.Succinct.BalancedParens as BP +import qualified Data.Text as T + +data XmlIndex + = XmlIndexDocument [XmlIndex] + | XmlIndexElement Text [XmlIndex] + | XmlIndexCData BS.ByteString + | XmlIndexComment BS.ByteString + | XmlIndexMeta Text [XmlIndex] + | XmlIndexAttrList [XmlIndex] + | XmlIndexValue BS.ByteString + | XmlIndexAttrName BS.ByteString + | XmlIndexAttrValue BS.ByteString + | XmlIndexError Text + deriving (Eq, Show) + +data XmlIndexState + = InAttrList + | InElement + | Unknown + deriving (Eq, Show) + +class XmlIndexAt a where + xmlIndexAt :: a -> XmlIndex + +pos :: (Select1 v, Rank1 w) => XmlCursor t v w -> Position +pos c = lastPositionOf (select1 (interests c) (rank1 (balancedParens c) (cursorRank c))) + +remText :: (Drop v, Select1 v1, Rank1 w) => XmlCursor v v1 w -> v +remText c = drop (toCount (pos c)) (cursorText c) + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlIndexAt (XmlCursor BS.ByteString v w) where + xmlIndexAt :: XmlCursor BS.ByteString v w -> XmlIndex + xmlIndexAt = getIndexAt Unknown + + +getIndexAt :: (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlIndexState -> XmlCursor BS.ByteString v w -> XmlIndex +getIndexAt state k = case uncons remainder of + Just (!c, cs) | isElementStart c -> parseElem cs + Just (!c, _ ) | isSpace c -> XmlIndexAttrList $ mapValuesFrom InAttrList (firstChild k) + Just (!c, _ ) | isAttribute && isQuote c -> XmlIndexAttrValue remainder + Just _ | isAttribute -> XmlIndexAttrName remainder + Just _ -> XmlIndexValue remainder + Nothing -> XmlIndexError "End of data" + where remainder = remText k + mapValuesFrom s = L.unfoldr (fmap (getIndexAt s &&& nextSibling)) + isAttribute = case state of + InAttrList -> True + InElement -> False + Unknown -> case remText <$> parent k >>= uncons of + Just (!c, _) | isSpace c -> True + _ -> False + + parseElem bs = + case ABC.parse parseXmlElement bs of + ABC.Fail {} -> decodeErr "Unable to parse element name" bs + ABC.Partial _ -> decodeErr "Unexpected end of string" bs + ABC.Done i r -> case r of + XmlElementTypeCData -> XmlIndexCData i + XmlElementTypeComment -> XmlIndexComment i + XmlElementTypeMeta s -> XmlIndexMeta s (mapValuesFrom InElement $ firstChild k) + XmlElementTypeElement s -> XmlIndexElement s (mapValuesFrom InElement $ firstChild k) + XmlElementTypeDocument -> XmlIndexDocument (mapValuesFrom InElement (firstChild k) <> mapValuesFrom InElement (nextSibling k)) + +decodeErr :: String -> BS.ByteString -> XmlIndex +decodeErr reason bs = XmlIndexError . T.pack $ reason <>": " <> show (BS.take 20 bs) <> "...'" diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Token.hs b/components/succinct-xml/src/Data/Succinct/Xml/Token.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Token.hs @@ -0,0 +1,6 @@ +module Data.Succinct.Xml.Token + ( module X + ) where + +import Data.Succinct.Xml.Token.Types as X +import Data.Succinct.Xml.Token.Tokenize as X diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Token/Tokenize.hs b/components/succinct-xml/src/Data/Succinct/Xml/Token/Tokenize.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Token/Tokenize.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Token.Tokenize + ( IsChar(..) + , XmlToken(..) + , ParseXml(..) + ) where + +import Control.Applicative +import Data.Bits +import Data.Char +import Data.Succinct.Parser as P +import Data.Succinct.Xml.Token.Types +import Data.Word +import Data.Word8 +import HaskellWorks.Data.Char.IsChar + +import qualified Data.Attoparsec.ByteString.Char8 as BC +import qualified Data.Attoparsec.Combinator as AC +import qualified Data.Attoparsec.Types as T +import qualified Data.ByteString as BS + +hexDigitNumeric :: P.Parser t Word8 => T.Parser t Int +hexDigitNumeric = do + c <- satisfyChar (\c -> '0' <= c && c <= '9') + return $ ord c - ord '0' + +hexDigitAlphaLower :: P.Parser t Word8 => T.Parser t Int +hexDigitAlphaLower = do + c <- satisfyChar (\c -> 'a' <= c && c <= 'z') + return $ ord c - ord 'a' + 10 + +hexDigitAlphaUpper :: P.Parser t Word8 => T.Parser t Int +hexDigitAlphaUpper = do + c <- satisfyChar (\c -> 'A' <= c && c <= 'Z') + return $ ord c - ord 'A' + 10 + +hexDigit :: P.Parser t Word8 => T.Parser t Int +hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper + +class ParseXml t s d where + parseXmlTokenString :: T.Parser t (XmlToken s d) + parseXmlToken :: T.Parser t (XmlToken s d) + parseXmlTokenBraceL :: T.Parser t (XmlToken s d) + parseXmlTokenBraceR :: T.Parser t (XmlToken s d) + parseXmlTokenBracketL :: T.Parser t (XmlToken s d) + parseXmlTokenBracketR :: T.Parser t (XmlToken s d) + parseXmlTokenComma :: T.Parser t (XmlToken s d) + parseXmlTokenColon :: T.Parser t (XmlToken s d) + parseXmlTokenWhitespace :: T.Parser t (XmlToken s d) + parseXmlTokenNull :: T.Parser t (XmlToken s d) + parseXmlTokenBoolean :: T.Parser t (XmlToken s d) + parseXmlTokenDouble :: T.Parser t (XmlToken s d) + + parseXmlToken = + parseXmlTokenString <|> + parseXmlTokenBraceL <|> + parseXmlTokenBraceR <|> + parseXmlTokenBracketL <|> + parseXmlTokenBracketR <|> + parseXmlTokenComma <|> + parseXmlTokenColon <|> + parseXmlTokenWhitespace <|> + parseXmlTokenNull <|> + parseXmlTokenBoolean <|> + parseXmlTokenDouble + +instance ParseXml BS.ByteString String Double where + parseXmlTokenBraceL = string "{" >> return XmlTokenBraceL + parseXmlTokenBraceR = string "}" >> return XmlTokenBraceR + parseXmlTokenBracketL = string "[" >> return XmlTokenBracketL + parseXmlTokenBracketR = string "]" >> return XmlTokenBracketR + parseXmlTokenComma = string "," >> return XmlTokenComma + parseXmlTokenColon = string ":" >> return XmlTokenColon + parseXmlTokenNull = string "null" >> return XmlTokenNull + parseXmlTokenDouble = XmlTokenNumber <$> rational + + parseXmlTokenString = do + _ <- string "\"" + value <- many (verbatimChar <|> escapedChar <|> escapedCode) + _ <- string "\"" + return $ XmlTokenString value + where + verbatimChar = satisfyChar (BC.notInClass "\"\\") "invalid string character" + escapedChar = do + _ <- string "\\" + ( char '"' >> return '"' ) <|> + ( char 'b' >> return '\b' ) <|> + ( char 'n' >> return '\n' ) <|> + ( char 'f' >> return '\f' ) <|> + ( char 'r' >> return '\r' ) <|> + ( char 't' >> return '\t' ) <|> + ( char '\\' >> return '\\' ) <|> + ( char '\'' >> return '\'' ) <|> + ( char '/' >> return '/' ) + escapedCode :: T.Parser BS.ByteString Char + escapedCode = do + _ <- string "\\u" + a <- hexDigit + b <- hexDigit + c <- hexDigit + d <- hexDigit + return . chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d + + parseXmlTokenWhitespace = do + _ <- AC.many1' $ BC.choice [string " ", string "\t", string "\n", string "\r"] + return XmlTokenWhitespace + + parseXmlTokenBoolean = true <|> false + where + true = string "true" >> return (XmlTokenBoolean True) + false = string "false" >> return (XmlTokenBoolean False) + +instance ParseXml BS.ByteString BS.ByteString Double where + parseXmlTokenBraceL = string "{" >> return XmlTokenBraceL + parseXmlTokenBraceR = string "}" >> return XmlTokenBraceR + parseXmlTokenBracketL = string "[" >> return XmlTokenBracketL + parseXmlTokenBracketR = string "]" >> return XmlTokenBracketR + parseXmlTokenComma = string "," >> return XmlTokenComma + parseXmlTokenColon = string ":" >> return XmlTokenColon + parseXmlTokenNull = string "null" >> return XmlTokenNull + parseXmlTokenDouble = XmlTokenNumber <$> rational + + parseXmlTokenString = do + _ <- string "\"" + value <- many (verbatimChar <|> escapedChar <|> escapedCode) + _ <- string "\"" + return . XmlTokenString $ BS.pack value + where + word :: Word8 -> T.Parser BS.ByteString Word8 + word w = satisfy (== w) + verbatimChar :: T.Parser BS.ByteString Word8 + verbatimChar = satisfy (\w -> w /= _quotedbl && w /= _backslash) -- "invalid string character" + escapedChar :: T.Parser BS.ByteString Word8 + escapedChar = do + _ <- string "\\" + ( word _quotedbl >> return _quotedbl ) <|> + ( word _b >> return 0x08 ) <|> + ( word _n >> return _lf ) <|> + ( word _f >> return _np ) <|> + ( word _r >> return _cr ) <|> + ( word _t >> return _tab ) <|> + ( word _backslash >> return _backslash ) <|> + ( word _quotesingle >> return _quotesingle ) <|> + ( word _slash >> return _slash ) + escapedCode :: T.Parser BS.ByteString Word8 + escapedCode = do + _ <- string "\\u" + a <- hexDigit + b <- hexDigit + c <- hexDigit + d <- hexDigit + return . fromIntegral $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d + + parseXmlTokenWhitespace = do + _ <- AC.many1' $ BC.choice [string " ", string "\t", string "\n", string "\r"] + return XmlTokenWhitespace + + parseXmlTokenBoolean = true <|> false + where + true = string "true" >> return (XmlTokenBoolean True) + false = string "false" >> return (XmlTokenBoolean False) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Token/Types.hs b/components/succinct-xml/src/Data/Succinct/Xml/Token/Types.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Token/Types.hs @@ -0,0 +1,15 @@ +module Data.Succinct.Xml.Token.Types (XmlToken(..)) where + +data XmlToken s d + = XmlTokenBraceL + | XmlTokenBraceR + | XmlTokenBracketL + | XmlTokenBracketR + | XmlTokenComma + | XmlTokenColon + | XmlTokenWhitespace + | XmlTokenString s + | XmlTokenBoolean Bool + | XmlTokenNumber d + | XmlTokenNull + deriving (Eq, Show) diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Type.hs b/components/succinct-xml/src/Data/Succinct/Xml/Type.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Type.hs @@ -0,0 +1,49 @@ +module Data.Succinct.Xml.Type where + +import Data.Char +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.Xml.Succinct +import Data.Word8 as W8 +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Positioning +import Prelude hiding (drop) + +import qualified Data.ByteString as BS +import qualified Data.Succinct.BalancedParens as BP + +{- HLINT ignore "Reduce duplication" -} + +data XmlType + = XmlTypeElement + | XmlTypeAttrList + | XmlTypeToken + deriving (Eq, Show) + +class XmlTypeAt a where + xmlTypeAtPosition :: Position -> a -> Maybe XmlType + xmlTypeAt :: a -> Maybe XmlType + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlTypeAt (XmlCursor String v w) where + xmlTypeAtPosition p k = case drop (toCount p) (cursorText k) of + c:_ | fromIntegral (ord c) == _less -> Just XmlTypeElement + c:_ | W8.isSpace $ fromIntegral (ord c) -> Just XmlTypeAttrList + _ -> Just XmlTypeToken + + xmlTypeAt k = xmlTypeAtPosition p k + where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + ik = interests k + bpk = balancedParens k + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlTypeAt (XmlCursor BS.ByteString v w) where + xmlTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of + Just (c, _) | c == _less -> Just XmlTypeElement + Just (c, _) | W8.isSpace c -> Just XmlTypeAttrList + _ -> Just XmlTypeToken + + xmlTypeAt k = xmlTypeAtPosition p k + where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + ik = interests k + bpk = balancedParens k diff --git a/components/succinct-xml/src/Data/Succinct/Xml/Value.hs b/components/succinct-xml/src/Data/Succinct/Xml/Value.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/src/Data/Succinct/Xml/Value.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Succinct.Xml.Value + ( Value(..) + , HasValue(..) + , _XmlDocument + , _XmlText + , _XmlElement + , _XmlCData + , _XmlComment + , _XmlMeta + , _XmlError + ) where + +import Control.Lens +import Data.Succinct.Xml.Internal.Show +import Data.Succinct.Xml.RawDecode +import Data.Succinct.Xml.RawValue +import Data.Text (Text) + +data Value + = XmlDocument + { _childNodes :: [Value] + } + | XmlText + { _textValue :: Text + } + | XmlElement + { _name :: Text + , _attributes :: [(Text, Text)] + , _childNodes :: [Value] + } + | XmlCData + { _cdata :: Text + } + | XmlComment + { _comment :: Text + } + | XmlMeta + { _name :: Text + , _childNodes :: [Value] + } + | XmlError + { _errorMessage :: Text + } + deriving (Eq, Show) + +makeClassy ''Value +makePrisms ''Value + +instance RawDecode Value where + rawDecode (RawDocument rvs ) = XmlDocument (rawDecode <$> rvs) + rawDecode (RawText text ) = XmlText text + rawDecode (RawElement n cs ) = mkXmlElement n cs + rawDecode (RawCData text ) = XmlCData text + rawDecode (RawComment text ) = XmlComment text + rawDecode (RawMeta n cs ) = XmlMeta n (rawDecode <$> cs) + rawDecode (RawAttrName nameValue ) = XmlError ("Can't decode attribute name: " <> nameValue) + rawDecode (RawAttrValue attrValue ) = XmlError ("Can't decode attribute value: " <> attrValue) + rawDecode (RawAttrList as ) = XmlError ("Can't decode attribute list: " <> tshow as) + rawDecode (RawError msg ) = XmlError msg + +mkXmlElement :: Text -> [RawValue] -> Value +mkXmlElement n (RawAttrList as:cs) = XmlElement n (mkAttrs as) (rawDecode <$> cs) +mkXmlElement n cs = XmlElement n [] (rawDecode <$> cs) + +mkAttrs :: [RawValue] -> [(Text, Text)] +mkAttrs (RawAttrName n:RawAttrValue v:cs) = (n, v):mkAttrs cs +mkAttrs (_:cs) = mkAttrs cs +mkAttrs [] = [] diff --git a/components/succinct-xml/test/Data/Succinct/Xml/Internal/BlankSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/Internal/BlankSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/Internal/BlankSpec.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Internal.BlankSpec (spec) where + +import Data.Char +import Data.Succinct.Xml.Internal.Blank +import HaskellWorks.Data.ByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +whenBlankedXmlShouldBe :: BS.ByteString -> BS.ByteString -> Spec +whenBlankedXmlShouldBe original expected = do + it (show original <> " when blanked xml should be " <> show expected) $ requireTest $ do + BS.concat (blankXml [original]) === expected + +repeatBS :: Int -> BS.ByteString -> BS.ByteString +repeatBS n bs | n > 0 = bs <> repeatBS (n - 1) bs +repeatBS _ _ = BS.empty + +noSpaces :: BS.ByteString -> BS.ByteString +noSpaces = BS.filter (/= fromIntegral (ord ' ')) + +data Annotated a b = Annotated a b deriving Show + +instance Eq a => Eq (Annotated a b) where + (Annotated a _) == (Annotated b _) = a == b + +spec :: Spec +spec = describe "Data.Succinct.Xml.Internal.BlankSpec" $ do + describe "Can blank XML" $ do + "" `whenBlankedXmlShouldBe` "< >" + "" `whenBlankedXmlShouldBe` "< >" + "text" `whenBlankedXmlShouldBe` "< t >" + " text " `whenBlankedXmlShouldBe` "< t >" + "" `whenBlankedXmlShouldBe` "< ()>" + "" `whenBlankedXmlShouldBe` "< (a v )>" + "" `whenBlankedXmlShouldBe` "< (a v )>" + "" `whenBlankedXmlShouldBe` "< (a v )>" + "" `whenBlankedXmlShouldBe` "< (a v a v )>" + "text" `whenBlankedXmlShouldBe` "< (a v a v )t >" + "" `whenBlankedXmlShouldBe` "< (a v a v )>" + "" `whenBlankedXmlShouldBe` "< (a v )< > >" + "test" `whenBlankedXmlShouldBe` "< (a v )< t > >" + " text bold " `whenBlankedXmlShouldBe` "< t < t > >" + " text bold uuu" `whenBlankedXmlShouldBe` "< t < t > t >" + "" `whenBlankedXmlShouldBe` "< (a v )>" + " " `whenBlankedXmlShouldBe` "< [ ] >" + " " `whenBlankedXmlShouldBe` "< [ ] >" + + " " `whenBlankedXmlShouldBe` "< [ ] >" + "" `whenBlankedXmlShouldBe` "< (a v a v )>" + + "]>" `whenBlankedXmlShouldBe` "[ [ ] ]" + + "Hello,\ + \ world!]]>" `whenBlankedXmlShouldBe` "< [ ] >" + + "" `whenBlankedXmlShouldBe` "< [ ] >" + "00" `whenBlankedXmlShouldBe` "< < t >< > >" + "0" `whenBlankedXmlShouldBe` "< < t >< > >" + + it "Can blank across chunk boundaries with basic tags" $ requireTest $ do + let inputOriginalPrefix = "\n\n " + let inputOriginalSuffix = "\n \n \n \n \n \n\n" + let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix + let inputOriginalChunked = chunkedBy 16 inputOriginal + let inputOriginalBlanked = blankXml inputOriginalChunked + + n <- forAll $ G.int (R.linear 0 16) + + let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix + let inputShiftedChunked = chunkedBy 16 inputShifted + let inputShiftedBlanked = blankXml inputShiftedChunked + + noSpaces (BS.concat inputShiftedBlanked) === noSpaces (BS.concat inputOriginalBlanked) + it "Can blank across chunk boundaries with auto-close tags" $ requireTest $ do + let inputOriginalPrefix = "" + let inputOriginalSuffix = "\n" + let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix + let inputOriginalChunked = chunkedBy 16 inputOriginal + let inputOriginalBlanked = blankXml inputOriginalChunked + + n <- forAll $ G.int (R.linear 0 16) + + let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix + let inputShiftedChunked = chunkedBy 16 inputShifted + let inputShiftedBlanked = blankXml inputShiftedChunked + + -- putStrLn $ show (BS.concat inputShiftedBlanked) <> " vs " <> show (BS.concat inputOriginalBlanked) + let actual = Annotated (noSpaces (BS.concat inputShiftedBlanked )) (inputShiftedBlanked, n) + let expected = Annotated (noSpaces (BS.concat inputOriginalBlanked)) (inputOriginalBlanked, n) + + actual === expected + it "Can blank across chunk boundaries with auto-close tags" $ requireTest $ do + let inputOriginalPrefix = "" + let inputOriginalSuffix = "\n" + let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix + let inputOriginalChunked = chunkedBy 16 inputOriginal + let inputOriginalBlanked = blankXml inputOriginalChunked + + let n = 15 + let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix + let inputShiftedChunked = chunkedBy 16 inputShifted + let inputShiftedBlanked = blankXml inputShiftedChunked + + -- putStrLn $ show (BS.concat inputShiftedBlanked) <> " vs " <> show (BS.concat inputOriginalBlanked) + let actual = Annotated (noSpaces (BS.concat inputShiftedBlanked )) (inputShiftedBlanked, n) + let expected = Annotated (noSpaces (BS.concat inputOriginalBlanked)) (inputOriginalBlanked, n) + + actual === expected diff --git a/components/succinct-xml/test/Data/Succinct/Xml/RawValueSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/RawValueSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/RawValueSpec.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Xml.RawValueSpec (spec) where + +import Control.Monad +import Data.String +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.Poppy512 +import Data.Succinct.Xml.RawValue +import Data.Succinct.Xml.Succinct.Cursor as C +import Data.Succinct.Xml.Succinct.Index +import Data.Text (Text) +import Data.Word +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} +{- HLINT ignore "Reduce duplication" -} + +fc = TC.firstChild +ns = TC.nextSibling + +attrs :: [(Text, Text)] -> RawValue +attrs as = RawAttrList $ as >>= (\(k, v) -> [RawAttrName k, RawAttrValue v]) + +spec :: Spec +spec = describe "Data.Succinct.Xml.ValueSpec" $ do + genSpec "DVS.Vector Word8" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))) + genSpec "DVS.Vector Word16" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) + genSpec "DVS.Vector Word32" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) + genSpec "DVS.Vector Word64" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) + genSpec "Poppy512" (undefined :: XmlCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) + +rawValueVia :: XmlIndexAt (XmlCursor BS.ByteString t u) + => Maybe (XmlCursor BS.ByteString t u) -> RawValue +rawValueVia mk = case mk of + Just k -> rawValueAt (xmlIndexAt k) --either (\(DecodeError e) -> XmlError e) id (rawValueAt <$> xmlIndexAt k) + Nothing -> RawError "No such element" + +genSpec :: forall t u. + ( Show t + , Select1 t + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u + , IsString (XmlCursor BS.ByteString t u) + ) + => String -> XmlCursor BS.ByteString t u -> SpecWith () +genSpec t _ = do + describe ("XML cursor of type " <> t) $ do + let forXml (cursor :: XmlCursor BS.ByteString t u) f = describe ("of value " <> show cursor) (f cursor) + + forXml "" $ \cursor -> do + it "should have correct value" $ requireTest $ rawValueVia (Just cursor) === RawElement "a" [] + + forXml "" $ \cursor -> do + it "should have correct value" $ requireTest $ rawValueVia (Just cursor) === + RawElement "a" [attrs [("attr", "value")]] + + forXml "" $ \cursor -> do + it "should have correct value" $ requireTest $ rawValueVia (Just cursor) === + RawElement "a" [attrs [("attr", "value")], + RawElement "b" [attrs [("attr", "value")]]] + + forXml "value text" $ \cursor -> do + it "should have correct value" $ requireTest $ rawValueVia (Just cursor) === + RawElement "a" [RawText "value text"] + + forXml "" $ \cursor -> do + it "should parse space separared comment" $ requireTest $ rawValueVia (Just cursor) === + RawComment " some comment " + + forXml "" $ \cursor -> do + it "should parse space separared comment" $ requireTest $ rawValueVia (Just cursor) === + RawComment "some comment ->" + + forXml " tag]]>" $ \cursor -> do + it "should parse cdata data" $ requireTest $ rawValueVia (Just cursor) === + RawCData "a
tag" + + forXml "]>" $ \cursor -> do + it "should parse metas" $ requireTest $ rawValueVia (Just cursor) === + RawMeta "DOCTYPE" [RawMeta "ELEMENT" []] + + forXml "free" $ \cursor -> do + it "should parse xml header" $ requireTest $ rawValueVia (Just cursor) === + RawDocument [ + attrs [("version", "1.0"), ("encoding", "UTF-8")], + RawElement "a" [attrs [("text", "value")], + RawText "free"]] + + it "navigate around" $ requireTest $ do + rawValueVia (ns cursor) === RawElement "a" [attrs [("text", "value")], RawText "free"] + rawValueVia ((ns >=> fc) cursor) === attrs [("text", "value")] + rawValueVia ((ns >=> fc >=> fc) cursor) === RawAttrName "text" + rawValueVia ((ns >=> fc >=> fc >=> ns) cursor) === RawAttrValue "value" + rawValueVia ((ns >=> fc >=> ns) cursor) === RawText "free" diff --git a/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/BalancedParensSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/BalancedParensSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/BalancedParensSpec.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Succinct.Cursor.BalancedParensSpec + ( spec + ) where + +import Data.String +import Data.Succinct.Xml.Internal.BalancedParens +import Data.Succinct.Xml.Internal.Blank +import Data.Succinct.Xml.Internal.List +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.ByteString +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS + +{- HLINT ignore "Redundant do" -} + +spec :: Spec +spec = describe "Data.Succinct.Xml.Succinct.Cursor.BalancedParensSpec" $ do + it "Blanking XML should work 1" $ requireTest $ do + let blankedXml = BlankedXml [">"] + let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml blankedXml))) + bp === fromString "11011000" + it "Blanking XML should work 2" $ requireTest $ do + let blankedXml = BlankedXml + [ "<><><><><><><><>" + , "<><><><><><><><>" + ] + let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml blankedXml))) + bp === fromString + "1010101010101010\ + \1010101010101010" + + let unchunkedInput = "\n\n \n \n \n \n \n \n\n" + let chunkedInput = chunkedBy 15 unchunkedInput + let chunkedBlank = blankXml chunkedInput + + let unchunkedBadInput = "\n\n \n \n \n \n \n \n\n" + let chunkedBadInput = chunkedBy 15 unchunkedBadInput + let chunkedBadBlank = blankXml chunkedBadInput + + it "Same input" $ requireTest $ do + unchunkedInput === BS.concat chunkedInput + + it "Blanking XML should work 3" $ requireTest $ do + let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens chunkedBlank)) + annotate $ "Good: " <> show chunkedBlank + bp === fromString "11101010 10001101 01010100" + + it "Blanking XML should work 3" $ requireTest $ do + let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens chunkedBadBlank)) + annotate $ "Bad: " <> show chunkedBadBlank + bp === fromString "11101010 10001101 01010100" + + describe "Chunking works" $ do + let document = "free" + let whole = mkBlank 4096 document + let chunked = mkBlank 15 document + + it "should BP the same with chanks" $ requireTest $ do + BS.concat chunked === BS.concat whole + + it "should produce same bits" $ requireTest $ do + BS.concat (mkBits chunked) === BS.concat (mkBits whole) + + +mkBlank :: Int -> BS.ByteString -> [BS.ByteString] +mkBlank csize bs = blankXml (chunkedBy csize bs) + +mkBits :: [BS.ByteString] -> [BS.ByteString] +mkBits = compressWordAsBit . blankedXmlToBalancedParens diff --git a/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/BlankedXmlSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/BlankedXmlSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/BlankedXmlSpec.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Succinct.Cursor.BlankedXmlSpec + ( spec + ) where + +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +{- HLINT ignore "Redundant do" -} + +spec :: Spec +spec = describe "Data.Succinct.Xml.Succinct.Cursor.BlankedXmlSpec" $ do + describe "Blanking XML should work" $ do + it "on strict bytestrings" $ requireTest $ do + let input = "" + let expected = "< < > >" + let blankedXml = bsToBlankedXml input + + mconcat (unblankedXml blankedXml) === expected + + it "on lazy bytestrings" $ requireTest $ do + let input = "" + let expected = "< < > >" + let blankedXml = lbsToBlankedXml input + + mconcat (unblankedXml blankedXml) === expected diff --git a/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/InterestBitsSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/InterestBitsSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/Cursor/InterestBitsSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Succinct.Cursor.InterestBitsSpec(spec) where + +import Data.String +import Data.Succinct.Xml.Succinct.Cursor.BlankedXml +import Data.Succinct.Xml.Succinct.Cursor.InterestBits +import Data.Word +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS + +{- HLINT ignore "Redundant do" -} + +interestBitsOf :: FromBlankedXml (XmlInterestBits a) => BS.ByteString -> a +interestBitsOf = getXmlInterestBits . fromBlankedXml . bsToBlankedXml + +spec :: Spec +spec = describe "Data.Succinct.Xml.Succinct.Cursor.InterestBitsSpec" $ do + it "Evaluating interest bits" $ requireTest $ do + (interestBitsOf "" :: BitShown (DVS.Vector Word8)) === fromString "" + (interestBitsOf " \n \r \t " :: BitShown (DVS.Vector Word8)) === fromString "00000000" + (interestBitsOf "" :: BitShown (DVS.Vector Word8)) === fromString "10010000 00000000" + (interestBitsOf " " :: BitShown (DVS.Vector Word8)) === fromString "01011010 00000000" + (interestBitsOf " " :: BitShown (DVS.Vector Word8)) === fromString "01000000 00000000" + (interestBitsOf " " + , "< < " + , "> >" + ] + annotate $ "Blanked: " <> show blanked + let ib :: XmlInterestBits (BitShown (DVS.Vector Word8)) + ib = XmlInterestBits (getXmlInterestBits (fromBlankedXml (BlankedXml blanked))) + let moo :: [BS.ByteString] + moo = blankedXmlToInterestBits blanked -- :: XmlInterestBits (BitShown (DVS.Vector Word8)) + annotate $ "Moo: " <> show (BitShown . BS.unpack <$> moo) + let actual = getXmlInterestBits ib :: BitShown (DVS.Vector Word8) + let expected = fromString "10000110 00000010 00001000 00000100 00000001 00100000 00000000" + + actual === expected diff --git a/components/succinct-xml/test/Data/Succinct/Xml/Succinct/CursorSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/CursorSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Xml.Succinct.CursorSpec(spec) where + +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.RankSelect.Poppy512 +import Data.Succinct.Xml.Succinct.Cursor as C +import Data.Succinct.Xml.Succinct.CursorSpec.Make +import Data.Word +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.FromByteString as BS +import qualified Data.Succinct.Xml.Succinct.Cursor.Create as CC + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Reduce duplication" -} + +spec :: Spec +spec = describe "Data.Succinct.Xml.Succinct.CursorSpec" $ do + make "DVS.Vector Word8" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word8 )) (SimpleBalancedParens (DVS.Vector Word8 ))) + make "DVS.Vector Word16" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) + make "DVS.Vector Word32" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) + make "DVS.Vector Word64" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) + make "Poppy512" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) + make "DVS.Vector Word8" CC.byteStringAsFastCursor + make "DVS.Vector Word16" CC.byteStringAsFastCursor + make "DVS.Vector Word32" CC.byteStringAsFastCursor + make "DVS.Vector Word64" CC.byteStringAsFastCursor + make "Poppy512" CC.byteStringAsFastCursor + it "Loads same Xml consistentally from different backing vectors" $ requireTest $ do + let cursor8 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)) + let cursor16 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)) + let cursor32 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)) + let cursor64 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) + cursorText cursor8 === cursorText cursor16 + cursorText cursor8 === cursorText cursor32 + cursorText cursor8 === cursorText cursor64 + let ic8 = bitShow $ interests cursor8 + let ic16 = bitShow $ interests cursor16 + let ic32 = bitShow $ interests cursor32 + let ic64 = bitShow $ interests cursor64 + ic16 `shouldBeginWith` ic8 + ic32 `shouldBeginWith` ic16 + ic64 `shouldBeginWith` ic32 + +shouldBeginWith :: (Eq a, Show a) => [a] -> [a] -> PropertyT IO () +shouldBeginWith as bs = take (length bs) as === bs diff --git a/components/succinct-xml/test/Data/Succinct/Xml/Succinct/CursorSpec/Make.hs b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/CursorSpec/Make.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/Succinct/CursorSpec/Make.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Data.Succinct.Xml.Succinct.CursorSpec.Make + ( make + ) where + +import Control.Monad +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.Xml.Succinct.Cursor as C +import Data.Succinct.Xml.Token +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Reduce duplication" -} + +fc = TC.firstChild +ns = TC.nextSibling +cd = TC.depth +ss = TC.subtreeSize + +make :: forall t u. + ( Select1 t + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u + ) + => String -> (BS.ByteString -> XmlCursor BS.ByteString t u) -> SpecWith () +make t mkCursor = do + describe ("Cursor for (" ++ t ++ ")") $ do + let forXml bs f = let cursor = mkCursor bs in describe (T.unpack ("of value " <> T.decodeUtf8 bs)) (f cursor) + forXml "[null]" $ \cursor -> do + xit "depth at top" $ requireTest $ cd cursor === Just 1 + xit "depth at first child of array" $ requireTest $ (fc >=> cd) cursor === Just 2 + forXml "[null, {\"field\": 1}]" $ \cursor -> do + xit "depth at second child of array" $ requireTest $ do + (fc >=> ns >=> cd) cursor === Just 2 + xit "depth at first child of object at second child of array" $ requireTest $ do + (fc >=> ns >=> fc >=> cd) cursor === Just 3 + xit "depth at first child of object at second child of array" $ requireTest $ do + (fc >=> ns >=> fc >=> ns >=> cd) cursor === Just 3 + + describe "For sample XML" $ do + let cursor = mkCursor " \ + \ \ + \ 500 \ + \ 600.01e-02 \ + \ false \ + \ \ + \" :: XmlCursor BS.ByteString t u + xit "can get token at cursor" $ requireTest $ do + (xmlTokenAt ) cursor === Just (XmlTokenBraceL ) + (fc >=> xmlTokenAt) cursor === Just (XmlTokenString "widget" ) + (fc >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBraceL ) + (fc >=> ns >=> fc >=> xmlTokenAt) cursor === Just (XmlTokenString "debug" ) + (fc >=> ns >=> fc >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "on" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBraceL ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> xmlTokenAt) cursor === Just (XmlTokenString "name" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "main_window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "dimensions" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBracketL ) + -- xit "can navigate up" $ requireTest $ do + -- ( pn) cursor === Nothing + -- (fc >=> pn) cursor === Just cursor + -- (fc >=> ns >=> pn) cursor === Just cursor + -- (fc >=> ns >=> fc >=> pn) cursor === (fc >=> ns ) cursor + -- (fc >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns ) cursor + -- (fc >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + -- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + -- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + -- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + -- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + -- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + xit "can get subtree size" $ requireTest $ do + ( ss) cursor === Just 16 + (fc >=> ss) cursor === Just 1 + (fc >=> ns >=> ss) cursor === Just 14 + (fc >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 10 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6 diff --git a/components/succinct-xml/test/Data/Succinct/Xml/Token/TokenizeSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/Token/TokenizeSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/Token/TokenizeSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Succinct.Xml.Token.TokenizeSpec (spec) where + +import Data.ByteString (ByteString) +import Data.Succinct.Xml.Token.Tokenize +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.Attoparsec.ByteString.Char8 as BC + +{- HLINT ignore "Redundant do" -} + +parseXmlToken' :: ByteString -> Either String (XmlToken String Double) +parseXmlToken' = BC.parseOnly parseXmlToken + +spec :: Spec +spec = describe "Data.Succinct.Xml.Token.TokenizeSpec" $ do + describe "When parsing single token at beginning of text" $ do + it "Empty Xml should produce no bits" $ requireTest $ + parseXmlToken' "" === Left "not enough input" + it "Xml with one space should produce whitespace token" $ requireTest $ + parseXmlToken' " " === Right XmlTokenWhitespace + it "Xml with two spaces should produce whitespace token" $ requireTest $ + parseXmlToken' " " === Right XmlTokenWhitespace + it "Spaces and newlines should produce no bits" $ requireTest $ + parseXmlToken' " \n \r \t " === Right XmlTokenWhitespace + it "`null` at beginning should produce one bit" $ requireTest $ + parseXmlToken' "null " === Right XmlTokenNull + it "number at beginning should produce one bit" $ requireTest $ + parseXmlToken' "1234 " === Right (XmlTokenNumber 1234) + it "false at beginning should produce one bit" $ requireTest $ + parseXmlToken' "false " === Right (XmlTokenBoolean False) + it "true at beginning should produce one bit" $ requireTest $ + parseXmlToken' "true " === Right (XmlTokenBoolean True) + it "string at beginning should produce one bit" $ requireTest $ + parseXmlToken' "\"hello\" " === Right (XmlTokenString "hello") + it "quoted string should parse" $ requireTest $ + parseXmlToken' "\"\\\"\" " === Right (XmlTokenString "\"") + it "left brace at beginning should produce one bit" $ requireTest $ + parseXmlToken' "{ " === Right XmlTokenBraceL + it "right brace at beginning should produce one bit" $ requireTest $ + parseXmlToken' "} " === Right XmlTokenBraceR + it "left bracket at beginning should produce one bit" $ requireTest $ + parseXmlToken' "[ " === Right XmlTokenBracketL + it "right bracket at beginning should produce one bit" $ requireTest $ + parseXmlToken' "] " === Right XmlTokenBracketR + it "right bracket at beginning should produce one bit" $ requireTest $ + parseXmlToken' ": " === Right XmlTokenColon + it "right bracket at beginning should produce one bit" $ requireTest $ + parseXmlToken' ", " === Right XmlTokenComma diff --git a/components/succinct-xml/test/Data/Succinct/Xml/TypeSpec.hs b/components/succinct-xml/test/Data/Succinct/Xml/TypeSpec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Data/Succinct/Xml/TypeSpec.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} + +module Data.Succinct.Xml.TypeSpec (spec) where + +import Control.Monad +import Data.String +import Data.Succinct.BalancedParens.BalancedParens +import Data.Succinct.BalancedParens.Simple +import Data.Succinct.RankSelect.Base.Rank0 +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.Poppy512 +import Data.Succinct.Xml.Succinct.Cursor as C +import Data.Succinct.Xml.Type +import Data.Word +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.TreeCursor as TC + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant bracket" -} +{- HLINT ignore "Reduce duplication" -} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "Data.Succinct.Xml.TypeSpec" $ do + genSpec "DVS.Vector Word8" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word8 )) (SimpleBalancedParens (DVS.Vector Word8 ))) + genSpec "DVS.Vector Word16" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) + genSpec "DVS.Vector Word32" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) + genSpec "DVS.Vector Word64" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) + genSpec "Poppy512" (undefined :: XmlCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) + +genSpec :: forall t u. + ( Show t + , Select1 t + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u + , IsString (XmlCursor BS.ByteString t u) + ) + => String -> (XmlCursor BS.ByteString t u) -> SpecWith () +genSpec t _ = do + describe ("XML cursor of type " ++ t) $ do + let forXml (cursor :: XmlCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor) + forXml "" $ \cursor -> do + it "should have correct type" . requireTest $ xmlTypeAt cursor === Just XmlTypeElement + forXml " " $ \cursor -> do + it "should have correct type" . requireTest $ xmlTypeAt cursor === Just XmlTypeElement + forXml "" $ \cursor -> do + it "cursor can navigate to second attribute" $ requireTest $ do + (fc >=> fc >=> ns >=> ns >=> xmlTypeAt) cursor === Just XmlTypeToken + it "cursor can navigate to first attribute of an inner element" $ requireTest $ do + (fc >=> ns >=> fc >=> fc >=> xmlTypeAt) cursor === Just XmlTypeToken + it "cursor can navigate to first atrribute value of an inner element" $ requireTest $ do + (fc >=> ns >=> fc >=> fc >=> ns >=> xmlTypeAt) cursor === Just XmlTypeToken + describe "For a single element" $ do + let cursor = "text" :: XmlCursor BS.ByteString t u + it "can navigate down and forwards" $ requireTest $ do + ( xmlTypeAt) cursor === Just XmlTypeElement + (fc >=> xmlTypeAt) cursor === Just XmlTypeToken + (fc >=> ns >=> xmlTypeAt) cursor === Nothing + (fc >=> ns >=> ns >=> xmlTypeAt) cursor === Nothing + describe "For sample Xml" $ do + let cursor = " \ + \ \ + \ 500 \ + \ 600.01e-02 \ + \ false \ + \ \ + \" :: XmlCursor BS.ByteString t u + it "can navigate down and forwards" $ requireTest $ do + ( xmlTypeAt) cursor === Just XmlTypeElement --widget + (fc >=> xmlTypeAt) cursor === Just XmlTypeAttrList --widget attrs + (fc >=> ns >=> xmlTypeAt) cursor === Just XmlTypeElement --window + (fc >=> ns >=> fc >=> xmlTypeAt) cursor === Just XmlTypeAttrList --window attrs + (fc >=> ns >=> fc >=> ns >=> xmlTypeAt) cursor === Just XmlTypeElement --dimension 500 + (fc >=> ns >=> fc >=> ns >=> ns >=> xmlTypeAt) cursor === Just XmlTypeElement --dimension 600 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> xmlTypeAt) cursor === Just XmlTypeElement --dimension false + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> xmlTypeAt) cursor === Just XmlTypeToken --false diff --git a/components/succinct-xml/test/Spec.hs b/components/succinct-xml/test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/succinct-xml/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/succinct/app/App/Cli/Commands.hs b/components/succinct/app/App/Cli/Commands.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands.hs @@ -0,0 +1,14 @@ +module App.Cli.Commands where + +import App.Cli.Commands.BalancedParens +import App.Cli.Commands.RankSelect +import Options.Applicative + +{- HLINT ignore "Monoid law, left identity" -} + +cmds :: Parser (IO ()) +cmds = + asum + [ cmdBalancedParens + , cmdRankSelect + ] diff --git a/components/succinct/app/App/Cli/Commands/BalancedParens.hs b/components/succinct/app/App/Cli/Commands/BalancedParens.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/BalancedParens.hs @@ -0,0 +1,26 @@ +module App.Cli.Commands.BalancedParens + ( cmdBalancedParens + ) where + +import App.Cli.Commands.BalancedParens.BitsToParens +import App.Cli.Commands.BalancedParens.ParensToBits +import App.Cli.Commands.BalancedParens.Positions +import Options.Applicative +import Options.Applicative qualified as Opt + +{- HLINT ignore "Monoid law, left identity" -} + +subParser :: String -> ParserInfo a -> Parser a +subParser availableCommand pInfo = + Opt.hsubparser $ Opt.command availableCommand pInfo <> Opt.metavar availableCommand + +cmdBalancedParens :: Parser (IO ()) +cmdBalancedParens = + subParser "balanced-parens" $ optInfo $ Opt.progDesc "Balanced Parens" + where + optInfo = + Opt.info $ subparser $ mconcat + [ cmdParensToBits + , cmdBitsToParens + , cmdPositions + ] diff --git a/components/succinct/app/App/Cli/Commands/BalancedParens/BitsToParens.hs b/components/succinct/app/App/Cli/Commands/BalancedParens/BitsToParens.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/BalancedParens/BitsToParens.hs @@ -0,0 +1,65 @@ +module App.Cli.Commands.BalancedParens.BitsToParens + ( cmdBitsToParens + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import Options.Applicative hiding (columns) + +import qualified App.Cli.Options.Type as Z +import qualified App.IO as IO +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS + +bitString :: Word8 -> B.Builder +bitString w = + go ((w .>. 0) .&. 1) <> + go ((w .>. 1) .&. 1) <> + go ((w .>. 2) .&. 1) <> + go ((w .>. 3) .&. 1) <> + go ((w .>. 4) .&. 1) <> + go ((w .>. 5) .&. 1) <> + go ((w .>. 6) .&. 1) <> + go ((w .>. 7) .&. 1) + where go :: Word8 -> B.Builder + go 1 = B.word8 40 + go _ = B.word8 41 + +parensBuilder :: LBS.ByteString -> B.Builder +parensBuilder lbs = case LBS.uncons lbs of + Just (w, rs) -> bitString w <> parensBuilder rs + Nothing -> mempty + +parens :: LBS.ByteString -> LBS.ByteString +parens = B.toLazyByteString . parensBuilder + +runBitsToParens :: Z.BitsToParensOptions -> IO () +runBitsToParens opts = do + let inputFile = opts ^. the @"inputFile" + let outputFile = opts ^. the @"outputFile" + + lbs <- IO.readInputFile inputFile + + IO.writeOutputFile outputFile $ parens lbs + + return () + +optsBitsToParens :: Parser Z.BitsToParensOptions +optsBitsToParens = Z.BitsToParensOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + <> value "-" + ) + <*> strOption + ( long "output" + <> help "Output file" + <> metavar "FILE" + <> value "-" + ) + +cmdBitsToParens :: Mod CommandFields (IO ()) +cmdBitsToParens = command "bits-to-parens" $ flip info idm $ runBitsToParens <$> optsBitsToParens diff --git a/components/succinct/app/App/Cli/Commands/BalancedParens/ParensToBits.hs b/components/succinct/app/App/Cli/Commands/BalancedParens/ParensToBits.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/BalancedParens/ParensToBits.hs @@ -0,0 +1,60 @@ +module App.Cli.Commands.BalancedParens.ParensToBits + ( cmdParensToBits + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Word +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning +import Options.Applicative hiding (columns) + +import qualified App.Cli.Options.Type as Z +import qualified App.IO as IO +import qualified Data.ByteString.Lazy as LBS + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} + +unparens :: LBS.ByteString -> LBS.ByteString +unparens = LBS.unfoldr go . (0, 0, ) + where go :: (Word8, Count, LBS.ByteString) -> Maybe (Word8, (Word8, Count, LBS.ByteString)) + go (w, c, lbs) = case LBS.uncons lbs of + Nothing -> if c > 0 + then Just (w, (0, 0, LBS.empty)) + else Nothing + Just (a, as) -> case a of + 40 -> if c < 8 + then go (w .|. (1 .<. c), c + 1, as) + else Just (w, (1, 1, as)) + 41 -> if c < 8 + then go (w, c + 1, as) + else Just (w, (0, 1, as)) + _ -> go (w, c, as) + +runParensToBits :: Z.ParensToBitsOptions -> IO () +runParensToBits opts = do + let inputFile = opts ^. the @"inputFile" + let outputFile = opts ^. the @"outputFile" + + lbs <- IO.readInputFile inputFile + + IO.writeOutputFile outputFile (unparens lbs) + +optsParensToBits :: Parser Z.ParensToBitsOptions +optsParensToBits = Z.ParensToBitsOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + <> value "-" + ) + <*> strOption + ( long "output" + <> help "Output file" + <> metavar "FILE" + <> value "-" + ) + +cmdParensToBits :: Mod CommandFields (IO ()) +cmdParensToBits = command "parens-to-bits" $ flip info idm $ runParensToBits <$> optsParensToBits diff --git a/components/succinct/app/App/Cli/Commands/BalancedParens/Positions.hs b/components/succinct/app/App/Cli/Commands/BalancedParens/Positions.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/BalancedParens/Positions.hs @@ -0,0 +1,54 @@ +module App.Cli.Commands.BalancedParens.Positions ( + cmdPositions, +) where + +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Succinct.BalancedParens.FindClose +import Data.Succinct.BalancedParens.OpenAt +import Data.Word +import HaskellWorks.Data.Positioning +import Options.Applicative hiding (columns) + +import App.Cli.Options.Type qualified as Z +import Data.Vector.Storable qualified as DVS +import HaskellWorks.Data.FromForeignRegion qualified as IO +import System.IO qualified as IO + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Redundant return" -} + +openCloses :: (FindClose v, OpenAt v) => v -> [(Count, Count)] +openCloses v = go 1 v [] + where + go :: (FindClose v, OpenAt v) => Count -> v -> [(Count, Count)] -> [(Count, Count)] + go p w = + if openAt w p + then case findClose w p of + Just q -> ((p, q) :) . go (p + 1) w . go (q + 1) w + Nothing -> id + else id + +runPositions :: Z.PositionsOptions -> IO () +runPositions opts = do + let inputFile = opts ^. the @"inputFile" + + v :: DVS.Vector Word64 <- IO.mmapFromForeignRegion inputFile + + forM_ (openCloses v) $ \(o, c) -> do + IO.putStrLn $ show o <> "," <> show c + + return () + +optsPositions :: Parser Z.PositionsOptions +optsPositions = + Z.PositionsOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + ) + +cmdPositions :: Mod CommandFields (IO ()) +cmdPositions = command "positions" $ flip info idm $ runPositions <$> optsPositions diff --git a/components/succinct/app/App/Cli/Commands/RankSelect.hs b/components/succinct/app/App/Cli/Commands/RankSelect.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/RankSelect.hs @@ -0,0 +1,28 @@ +module App.Cli.Commands.RankSelect + ( cmdRankSelect + ) where + +import App.Cli.Commands.RankSelect.Build +import App.Cli.Commands.RankSelect.SelectAll +import App.Cli.Commands.RankSelect.UnitTest +import App.Cli.Commands.RankSelect.Validate +import Options.Applicative +import Options.Applicative qualified as Opt + +{- HLINT ignore "Monoid law, left identity" -} + +subParser :: String -> ParserInfo a -> Parser a +subParser availableCommand pInfo = + Opt.hsubparser $ Opt.command availableCommand pInfo <> Opt.metavar availableCommand + +cmdRankSelect :: Parser (IO ()) +cmdRankSelect = + subParser "rank-select" $ optInfo $ Opt.progDesc "Rank Select" + where + optInfo = + Opt.info $ subparser $ mconcat + [ cmdBuild + , cmdSelectAll + , cmdValidate + , cmdUnitTest + ] diff --git a/components/succinct/app/App/Cli/Commands/RankSelect/Build.hs b/components/succinct/app/App/Cli/Commands/RankSelect/Build.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/RankSelect/Build.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE BangPatterns #-} + +module App.Cli.Commands.RankSelect.Build + ( cmdBuild + ) where + +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import HaskellWorks.Data.FromForeignRegion +import Options.Applicative +import System.Directory + +import qualified App.Cli.Options.Type as Z +import qualified Data.List as L +import qualified Data.Succinct.RankSelect.CsPoppy as CS +import qualified Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 as A1 +import qualified Data.Succinct.RankSelect.Poppy512 as P512 + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +runBuild :: Z.BuildOptions -> IO () +runBuild opts = case opts ^. the @"indexType" of + Z.CsPoppy -> do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `L.isSuffixOf`) `filter` entries + forM_ files $ \file -> do + putStrLn $ "Loading cspoppy for " <> file + CS.CsPoppy !_ !_ (A1.CsPoppyIndex !_ !_) <- mmapFromForeignRegion file + return () + Z.Poppy512 -> do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `L.isSuffixOf`) `filter` entries + forM_ files $ \file -> do + putStrLn $ "Loading cspoppy for " <> file + P512.Poppy512 !_ !_ <- mmapFromForeignRegion file + return () + +optsBuild :: Parser Z.BuildOptions +optsBuild = Z.BuildOptions + <$> option auto + ( long "index-type" + <> help "Index type" + <> metavar "INDEX_TYPE" + ) + +cmdBuild :: Mod CommandFields (IO ()) +cmdBuild = command "build" $ flip info idm $ runBuild <$> optsBuild diff --git a/components/succinct/app/App/Cli/Commands/RankSelect/SelectAll.hs b/components/succinct/app/App/Cli/Commands/RankSelect/SelectAll.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/RankSelect/SelectAll.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BangPatterns #-} + +module App.Cli.Commands.RankSelect.SelectAll + ( cmdSelectAll + ) where + +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy +import Data.Succinct.RankSelect.Poppy512 +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.FromForeignRegion +import Options.Applicative hiding (columns) +import System.Directory + +import qualified App.Cli.Options.Type as Z +import qualified Data.List as L + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +runSelectAll :: Z.SelectAllOptions -> IO () +runSelectAll opts = case opts ^. the @"indexType" of + Z.CsPoppy -> do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `L.isSuffixOf`) `filter` entries + forM_ files $ \file -> do + putStrLn $ "Loading cspoppy for " <> file + v :: CsPoppy <- mmapFromForeignRegion file + forM_ [1..popCount1 v] $ \i -> do + let !_ = select1 v i + return () + return () + Z.Poppy512 -> do + entries <- getDirectoryContents "components/succinct-core/data" + let files = ("components/succinct-core/data/" ++) <$> (".ib" `L.isSuffixOf`) `filter` entries + forM_ files $ \file -> do + putStrLn $ "Loading cspoppy for " <> file + v :: Poppy512 <- mmapFromForeignRegion file + forM_ [1..popCount1 v] $ \i -> do + let !_ = select1 v i + return () + return () + +optsSelectAll :: Parser Z.SelectAllOptions +optsSelectAll = Z.SelectAllOptions + <$> option auto + ( long "index-type" + <> help "Index type" + <> metavar "INDEX_TYPE" + ) + +cmdSelectAll :: Mod CommandFields (IO ()) +cmdSelectAll = command "select-all" $ flip info idm $ runSelectAll <$> optsSelectAll diff --git a/components/succinct/app/App/Cli/Commands/RankSelect/UnitTest.hs b/components/succinct/app/App/Cli/Commands/RankSelect/UnitTest.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/RankSelect/UnitTest.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE BangPatterns #-} + +module App.Cli.Commands.RankSelect.UnitTest + ( cmdUnitTest + ) where + +import Control.Lens +import Control.Monad +import Data.Generics.Product.Any +import Data.Succinct.RankSelect.Base.Select1 +import Data.Succinct.RankSelect.CsPoppy +import Data.Word +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import Options.Applicative + +import qualified App.Cli.Options.Type as Z +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.FromForeignRegion as IO +import qualified System.IO as IO + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} + +runUnitTest :: Z.UnitTestOptions -> IO () +runUnitTest opts = case opts ^. the @"name" of + "select1 example 1" -> do + let v :: DVS.Vector Word64 = DVS.fromList + [ 0, 19, 80, 129, 161, 179, 237, 281, 302, 350, 394, 438, 438, 458, 470, 524 + , 546, 592, 634, 648, 688, 713, 774, 795, 852, 861, 884, 936, 992, 992, 1001, 1036 + , 1068, 1087, 1109, 1145, 1161, 1179, 1182, 1211, 1234, 1295, 1309, 1335, 1359, 1359, 1361, 1383 + ] + let r = 144 + let !rsbs = makeCsPoppy v + let !p = select1 v r + + when (select1 rsbs r /= p) $ error "Failed unit test" + "select1 example 2" -> do + fileV <- IO.mmapFromForeignRegion "components/succinct-core/data/example.ib" + let csPoppy = makeCsPoppy fileV + let pc = popCount1 (csPoppyBits csPoppy) + putStrLn $ "PopCount: " <> show pc + let r = 21 + + let !p = select1 fileV r + + when (select1 csPoppy r /= p) $ error "Failed unit test" + "select1 example 3" -> do + fileV <- IO.mmapFromForeignRegion "components/succinct-core/data/example.ib" + let csPoppy = makeCsPoppy fileV + let pc = popCount1 (csPoppyBits csPoppy) + putStrLn $ "PopCount: " <> show pc + let r = 38 + + let !p = select1 fileV r + + when (select1 csPoppy r /= p) $ error "Failed unit test" + xs -> IO.putStrLn $ "Invalid unit test" <> xs + +optsUnitTest :: Parser Z.UnitTestOptions +optsUnitTest = Z.UnitTestOptions + <$> strOption + ( long "name" + <> help "Unit test name" + <> metavar "STRING" + ) + +cmdUnitTest :: Mod CommandFields (IO ()) +cmdUnitTest = command "unit-test" $ flip info idm $ runUnitTest <$> optsUnitTest diff --git a/components/succinct/app/App/Cli/Commands/RankSelect/Validate.hs b/components/succinct/app/App/Cli/Commands/RankSelect/Validate.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Commands/RankSelect/Validate.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE BangPatterns #-} + +module App.Cli.Commands.RankSelect.Validate + ( cmdValidate + ) where + +import Control.Lens +import Control.Monad +import Control.Monad.State +import Data.Generics.Product.Any +import Data.Succinct.RankSelect.Base.Rank1 +import Data.Succinct.RankSelect.Base.Select1 +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import Options.Applicative + +import qualified App.Cli.Options.Type as Z +import qualified Data.Succinct.RankSelect.CsPoppy as CS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.FromForeignRegion as IO +import qualified System.IO as IO + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Reduce duplication" -} +{- HLINT ignore "Redundant bracket" -} + +runValidate :: Z.ValidateOptions -> IO () +runValidate opts = case opts ^. the @"indexType" of + Z.CsPoppy -> do + !(v :: DVS.Vector Word64) <- IO.mmapFromForeignRegion (opts ^. the @"file") + + let !csIndex = CS.makeCsPoppy v + + (_, final) <- flip runStateT Z.emptyValidateState $ + forM_ [0 .. fromIntegral (DVS.length v - 1)] $ \i -> do + let w = v !!! i + let wPopCount = popCount1 w + lastPopCount <- use (the @"cumulativePopCount") + + forM_ [0 .. 64] $ \pw -> do + let r = rank1 w pw + lastPopCount + let p = fromIntegral (i * 64) + pw + let actualR = rank1 csIndex p + when (actualR /= r) $ do + liftIO $ IO.putStrLn $ "Corrupt bit-index. Expected: rank1 " <> show p <> " == " <> show r <> ", but: rank1 " <> show p <> " == " <> show actualR + + forM_ [0 .. 63] $ \pw -> do + let r0 = rank1 w pw + lastPopCount + let r1 = rank1 w (pw + 1) + lastPopCount + let p = fromIntegral (i * 64) + pw + when (r0 == r1) $ do + let actualP = select1 csIndex r0 + when (actualP > p) $ do + liftIO $ IO.putStrLn $ "Corrupt bit-index. Expected: select1 " <> show r0 <> " <= " <> show p <> ", but: select1 " <> show r0 <> " == " <> show actualP + + forM_ [lastPopCount + 1 .. lastPopCount + wPopCount] $ \r -> do + let p = select1 csIndex r + when (rank1 csIndex p /= r) $ do + liftIO $ IO.putStrLn $ "Corrupt bit-index at (p, r) = (" <> show p <> ", " <> show r <> ")" + return () + return () + + the @"cumulativePopCount" += wPopCount + + return () + + IO.putStrLn $ "PopCounts validated: " <> show (final ^. the @"cumulativePopCount") + + return () + Z.Poppy512 -> do + putStrLn "Not implemented" + return () + +optsValidate :: Parser Z.ValidateOptions +optsValidate = Z.ValidateOptions + <$> option auto + ( long "index-type" + <> help "Index type" + <> metavar "INDEX_TYPE" + ) + <*> strOption + ( long "file" + <> help "Input file" + <> metavar "FILE" + ) + +cmdValidate :: Mod CommandFields (IO ()) +cmdValidate = command "validate" $ flip info idm $ runValidate <$> optsValidate diff --git a/components/succinct/app/App/Cli/Options/Type.hs b/components/succinct/app/App/Cli/Options/Type.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/Cli/Options/Type.hs @@ -0,0 +1,44 @@ +module App.Cli.Options.Type where + +import Data.Word +import GHC.Generics + +data IndexType = CsPoppy | Poppy512 deriving (Eq, Read, Show, Generic) + +newtype BuildOptions = BuildOptions + { indexType :: IndexType + } deriving (Eq, Show, Generic) + +newtype SelectAllOptions = SelectAllOptions + { indexType :: IndexType + } deriving (Eq, Show, Generic) + +newtype UnitTestOptions = UnitTestOptions + { name :: String + } deriving (Eq, Show, Generic) + +data ValidateOptions = ValidateOptions + { indexType :: IndexType + , file :: FilePath + } deriving (Eq, Show, Generic) + +newtype ValidateState = ValidateState + { cumulativePopCount :: Word64 + } deriving (Eq, Show, Generic) + +emptyValidateState :: ValidateState +emptyValidateState = ValidateState 0 + +newtype PositionsOptions = PositionsOptions + { inputFile :: FilePath + } deriving (Eq, Show, Generic) + +data BitsToParensOptions = BitsToParensOptions + { inputFile :: FilePath + , outputFile :: FilePath + } deriving (Eq, Show, Generic) + +data ParensToBitsOptions = ParensToBitsOptions + { inputFile :: FilePath + , outputFile :: FilePath + } deriving (Eq, Show, Generic) diff --git a/components/succinct/app/App/IO.hs b/components/succinct/app/App/IO.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/App/IO.hs @@ -0,0 +1,12 @@ +module App.IO where + +import qualified Data.ByteString.Lazy as LBS +import qualified System.IO as IO + +readInputFile :: FilePath -> IO LBS.ByteString +readInputFile "-" = LBS.hGetContents IO.stdin +readInputFile filePath = LBS.readFile filePath + +writeOutputFile :: FilePath -> LBS.ByteString -> IO () +writeOutputFile "-" bs = LBS.hPut IO.stdout bs +writeOutputFile filePath bs = LBS.writeFile filePath bs diff --git a/components/succinct/app/Main.hs b/components/succinct/app/Main.hs new file mode 100644 --- /dev/null +++ b/components/succinct/app/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import App.Cli.Commands +import Control.Monad +import Options.Applicative + +main :: IO () +main = join $ customExecParser + (prefs $ showHelpOnEmpty <> showHelpOnError) + (info (cmds <**> helper) idm) diff --git a/succinct.cabal b/succinct.cabal new file mode 100644 --- /dev/null +++ b/succinct.cabal @@ -0,0 +1,1158 @@ +cabal-version: 3.4 + +name: succinct +version: 0.0.0.1 +synopsis: Memory efficient JSON parser +description: Memory efficient JSON parser. Please see README.md +category: Data +homepage: http://github.com/haskell-works/succinct#readme +bug-reports: https://github.com/haskell-works/succinct/issues +author: John Ky +maintainer: newhoggy@gmail.com +copyright: 2016-2024 John Ky +license: BSD-3-Clause +license-file: LICENSE +tested-with: GHC == 9.10.1, GHC == 9.8.4, GHC == 9.6.6, GHC == 9.4.8 +build-type: Simple +extra-source-files: README.md + components/succinct-dsv/data/bench/data-0001000.csv + components/succinct-json/corpus/5000B.json + components/succinct-json/corpus/5000B.json.bp.idx + components/succinct-json/corpus/5000B.json.ib.idx + components/succinct-json/corpus/issue-0001.json + components/succinct-json/corpus/issue-0001.json.bp.idx + components/succinct-json/corpus/issue-0001.json.ib.idx + components/succinct-json/corpus/issue-0001.md + +source-repository head + type: git + location: https://github.com/haskell-works/succinct + +flag bmi2 + description: Enable bmi2 instruction set + manual: False + default: False + +flag sse42 + description: Enable sse4.2 instruction set + manual: False + default: False + +common base { build-depends: base >= 4.11 && < 5 } + +common aeson { build-depends: aeson >= 2.0 && < 2.3 } +common appar { build-depends: appar >= 0.1.8 && < 0.2 } +common array { build-depends: array >= 0.5 && < 0.6 } +common attoparsec { build-depends: attoparsec >= 0.13 && < 0.15 } +common attoparsec-aeson { build-depends: attoparsec-aeson >= 2 && < 3 } +common bits-extra { build-depends: bits-extra >= 0.0.1.3 && < 0.1 } +common bytestring { build-depends: bytestring >= 0.10.6 && < 0.13 } +common cassava { build-depends: cassava >= 0.5.1.0 && < 0.6 } +common cereal { build-depends: cereal >= 0.5.8.1 && < 0.6 } +common conduit { build-depends: conduit >= 1.2 && < 1.4 } +common containers { build-depends: containers >= 0.5 && < 0.8 } +common criterion { build-depends: criterion >= 1.4 && < 1.7 } +common deepseq { build-depends: deepseq >= 1.4 && < 1.6 } +common directory { build-depends: directory >= 1.3 && < 1.4 } +common dlist { build-depends: dlist >= 0.8 && < 1.1 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.25 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +common filepath { build-depends: filepath >= 1.4 && < 1.6 } +common generic-lens { build-depends: generic-lens >= 1.2.0.1 && < 2.3 } +common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.14 } +common hedgehog { build-depends: hedgehog >= 0.6 && < 1.6 } +common hspec { build-depends: hspec >= 2.4 && < 3 } +common hw-bits { build-depends: hw-bits >= 0.7.0.5 && < 0.8 } +common hw-hedgehog { build-depends: hw-hedgehog >= 0.1.0.1 && < 0.2 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } +common hw-int { build-depends: hw-int >= 0.0.2 && < 0.0.3 } +common hw-ip { build-depends: hw-ip >= 2.3.4.2 && < 2.5 } +common hw-prim { build-depends: hw-prim >= 0.6.2.32 && < 0.7 } +common lens { build-depends: lens >= 4 && < 6 } +common mmap { build-depends: mmap >= 0.5 && < 0.6 } +common mtl { build-depends: mtl >= 2.2 && < 3 } +common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.19 } +common prettyprinter { build-depends: prettyprinter >= 1 && < 2 } +common QuickCheck { build-depends: QuickCheck >= 2.10 && < 2.15 } +common resourcet { build-depends: resourcet >= 1.1 && < 1.4 } +common safe { build-depends: safe >= 0.2 && < 0.4 } +common scientific { build-depends: scientific >= 0.3.6.2 && < 0.4 } +common text { build-depends: text >= 1.2 && < 3 } +common transformers { build-depends: transformers >= 0.4 && < 0.7 } +common unordered-containers { build-depends: unordered-containers >= 0.2 && < 0.3 } +common vector { build-depends: vector >= 0.12 && < 0.14 } +common weigh { build-depends: weigh >= 0.0.6 && < 0.1 } +common word8 { build-depends: word8 >= 0.1 && < 0.2 } + +common succinct-balancedparens { build-depends: succinct:balancedparens } +common succinct-core-gen { build-depends: succinct:core-gen } +common succinct-dsv { build-depends: succinct:dsv } +common succinct-json { build-depends: succinct:json } +common succinct-json-simd { build-depends: succinct:json-simd } +common succinct-json-simple-cursor { build-depends: succinct:json-simple-cursor } +common succinct-json-standard-cursor { build-depends: succinct:json-standard-cursor } +common succinct-core { build-depends: succinct:core } +common succinct-simd { build-depends: succinct:simd } +common succinct-xml { build-depends: succinct:xml } + +common config + default-language: Haskell2010 + default-extensions: BinaryLiterals + DataKinds + DeriveFunctor + DeriveGeneric + DeriveTraversable + DuplicateRecordFields + ExplicitForAll + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + ImportQualifiedPost + InstanceSigs + MultiParamTypeClasses + MultiWayIf + OverloadedRecordDot + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + TypeSynonymInstances + ghc-options: -Wall -O2 -msse4.2 + if flag(sse42) + ghc-options: -msse4.2 + if flag(bmi2) && impl(ghc >= 8.4.1) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED + +library core + import: base, config + , attoparsec + , bits-extra + , bytestring + , deepseq + , dlist + , hw-bits + , hw-int + , hw-prim + , lens + , prettyprinter + , safe + , text + , vector + visibility: public + exposed-modules: Data.Succinct.BalancedParens + Data.Succinct.BalancedParens.BalancedParens + Data.Succinct.BalancedParens.CloseAt + Data.Succinct.BalancedParens.Enclose + Data.Succinct.BalancedParens.FindClose + Data.Succinct.BalancedParens.FindCloseN + Data.Succinct.BalancedParens.FindOpen + Data.Succinct.BalancedParens.FindOpenN + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector16 + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector32 + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64 + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector8 + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word16 + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word32 + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word64 + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Word8 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64 + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8 + Data.Succinct.BalancedParens.Internal.Broadword.Word64 + Data.Succinct.BalancedParens.Internal.List + Data.Succinct.BalancedParens.Internal.Show + Data.Succinct.BalancedParens.Internal.Slow.FindCloseC.Generic + Data.Succinct.BalancedParens.Internal.Slow.FindCloseN.Generic + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector16 + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector32 + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector64 + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Vector8 + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word16 + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word32 + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word64 + Data.Succinct.BalancedParens.Internal.Slow.FindUnmatchedCloseFar.Word8 + Data.Succinct.BalancedParens.Internal.Trace + Data.Succinct.BalancedParens.Internal.Vector.Storable + Data.Succinct.BalancedParens.Internal.Word + Data.Succinct.BalancedParens.Internal.Word16 + Data.Succinct.BalancedParens.Internal.Word32 + Data.Succinct.BalancedParens.Internal.Word64 + Data.Succinct.BalancedParens.Internal.Word8 + Data.Succinct.BalancedParens.NewCloseAt + Data.Succinct.BalancedParens.NewOpenAt + Data.Succinct.BalancedParens.OpenAt + Data.Succinct.BalancedParens.RangeMin + Data.Succinct.BalancedParens.RangeMin2 + Data.Succinct.BalancedParens.Simple + Data.Succinct.Excess + Data.Succinct.Excess.Excess0 + Data.Succinct.Excess.Excess1 + Data.Succinct.Excess.Internal.Branchless + Data.Succinct.Excess.Internal.Partial.Table + Data.Succinct.Excess.Internal.Table + Data.Succinct.Excess.Internal.Triplet8 + Data.Succinct.Excess.MinExcess + Data.Succinct.Excess.MinExcess0 + Data.Succinct.Excess.MinExcess1 + Data.Succinct.Excess.MinMaxExcess0 + Data.Succinct.Excess.MinMaxExcess1 + Data.Succinct.Excess.PartialMinExcess0 + Data.Succinct.Excess.PartialMinExcess1 + Data.Succinct.Excess.PartialMinMaxExcess0 + Data.Succinct.Excess.PartialMinMaxExcess1 + Data.Succinct.Excess.Triplet + Data.Succinct.MQuery + Data.Succinct.MQuery.AtLeastSize + Data.Succinct.MQuery.Entry + Data.Succinct.MQuery.Micro + Data.Succinct.MQuery.Mini + Data.Succinct.MQuery.Row + Data.Succinct.MQuery.Shows + Data.Succinct.MQuery.ToBool + Data.Succinct.Parser + Data.Succinct.RankSelect.Base + Data.Succinct.RankSelect.Base.Internal + Data.Succinct.RankSelect.Base.Rank + Data.Succinct.RankSelect.Base.Rank0 + Data.Succinct.RankSelect.Base.Rank1 + Data.Succinct.RankSelect.Base.Select + Data.Succinct.RankSelect.Base.Select0 + Data.Succinct.RankSelect.Base.Select1 + Data.Succinct.RankSelect.CsPoppy + Data.Succinct.RankSelect.CsPoppy0 + Data.Succinct.RankSelect.CsPoppy1 + Data.Succinct.RankSelect.CsPoppy.Internal.Alpha0 + Data.Succinct.RankSelect.CsPoppy.Internal.Alpha1 + Data.Succinct.RankSelect.CsPoppy.Internal.CsInterleaved + Data.Succinct.RankSelect.CsPoppy.Internal.Lookup + Data.Succinct.RankSelect.CsPoppy.Internal.Nice + Data.Succinct.RankSelect.CsPoppy.Internal.Reference + Data.Succinct.RankSelect.CsPoppy.Internal.Vector + Data.Succinct.RankSelect.Internal.List + Data.Succinct.RankSelect.Internal.Word + Data.Succinct.RankSelect.Poppy512 + Data.Succinct.String.Parse + other-modules: Paths_succinct + autogen-modules: Paths_succinct + hs-source-dirs: components/succinct-core/src + ghc-options: -Wall -O2 -msse4.2 + +library core-gen + import: base, config + , deepseq + , directory + , hedgehog + , hspec + , hw-prim + , succinct-core + , vector + visibility: public + exposed-modules: Data.Succinct.BalancedParens.Gen + Data.Succinct.BalancedParens.Internal.IO + hs-source-dirs: components/succinct-core-gen/src + +library dsv + import: base, config + , bits-extra + , bytestring + , deepseq + , ghc-prim + , hw-bits + , hw-prim + , succinct-core + , succinct-simd + , transformers + , vector + visibility: public + exposed-modules: + Data.Succinct.Dsv.Internal.Bits + Data.Succinct.Dsv.Internal.Broadword + Data.Succinct.Dsv.Internal.Char + Data.Succinct.Dsv.Internal.Char.Word64 + Data.Succinct.Dsv.Internal.Vector + Data.Succinct.Dsv.Lazy.Cursor + Data.Succinct.Dsv.Lazy.Cursor.Internal + Data.Succinct.Dsv.Lazy.Cursor.Lazy + Data.Succinct.Dsv.Lazy.Cursor.Strict + Data.Succinct.Dsv.Lazy.Cursor.Type + Data.Succinct.Dsv.Strict.Cursor + Data.Succinct.Dsv.Strict.Cursor.Internal + Data.Succinct.Dsv.Strict.Cursor.Internal.Reference + Data.Succinct.Dsv.Strict.Cursor.Type + hs-source-dirs: components/succinct-dsv/src + +library json + import: base, config + , aeson + , attoparsec + , attoparsec-aeson + , bits-extra + , bytestring + , dlist + , hw-bits + , hw-prim + , mmap + , prettyprinter + , scientific + , succinct-core + , succinct-json-simple-cursor + , succinct-json-standard-cursor + , succinct-simd + , text + , vector + , word8 + visibility: public + hs-source-dirs: components/succinct-json/src + exposed-modules: Data.Succinct.Json.DecodeError + Data.Succinct.Json.FromValue + Data.Succinct.Json.Internal.CharLike + Data.Succinct.Json.Internal.Doc + Data.Succinct.Json.Internal.Index + Data.Succinct.Json.Internal.PartialIndex + Data.Succinct.Json.Internal.Slurp + Data.Succinct.Json.Internal.Standard.Cursor.Token + Data.Succinct.Json.Internal.Standard.Token.Tokenize + Data.Succinct.Json.Internal.Token + Data.Succinct.Json.Internal.Token.Types + Data.Succinct.Json.Internal.Value + Data.Succinct.Json.Internal.Word64 + Data.Succinct.Json.LightJson + Data.Succinct.Json.PartialValue + Data.Succinct.Json.Query + Data.Succinct.Json.Simple.Value + Data.Succinct.Json.Standard.Load.Partial + Data.Succinct.Json.Value + +library json-examples + import: base, config + , aeson + , bytestring + , dlist + , hw-prim + , succinct-core + , succinct-json + , succinct-json-standard-cursor + visibility: public + hs-source-dirs: components/succinct-json-examples/src + other-modules: Example1 + Example2 + Example3 + Example4 + +library json-simd + import: base, config + , bytestring + , hw-prim + , lens + , vector + visibility: public + hs-source-dirs: components/succinct-json-simd/src + cc-options: -mssse3 -mlzcnt -mbmi2 -mavx2 + include-dirs: components/succinct-json-simd/cbits + build-tool-depends: c2hs:c2hs + exposed-modules: Data.Succinct.Json.Simd.Capabilities + Data.Succinct.Json.Simd.Index.Simple + Data.Succinct.Json.Simd.Index.Standard + Data.Succinct.Json.Simd.Internal.Foreign + Data.Succinct.Json.Simd.Internal.Index.Simple + Data.Succinct.Json.Simd.Internal.Index.Standard + Data.Succinct.Json.Simd.Internal.List + c-sources: components/succinct-json-simd/cbits/debug.c + components/succinct-json-simd/cbits/simd.c + components/succinct-json-simd/cbits/simd-spliced.c + components/succinct-json-simd/cbits/simd-state.c + components/succinct-json-simd/cbits/simd-phi-table-32.c + components/succinct-json-simd/cbits/simd-transition-table-32.c + +library json-simple-cursor + import: base, config + , bytestring + , hw-bits + , hw-prim + , succinct-core + , vector + , word8 + visibility: public + hs-source-dirs: components/succinct-json-simple-cursor/src + exposed-modules: Data.Succinct.Json.Simple.Cursor + Data.Succinct.Json.Simple.Cursor.Fast + Data.Succinct.Json.Simple.Cursor.Internal.IbBp + Data.Succinct.Json.Simple.Cursor.Internal.ToIbBp + Data.Succinct.Json.Simple.Cursor.Internal.Word8 + Data.Succinct.Json.Simple.Cursor.SemiIndex + Data.Succinct.Json.Simple.Cursor.Snippet + +library json-standard-cursor + import: base, config + , array + , bits-extra + , bytestring + , hw-bits + , hw-prim + , mmap + , succinct-core + , succinct-json-simd + , vector + , word8 + visibility: public + hs-source-dirs: components/succinct-json-standard-cursor/src + exposed-modules: Data.Succinct.Json.Standard.Cursor + Data.Succinct.Json.Standard.Cursor.Fast + Data.Succinct.Json.Standard.Cursor.Generic + Data.Succinct.Json.Standard.Cursor.IbBp + Data.Succinct.Json.Standard.Cursor.Index + Data.Succinct.Json.Standard.Cursor.Internal.Blank + Data.Succinct.Json.Standard.Cursor.Internal.BlankedJson + Data.Succinct.Json.Standard.Cursor.Internal.MakeIndex + Data.Succinct.Json.Standard.Cursor.Internal.StateMachine + Data.Succinct.Json.Standard.Cursor.Internal.ToBalancedParens64 + Data.Succinct.Json.Standard.Cursor.Internal.ToInterestBits64 + Data.Succinct.Json.Standard.Cursor.Internal.Word8 + Data.Succinct.Json.Standard.Cursor.Load.Cursor + Data.Succinct.Json.Standard.Cursor.Load.Raw + Data.Succinct.Json.Standard.Cursor.SemiIndex + Data.Succinct.Json.Standard.Cursor.Slow + Data.Succinct.Json.Standard.Cursor.Specific + Data.Succinct.Json.Standard.Cursor.Type + +library simd + import: base, config + , bits-extra + , bytestring + , deepseq + , hw-bits + , hw-prim + , succinct-core + , transformers + , vector + visibility: public + exposed-modules: Data.Succinct.Simd.Capabilities + Data.Succinct.Simd.ChunkString + Data.Succinct.Simd.Comparison + Data.Succinct.Simd.Comparison.Avx2 + Data.Succinct.Simd.Comparison.Stock + Data.Succinct.Simd.Internal.Bits + Data.Succinct.Simd.Internal.Broadword + Data.Succinct.Simd.Internal.ChunkString + Data.Succinct.Simd.Internal.Foreign + Data.Succinct.Simd.Internal.Marshal + Data.Succinct.Simd.Logical + Data.Succinct.Simd.Logical.Avx2 + Data.Succinct.Simd.Logical.Stock + hs-source-dirs: components/succinct-simd/src + include-dirs: components/succinct-simd/cbits + c-sources: components/succinct-simd/cbits/simd_avx2.c + components/succinct-simd/cbits/simd_sse2.c + build-tool-depends: c2hs:c2hs + +library xml + import: base, config + , array + , attoparsec + , base + , bytestring + , cereal + , containers + , deepseq + , ghc-prim + , hw-bits + , hw-prim + , lens + , mmap + , mtl + , prettyprinter + , resourcet + , succinct-core + , text + , transformers + , vector + , word8 + visibility: public + exposed-modules: Data.Succinct.Xml + Data.Succinct.Xml.Blank + Data.Succinct.Xml.CharLike + Data.Succinct.Xml.Decode + Data.Succinct.Xml.DecodeError + Data.Succinct.Xml.DecodeResult + Data.Succinct.Xml.Grammar + Data.Succinct.Xml.Index + Data.Succinct.Xml.Internal.BalancedParens + Data.Succinct.Xml.Internal.ByteString + Data.Succinct.Xml.Internal.Blank + Data.Succinct.Xml.Internal.List + Data.Succinct.Xml.Internal.Show + Data.Succinct.Xml.Internal.Tables + Data.Succinct.Xml.Internal.ToIbBp64 + Data.Succinct.Xml.Internal.Words + Data.Succinct.Xml.Lens + Data.Succinct.Xml.Succinct + Data.Succinct.Xml.Succinct.Cursor + Data.Succinct.Xml.Succinct.Cursor.BalancedParens + Data.Succinct.Xml.Succinct.Cursor.BlankedXml + Data.Succinct.Xml.Succinct.Cursor.Create + Data.Succinct.Xml.Succinct.Cursor.InterestBits + Data.Succinct.Xml.Succinct.Cursor.Internal + Data.Succinct.Xml.Succinct.Cursor.Load + Data.Succinct.Xml.Succinct.Cursor.Types + Data.Succinct.Xml.Succinct.Cursor.MMap + Data.Succinct.Xml.Succinct.Cursor.Token + Data.Succinct.Xml.Succinct.Index + Data.Succinct.Xml.RawDecode + Data.Succinct.Xml.RawValue + Data.Succinct.Xml.Token.Tokenize + Data.Succinct.Xml.Token.Types + Data.Succinct.Xml.Token + Data.Succinct.Xml.Type + Data.Succinct.Xml.Value + hs-source-dirs: components/succinct-xml/src + ghc-options: -Wall -O2 -msse4.2 + +test-suite core--test + import: base, config + , bits-extra + , bytestring + , directory + , dlist + , hedgehog + , hspec + , hw-bits + , hw-hedgehog + , hw-hspec-hedgehog + , hw-int + , hw-prim + , lens + , mmap + , QuickCheck + , succinct-core + , succinct-core-gen + , transformers + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: components/succinct-core/test + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: hspec-discover:hspec-discover + build-depends: hw-string-parse + other-modules: Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector8Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector16Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector32Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Vector64Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector8Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector16Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector32Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindClose.Vector64Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word16Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word32Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word64Spec + Data.Succinct.BalancedParens.Internal.Broadword.FindUnmatchedCloseFar.Word8Spec + Data.Succinct.BalancedParens.Internal.BroadwordSpec + Data.Succinct.BalancedParens.FindCloseNSpec + Data.Succinct.BalancedParens.RangeMin2Spec + Data.Succinct.BalancedParens.RangeMinSpec + Data.Succinct.BalancedParens.SimpleSpec + Data.Succinct.Excess.Internal.BranchlessSpec + Data.Succinct.Excess.MinExcess0Spec + Data.Succinct.Excess.MinExcess1Spec + Data.Succinct.Excess.MinMaxExcess0Spec + Data.Succinct.Excess.MinMaxExcess1Spec + Data.Succinct.Excess.PartialMinExcess0Spec + Data.Succinct.Excess.PartialMinExcess1Spec + Data.Succinct.Excess.PartialMinMaxExcess0Spec + Data.Succinct.Excess.PartialMinMaxExcess1Spec + Data.Succinct.Model.Example + Data.Succinct.Model.Lens + Data.Succinct.Model.Type + Data.Succinct.MQuerySpec + Data.Succinct.RankSelect.Base.InternalSpec + Data.Succinct.RankSelect.Base.Rank0Spec + Data.Succinct.RankSelect.Base.Rank1Spec + Data.Succinct.RankSelect.Base.Select0Spec + Data.Succinct.RankSelect.Base.Select1Spec + Data.Succinct.RankSelect.BasicGen + Data.Succinct.RankSelect.BinarySearchSpec + Data.Succinct.RankSelect.CsPoppy.InternalSpec + Data.Succinct.RankSelect.CsPoppySpec + Data.Succinct.RankSelect.Gen + Data.Succinct.RankSelect.InternalSpec + Data.Succinct.RankSelect.Poppy512Spec + Data.Succinct.RankSelect.SimpleSpec + Data.Succinct.RankSelect.SpecCommon + Data.Succinct.RankSelect.ValidateSpec + Test.Common + +test-suite core--doctest + import: base, config + , doctest + , doctest-discover + , succinct-core + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-core/doctest + build-tool-depends: doctest-discover:doctest-discover + +test-suite dsv-space + import: base, config + , bits-extra + , bytestring + , cassava + , deepseq + , ghc-prim + , hw-bits + , hw-prim + , succinct-core + , succinct-dsv + , succinct-simd + , vector + , weigh + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: Space.hs + hs-source-dirs: components/succinct-dsv/weigh + build-tool-depends: hspec-discover:hspec-discover + +test-suite dsv-test + import: base, config + , bits-extra + , bytestring + , deepseq + , directory + , ghc-prim + , hedgehog + , hspec + , hw-bits + , hw-hspec-hedgehog + , hw-prim + , succinct-core + , succinct-dsv + , succinct-simd + , text + , vector + ghc-options: -threaded -rtsopts -with-rtsopts=-N + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: Data.Succinct.Dsv.BroadwordSpec + Data.Succinct.Dsv.Gen + Data.Succinct.Dsv.Lazy.CursorSpec + Data.Succinct.Dsv.Strict.Cursor.InternalSpec + Data.Succinct.DsvSpec + hs-source-dirs: components/succinct-dsv/test + build-tool-depends: hspec-discover:hspec-discover + +test-suite dsv-doctest + import: base, config + , doctest + , doctest-discover + , succinct-dsv + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-dsv/doctest + build-tool-depends: doctest-discover:doctest-discover + +test-suite json--test + import: base, config + , aeson + , attoparsec + , attoparsec-aeson + , bytestring + , dlist + , hedgehog + , hspec + , hw-bits + , hw-hspec-hedgehog + , hw-prim + , scientific + , succinct-core + , succinct-json + , succinct-json-simple-cursor + , succinct-json-standard-cursor + , text + , transformers + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: components/succinct-json/test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: hspec-discover:hspec-discover + other-modules: Data.Succinct.Json.LightJsonSpec + Data.Succinct.Json.Simple.CursorSpec + Data.Succinct.Json.Standard.CursorSpec + Data.Succinct.Json.Standard.GenCursorTest + Data.Succinct.Json.Token.TokenizeSpec + Data.Succinct.Json.TypeSpec + Data.Succinct.Json.ValueSpec + +test-suite json--doctest + import: base, config + , doctest + , doctest-discover + , succinct-json + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-json/doctest + build-tool-depends: doctest-discover:doctest-discover + +test-suite json-simd--test + import: base, config + , bytestring + , hw-prim + , lens + , succinct-json-simd + , transformers + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: components/succinct-json-simd/test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + +test-suite json-simd--doctest + import: base, config + , doctest + , doctest-discover + , succinct-json-simd + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-json-simd/doctest + build-tool-depends: doctest-discover:doctest-discover + +test-suite json-simple-cursor--test + import: base, config + , bytestring + , hedgehog + , hspec + , hw-bits + , hw-hspec-hedgehog + , hw-prim + , succinct-core + , succinct-json-simple-cursor + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: components/succinct-json-simple-cursor/test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: hspec-discover:hspec-discover + other-modules: Data.Succinct.Json.Simple.CursorSpec + +test-suite json-simple-cursor-doctest + import: base, config + , doctest + , doctest-discover + , succinct-json-simple-cursor + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-json-simple-cursor/doctest + build-tool-depends: doctest-discover:doctest-discover + +test-suite json-standard-cursor--test + import: base, config + , bytestring + , filepath + , hedgehog + , hspec + , hw-bits + , hw-hspec-hedgehog + , hw-prim + , succinct-core + , succinct-json-standard-cursor + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: components/succinct-json-standard-cursor/test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: hspec-discover:hspec-discover + other-modules: Data.Succinct.Json.Standard.CorpusSpec + Data.Succinct.Json.Standard.Cursor.BalancedParensSpec + Data.Succinct.Json.Standard.Cursor.InterestBitsSpec + Data.Succinct.Json.Standard.Cursor.Internal.BlankSpec + Data.Succinct.Json.Standard.Cursor.TypeSpec + Data.Succinct.Json.Standard.CursorSpec + Data.Succinct.Json.Standard.GenCursorTest + +test-suite json-standard-cursor--doctest + import: base, config + , doctest + , doctest-discover + , bits-extra + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-json-standard-cursor/doctest + build-tool-depends: doctest-discover:doctest-discover + +test-suite simd--test + import: base, config + , bits-extra + , bytestring + , deepseq + , directory + , hedgehog + , hspec + , hw-bits + , hw-hedgehog + , hw-hspec-hedgehog + , hw-prim + , lens + , succinct-core + , succinct-simd + , text + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: Data.Succinct.Simd.ComparisonSpec + Data.Succinct.Simd.Internal.BroadwordSpec + Data.Succinct.Simd.LogicalSpec + hs-source-dirs: components/succinct-simd/test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: hspec-discover:hspec-discover + +test-suite simd--doctest + import: base, config + , doctest + , doctest-discover + , succinct-simd + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-simd/doctest + build-tool-depends: doctest-discover:doctest-discover + +test-suite xml--test + import: base, config + , attoparsec + , base + , bytestring + , hedgehog + , hspec + , hw-bits + , hw-hspec-hedgehog + , hw-prim + , succinct-core + , succinct-xml + , text + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: components/succinct-xml/test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + build-tool-depends: hspec-discover:hspec-discover + other-modules: Data.Succinct.Xml.Internal.BlankSpec + Data.Succinct.Xml.RawValueSpec + Data.Succinct.Xml.Succinct.Cursor.BalancedParensSpec + Data.Succinct.Xml.Succinct.Cursor.BlankedXmlSpec + Data.Succinct.Xml.Succinct.Cursor.InterestBitsSpec + Data.Succinct.Xml.Succinct.CursorSpec.Make + Data.Succinct.Xml.Succinct.CursorSpec + Data.Succinct.Xml.Token.TokenizeSpec + Data.Succinct.Xml.TypeSpec + +test-suite xml--doctest + import: base, config + , doctest + , doctest-discover + , succinct-xml + type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + main-is: DoctestDriver.hs + HS-Source-Dirs: components/succinct-xml/doctest + build-tool-depends: doctest-discover:doctest-discover + +benchmark core--bench + import: base, config + , bits-extra + , bytestring + , criterion + , deepseq + , directory + , generic-lens + , hedgehog + , hw-bits + , hw-prim + , lens + , succinct-core + , succinct-core-gen + , vector + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: components/succinct-core/bench + other-modules: Bench.BalancedParens + Bench.Excess + Bench.RankSelect + Bench.RankSelectBase + +benchmark dsv-bench + import: base, config + , bits-extra + , bytestring + , cassava + , criterion + , deepseq + , directory + , ghc-prim + , hw-bits + , hw-prim + , mmap + , succinct-core + , succinct-dsv + , succinct-simd + , vector + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: components/succinct-dsv/bench + ghc-options: -msse4.2 + +benchmark succinct-json--bench + import: base, config + , bytestring + , criterion + , directory + , mmap + , succinct-json + , succinct-json-standard-cursor + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: components/succinct-json/bench + +benchmark succinct-json-simple-cursor-bench + import: base, config + , bytestring + , criterion + , directory + , mmap + , succinct-json-simple-cursor + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: components/succinct-json-simple-cursor/bench + +benchmark succinct-json-standard-cursor-bench + import: base, config + , bytestring + , criterion + , directory + , mmap + , succinct-json-standard-cursor + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: components/succinct-json-standard-cursor/bench + +benchmark succinct-simd--bench + import: base, config + , bits-extra + , bytestring + , cassava + , containers + , criterion + , deepseq + , directory + , hw-bits + , hw-prim + , mmap + , succinct-core + , succinct-simd + , transformers + , vector + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: components/succinct-simd/bench + +benchmark succinct-xml--bench + import: base, config + , bytestring + , criterion + , hw-bits + , hw-prim + , mmap + , resourcet + , succinct-core + , succinct-xml + , vector + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: components/succinct-xml/bench + ghc-options: -O2 -Wall -msse4.2 + +executable succinct + import: base, config + , bytestring + , directory + , generic-lens + , hw-bits + , hw-prim + , lens + , mmap + , mtl + , optparse-applicative + , succinct-core + , vector + main-is: Main.hs + hs-source-dirs: components/succinct/app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: App.Cli.Commands + App.Cli.Commands.BalancedParens + App.Cli.Commands.BalancedParens.BitsToParens + App.Cli.Commands.BalancedParens.ParensToBits + App.Cli.Commands.BalancedParens.Positions + App.Cli.Commands.RankSelect + App.Cli.Commands.RankSelect.Build + App.Cli.Commands.RankSelect.SelectAll + App.Cli.Commands.RankSelect.UnitTest + App.Cli.Commands.RankSelect.Validate + App.Cli.Options.Type + App.IO + +executable succinct-dsv + import: base, config + , appar + , bits-extra + , bytestring + , deepseq + , generic-lens + , ghc-prim + , hedgehog + , hw-bits + , hw-ip + , hw-prim + , lens + , optparse-applicative + , resourcet + , succinct-core + , succinct-dsv + , succinct-simd + , text + , transformers + , vector + main-is: Main.hs + other-modules: App.Char + App.Commands + App.Commands.CreateIndex + App.Commands.Generate + App.Commands.IndexWord8s + App.Commands.Options.Parse + App.Commands.Options.Type + App.Commands.QueryLazy + App.Commands.QueryStrict + App.Commands.RangeJoin + App.Data.ColumnDesc + App.Data.RangeJoinColumn + App.Data.List + App.Gen + App.IO + hs-source-dirs: components/succinct-dsv/app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + +executable succinct-json + import: base, config + , aeson + , bytestring + , dlist + , generic-lens + , hw-prim + , lens + , mmap + , optparse-applicative + , succinct-core + , succinct-json + , succinct-json-simd + , succinct-json-simple-cursor + , succinct-json-standard-cursor + , text + , unordered-containers + , vector + main-is: Main.hs + hs-source-dirs: components/succinct-json/app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: App.Commands + App.Commands.CreateIndex + App.Commands.Count + App.Commands.CountAeson + App.Commands.Demo + App.Commands.Types + +executable succinct-json-simd + import: base, config + , bytestring + , hw-prim + , lens + , optparse-applicative + , succinct-json-simd + , vector + main-is: Main.hs + hs-source-dirs: components/succinct-json-simd/app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: App.Commands + App.Commands.Capabilities + App.Commands.CreateIndex + App.Commands.Types + App.Lens + +executable succinct-json-simple-cursor + import: base, config + , bytestring + , generic-lens + , hw-prim + , lens + , mmap + , optparse-applicative + , succinct-core + , succinct-json-simd + , succinct-json-simple-cursor + , text + , vector + main-is: Main.hs + hs-source-dirs: components/succinct-json-simple-cursor/app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: App.Commands + App.Commands.CreateIndex + App.Commands.Types + +executable succinct-xml + import: base, config + , attoparsec + , bytestring + , deepseq + , generic-lens + , hw-bits + , hw-prim + , lens + , mmap + , mtl + , optparse-applicative + , resourcet + , succinct-core + , succinct-xml + , text + , vector + main-is: Main.hs + other-modules: App.Commands + App.Commands.Count + App.Commands.CreateBlankedXml + App.Commands.CreateBpIndex + App.Commands.CreateIbIndex + App.Commands.CreateIndex + App.Commands.Demo + App.Commands.Types + App.Options + App.XPath.Parser + App.XPath.Types + App.Show + App.Naive + hs-source-dirs: components/succinct-xml/app + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2