arith-encode 0.6.0 → 0.7.0
raw patch · 2 files changed
+211/−6 lines, 2 filesdep +binary
Dependencies added: binary
Files
- arith-encode.cabal +7/−6
- src/Data/ArithEncode/Binary.hs +204/−0
arith-encode.cabal view
@@ -1,11 +1,11 @@ Name: arith-encode-Category: Testing, Test, Serialization, Data-Version: 0.6.0+Category: Data, Serialization, Test, Testing+Version: 0.7.0 License: BSD3 License-File: LICENSE Author: Eric McCorkle Maintainer: Eric McCorkle <emc2@metricspace.net>-Stability: Pre-alpha+Stability: Beta Synopsis: A practical arithmetic encoding (aka Godel numbering) library. Homepage: https://github.com/emc2/arith-encode Bug-Reports: https://github.com/emc2/arith-encode/issues@@ -20,7 +20,7 @@ This has various uses, among them binary serialization/deserialization and enumeration testing. .- This is the first release candidate for 1.0 (the initial release).+ This is the second release candidate for 1.0 (initial release). Build-type: Simple Cabal-version: >= 1.16 @@ -34,14 +34,15 @@ Main-Is: UnitTest.hs hs-source-dirs: src test build-depends: base >= 4.4.0 && < 5, Cabal >= 1.16.0, HUnit-Plus, containers,- unordered-containers, array, hashable, fgl, arithmoi+ unordered-containers, array, hashable, fgl, arithmoi, binary ghc-options: -fhpc Library default-language: Haskell2010 hs-source-dirs: src build-depends: base >= 4.4.0 && < 5, Cabal >= 1.16.0, containers,- unordered-containers, array, hashable, fgl, arithmoi+ unordered-containers, array, hashable, fgl, arithmoi, binary exposed-modules: Data.ArithEncode Data.ArithEncode.Basic+ Data.ArithEncode.Binary Data.ArithEncode.Util
+ src/Data/ArithEncode/Binary.hs view
@@ -0,0 +1,204 @@+-- Copyright (c) 2014 Eric McCorkle. 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 any contributors+-- may be used to endorse or promote products derived from this software+-- without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS 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 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.+{-# OPTIONS_GHC -Wall -Werror #-}++-- | Facilities for using @Encoding@s as binary serializers. The+-- resulting binary format is, for the most part, determined by the+-- @Encoding@, and therefore is within a constant factor of+-- succintness.+--+-- In all cases, little-endian byte ordering is used in order to allow+-- for very large data to be read in an decoded lazily. (Note:+-- Haskell's libraries do not provide support for this functionality+-- at this time).+--+-- For finite @Encoding@s, the binary format is just the little-endian+-- encoding of the encoded value, using as few bytes as necessary to+-- represent the largest encoded value.+--+-- For infinite @Encoding@s, the binary format includes a length field+-- for most values. The current encoding uses length fields of+-- different sizes, depending on the size of the encoded value.+module Data.ArithEncode.Binary(+ getWithEncoding,+ putWithEncoding+ ) where++import Data.ArithEncode.Basic+import Data.Binary.Put+import Data.Binary.Get hiding (remaining)+import Data.Bits+import Math.NumberTheory.Logarithms++-- Read in a natural number as a sequence of some number of bytes+getNatural :: Int -> Get Integer+getNatural bytes =+ let+ getNatural' :: Integer -> Int -> Get Integer+ getNatural' accum count+ | count + 8 < bytes =+ do+ input <- getWord64le+ getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum) (count + 8)+ | count + 4 < bytes =+ do+ input <- getWord32le+ getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum) (count + 4)+ | count + 2 < bytes =+ do+ input <- getWord16le+ getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum) (count + 2)+ | count < bytes =+ do+ input <- getWord8+ getNatural' ((toInteger input `shiftL` (count * 8)) .|. accum) (count + 1)+ | otherwise = return accum+ in+ getNatural' 0 0++-- | Use an @Encoding@ to extract a @ty@ from binary data.+getWithEncoding :: Encoding ty+ -- ^ The encoding to use.+ -> Get ty+getWithEncoding enc =+ case size enc of+ Just 0 -> error "Cannot decode with empty encoding"+ -- For the degenerate case of a singleton, no need to encode anything at all+ Just 1 -> return (decode enc 0)+ -- Otherwise store the natural as a sequence of bytes. We store+ -- this in little-endian order to allow lazy handling of very large+ -- numbers.+ Just finitesize ->+ let+ bytes = ((integerLog2 (finitesize - 1)) `quot` 3) + 1+ in do+ encoded <- getNatural bytes+ return (decode enc encoded)+ -- Arbitrary-length naturals are encoded with a more complex+ -- scheme. The first two bits are a tag, which tells how to+ -- interpret the rest.+ Nothing ->+ do+ firstbyte <- lookAhead getWord8+ encoded <-+ case firstbyte .&. 0x03 of+ -- Naturals less than 64 get packed into the same byte as the tag+ 0x0 ->+ do+ datafield <- getWord8+ return (toInteger (datafield `shiftR` 2))+ -- One-byte length field, and then up to 64 bytes of data+ 0x1 ->+ do+ lenfield <- getWord8+ getNatural (fromIntegral (lenfield `shiftR` 2) + 1)+ -- Two-byte length field, and then up to 16384 bytes of data+ 0x2 ->+ do+ lenfield <- getWord16le+ getNatural (fromIntegral (lenfield `shiftR` 2) + 1)+ -- Eight-byte length field, and then data+ 0x3 ->+ do+ lenfield <- getWord64le+ getNatural (fromIntegral (lenfield `shiftR` 2) + 1)+ _ -> error "Impossible case"+ return (decode enc encoded)++-- Emit a natural number as a sequence of some number of bytes+putNatural :: Int -> Integer -> Put+putNatural 0 0 = return ()+putNatural 0 _ = error "Data remaining at end of encoding"+putNatural remaining natural+ | remaining > 8 =+ let+ output = fromInteger (natural .&. 0xffffffffffffffff)+ rest = natural `shiftR` 64+ in do+ putWord64le output+ putNatural (remaining - 8) rest+ | remaining > 4 =+ let+ output = fromInteger (natural .&. 0xffffffff)+ rest = natural `shiftR` 32+ in do+ putWord32le output+ putNatural (remaining - 4) rest+ | remaining > 2 =+ let+ output = fromInteger (natural .&. 0xffff)+ rest = natural `shiftR` 16+ in do+ putWord16le output+ putNatural (remaining - 2) rest+ | otherwise =+ let+ output = fromInteger (natural .&. 0xff)+ rest = natural `shiftR` 8+ in do+ putWord8 output+ putNatural (remaining - 1) rest++-- | Use an @Encoding@ to write a @ty@ out as binary data.+putWithEncoding :: Encoding ty+ -- ^ The encoding to use.+ -> ty+ -- ^ The value to encode.+ -> Put+putWithEncoding enc val =+ case size enc of+ Just 0 -> error "Cannot encode with empty encoding"+ -- For the degenerate case of a singleton, no need to encode anything at all+ Just 1 -> return ()+ -- Otherwise store the natural as a sequence of bytes. We store+ -- this in little-endian order to allow lazy handling of very large+ -- numbers.+ Just finitesize ->+ let+ bytes = ((integerLog2 (finitesize - 1)) `quot` 3) + 1+ encoded = encode enc val+ in+ putNatural bytes encoded+ Nothing ->+ let+ encoded = encode enc val+ in+ if encoded < 64+ then putWord8 (fromInteger encoded `shiftL` 2)+ else+ let+ bytes = ((integerLog2 (encoded - 1)) `quot` 3) + 1+ in do+ if bytes <= 64+ then putWord8 (fromIntegral (((bytes - 1) `shiftL` 2) .|. 0x1))+ else if bytes <= 16384+ then putWord16le (fromIntegral (((bytes - 1) `shiftL` 2) .|. 0x2))+ else putWord64le (fromIntegral (((bytes - 1) `shiftL` 2) .|. 0x3))+ putNatural bytes encoded