{- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
-}{-# LANGUAGE GeneralizedNewtypeDeriving #-}moduleData.Binary.IEEE754(-- * ParsingparseFloatBE,parseFloatLE,getFloat16be,getFloat16le,getFloat32be,getFloat32le,getFloat64be,getFloat64le,getFloat-- * Serializing,putFloat32be,putFloat32le,putFloat64be,putFloat64le,putFloat-- * Parser implementation,exponentWidth,bitSlice,splitRawIEEE754,unbias,mergeFloat-- * Serializer implementation,bias,encodeIntBE,encodeIntLE,floatToMerged,mergeFloatBits,floatComponents-- * Useful type aliases,Exponent,Fraction,BitCount,ByteCount)whereimportData.Bits((.&.),(.|.),shiftL,shiftR,Bits)importData.Word(Word8)importData.List(foldl')importqualifiedData.ByteStringasBimportData.Binary.Get(Get,getByteString)importData.Binary.Put(Put,putByteString)----------------------------------------------------------------------- |Parse a big-endian byte list into a floating-point value.parseFloatBE::(RealFloata)=>[Word8]->aparseFloatBE=parseFloat-- |Parse a little-endian byte list into a floating-point value.parseFloatLE::(RealFloata)=>[Word8]->aparseFloatLE=parseFloat.reversegetFloat16be::GetFloatgetFloat16be=getFloat(ByteCount2)parseFloatBEgetFloat16le::GetFloatgetFloat16le=getFloat(ByteCount2)parseFloatLEgetFloat32be::GetFloatgetFloat32be=getFloat(ByteCount4)parseFloatBEgetFloat32le::GetFloatgetFloat32le=getFloat(ByteCount4)parseFloatLEgetFloat64be::GetDoublegetFloat64be=getFloat(ByteCount8)parseFloatBEgetFloat64le::GetDoublegetFloat64le=getFloat(ByteCount8)parseFloatLE-- |Parse a floating-point value of the given width (in bytes) from within-- a Get monad.getFloat::(RealFloata)=>ByteCount->([Word8]->a)->GetagetFloat(ByteCountwidth)parser=dobytes<-getByteStringwidth(return.parser.B.unpack)bytes---------------------------------------------------------------------putFloat32be::Float->PutputFloat32bex=putFloat(ByteCount4)encodeIntBExputFloat32le::Float->PutputFloat32lex=putFloat(ByteCount4)encodeIntLExputFloat64be::Double->PutputFloat64bex=putFloat(ByteCount8)encodeIntBExputFloat64le::Double->PutputFloat64lex=putFloat(ByteCount8)encodeIntLExputFloat::(RealFloata)=>ByteCount->(ByteCount->Integer->[Word8])->a->PutputFloatwidthfv=putByteString$B.packwords'wherewords'=fwidth(floatToMergedwidthv)floatComponents::(RealFloata)=>ByteCount->a->(Bool,Fraction,Exponent)floatComponentswidthv=case(dFraction,dExponent,biasedE)of(0,0,_)->(sign,0,0)(_,_,0)->(sign,truncatedFraction+1,0)_->(sign,truncatedFraction,biasedE)wheredFraction=Fraction$fst(decodeFloatv)dExponent=Exponent$snd(decodeFloatv)eWidth=exponentWidth(bitCountwidth)fWidth=(bitCountwidth)-eWidth-1-- 1 for sign bitbiasedE=bias(dExponent+(fromIntegralfWidth))eWidthabsFraction=absdFraction-- Weird check is for detecting -0.0sign=(1.0/v)<0.0-- Fraction needs to be truncated, depending on the exponenttruncatedFraction=absFraction-(1`bitShiftL`fWidth)floatToMerged::(RealFloata)=>ByteCount->a->IntegerfloatToMergedwidthv=mergeFloatBits'(floatComponentswidthv)wheremergeFloatBits'(s,f,e)=mergeFloatBitsfWidtheWidthsfeeWidth=exponentWidth(bitCountwidth)fWidth=(bitCountwidth)-eWidth-1-- 1 for sign bitmergeFloatBits::BitCount->BitCount->Bool->Fraction->Exponent->IntegermergeFloatBitsfWidtheWidthsfe=shiftedSign.|.shiftedFrac.|.shiftedExpwheresBit=(ifsthen1else0)::IntegershiftedSign=(sBit`bitShiftL`(fWidth+eWidth))::IntegershiftedExp=((fromIntegrale)`bitShiftL`fWidth)::IntegershiftedFrac=fromIntegralf-- |Encode an integer to a list of words, in big-endian formatencodeIntBE::ByteCount->Integer->[Word8]encodeIntBE0_=[]encodeIntBEwidthx=(encodeIntBE(width-1)(x`shiftR`8))++[step]wherestep=(fromIntegralx).&.0xFF-- |Encode an integer to a list of words, in little-endian formatencodeIntLE::ByteCount->Integer->[Word8]encodeIntLEwidthx=reverse(encodeIntBEwidthx)bias::Exponent->BitCount->ExponentbiaseeWidth=e-(1-(2`iExp`(eWidth-1)))---------------------------------------------------------------------parseFloat::(RealFloata)=>[Word8]->aparseFloatbs=merge'(splitRawIEEE754bs)wheremerge'(sign,e,f)=encode'(mergeFloatefwidth)*signFactorsignencode'(f,e)=encodeFloatfesignFactors=ifsthen(-1)else1width=bitsInWord8bs-- |Considering a byte list as a sequence of bits, slice it from start-- inclusive to end exclusive, and return the resulting bit sequence as an-- integerbitSlice::[Word8]->BitCount->BitCount->IntegerbitSlicebs=sliceInt(foldl'step0bs)bitCount'wherestepaccw=(shiftLacc8)+(fromIntegralw)bitCount'=bitsInWord8bs-- |Slice a single integer by start and end bit locationsliceInt::Integer->BitCount->BitCount->BitCount->IntegersliceIntxxBitCountse=fromIntegral$(x.&.startMask)`bitShiftR`(xBitCount-e)wherestartMask=n1Bits(xBitCount-s)n1Bitsn=(2`iExp`n)-1-- |Split a raw bit array into (sign, exponent, fraction) components. These-- components have not been processed (unbiased, added significant bit,-- etc).splitRawIEEE754::[Word8]->(Bool,Exponent,Fraction)splitRawIEEE754bs=(sign,exp',frac)wheresign=(headbs.&.0x80)==0x80exp'=Exponent(fromIntegral$bitSlicebs1(1+w))frac=Fraction(bitSlicebs(1+w)(bitsInWord8bs))w=exponentWidth$bitsInWord8bs-- |Unbias an exponentunbias::Exponent->BitCount->ExponentunbiaseeWidth=e+1-(2`iExp`(eWidth-1))-- |Parse values into a form suitable for encodeFloat-- sign exponent fraction width-in-bits -> fraction, exponentmergeFloat::Exponent->Fraction->BitCount->(Integer,Int)-- ZeromergeFloat00_=(0,0)mergeFloatefwidth-- Infinity / NaN (TODO)|e==eMax=error"Infinity/NaN not supported"|otherwise=caseeof-- Denormalized0->(fromIntegralf,(fromIntegralunbiasedE+1)-(fromIntegralfWidth))-- Normalized_->(fromIntegralf+(1`bitShiftL`fWidth),(fromIntegralunbiasedE)-(fromIntegralfWidth))whereeWidth=exponentWidthwidthfWidth=width-eWidth-1eMax=(2`iExp`eWidth)-1unbiasedE=unbiase(eWidth)----------------------------------------------------------------------- |Calculate the proper size of the exponent field, in bits, given the-- size of the full structure.exponentWidth::BitCount->BitCountexponentWidthk|k==16=5|k==32=8|k`mod`32==0=ceiling(4*(logBase2(fromIntegralk)))-13|otherwise=error"Invalid length of floating-point value"-- |Integral exponentiExp::(Integrala,Integralb,Integralc)=>a->b->ciExpbe=floor$(fromIntegralb)**(fromIntegrale)newtypeExponent=ExponentIntderiving(Show,Eq,Num,Ord,Real,Enum,Integral,Bits)newtypeFraction=FractionIntegerderiving(Show,Eq,Num,Ord,Real,Enum,Integral,Bits)newtypeBitCount=BitCountIntderiving(Show,Eq,Num,Ord,Real,Enum,Integral)newtypeByteCount=ByteCountIntderiving(Show,Eq,Num,Ord,Real,Enum,Integral)bitCount::ByteCount->BitCountbitCount(ByteCountx)=BitCount(x*8)bitsInWord8::[Word8]->BitCountbitsInWord8ws=bitCount(ByteCount(lengthws))bitShiftL::(Bitsa)=>a->BitCount->abitShiftLx(BitCountn)=shiftLxnbitShiftR::(Bitsa)=>a->BitCount->abitShiftRx(BitCountn)=shiftRxn