Initial commit

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2013, Bas van Dijk
+
+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 Bas van Dijk 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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

bench/bench.hs

@@ -0,0 +1,96 @@
+module Main where
+
+import Criterion.Main
+import Data.Scientific
+
+main :: IO ()
+main = defaultMain
+       [ bgroup "realToFrac"
+         [ bgroup "Scientific->Double"
+           [ sToD "pos"    pos
+           , sToD "neg"    neg
+           , sToD "int"    int
+           , sToD "negInt" negInt
+           ]
+         , bgroup "Double->Scientific"
+           [ dToS "pos"    pos
+           , dToS "neg"    neg
+           , dToS "int"    int
+           , dToS "negInt" negInt
+           ]
+         ]
+       , bgroup "floor"
+         [ bench "floor"        (nf (floor :: Scientific -> Integer) $! pos)
+         , bench "floorDefault" (nf floorDefault                     $! pos)
+         ]
+       , bgroup "ceiling"
+         [ bench "ceiling"        (nf (ceiling :: Scientific -> Integer) $! pos)
+         , bench "ceilingDefault" (nf ceilingDefault                     $! pos)
+         ]
+       , bgroup "truncate"
+         [ bench "truncate"        (nf (truncate :: Scientific -> Integer) $! pos)
+         , bench "truncateDefault" (nf truncateDefault                     $! pos)
+         ]
+
+       , bgroup "round"
+         [ bench "round"        (nf (round :: Scientific -> Integer) $! pos)
+         , bench "roundDefault" (nf roundDefault                     $! pos)
+         ]
+       ]
+    where
+      pos :: Fractional a => a
+      pos = 12345.12345
+
+      neg :: Fractional a => a
+      neg = -pos
+
+      int :: Fractional a => a
+      int = 12345
+
+      negInt :: Fractional a => a
+      negInt = -int
+
+realToFracStoD :: Scientific -> Double
+realToFracStoD = fromRational . toRational
+{-# INLINE realToFracStoD #-}
+
+realToFracDtoS :: Double -> Scientific
+realToFracDtoS = fromRational . toRational
+{-# INLINE realToFracDtoS #-}
+
+
+sToD :: String -> Scientific -> Benchmark
+sToD name f = bgroup name
+              [ bench "fromScientific" . nf (realToFrac     :: Scientific -> Double) $! f
+              , bench "via Rational"   . nf (realToFracStoD :: Scientific -> Double) $! f
+              ]
+
+dToS :: String -> Double -> Benchmark
+dToS name f = bgroup name
+              [ bench "fromRealFloat"  . nf (realToFrac     :: Double -> Scientific) $! f
+              , bench "via Rational"   . nf (realToFracDtoS :: Double -> Scientific) $! f
+              ]
+
+floorDefault :: Scientific -> Integer
+floorDefault x = if r < 0 then n - 1 else n
+                 where (n,r) = properFraction x
+{-# INLINE floorDefault #-}
+
+ceilingDefault :: Scientific -> Integer
+ceilingDefault x = if r > 0 then n + 1 else n
+                   where (n,r) = properFraction x
+{-# INLINE ceilingDefault #-}
+
+truncateDefault :: Scientific -> Integer
+truncateDefault x =  m where (m,_) = properFraction x
+{-# INLINE truncateDefault #-}
+
+roundDefault :: Scientific -> Integer
+roundDefault x = let (n,r) = properFraction x
+                     m     = if r < 0 then n - 1 else n + 1
+                 in case signum (abs r - 0.5) of
+                      -1 -> n
+                      0  -> if even n then n else m
+                      1  -> m
+                      _  -> error "round default defn: Bad value"
+{-# INLINE roundDefault #-}

scientific.cabal

@@ -0,0 +1,63 @@
+name:                scientific
+version:             0.0.0.0
+synopsis:            Arbitrary-precision floating-point numbers represented using scientific notation
+description:         A @Scientific@ number is an arbitrary-precision floating-point number
+                     represented using scientific notation.
+                     .
+                     A scientific number with 'coefficient' @c@ and
+                     'base10Exponent' @e@ corresponds to the
+                     'Fractional' number: @'fromInteger' c * 10 '^^' e@
+                     .
+                     Its primary use-case is to serve as the target of
+                     parsing floating point numbers. Since the textual
+                     representation of floating point numbers use
+                     scientific notation they can be efficiently
+                     parsed to a @Scientific@ number.
+homepage:            https://github.com/basvandijk/scientific
+bug-reports:         https://github.com/basvandijk/scientific/issues
+license:             BSD3
+license-file:        LICENSE
+author:              Bas van Dijk
+maintainer:          Bas van Dijk <[email protected]>
+category:            Data
+build-type:          Simple
+cabal-version:       >=1.10
+
+source-repository head
+  type:     git
+  location: git://github.com/basvandijk/scientific.git
+
+library
+  exposed-modules:     Data.Scientific
+  other-extensions:    DeriveDataTypeable, BangPatterns
+  ghc-options:         -Wall
+  build-depends:       base     >= 4.6   && < 4.7
+                     , deepseq  >= 1.3   && < 1.4
+                     , text     >= 0.8   && < 0.12
+                     , hashable >= 1.1.2 && < 1.3
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+test-suite test-scientific
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          test.hs
+  default-language: Haskell2010
+  ghc-options:      -Wall
+
+  build-depends: scientific
+               , base             >= 4.6   && < 4.7
+               , tasty            >= 0.3.1 && < 0.4
+               , tasty-smallcheck >= 0.2   && < 0.3
+               , smallcheck       >= 1.0   && < 1.1
+               , text             >= 0.8   && < 0.12
+
+benchmark bench-scientific
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   bench
+  main-is:          bench.hs
+  default-language: Haskell2010
+  ghc-options:      -O2
+  build-depends:    scientific
+                  , base       >= 4.6 && < 4.7
+                  , criterion  >= 0.5 && < 0.9