diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS new file mode 100644 index 0000000..f6c0b22 --- /dev/null +++ b/.github/CODEOWNERS @@ -0,0 +1 @@ +@byteverse/l3c diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml new file mode 100644 index 0000000..085bbaf --- /dev/null +++ b/.github/workflows/build.yaml @@ -0,0 +1,12 @@ +name: build +on: + pull_request: + branches: + - "*" + +jobs: + call-workflow: + uses: byteverse/.github/.github/workflows/build.yaml@main + secrets: inherit + with: + release: false diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml new file mode 100644 index 0000000..bd0bbd5 --- /dev/null +++ b/.github/workflows/release.yaml @@ -0,0 +1,12 @@ +name: release +on: + push: + tags: + - "*" + +jobs: + call-workflow: + uses: byteverse/.github/.github/workflows/build.yaml@main + secrets: inherit + with: + release: true diff --git a/.gitignore b/.gitignore index 28d589b..cde1485 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +.vscode/ dist dist-* cabal-dev diff --git a/CHANGELOG.md b/CHANGELOG.md index 84b8ff1..75d078c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for array-builder +## 0.1.4.1 -- 2024-02-01 + +* Update package metadata. + ## 0.1.4.0 -- 2023-08-30 * Add `constructN` functions to Data.Builder.Catenable.Bytes. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/array-builder.cabal b/array-builder.cabal index dc064f1..ef5dd7a 100644 --- a/array-builder.cabal +++ b/array-builder.cabal @@ -1,16 +1,17 @@ -cabal-version: 2.2 -name: array-builder -version: 0.1.4.0 -synopsis: Builders for arrays -homepage: https://github.com/andrewthad/array-builder -bug-reports: https://github.com/andrewthad/array-builder/issues -license: BSD-3-Clause -license-file: LICENSE -author: Andrew Martin -maintainer: andrew.thaddeus@gmail.com -copyright: 2019 Andrew Martin -category: Data -extra-source-files: CHANGELOG.md +cabal-version: 2.2 +name: array-builder +version: 0.1.4.1 +synopsis: Builders for arrays +description: Builders for arrays. +homepage: https://github.com/byteverse/array-builder +bug-reports: https://github.com/byteverse/array-builder/issues +license: BSD-3-Clause +license-file: LICENSE +author: Andrew Martin +maintainer: amartin@layer3com.com +copyright: 2019 Andrew Martin +category: Data +extra-doc-files: CHANGELOG.md library exposed-modules: @@ -19,35 +20,43 @@ library Data.Builder.Catenable.Bytes Data.Builder.Catenable.Text Data.Builder.ST - other-modules: - Compat + + other-modules: Compat build-depends: - , array-chunks >=0.1 && <0.2 - , base >=4.12 && <5 - , bytebuild >=0.3.5 - , byteslice >=0.2.7 - , bytestring - , natural-arithmetic >=0.1.3 - , primitive >=0.6.4 && <0.10 - , run-st >=0.1 && <0.2 - , text-short >=0.1.3 - hs-source-dirs: src - if impl(ghc >= 8.9) + , array-chunks >=0.1 && <0.2 + , base >=4.12 && <5 + , bytebuild >=0.3.5 && <0.4 + , byteslice >=0.2.7 && <0.3 + , bytestring >=0.11.5 && <0.12 + , natural-arithmetic >=0.1.3 && <0.3 + , primitive >=0.6.4 && <0.10 + , run-st >=0.1 && <0.2 + , text-short >=0.1.3 && <0.2 + + hs-source-dirs: src + + if impl(ghc >=8.9) hs-source-dirs: src-post-8.9 + else hs-source-dirs: src-pre-8.9 + default-language: Haskell2010 - ghc-options: -Wall -O2 + ghc-options: -Wall -O2 test-suite test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Main.hs + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs build-depends: , array-builder , base , tasty , tasty-hunit - ghc-options: -Wall -O2 + + ghc-options: -Wall -O2 default-language: Haskell2010 +source-repository head + type: git + location: git://github.com/byteverse/array-builder.git diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..40cd005 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,51 @@ +# Number of spaces per indentation step +indentation: 2 + +# Max line length for automatic line breaking +column-limit: 200 + +# Styling of arrows in type signatures (choices: trailing, leading, or leading-args) +function-arrows: trailing + +# How to place commas in multi-line lists, records, etc. (choices: leading or trailing) +comma-style: leading + +# Styling of import/export lists (choices: leading, trailing, or diff-friendly) +import-export-style: leading + +# Whether to full-indent or half-indent 'where' bindings past the preceding body +indent-wheres: false + +# Whether to leave a space before an opening record brace +record-brace-space: true + +# Number of spaces between top-level declarations +newlines-between-decls: 1 + +# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) +haddock-style: multi-line + +# How to print module docstring +haddock-style-module: null + +# Styling of let blocks (choices: auto, inline, newline, or mixed) +let-style: auto + +# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) +in-style: right-align + +# Whether to put parentheses around a single constraint (choices: auto, always, or never) +single-constraint-parens: always + +# Output Unicode syntax (choices: detect, always, or never) +unicode: never + +# Give the programmer more choice on where to insert blank lines +respectful: true + +# Fixity information for operators +fixities: [] + +# Module reexports Fourmolu should know about +reexports: [] + diff --git a/src-post-8.9/Compat.hs b/src-post-8.9/Compat.hs index a875e14..8af21b6 100644 --- a/src-post-8.9/Compat.hs +++ b/src-post-8.9/Compat.hs @@ -1,15 +1,14 @@ -{-# language MagicHash #-} -{-# language UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} module Compat ( unsafeShrinkAndFreeze , unsafeShrinkAndFreeze# ) where -import Data.Primitive (SmallArray(..),SmallMutableArray(..)) -import GHC.Exts (SmallArray#,SmallMutableArray#,Int(I#)) -import GHC.Exts (State#,Int#) -import GHC.ST (ST(ST)) +import Data.Primitive (SmallArray (..), SmallMutableArray (..)) +import GHC.Exts (Int (I#), Int#, SmallArray#, SmallMutableArray#, State#) +import GHC.ST (ST (ST)) import qualified GHC.Exts as Exts @@ -17,22 +16,23 @@ import qualified GHC.Exts as Exts -- The argument must not be reused after being passed to -- this function. unsafeShrinkAndFreeze :: - SmallMutableArray s a - -> Int - -> ST s (SmallArray a) -{-# inline unsafeShrinkAndFreeze #-} -unsafeShrinkAndFreeze (SmallMutableArray x) (I# n) = ST - (\s0 -> case Exts.shrinkSmallMutableArray# x n s0 of - s1 -> case Exts.unsafeFreezeSmallArray# x s1 of - (# s2, r #) -> (# s2, SmallArray r #) - ) + SmallMutableArray s a -> + Int -> + ST s (SmallArray a) +{-# INLINE unsafeShrinkAndFreeze #-} +unsafeShrinkAndFreeze (SmallMutableArray x) (I# n) = + ST + ( \s0 -> case Exts.shrinkSmallMutableArray# x n s0 of + s1 -> case Exts.unsafeFreezeSmallArray# x s1 of + (# s2, r #) -> (# s2, SmallArray r #) + ) unsafeShrinkAndFreeze# :: - SmallMutableArray# s a - -> Int# - -> State# s - -> (# State# s, SmallArray# a #) -{-# inline unsafeShrinkAndFreeze# #-} + SmallMutableArray# s a -> + Int# -> + State# s -> + (# State# s, SmallArray# a #) +{-# INLINE unsafeShrinkAndFreeze# #-} unsafeShrinkAndFreeze# x n s0 = case Exts.shrinkSmallMutableArray# x n s0 of s1 -> Exts.unsafeFreezeSmallArray# x s1 diff --git a/src-pre-8.9/Compat.hs b/src-pre-8.9/Compat.hs index e2ff6d9..bb9c155 100644 --- a/src-pre-8.9/Compat.hs +++ b/src-pre-8.9/Compat.hs @@ -1,5 +1,5 @@ -{-# language MagicHash #-} -{-# language UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} module Compat ( unsafeShrinkAndFreeze @@ -7,8 +7,8 @@ module Compat ) where import Control.Monad.ST (ST) -import Data.Primitive (SmallArray,SmallMutableArray) -import GHC.Exts (SmallArray#,SmallMutableArray#,Int#,State#) +import Data.Primitive (SmallArray, SmallMutableArray) +import GHC.Exts (Int#, SmallArray#, SmallMutableArray#, State#) import qualified Data.Primitive as PM import qualified GHC.Exts as Exts @@ -17,17 +17,17 @@ import qualified GHC.Exts as Exts -- The argument must not be reused after being passed to -- this function. unsafeShrinkAndFreeze :: - SmallMutableArray s a - -> Int - -> ST s (SmallArray a) -{-# inline unsafeShrinkAndFreeze #-} + SmallMutableArray s a -> + Int -> + ST s (SmallArray a) +{-# INLINE unsafeShrinkAndFreeze #-} unsafeShrinkAndFreeze arr = PM.freezeSmallArray arr 0 unsafeShrinkAndFreeze# :: - SmallMutableArray# s a - -> Int# - -> State# s - -> (# State# s, SmallArray# a #) -{-# inline unsafeShrinkAndFreeze# #-} + SmallMutableArray# s a -> + Int# -> + State# s -> + (# State# s, SmallArray# a #) +{-# INLINE unsafeShrinkAndFreeze# #-} unsafeShrinkAndFreeze# x n s0 = Exts.freezeSmallArray# x 0# n s0 diff --git a/src/Data/Builder.hs b/src/Data/Builder.hs index 53ae99f..95da6ac 100644 --- a/src/Data/Builder.hs +++ b/src/Data/Builder.hs @@ -1,140 +1,157 @@ -{-# language RankNTypes #-} -{-# language BangPatterns #-} -{-# language UnboxedTuples #-} -{-# language MagicHash #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} module Data.Builder ( -- * Builder - Builder(..) + Builder (..) , cons , singleton , doubleton , tripleton + -- * Run , run ) where import Compat (unsafeShrinkAndFreeze#) -import Data.Chunks (Chunks(ChunksNil,ChunksCons)) -import Data.Primitive (SmallArray(SmallArray)) -import GHC.Exts ((*#),(+#),(-#),(>#)) -import GHC.Exts (SmallMutableArray#) -import GHC.Exts (State#,Int#,runRW#) -import GHC.Exts (newSmallArray#) -import GHC.Exts (writeSmallArray#,unsafeFreezeSmallArray#) +import Data.Chunks (Chunks (ChunksCons, ChunksNil)) +import Data.Primitive (SmallArray (SmallArray)) +import GHC.Exts (Int#, SmallMutableArray#, State#, newSmallArray#, runRW#, unsafeFreezeSmallArray#, writeSmallArray#, (*#), (+#), (-#), (>#)) import qualified Data.Chunks as C -- | Builder for an array of boxed elements. -newtype Builder a = Builder - -- The chunks being built up are in reverse order. - -- Consequently, functions that run a builder must - -- reverse the chunks at the end. - (forall s. SmallMutableArray# s a -> Int# -> Int# -> Chunks a -> State# s - -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #) - ) +newtype Builder a + = Builder + -- The chunks being built up are in reverse order. + -- Consequently, functions that run a builder must + -- reverse the chunks at the end. + ( forall s. + SmallMutableArray# s a -> + Int# -> + Int# -> + Chunks a -> + State# s -> + (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #) + ) run :: Builder a -> Chunks a run (Builder f) = case runRW# -- The initial size of 16 elements is chosen somewhat -- arbitrarily. It is more than enough to saturate a -- cache line. - (\s0 -> case newSmallArray# 16# errorThunk s0 of - (# s1, marr0 #) -> case f marr0 0# 16# ChunksNil s1 of - (# s2, marr, off, _, cs #) -> - -- Recall that freezeSmallArray copies a slice. - -- If resize functions ever become available for - -- SmallArray, we should use that instead. - case unsafeShrinkAndFreeze# marr off s2 of - (# s3, arr #) -> - let !r = C.reverseOnto - (ChunksCons (SmallArray arr) ChunksNil) - cs - in (# s3, r #) - ) of (# _, cs #) -> cs + ( \s0 -> case newSmallArray# 16# errorThunk s0 of + (# s1, marr0 #) -> case f marr0 0# 16# ChunksNil s1 of + (# s2, marr, off, _, cs #) -> + -- Recall that freezeSmallArray copies a slice. + -- If resize functions ever become available for + -- SmallArray, we should use that instead. + case unsafeShrinkAndFreeze# marr off s2 of + (# s3, arr #) -> + let !r = + C.reverseOnto + (ChunksCons (SmallArray arr) ChunksNil) + cs + in (# s3, r #) + ) of + (# _, cs #) -> cs errorThunk :: a -{-# noinline errorThunk #-} +{-# NOINLINE errorThunk #-} errorThunk = error "array-builder:Data.Builder: error" instance Monoid (Builder a) where - {-# inline mempty #-} - mempty = Builder - (\marr0 off0 len0 cs0 s0 -> - (# s0, marr0, off0, len0, cs0 #) - ) + {-# INLINE mempty #-} + mempty = + Builder + ( \marr0 off0 len0 cs0 s0 -> + (# s0, marr0, off0, len0, cs0 #) + ) instance Semigroup (Builder a) where - {-# inline (<>) #-} - Builder f <> Builder g = Builder - (\marr0 off0 len0 cs0 s0 -> case f marr0 off0 len0 cs0 s0 of - (# s1, marr1, off1, len1, cs1 #) -> - g marr1 off1 len1 cs1 s1 - ) + {-# INLINE (<>) #-} + Builder f <> Builder g = + Builder + ( \marr0 off0 len0 cs0 s0 -> case f marr0 off0 len0 cs0 s0 of + (# s1, marr1, off1, len1, cs1 #) -> + g marr1 off1 len1 cs1 s1 + ) cons :: a -> Builder a -> Builder a -{-# inline cons #-} +{-# INLINE cons #-} cons a b = singleton a <> b -- | A builder with one element. singleton :: a -> Builder a -{-# noinline singleton #-} -singleton a = Builder - (\marr off len cs s0 -> case len ># 0# of - 1# -> case writeSmallArray# marr off a s0 of - s1 -> (# s1, marr, off +# 1#, len -# 1#, cs #) - _ -> case unsafeFreezeSmallArray# marr s0 of - (# s1, arr #) -> let !lenNew = nextLength off in - -- Since we feed the element to newSmallArray#, we do not - -- need to write it to the 0 index. - case newSmallArray# lenNew a s1 of - (# s2, marrNew #) -> - let !csNew = ChunksCons (SmallArray arr) cs in - (# s2, marrNew, 1#, lenNew -# 1#, csNew #) - ) - --- | A builder with two elements. --- --- @since 0.1.1.0 +{-# NOINLINE singleton #-} +singleton a = + Builder + ( \marr off len cs s0 -> case len ># 0# of + 1# -> case writeSmallArray# marr off a s0 of + s1 -> (# s1, marr, off +# 1#, len -# 1#, cs #) + _ -> case unsafeFreezeSmallArray# marr s0 of + (# s1, arr #) -> + let !lenNew = nextLength off + in -- Since we feed the element to newSmallArray#, we do not + -- need to write it to the 0 index. + case newSmallArray# lenNew a s1 of + (# s2, marrNew #) -> + let !csNew = ChunksCons (SmallArray arr) cs + in (# s2, marrNew, 1#, lenNew -# 1#, csNew #) + ) + +{- | A builder with two elements. + +@since 0.1.1.0 +-} doubleton :: a -> a -> Builder a -{-# noinline doubleton #-} -doubleton a b = Builder - (\marr off len cs s0 -> case len ># 1# of - 1# -> case writeSmallArray# marr off a s0 of - s1 -> case writeSmallArray# marr (off +# 1#) b s1 of - s2 -> (# s2, marr, off +# 2#, len -# 2#, cs #) - _ -> case unsafeShrinkAndFreeze# marr off s0 of - (# s1, arr #) -> let !lenNew = nextLength off in - -- Since we feed the element to newSmallArray#, we do not - -- need to write element a to the 0 index. - case newSmallArray# lenNew a s1 of - (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of - s3 -> let !csNew = ChunksCons (SmallArray arr) cs in - (# s3, marrNew, 2#, lenNew -# 2#, csNew #) - ) - --- | A builder with three elements. --- --- @since 0.1.1.0 +{-# NOINLINE doubleton #-} +doubleton a b = + Builder + ( \marr off len cs s0 -> case len ># 1# of + 1# -> case writeSmallArray# marr off a s0 of + s1 -> case writeSmallArray# marr (off +# 1#) b s1 of + s2 -> (# s2, marr, off +# 2#, len -# 2#, cs #) + _ -> case unsafeShrinkAndFreeze# marr off s0 of + (# s1, arr #) -> + let !lenNew = nextLength off + in -- Since we feed the element to newSmallArray#, we do not + -- need to write element a to the 0 index. + case newSmallArray# lenNew a s1 of + (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of + s3 -> + let !csNew = ChunksCons (SmallArray arr) cs + in (# s3, marrNew, 2#, lenNew -# 2#, csNew #) + ) + +{- | A builder with three elements. + +@since 0.1.1.0 +-} tripleton :: a -> a -> a -> Builder a -{-# noinline tripleton #-} -tripleton a b c = Builder - (\marr off len cs s0 -> case len ># 1# of - 1# -> case writeSmallArray# marr off a s0 of - s1 -> case writeSmallArray# marr (off +# 1#) b s1 of - s2 -> case writeSmallArray# marr (off +# 2#) c s2 of - s3 -> (# s3, marr, off +# 3#, len -# 3#, cs #) - _ -> case unsafeShrinkAndFreeze# marr off s0 of - (# s1, arr #) -> let !lenNew = nextLength off in - -- Since we feed the element to newSmallArray#, we do not - -- need to write element a to the 0 index. - case newSmallArray# lenNew a s1 of - (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of - s3 -> case writeSmallArray# marrNew 2# c s3 of - s4 -> let !csNew = ChunksCons (SmallArray arr) cs in - (# s4, marrNew, 3#, lenNew -# 3#, csNew #) - ) +{-# NOINLINE tripleton #-} +tripleton a b c = + Builder + ( \marr off len cs s0 -> case len ># 1# of + 1# -> case writeSmallArray# marr off a s0 of + s1 -> case writeSmallArray# marr (off +# 1#) b s1 of + s2 -> case writeSmallArray# marr (off +# 2#) c s2 of + s3 -> (# s3, marr, off +# 3#, len -# 3#, cs #) + _ -> case unsafeShrinkAndFreeze# marr off s0 of + (# s1, arr #) -> + let !lenNew = nextLength off + in -- Since we feed the element to newSmallArray#, we do not + -- need to write element a to the 0 index. + case newSmallArray# lenNew a s1 of + (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of + s3 -> case writeSmallArray# marrNew 2# c s3 of + s4 -> + let !csNew = ChunksCons (SmallArray arr) cs + in (# s4, marrNew, 3#, lenNew -# 3#, csNew #) + ) nextLength :: Int# -> Int# -{-# inline nextLength #-} +{-# INLINE nextLength #-} nextLength i = i *# 2# diff --git a/src/Data/Builder/Catenable.hs b/src/Data/Builder/Catenable.hs index 8680923..c5c91d9 100644 --- a/src/Data/Builder/Catenable.hs +++ b/src/Data/Builder/Catenable.hs @@ -1,51 +1,55 @@ -{-# language BangPatterns #-} -{-# language PatternSynonyms #-} -{-# language TypeFamilies #-} - --- | Builder with cheap concatenation. Like the builder type from --- @Data.Builder.ST@, this builder can be stored somewhere and this used --- again later. However, this builder type has several advantages: --- --- * Supports both cons and snoc (@Data.Builder.ST@ only supports snoc) --- * No linear-use restriction --- * Extremely cheap concatenation (not supported by @Data.Builder.ST@ at all) --- --- In exchange for all of these, this implementation trades performance. --- Performance is degraded for two reasons: --- --- * Evaluation of the builder is deferred, and the evaluation requires walking --- a tree of nodes. --- * This builder stores individual elements rather than chunks. There is --- no fundamental reason for this. It is possible to store a SmallArray --- in each Cons and Snoc instead, but this makes the implementation a --- little more simple. --- --- One reason to prefer this module instead of @Data.Builder.ST@ is that --- this module lets the user works with builder in a more monoidal style --- rather than a stateful style. Consider a data type with several fields --- that is being converted to a builder. Here, @Data.Builder.ST@ --- would require that @Builder@ appear as both an argument and an result for --- each field\'s encode function. The linearly-used builder must be threaded --- through by hand or by clever use of @StateT@. With @Data.Builder.Catenable@, --- the encode functions only need return the builder. +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} + +{- | Builder with cheap concatenation. Like the builder type from +@Data.Builder.ST@, this builder can be stored somewhere and this used +again later. However, this builder type has several advantages: + +* Supports both cons and snoc (@Data.Builder.ST@ only supports snoc) +* No linear-use restriction +* Extremely cheap concatenation (not supported by @Data.Builder.ST@ at all) + +In exchange for all of these, this implementation trades performance. +Performance is degraded for two reasons: + +* Evaluation of the builder is deferred, and the evaluation requires walking + a tree of nodes. +* This builder stores individual elements rather than chunks. There is + no fundamental reason for this. It is possible to store a SmallArray + in each Cons and Snoc instead, but this makes the implementation a + little more simple. + +One reason to prefer this module instead of @Data.Builder.ST@ is that +this module lets the user works with builder in a more monoidal style +rather than a stateful style. Consider a data type with several fields +that is being converted to a builder. Here, @Data.Builder.ST@ +would require that @Builder@ appear as both an argument and an result for +each field\'s encode function. The linearly-used builder must be threaded +through by hand or by clever use of @StateT@. With @Data.Builder.Catenable@, +the encode functions only need return the builder. +-} module Data.Builder.Catenable ( -- * Type - Builder(..) + Builder (..) + -- * Convenient infix operators , pattern (:<) , pattern (:>) + -- * Functions , singleton , doubleton , tripleton + -- * Run , run ) where -import Control.Monad.ST (ST,runST) +import Control.Monad.ST (ST, runST) import Data.Chunks (Chunks) import Data.Foldable (foldl') -import GHC.Exts (IsList(..)) +import GHC.Exts (IsList (..)) import qualified Data.Builder.ST as STB import qualified Data.Chunks as Chunks @@ -60,11 +64,11 @@ data Builder a | Append !(Builder a) !(Builder a) instance Monoid (Builder a) where - {-# inline mempty #-} + {-# INLINE mempty #-} mempty = Empty instance Semigroup (Builder a) where - {-# inline (<>) #-} + {-# INLINE (<>) #-} (<>) = Append instance IsList (Builder a) where @@ -79,7 +83,7 @@ pattern (:>) :: Builder a -> a -> Builder a pattern (:>) x y = Snoc x y run :: Builder a -> Chunks a -{-# noinline run #-} +{-# NOINLINE run #-} run b = runST $ do bldr0 <- STB.new bldr1 <- pushCatenable bldr0 b @@ -99,13 +103,13 @@ pushCatenable !bldr0 b = case b of pushCatenable bldr1 y singleton :: a -> Builder a -{-# inline singleton #-} +{-# INLINE singleton #-} singleton a = Cons a Empty doubleton :: a -> a -> Builder a -{-# inline doubleton #-} +{-# INLINE doubleton #-} doubleton a b = Cons a (Cons b Empty) tripleton :: a -> a -> a -> Builder a -{-# inline tripleton #-} +{-# INLINE tripleton #-} tripleton a b c = Append (Cons a (Cons b Empty)) (Cons c Empty) diff --git a/src/Data/Builder/Catenable/Bytes.hs b/src/Data/Builder/Catenable/Bytes.hs index a1f8985..a3df77e 100644 --- a/src/Data/Builder/Catenable/Bytes.hs +++ b/src/Data/Builder/Catenable/Bytes.hs @@ -1,20 +1,25 @@ -{-# language BangPatterns #-} -{-# language PatternSynonyms #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} -- | @Data.Builder.Bytes@ specialized to @Bytes@. module Data.Builder.Catenable.Bytes ( -- * Type - Builder(..) + Builder (..) + -- * Convenient infix operators , pattern (:<) , pattern (:>) + -- * Run , run + -- * Properties , length + -- * Create , bytes , byteArray + -- * Mimic data constructors , cons , snoc @@ -24,9 +29,9 @@ module Data.Builder.Catenable.Bytes import Prelude hiding (length) -import Control.Monad.ST (ST,runST) +import Control.Monad.ST (ST, runST) import Data.Bytes (Bytes) -import Data.Bytes.Chunks (Chunks(ChunksNil)) +import Data.Bytes.Chunks (Chunks (ChunksNil)) import Data.Primitive (ByteArray) import qualified Data.Bytes as Bytes @@ -43,11 +48,11 @@ data Builder | Append !Builder !Builder instance Monoid Builder where - {-# inline mempty #-} + {-# INLINE mempty #-} mempty = Empty instance Semigroup Builder where - {-# inline (<>) #-} + {-# INLINE (<>) #-} (<>) = Append pattern (:<) :: Bytes -> Builder -> Builder @@ -65,7 +70,7 @@ length b0 = case b0 of Append x y -> length x + length y run :: Builder -> Chunks -{-# noinline run #-} +{-# NOINLINE run #-} run b = runST $ do bldr0 <- BBU.newBuilderState 128 bldr1 <- pushCatenable bldr0 b @@ -91,17 +96,17 @@ byteArray :: ByteArray -> Builder byteArray !b = Cons (Bytes.fromByteArray b) Empty snoc :: Builder -> Bytes -> Builder -{-# inline snoc #-} +{-# INLINE snoc #-} snoc = Snoc cons :: Bytes -> Builder -> Builder -{-# inline cons #-} +{-# INLINE cons #-} cons = Cons empty :: Builder -{-# inline empty #-} +{-# INLINE empty #-} empty = Empty append :: Builder -> Builder -> Builder -{-# inline append #-} +{-# INLINE append #-} append = Append diff --git a/src/Data/Builder/Catenable/Text.hs b/src/Data/Builder/Catenable/Text.hs index fa24686..6696831 100644 --- a/src/Data/Builder/Catenable/Text.hs +++ b/src/Data/Builder/Catenable/Text.hs @@ -1,17 +1,21 @@ -{-# language BangPatterns #-} -{-# language PatternSynonyms #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} -- | @Data.Builder.Catenable@ specialized to @ShortText@. module Data.Builder.Catenable.Text ( -- * Type - Builder(..) + Builder (..) + -- * Convenient infix operators , pattern (:<) , pattern (:>) + -- * Run , run + -- * Properties , length + -- * Create , shortText , char @@ -23,14 +27,14 @@ module Data.Builder.Catenable.Text import Prelude hiding (length) -import Control.Monad.ST (ST,runST) -import Data.ByteString.Short.Internal (ShortByteString(SBS)) -import Data.Bytes.Chunks (Chunks(ChunksNil)) -import Data.Int (Int32,Int64) -import Data.Primitive (ByteArray(ByteArray)) -import Data.String (IsString(fromString)) +import Control.Monad.ST (ST, runST) +import Data.ByteString.Short.Internal (ShortByteString (SBS)) +import Data.Bytes.Chunks (Chunks (ChunksNil)) +import Data.Int (Int32, Int64) +import Data.Primitive (ByteArray (ByteArray)) +import Data.String (IsString (fromString)) import Data.Text.Short (ShortText) -import Data.Word (Word32,Word64) +import Data.Word (Word32, Word64) import qualified Arithmetic.Nat as Nat import qualified Data.Bytes.Builder as BB @@ -75,22 +79,24 @@ length b0 = case b0 of Snoc b1 x -> TS.length x + length b1 Append x y -> length x + length y --- | Note: The choice of appending to the left side of @Empty@ instead --- of the right side of arbitrary. Under ordinary use, this difference --- cannot be observed by the user. +{- | Note: The choice of appending to the left side of @Empty@ instead +of the right side of arbitrary. Under ordinary use, this difference +cannot be observed by the user. +-} instance IsString Builder where fromString t = Cons (TS.pack t) Empty instance Monoid Builder where - {-# inline mempty #-} + {-# INLINE mempty #-} mempty = Empty instance Semigroup Builder where - {-# inline (<>) #-} + {-# INLINE (<>) #-} (<>) = Append --- | Not structural equality. Converts builders to chunks and then --- compares the chunks. +{- | Not structural equality. Converts builders to chunks and then +compares the chunks. +-} instance Eq Builder where a == b = run a == run b @@ -98,7 +104,7 @@ instance Show Builder where show b = TS.unpack (ba2st (Chunks.concatU (run b))) ba2st :: ByteArray -> ShortText -{-# inline ba2st #-} +{-# INLINE ba2st #-} ba2st (ByteArray x) = TS.fromShortByteStringUnsafe (SBS x) pattern (:<) :: ShortText -> Builder -> Builder @@ -107,11 +113,12 @@ pattern (:<) x y = Cons x y pattern (:>) :: Builder -> ShortText -> Builder pattern (:>) x y = Snoc x y --- | The result is chunks, but this is guaranteed to be UTF-8 encoded --- text, so if needed, you can flatten out the chunks and convert back --- to @ShortText@. +{- | The result is chunks, but this is guaranteed to be UTF-8 encoded +text, so if needed, you can flatten out the chunks and convert back +to @ShortText@. +-} run :: Builder -> Chunks -{-# noinline run #-} +{-# NOINLINE run #-} run b = runST $ do bldr0 <- BBU.newBuilderState 128 bldr1 <- pushCatenable bldr0 b diff --git a/src/Data/Builder/ST.hs b/src/Data/Builder/ST.hs index 6b8c2c5..51576b1 100644 --- a/src/Data/Builder/ST.hs +++ b/src/Data/Builder/ST.hs @@ -1,7 +1,7 @@ -{-# language BangPatterns #-} +{-# LANGUAGE BangPatterns #-} module Data.Builder.ST - ( Builder(..) + ( Builder (..) , new , new1 , push @@ -10,26 +10,26 @@ module Data.Builder.ST import Compat (unsafeShrinkAndFreeze) import Control.Monad.ST (ST) -import Data.Chunks (Chunks(ChunksNil,ChunksCons)) -import Data.Primitive (SmallMutableArray) -import Data.Primitive (newSmallArray,writeSmallArray,unsafeFreezeSmallArray) -import Data.Primitive (sizeofSmallArray) +import Data.Chunks (Chunks (ChunksCons, ChunksNil)) +import Data.Primitive (SmallMutableArray, newSmallArray, sizeofSmallArray, unsafeFreezeSmallArray, writeSmallArray) import Foreign.Storable (sizeOf) import qualified Data.Chunks as C --- | Builder for an array of boxed elements. This type is appropriate --- when constructing an array of unknown size in an effectful --- (@ST@ or @IO@) setting. In a non-effectful setting, consider --- the @Builder@ from @Data.Builder@ instead. --- --- A 'Builder' must be used linearly. The type system does not --- enforce this, so users must be careful when handling a 'Builder'. -data Builder s a = Builder - !(SmallMutableArray s a) - !Int - !Int - !(Chunks a) +{- | Builder for an array of boxed elements. This type is appropriate +when constructing an array of unknown size in an effectful +(@ST@ or @IO@) setting. In a non-effectful setting, consider +the @Builder@ from @Data.Builder@ instead. + +A 'Builder' must be used linearly. The type system does not +enforce this, so users must be careful when handling a 'Builder'. +-} +data Builder s a + = Builder + !(SmallMutableArray s a) + !Int + !Int + !(Chunks a) -- | Create a new 'Builder' with no elements in it. new :: ST s (Builder s a) @@ -37,25 +37,30 @@ new = do marr <- newSmallArray initialLength errorThunk pure (Builder marr 0 initialLength ChunksNil) --- | Create a new 'Builder' with a single element. Useful when builder --- creation is immidiately followed by 'push'. Note that: --- --- > new >>= push x ≡ new1 x --- --- But 'new1' performs slightly better. +{- | Create a new 'Builder' with a single element. Useful when builder +creation is immidiately followed by 'push'. Note that: + +> new >>= push x ≡ new1 x + +But 'new1' performs slightly better. +-} new1 :: a -> ST s (Builder s a) new1 a0 = do marr <- newSmallArray initialLength a0 pure (Builder marr 1 initialLength ChunksNil) --- | Push an element onto the end of the builder. This --- is not strict in the element, so force it before pushing --- it on to the builder if doing so is needed to prevent --- space leaks. +{- | Push an element onto the end of the builder. This +is not strict in the element, so force it before pushing +it on to the builder if doing so is needed to prevent +space leaks. +-} push :: - a -- ^ Element to push onto the end - -> Builder s a -- ^ Builder, do not reuse this after pushing onto it - -> ST s (Builder s a) -- ^ New builder + -- | Element to push onto the end + a -> + -- | Builder, do not reuse this after pushing onto it + Builder s a -> + -- | New builder + ST s (Builder s a) push a (Builder marr off len cs) = case len > 0 of True -> do writeSmallArray marr off a @@ -75,9 +80,10 @@ push a (Builder marr off len cs) = case len > 0 of -- A 254-element SmallArray on a 64-bit platform uses -- exactly 4KB (header + ptrs + payload). nextLength :: Int -> Int -nextLength i = if i < maxElementCount - smallArrayHeaderWords - then i * 2 + smallArrayHeaderWords - else maxElementCount - smallArrayHeaderWords +nextLength i = + if i < maxElementCount - smallArrayHeaderWords + then i * 2 + smallArrayHeaderWords + else maxElementCount - smallArrayHeaderWords maxElementCount :: Int maxElementCount = div 4096 (sizeOf (undefined :: Int)) @@ -88,16 +94,17 @@ initialLength = 16 - smallArrayHeaderWords smallArrayHeaderWords :: Int smallArrayHeaderWords = 2 --- | Convert a 'Builder' to 'Chunks'. The 'Builder' must not --- be reused after this operation. +{- | Convert a 'Builder' to 'Chunks'. The 'Builder' must not +be reused after this operation. +-} freeze :: - Builder s a -- ^ Builder, do not reuse after freezing - -> ST s (Chunks a) + -- | Builder, do not reuse after freezing + Builder s a -> + ST s (Chunks a) freeze (Builder marr off _ cs) = do arr <- unsafeShrinkAndFreeze marr off pure $! C.reverseOnto (ChunksCons arr ChunksNil) cs errorThunk :: a -{-# noinline errorThunk #-} +{-# NOINLINE errorThunk #-} errorThunk = error "array-builder:Data.Builder.ST: error" - diff --git a/test/Main.hs b/test/Main.hs index f58802b..6e4048d 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,68 +1,81 @@ -{-# language BangPatterns #-} -{-# language PatternSynonyms #-} -{-# language ScopedTypeVariables #-} -{-# language TypeApplications #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} -import Data.Builder (singleton,doubleton,tripleton,run) -import Test.Tasty (defaultMain,testGroup,TestTree) -import Test.Tasty.HUnit ((@=?)) -import Data.Semigroup (stimes) +import Data.Builder (doubleton, run, singleton, tripleton) import Data.Builder.Catenable (pattern (:<), pattern (:>)) +import Data.Semigroup (stimes) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit ((@=?)) import qualified Data.Builder.Catenable as Cat -import qualified Data.List as L import qualified Data.Foldable as F +import qualified Data.List as L import qualified Test.Tasty.HUnit as THU main :: IO () main = defaultMain tests tests :: TestTree -tests = testGroup "Tests" - [ testGroup "Data.Builder" - [ THU.testCase "A" $ "ABCDEF" @=? - ( F.toList $ run - ( singleton 'A' - <> singleton 'B' - <> singleton 'C' - <> singleton 'D' - <> singleton 'E' - <> singleton 'F' - ) - ) - , THU.testCase "B" $ "ABCCCCCCCCCCCCCCCD" @=? - ( F.toList $ run - ( singleton 'A' - <> singleton 'B' - <> stimes (15 :: Int) (singleton 'C') - <> singleton 'D' - ) - ) - , THU.testCase "C" $ (L.replicate 500 'X') @=? - (F.toList $ run (stimes (500 :: Int) (singleton 'X'))) - , THU.testCase "D" $ "ACDCDCDCDCDCDCDCDCDX" @=? - ( F.toList $ run - ( singleton 'A' - <> stimes (9 :: Int) (doubleton 'C' 'D') - <> singleton 'X' - ) - ) - , THU.testCase "E" $ "ABCABCABCABCABCABCABCX" @=? - ( F.toList $ run - ( stimes (7 :: Int) (tripleton 'A' 'B' 'C') - <> singleton 'X' - ) - ) - ] - , testGroup "Data.Builder.Catenable" - [ THU.testCase "A" $ "ABCDEF" @=? - ( F.toList $ Cat.run - ( ('A' :< 'B' :< 'C' :< mempty) - <> - (mempty :> 'D' :> 'E' :> 'F') - ) - ) - , THU.testCase "B" $ "DEF" @=? - (F.toList $ Cat.run (mempty :> 'D' :> 'E' :> 'F')) +tests = + testGroup + "Tests" + [ testGroup + "Data.Builder" + [ THU.testCase "A" $ + "ABCDEF" + @=? ( F.toList $ + run + ( singleton 'A' + <> singleton 'B' + <> singleton 'C' + <> singleton 'D' + <> singleton 'E' + <> singleton 'F' + ) + ) + , THU.testCase "B" $ + "ABCCCCCCCCCCCCCCCD" + @=? ( F.toList $ + run + ( singleton 'A' + <> singleton 'B' + <> stimes (15 :: Int) (singleton 'C') + <> singleton 'D' + ) + ) + , THU.testCase "C" $ + (L.replicate 500 'X') + @=? (F.toList $ run (stimes (500 :: Int) (singleton 'X'))) + , THU.testCase "D" $ + "ACDCDCDCDCDCDCDCDCDX" + @=? ( F.toList $ + run + ( singleton 'A' + <> stimes (9 :: Int) (doubleton 'C' 'D') + <> singleton 'X' + ) + ) + , THU.testCase "E" $ + "ABCABCABCABCABCABCABCX" + @=? ( F.toList $ + run + ( stimes (7 :: Int) (tripleton 'A' 'B' 'C') + <> singleton 'X' + ) + ) + ] + , testGroup + "Data.Builder.Catenable" + [ THU.testCase "A" $ + "ABCDEF" + @=? ( F.toList $ + Cat.run + ( ('A' :< 'B' :< 'C' :< mempty) + <> (mempty :> 'D' :> 'E' :> 'F') + ) + ) + , THU.testCase "B" $ + "DEF" + @=? (F.toList $ Cat.run (mempty :> 'D' :> 'E' :> 'F')) + ] ] - ]