diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for binary-ieee754 + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/Data/Binary/IEEE754.hs b/Data/Binary/IEEE754.hs new file mode 100644 --- /dev/null +++ b/Data/Binary/IEEE754.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} + +-- | This module backports ieee754 double/float combinators from binary 0.8.4 to older +-- version, and simply re-export these combinators for binary >= 0.8.4. You can safely +-- import this module alongside "Data.Binary.Get" and "Data.Binary.Put". +-- +-- Implements casting via a 1-elemnt STUArray, as described in +-- . +-- +module Data.Binary.IEEE754 + ( -- * Double/Float Word cast + floatToWord + , wordToFloat + , doubleToWord + , wordToDouble + -- * Double/Floats Get + , getFloatbe + , getFloatle + , getFloathost + , getDoublebe + , getDoublele + , getDoublehost + -- * Double/Floats Put + , putFloatbe + , putFloatle + , putFloathost + , putDoublebe + , putDoublele + , putDoublehost + ) where + +import Data.Word (Word32, Word64) +import Data.Array.ST (newArray, readArray, MArray, STUArray) +import Data.Array.Unsafe (castSTUArray) +import GHC.ST (runST, ST) +import Data.Binary.Get +import Data.Binary.Put +import Control.Applicative ((<$>)) + +------------------------------------------------------------------------ +-- Double/Float Word cast + +-- | Reinterpret-casts a `Float` to a `Word32`. +floatToWord :: Float -> Word32 +floatToWord x = runST (cast x) +{-# INLINE floatToWord #-} + +-- | Reinterpret-casts a `Word32` to a `Float`. +wordToFloat :: Word32 -> Float +wordToFloat x = runST (cast x) +{-# INLINE wordToFloat #-} + +-- | Reinterpret-casts a `Double` to a `Word64`. +doubleToWord :: Double -> Word64 +doubleToWord x = runST (cast x) +{-# INLINE doubleToWord #-} + +-- | Reinterpret-casts a `Word64` to a `Double`. +wordToDouble :: Word64 -> Double +wordToDouble x = runST (cast x) +{-# INLINE wordToDouble #-} + +cast :: (MArray (STUArray s) a (ST s), + MArray (STUArray s) b (ST s)) => a -> ST s b +cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0 +{-# INLINE cast #-} + +#if !(MIN_VERSION_binary(0,8,4)) + +------------------------------------------------------------------------ +-- Double/Float Get + +-- | Read a 'Float' in big endian IEEE-754 format. +getFloatbe :: Get Float +getFloatbe = wordToFloat <$> getWord32be +{-# INLINE getFloatbe #-} + +-- | Read a 'Float' in little endian IEEE-754 format. +getFloatle :: Get Float +getFloatle = wordToFloat <$> getWord32le +{-# INLINE getFloatle #-} + +-- | Read a 'Float' in IEEE-754 format and host endian. +getFloathost :: Get Float +getFloathost = wordToFloat <$> getWord32host +{-# INLINE getFloathost #-} + +-- | Read a 'Double' in big endian IEEE-754 format. +getDoublebe :: Get Double +getDoublebe = wordToDouble <$> getWord64be +{-# INLINE getDoublebe #-} + +-- | Read a 'Double' in little endian IEEE-754 format. +getDoublele :: Get Double +getDoublele = wordToDouble <$> getWord64le +{-# INLINE getDoublele #-} + +-- | Read a 'Double' in IEEE-754 format and host endian. +getDoublehost :: Get Double +getDoublehost = wordToDouble <$> getWord64host +{-# INLINE getDoublehost #-} + +------------------------------------------------------------------------ +-- Double/Floats Put + +-- | Write a 'Float' in big endian IEEE-754 format. +putFloatbe :: Float -> Put +putFloatbe = putWord32be . floatToWord +{-# INLINE putFloatbe #-} + +-- | Write a 'Float' in little endian IEEE-754 format. +putFloatle :: Float -> Put +putFloatle = putWord32le . floatToWord +{-# INLINE putFloatle #-} + +-- | Write a 'Float' in native in IEEE-754 format and host endian. +putFloathost :: Float -> Put +putFloathost = putWord32host . floatToWord +{-# INLINE putFloathost #-} + +-- | Write a 'Double' in big endian IEEE-754 format. +putDoublebe :: Double -> Put +putDoublebe = putWord64be . doubleToWord +{-# INLINE putDoublebe #-} + +-- | Write a 'Double' in little endian IEEE-754 format. +putDoublele :: Double -> Put +putDoublele = putWord64le . doubleToWord +{-# INLINE putDoublele #-} + +-- | Write a 'Double' in native in IEEE-754 format and host endian. +putDoublehost :: Double -> Put +putDoublehost = putWord64host . doubleToWord +{-# INLINE putDoublehost #-} + +#endif diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Winterland + +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 Winterland 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,7 @@ +binary-ieee754 +============== + +[![Hackage](https://img.shields.io/hackage/v/binary-ieee754.svg?style=flat)](http://hackage.haskell.org/package/binary-ieee754) +[![Build Status](https://travis-ci.org/winterland1989/binary-ieee754.svg)](https://travis-ci.org/winterland1989/binary-ieee754) + +This package backports ieee754 double/float combinators from [binary](http://hackage.haskell.org/package/binary) 0.8.4 to older version, and simply re-export these combinators for binary >= 0.8.4. It's meant for packages which need fast double/float combinators and old binary compatibility. 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/binary-ieee754.cabal b/binary-ieee754.cabal new file mode 100644 --- /dev/null +++ b/binary-ieee754.cabal @@ -0,0 +1,30 @@ +name: binary-ieee754 +version: 0.1.0.0 +synopsis: Backport ieee754 float double combinators to older binary +description: Backport ieee754 float double combinators to older binary +homepage: https://github.com/winterland1989/binary-ieee754 +bug-reports: https://github.com/winterland1989/binary-ieee754/issues +license: BSD3 +license-file: LICENSE +author: Winterland +maintainer: winterland1989@gmail.com +-- copyright: +category: Data +build-type: Simple +extra-source-files: ChangeLog.md, README.md +cabal-version: >=1.10 + +source-repository head + type: git + location: git://github.com/winterland1989/binary-ieee754.git + +library + exposed-modules: Data.Binary.IEEE754 + -- other-modules: + -- other-extensions: + build-depends: base >=4.5 && <5.0 + , array + , binary >= 0.3 + + -- hs-source-dirs: + default-language: Haskell2010