packages feed

blaze-textual-native (empty) → 0.2.1

raw patch · 9 files changed

+559/−0 lines, 9 filesdep +basedep +blaze-builderdep +bytestringsetup-changed

Dependencies added: base, blaze-builder, bytestring, double-conversion, ghc-prim, integer, integer-gmp, old-locale, text, time, vector

Files

+ Blaze/Text.hs view
@@ -0,0 +1,9 @@+module Blaze.Text+    (+      float+    , double+    , integral+    ) where++import Blaze.Text.Double+import Blaze.Text.Int
+ Blaze/Text/Double.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP #-}++-- Module:      Blaze.Text.Double+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently serialize a Double as a lazy 'L.ByteString'.++module Blaze.Text.Double+    (+      float+    , double+    ) where++#ifdef NATIVE+import Blaze.Text.Double.Native+#else+import Blaze.ByteString.Builder (Builder, fromByteString)+import Data.Double.Conversion.ByteString (toShortest)++float :: Float -> Builder+float = double . realToFrac++double :: Double -> Builder+double f = fromByteString (toShortest f)+#endif
+ Blaze/Text/Double/Native.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}++-- Module:      Blaze.Text.Double.Native+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently serialize a Double as a lazy 'L.ByteString'.++module Blaze.Text.Double.Native+    (+      float+    , double+    ) where++import Blaze.ByteString.Builder (Builder, fromByteString)+import Blaze.ByteString.Builder.Char8 (fromChar)+import Blaze.Text.Int (digit, integral, minus)+import Data.ByteString.Char8 ()+import Data.Monoid (mappend, mconcat, mempty)+import qualified Data.Vector as V++-- The code below is originally from GHC.Float, but has been optimised+-- in quite a few ways.++data T = T [Int] {-# UNPACK #-} !Int++float :: Float -> Builder+float = double . realToFrac++double :: Double -> Builder+double f+    | isInfinite f              = fromByteString $+                                  if f > 0 then "Infinity" else "-Infinity"+    | f < 0 || isNegativeZero f = minus `mappend` goGeneric (floatToDigits (-f))+    | f >= 0                    = goGeneric (floatToDigits f)+    | otherwise                 = fromByteString "NaN"+  where+   goGeneric p@(T _ e)+     | e < 0 || e > 7 = goExponent p+     | otherwise      = goFixed    p+   goExponent (T is e) =+       case is of+         []     -> error "putFormattedFloat"+         [0]    -> fromByteString "0.0e0"+         [d]    -> digit d `mappend` fromByteString ".0e" `mappend` integral (e-1)+         (d:ds) -> digit d `mappend` fromChar '.' `mappend` digits ds `mappend`+                   fromChar 'e' `mappend` integral (e-1)+   goFixed (T is e)+       | e <= 0    = fromChar '0' `mappend` fromChar '.' `mappend`+                     mconcat (replicate (-e) (fromChar '0')) `mappend`+                     digits is+       | otherwise = let g 0 rs     = fromChar '.' `mappend` mk0 rs+                         g n []     = fromChar '0' `mappend` g (n-1) []+                         g n (r:rs) = digit r `mappend` g (n-1) rs+                     in g e is+   mk0 [] = fromChar '0'+   mk0 rs = digits rs++digits :: [Int] -> Builder+digits (d:ds) = digit d `mappend` digits ds+digits _      = mempty+{-# INLINE digits #-}++floatToDigits :: Double -> T+floatToDigits 0 = T [0] 0+floatToDigits x = T (reverse rds) k+ where+  (f0, e0)     = decodeFloat x+  (minExp0, _) = floatRange (undefined::Double)+  p = floatDigits x+  b = floatRadix x+  minExp = minExp0 - p -- the real minimum exponent+  -- Haskell requires that f be adjusted so denormalized numbers+  -- will have an impossibly low exponent.  Adjust for this.+  (# f, e #) =+   let n = minExp - e0 in+   if n > 0 then (# f0 `div` (b^n), e0+n #) else (# f0, e0 #)+  (# r, s, mUp, mDn #) =+   if e >= 0+   then let be = b^ e+        in if f == b^(p-1)+           then (# f*be*b*2, 2*b, be*b, b #)+           else (# f*be*2, 2, be, be #)+   else if e > minExp && f == b^(p-1)+        then (# f*b*2, b^(-e+1)*2, b, 1 #)+        else (# f*2, b^(-e)*2, 1, 1 #)+  k = fixup k0+   where+    k0 | b == 2 = (p - 1 + e0) * 3 `div` 10+        -- logBase 10 2 is slightly bigger than 3/10 so the following+        -- will err on the low side.  Ignoring the fraction will make+        -- it err even more.  Haskell promises that p-1 <= logBase b f+        -- < p.+       | otherwise = ceiling ((log (fromInteger (f+1) :: Double) ++                               fromIntegral e * log (fromInteger b)) / log 10)+    fixup n+      | n >= 0    = if r + mUp <= exp10 n * s then n else fixup (n+1)+      | otherwise = if exp10 (-n) * (r + mUp) <= s then n else fixup (n+1)++  gen ds !rn !sN !mUpN !mDnN =+   let (dn0, rn') = (rn * 10) `divMod` sN+       mUpN' = mUpN * 10+       mDnN' = mDnN * 10+       !dn   = fromInteger dn0+       !dn'  = dn + 1+   in case (# rn' < mDnN', rn' + mUpN' > sN #) of+        (# True,  False #) -> dn : ds+        (# False, True #)  -> dn' : ds+        (# True,  True #)  -> if rn' * 2 < sN then dn : ds else dn' : ds+        (# False, False #) -> gen (dn:ds) rn' sN mUpN' mDnN'++  rds | k >= 0    = gen [] r (s * exp10 k) mUp mDn+      | otherwise = gen [] (r * bk) s (mUp * bk) (mDn * bk)+      where bk = exp10 (-k)+                    +exp10 :: Int -> Integer+exp10 n+    | n >= 0 && n < maxExpt = V.unsafeIndex expts n+    | otherwise             = 10 ^ n+  where expts = V.generate maxExpt (10^)+        {-# NOINLINE expts #-}+        maxExpt = 17+{-# INLINE exp10 #-}
+ Blaze/Text/Int.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}++-- Module:      Blaze.Text.Int+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently serialize an integral value as a lazy 'L.ByteString'.++module Blaze.Text.Int+    (+      digit+    , integral+    , minus+    ) where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+import Data.ByteString.Char8 ()+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid (mappend, mempty)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import GHC.Base (quotInt, remInt)+import GHC.Num (quotRemInteger)+import GHC.Types (Int(..))++#ifdef  __GLASGOW_HASKELL__+# if __GLASGOW_HASKELL__ < 611+import GHC.Integer.Internals+# else+import GHC.Integer.GMP.Internals+# endif+#endif++#ifdef INTEGER_GMP+# define PAIR(a,b) (# a,b #)+#else+# define PAIR(a,b) (a,b)+#endif++integral :: Integral a => a -> Builder+{-# RULES "integral/Int" integral = bounded :: Int -> Builder #-}+{-# RULES "integral/Int8" integral = bounded :: Int8 -> Builder #-}+{-# RULES "integral/Int16" integral = bounded :: Int16 -> Builder #-}+{-# RULES "integral/Int32" integral = bounded :: Int32 -> Builder #-}+{-# RULES "integral/Int64" integral = bounded :: Int64 -> Builder #-}+{-# RULES "integral/Word" integral = nonNegative :: Word -> Builder #-}+{-# RULES "integral/Word8" integral = nonNegative :: Word8 -> Builder #-}+{-# RULES "integral/Word16" integral = nonNegative :: Word16 -> Builder #-}+{-# RULES "integral/Word32" integral = nonNegative :: Word32 -> Builder #-}+{-# RULES "integral/Word64" integral = nonNegative :: Word64 -> Builder #-}+{-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-}++-- This definition of the function is here PURELY to be used by ghci+-- and those rare cases where GHC is being invoked without+-- optimization, as otherwise the rewrite rules above should fire. The+-- test for "-0" catches an overflow if we render minBound.+integral i+    | i >= 0                 = nonNegative i+    | toByteString b == "-0" = fromString (show i)+    | otherwise              = b+  where b = minus `mappend` nonNegative (-i)++bounded :: (Bounded a, Integral a) => a -> Builder+{-# SPECIALIZE bounded :: Int -> Builder #-}+{-# SPECIALIZE bounded :: Int8 -> Builder #-}+{-# SPECIALIZE bounded :: Int16 -> Builder #-}+{-# SPECIALIZE bounded :: Int32 -> Builder #-}+{-# SPECIALIZE bounded :: Int64 -> Builder #-}+bounded i+    | i >= 0        = nonNegative i+    | i > minBound  = minus `mappend` nonNegative (-i)+    | otherwise     = minus `mappend`+                      nonNegative (negate (k `quot` 10)) `mappend`+                      digit (negate (k `rem` 10))+  where k = minBound `asTypeOf` i++nonNegative :: Integral a => a -> Builder+{-# SPECIALIZE nonNegative :: Int -> Builder #-}+{-# SPECIALIZE nonNegative :: Int8 -> Builder #-}+{-# SPECIALIZE nonNegative :: Int16 -> Builder #-}+{-# SPECIALIZE nonNegative :: Int32 -> Builder #-}+{-# SPECIALIZE nonNegative :: Int64 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word -> Builder #-}+{-# SPECIALIZE nonNegative :: Word8 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word16 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word32 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word64 -> Builder #-}+nonNegative = go+  where+    go n | n < 10    = digit n+         | otherwise = go (n `quot` 10) `mappend` digit (n `rem` 10)++digit :: Integral a => a -> Builder+digit n = fromWord8 $! fromIntegral n + 48+{-# INLINE digit #-}++minus :: Builder+minus = fromWord8 45++int :: Int -> Builder+int = integral+{-# INLINE int #-}++integer :: Integer -> Builder+integer (S# i#) = int (I# i#)+integer i+    | i < 0     = minus `mappend` go (-i)+    | otherwise = go i+  where+    go n | n < maxInt = int (fromInteger n)+         | otherwise  = putH (splitf (maxInt * maxInt) n)++    splitf p n+      | p > n       = [n]+      | otherwise   = splith p (splitf (p*p) n)++    splith p (n:ns) = case n `quotRemInteger` p of+                        PAIR(q,r) | q > 0     -> q : r : splitb p ns+                                  | otherwise -> r : splitb p ns+    splith _ _      = error "splith: the impossible happened."++    splitb p (n:ns) = case n `quotRemInteger` p of+                        PAIR(q,r) -> q : r : splitb p ns+    splitb _ _      = []++data T = T !Integer !Int++fstT :: T -> Integer+fstT (T a _) = a++maxInt :: Integer+maxDigits :: Int+T maxInt maxDigits =+    until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)+  where mi = fromIntegral (maxBound :: Int)++putH :: [Integer] -> Builder+putH (n:ns) = case n `quotRemInteger` maxInt of+                PAIR(x,y)+                    | q > 0     -> int q `mappend` pblock r `mappend` putB ns+                    | otherwise -> int r `mappend` putB ns+                    where q = fromInteger x+                          r = fromInteger y+putH _ = error "putH: the impossible happened"++putB :: [Integer] -> Builder+putB (n:ns) = case n `quotRemInteger` maxInt of+                PAIR(x,y) -> pblock q `mappend` pblock r `mappend` putB ns+                    where q = fromInteger x+                          r = fromInteger y+putB _ = mempty++pblock :: Int -> Builder+pblock = go maxDigits+  where+    go !d !n+        | d == 1    = digit n+        | otherwise = go (d-1) q `mappend` digit r+        where q = n `quotInt` 10+              r = n `remInt` 10
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011, MailRank, Inc.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.
+ README.markdown view
@@ -0,0 +1,72 @@+# Welcome to blaze-textual++blaze-textual is a fast Haskell library for rendering common Haskell+datatypes in text form using the+[blaze-builder](http://hackage.haskell.org/package/blaze-builder)+library.++# Important note for users of GHCi and Template Haskell++To achieve excellent performance for rendering floating point numbers,+this package uses the+[double-conversion](http://hackage.haskell.org/package/double-conversion)+package.++Unfortunately, due to bugs in GHC, some uses of GHCi and Template+Haskell can crash if this package is loaded.++* [5289: Can't use ghci with a library linked against+  libstdc++](http://hackage.haskell.org/trac/ghc/ticket/5289) (fixed+  in GHC 7.2.1).++* [5386: GHCi crashes with SIGFPE when using double-conversion+  package](http://hackage.haskell.org/trac/ghc/ticket/5386) (not yet+  fixed at the time of writing)++If you are affected by these problems, you should expect the 5289+crash to look like this:++    Loading package double-conversion-0.2.0.0 ... can't load .so/.DLL for: stdc++++The 5386 crash causes GHCi to die with a floating point exception+(SIGFPE).++To work around these bugs, this package includes an alternative,+slower, floating point conversion that is written in pure Haskell.+Because it is 10 times slower than the double-conversion package, it+is not the default.++To use it, reinstall this package by passing the `native` flag to+`cabal`:++    cabal install -fnative++Afterwards, you will also need to reinstall any downstream packages+that depend on this one, e.g. the [aeson JSON+library](http://hackage.haskell.org/package/aeson):++    cabal install aeson --reinstall++# Join in!++We are happy to receive bug reports, fixes, documentation+enhancements, and other improvements.++Please report bugs via the+[github issue tracker](http://github.com/mailrank/blaze-textual/issues).++Master [git repository](http://github.com/mailrank/blaze-textual):++* `git clone git://github.com/mailrank/blaze-textual.git`++There's also a [Mercurial mirror](http://bitbucket.org/bos/blaze-textual):++* `hg clone http://bitbucket.org/bos/blaze-textual`++(You can create and contribute changes using either git or Mercurial.)++Authors+-------++This library is written and maintained by Bryan O'Sullivan,+<bos@mailrank.com>.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ blaze-textual-native.cabal view
@@ -0,0 +1,81 @@+name:            blaze-textual-native+version:         0.2.1+license:         BSD3+license-file:    LICENSE+category:        Text+copyright:       Copyright 2011 MailRank, Inc.+author:          Bryan O'Sullivan <bos@mailrank.com>+maintainer:      Bryan O'Sullivan <bos@mailrank.com>+stability:       experimental+synopsis:        Fast rendering of common datatypes+cabal-version:   >= 1.8+homepage:        http://github.com/mailrank/blaze-textual+bug-reports:     http://github.com/mailrank/blaze-textual/issues+build-type:      Simple+description:+    A library for efficiently rendering Haskell datatypes to+    bytestrings.+    .+    /Note/: if you use GHCi or Template Haskell, please see the+    @README@ file for important details about building this package,+    and other packages that depend on it:+    <https://github.com/mailrank/blaze-textual#readme>++extra-source-files:+    README.markdown+    tests/*.hs++flag developer+  description: operate in developer mode+  default: False++flag native+  description: use slow native code for double conversion+  default: True++library+  exposed-modules:+    Blaze.Text+    Blaze.Text.Double+    Blaze.Text.Int++  if flag(native)+    other-modules: Blaze.Text.Double.Native++  build-depends:+    base == 4.*,+    blaze-builder >= 0.2.1.4,+    bytestring,+    ghc-prim,+    old-locale,+    text >= 0.11.0.2,+    time,+    vector++  if !flag(native)+    build-depends:+      double-conversion >= 0.2.0.1++  if flag(developer)+    ghc-prof-options: -auto-all++  if flag(native)+    cpp-options: -DNATIVE++  ghc-options:      -Wall++  if impl(ghc >= 6.11)+    cpp-options: -DINTEGER_GMP+    build-depends: integer-gmp >= 0.2 && < 0.4++  if impl(ghc >= 6.9) && impl(ghc < 6.11)+    cpp-options: -DINTEGER_GMP+    build-depends: integer >= 0.1 && < 0.2++source-repository head+  type:     git+  location: http://github.com/mailrank/blaze-textual++source-repository head+  type:     mercurial+  location: http://bitbucket.org/bos/blaze-textual
+ tests/QC.hs view
@@ -0,0 +1,46 @@+module Main (main) where++import Blaze.ByteString.Builder (Builder, toByteString)+import Blaze.Text (double, float, integral)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import qualified Data.ByteString.Char8 as B++-- Integral values should be rendered exactly as Haskell does.+t_integral :: Integral a => a -> a -> Bool+t_integral _ i = toByteString (integral i) == B.pack (show i)++-- This package doesn't render floating point numbers exactly as+-- Haskell does, but the numbers it renders should read back exactly.+-- So that's the property we check.+t_real :: (RealFloat a, Read a) => (a -> Builder) -> a -> a -> Bool+t_real f i j =+    case read (B.unpack . toByteString . f $ ij) of+      r | isNaN r      -> isNaN ij+        | isInfinite r -> isInfinite ij && signum r == signum ij+        | otherwise    -> r == ij+  where ij = i / j++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests = [+    testGroup "int" [ testProperty "Integer" $ t_integral (undefined::Integer)+                    , testProperty "Int" $ t_integral (undefined::Int)+                    , testProperty "Int8" $ t_integral (undefined::Int8)+                    , testProperty "Int16" $ t_integral (undefined::Int16)+                    , testProperty "Int32" $ t_integral (undefined::Int32)+                    , testProperty "Int64" $ t_integral (undefined::Int64)+                    ]+  , testGroup "word" [ testProperty "Word" $ t_integral (undefined::Word)+                     , testProperty "Word8" $ t_integral (undefined::Word8)+                     , testProperty "Word16" $ t_integral (undefined::Word16)+                     , testProperty "Word32" $ t_integral (undefined::Word32)+                     , testProperty "Word64" $ t_integral (undefined::Word64)+                     ]+  , testProperty "Double" $ t_real double+  , testProperty "Float" $ t_real float+  ]