Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP #-}{-# OPTIONS -Wall -fno-warn-unused-binds #-}#ifndef __NHC__{-# LANGUAGE DeriveDataTypeable #-}#endif------------------------------------------------------------------------------- |-- Module      :  Data.Fixed-- Copyright   :  (c) Ashley Yakeley 2005, 2006, 2009-- License     :  BSD-style (see the file libraries/base/LICENSE)---- Maintainer  :  Ashley Yakeley <ashley@semantic.org>-- Stability   :  experimental-- Portability :  portable---- This module defines a \"Fixed\" type for fixed-precision arithmetic.-- The parameter to Fixed is any type that's an instance of HasResolution.-- HasResolution has a single method that gives the resolution of the Fixed type.---- This module also contains generalisations of div, mod, and divmod to work-- with any Real instance.-------------------------------------------------------------------------------moduleData.Fixed(div',mod',divMod',Fixed,HasResolution(..),showFixed,E0,Uni,E1,Deci,E2,Centi,E3,Milli,E6,Micro,E9,Nano,E12,Pico)whereimportPrelude-- necessary to get dependencies rightimportData.CharimportData.List#ifndef __NHC__importData.TypeableimportData.Data#endif#ifndef __NHC__default()-- avoid any defaulting shenanigans#endif-- | generalisation of 'div' to any instance of Realdiv'::(Reala,Integralb)=>a->a->bdiv'nd=floor((toRationaln)/(toRationald))-- | generalisation of 'divMod' to any instance of RealdivMod'::(Reala,Integralb)=>a->a->(b,a)divMod'nd=(f,n-(fromIntegralf)*d)wheref=div'nd-- | generalisation of 'mod' to any instance of Realmod'::(Reala)=>a->a->amod'nd=n-(fromIntegerf)*dwheref=div'nd-- | The type parameter should be an instance of 'HasResolution'.newtypeFixeda=MkFixedInteger#ifndef __NHC__deriving(Eq,Ord,Typeable)#elsederiving(Eq,Ord)#endif#ifndef __NHC__-- We do this because the automatically derived Data instance requires (Data a) context.-- Our manual instance has the more general (Typeable a) context.tyFixed::DataTypetyFixed=mkDataType"Data.Fixed.Fixed"[conMkFixed]conMkFixed::ConstrconMkFixed=mkConstrtyFixed"MkFixed"[]Prefixinstance(Typeablea)=>Data(Fixeda)wheregfoldlkz(MkFixeda)=k(zMkFixed)agunfoldkz_=k(zMkFixed)dataTypeOf_=tyFixedtoConstr_=conMkFixed#endifclassHasResolutionawhereresolution::pa->IntegerwithType::(pa->fa)->fawithTypefoo=fooundefinedwithResolution::(HasResolutiona)=>(Integer->fa)->fawithResolutionfoo=withType(foo.resolution)instanceEnum(Fixeda)wheresucc(MkFixeda)=MkFixed(succa)pred(MkFixeda)=MkFixed(preda)toEnum=MkFixed.toEnumfromEnum(MkFixeda)=fromEnumaenumFrom(MkFixeda)=fmapMkFixed(enumFroma)enumFromThen(MkFixeda)(MkFixedb)=fmapMkFixed(enumFromThenab)enumFromTo(MkFixeda)(MkFixedb)=fmapMkFixed(enumFromToab)enumFromThenTo(MkFixeda)(MkFixedb)(MkFixedc)=fmapMkFixed(enumFromThenToabc)instance(HasResolutiona)=>Num(Fixeda)where(MkFixeda)+(MkFixedb)=MkFixed(a+b)(MkFixeda)-(MkFixedb)=MkFixed(a-b)fa@(MkFixeda)*(MkFixedb)=MkFixed(div(a*b)(resolutionfa))negate(MkFixeda)=MkFixed(negatea)abs(MkFixeda)=MkFixed(absa)signum(MkFixeda)=fromInteger(signuma)fromIntegeri=withResolution(\res->MkFixed(i*res))instance(HasResolutiona)=>Real(Fixeda)wheretoRationalfa@(MkFixeda)=(toRationala)/(toRational(resolutionfa))instance(HasResolutiona)=>Fractional(Fixeda)wherefa@(MkFixeda)/(MkFixedb)=MkFixed(div(a*(resolutionfa))b)recipfa@(MkFixeda)=MkFixed(div(res*res)a)whereres=resolutionfafromRationalr=withResolution(\res->MkFixed(floor(r*(toRationalres))))instance(HasResolutiona)=>RealFrac(Fixeda)whereproperFractiona=(i,a-(fromIntegrali))wherei=truncateatruncatef=truncate(toRationalf)roundf=round(toRationalf)ceilingf=ceiling(toRationalf)floorf=floor(toRationalf)chopZeros::Integer->StringchopZeros0=""chopZerosa|moda10==0=chopZeros(diva10)chopZerosa=showa-- only works for positive ashowIntegerZeros::Bool->Int->Integer->StringshowIntegerZerosTrue_0=""showIntegerZeroschopTrailingZerosdigitsa=replicate(digits-lengths)'0'++s'wheres=showas'=ifchopTrailingZerosthenchopZerosaelseswithDot::String->StringwithDot""=""withDots='.':s-- | First arg is whether to chop off trailing zerosshowFixed::(HasResolutiona)=>Bool->Fixeda->StringshowFixedchopTrailingZerosfa@(MkFixeda)|a<0="-"++(showFixedchopTrailingZeros(asTypeOf(MkFixed(negatea))fa))showFixedchopTrailingZerosfa@(MkFixeda)=(showi)++(withDot(showIntegerZeroschopTrailingZerosdigitsfracNum))whereres=resolutionfa(i,d)=divModares-- enough digits to be unambiguousdigits=ceiling(logBase10(fromIntegerres)::Double)maxnum=10^digitsfracNum=div(d*maxnum)resreadsFixed::(HasResolutiona)=>ReadS(Fixeda)readsFixed=readsSignedwherereadsSigned('-':xs)=[(negatex,rest)|(x,rest)<-readsUnsignedxs]readsSignedxs=readsUnsignedxsreadsUnsignedxs=casespanisDigitxsof([],_)->[](is,xs')->leti=fromInteger(readis)incasexs'of'.':xs''->casespanisDigitxs''of([],_)->[](js,xs''')->letj=fromInteger(readjs)l=genericLengthjs::Integerin[(i+(j/(10^l)),xs''')]_->[(i,xs')]instance(HasResolutiona)=>Show(Fixeda)whereshow=showFixedFalseinstance(HasResolutiona)=>Read(Fixeda)wherereadsPrec_=readsFixeddataE0=E0#ifndef __NHC__deriving(Typeable)#endifinstanceHasResolutionE0whereresolution_=1-- | resolution of 1, this works the same as IntegertypeUni=FixedE0dataE1=E1#ifndef __NHC__deriving(Typeable)#endifinstanceHasResolutionE1whereresolution_=10-- | resolution of 10^-1 = .1typeDeci=FixedE1dataE2=E2#ifndef __NHC__deriving(Typeable)#endifinstanceHasResolutionE2whereresolution_=100-- | resolution of 10^-2 = .01, useful for many monetary currenciestypeCenti=FixedE2dataE3=E3#ifndef __NHC__deriving(Typeable)#endifinstanceHasResolutionE3whereresolution_=1000-- | resolution of 10^-3 = .001typeMilli=FixedE3dataE6=E6#ifndef __NHC__deriving(Typeable)#endifinstanceHasResolutionE6whereresolution_=1000000-- | resolution of 10^-6 = .000001typeMicro=FixedE6dataE9=E9#ifndef __NHC__deriving(Typeable)#endifinstanceHasResolutionE9whereresolution_=1000000000-- | resolution of 10^-9 = .000000001typeNano=FixedE9dataE12=E12#ifndef __NHC__deriving(Typeable)#endifinstanceHasResolutionE12whereresolution_=1000000000000-- | resolution of 10^-12 = .000000000001typePico=FixedE12