You can use (real!) real numbers (ok, computables only), fixed point numbers with arbitrary precision, power series, physical units, residue classes immediately with GHCi. Just download the NumericPrelude package from http://hackage.haskell.org/cgi-bin/hackage-scripts/package/numeric-prelude or get the cutting edge version (caution: frequent API changes!) wget -r --no-parent http://darcs.haskell.org/numericprelude/ or even better with 'darcs' (see http://darcs.net/) if available darcs get http://darcs.haskell.org/numericprelude/ then start GHCi as follows. numericprelude$ make ghci ... *Main> showReal (logBase 2 3 + pi + sqrt 2) "6.14076871668404446871807105143701747152665568244453495460737698483964711254267460000070283458784688280 81425952192537Interrupted. *Main> showFixedPoint (log 2 + sqrt 2 + pi) "5.2489533965228335966815642289473775308423414091123091482723043397919425067180107530842856866661773283" *Main> showFixedPoint (FixedPoint.lift0 (10^1000) Number.FixedPoint.piConst) "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201997" *Main> showFixedPoint (sqrt $ log $ FixedPoint.fromIntegerBasis 10 1000 2) "0.8325546111576977563531646448952010476305888522644407291668291172340794351973046371489980076416742886448482282410637851330108956418582929396049471528907228470171676350886723388423935936597108246765808570792700443622966196741818893190586581386252927024531072144299452636462660173046566333123423559517018232473131336553277397460554922101186525242623654599834751330464388563784517713133769314261857977824435543915784989600358362742619360874461618454558851154639567200399205141997756487547096515291667876389818410045279797332626020900120913715779072042123248766285273274106918375012034073383400019132961678929241754711455999383432933099386116049520197996591124299426029350053074823745166425774910775252128414873633138846561928632399126787643990250582692324765636262660441952182748966643014552842325814025874977948870859994990052332656663016056779182667586683292672622606377187398292031363768554806074838642380037406327808548247471555604075913559987467405262524094749104596792515303983594015683517043115422" *Main> divMod (polynomial [1,3,3]) (polynomial [1,1::Rational]) (Polynomial.fromCoeffs [0 % 1,3 % 1],Polynomial.fromCoeffs [1 % 1]) *Main> 2*kilo*meter / mach :: SIDouble 6.024096385542169 s *Main> sqrt (powerSeries [1,1::Double]) PowerSeries.fromCoeffs [1.0,0.5,-0.125,6.25e-2,-3.90625e-2,2.734375e-2,-2.05078125e-2,1.611328125e-2,-1.3092041015625e-2,... *Main> PowerSeries.sqrt (const 1) [1,1::Rational] [1 % 1,1 % 2,-1 % 8,1 % 16,-5 % 128,7 % 256,-21 % 1024,33 % 2048,-429 % 32768,715 % 65536,-2431 % 262144,4199 % 524288,-29393 % 4194304,52003 % 8388608, ... *Main> ResidueClass.concrete 7 (5*3/2) :: Integer 4 *Main> polynomial [1,5,6] % polynomial [1,4,4::Rational] Polynomial.fromCoeffs [1 % 2,3 % 2] % Polynomial.fromCoeffs [1 % 2,1 % 1] -- (1 + 2 * sqrt 2) * (3 + 4 * sqrt 2) == (19 + 10 * sqrt 2) *Main> ResidueClass.concrete (polynomial [-2,0,1::Rational]) (polyResidueClass [1,2] * polyResidueClass[3,4]) Polynomial.fromCoeffs [19 % 1,10 % 1] For given factorization of the denominator of a fraction, you can compute the partial fraction decomposition and you can do calculations in this representation. *Main> let a = partialFraction [2,3,5] (1::Integer) *Main> a PartialFraction.fromFractionSum (-1) [(2,[1]),(3,[1]),(5,[1])] *Main> a^2 PartialFraction.fromFractionSum (-1) [(2,[0,1]),(3,[0,1]),(5,[3,1])] *Main> PartialFraction.toFraction (a^2) == 1/(2*3*5)^2 True *Main> let x = polynomial [0,1::Rational] *Main> partialFraction [x-4,x,x+4] ((x-2)*(x+2)) PartialFraction.fromFractionSum (Polynomial.fromCoeffs [0 % 1,0 % 1,0 % 1]) [(Polynomial.fromCoeffs [-4 %1,1 % 1],[Polynomial.fromCoeffs [3 % 8]]),(Polynomial.fromCoeffs [0 % 1,1 % 1],[Polynomial.fromCoeffs [1 % 4]]),(Polynomial.fromCoeffs [4 % 1,1 % 1],[Polynomial.fromCoeffs [3 % 8]])]