)abbrev domain FLOAT Float

B ==> Boolean
I ==> Integer
S ==> String
PI ==> PositiveInteger
RN ==> Fraction Integer
SF ==> DoubleFloat
N ==> NonNegativeInteger

++ Author: Michael Monagan
++ Date Created: December 1987
++ Basic Operations: outputFloating, outputFixed, outputGeneral, outputSpacing,
++   atan, convert, exp1, log2, log10, normalize, rationalApproximation,
++   relerror, shift, / , ^
++ Keywords: float, floating point, number
++ Description: \spadtype{Float} implements arbitrary precision floating
++ point arithmetic.
++ The number of significant digits of each operation can be set
++ to an arbitrary value (the default is 20 decimal digits).
++ The operation \spadfunFrom{float}{FloatingPointSystem}(mantissa,
++ exponent, \spadfunFrom{base}{FloatingPointSystem}) for integer
++ \spad{mantissa}, \spad{exponent} specifies the number
++ \spad{mantissa} * \spadfunFrom{base}{FloatingPointSystem} ^ \spad{exponent}
++ The underlying representation for floats is binary
++ not decimal. The implications of this are described below.
++
++ The model adopted is that arithmetic operations are rounded to
++ to nearest unit in the last place, that is, accurate to within
++ 2^(-\spadfunFrom{bits}{FloatingPointSystem}).
++ Also, the elementary functions and constants are
++ accurate to one unit in the last place.
++ A float is represented as a record of two integers, the mantissa
++ and the exponent.  The \spadfunFrom{base}{FloatingPointSystem}
++ of the representation is binary, hence
++ a \spad{Record(m: mantissa, e: exponent)} represents the number \spad{m * 2 ^ e}.
++ Though it is not assumed that the underlying integers are represented
++ with a binary \spadfunFrom{base}{FloatingPointSystem},
++ the code will be most efficient when this is the
++ the case (this is true in most implementations of Lisp).
++ The decision to choose the \spadfunFrom{base}{FloatingPointSystem} to be
++ binary has some unfortunate
++ consequences.  First, decimal numbers like 0.3 cannot be represented
++ exactly.  Second, there is a further loss of accuracy during
++ conversion to decimal for output.  To compensate for this, if d digits
++ of precision are specified, \spad{1 + ceiling(log2(10^d))} bits are used.
++ Two numbers that are displayed identically may therefore be
++ not equal.  On the other hand, a significant efficiency loss would
++ be incurred if we chose to use a decimal \spadfunFrom{base}{FloatingPointSystem} when the underlying
++ integer base is binary.
++
++ Algorithms used:
++ For the elementary functions, the general approach is to apply
++ identities so that the taylor series can be used, and, so
++ that it will converge within \spad{O( sqrt n )} steps.  For example,
++ using the identity \spad{exp(x) = exp(x/2)^2}, we can compute
++ \spad{exp(1/3)} to n digits of precision as follows.  We have
++ \spad{exp(1/3) = exp(2 ^ (-sqrt s) / 3) ^ (2 ^ sqrt s)}.
++ The taylor series will converge in less than sqrt n steps and the
++ exponentiation requires sqrt n multiplications for a total of
++ \spad{2 sqrt n} multiplications.  Assuming integer multiplication costs
++ \spad{O( n^2 )} the overall running time is \spad{O( sqrt(n) n^2 )}.
++ This approach is the best known approach for precisions up to
++ about 10, 000 digits at which point the methods of Brent
++ which are \spad{O( log(n) n^2 )} become competitive.  Note also that
++ summing the terms of the taylor series for the elementary
++ functions is done using integer operations.  This avoids the
++ overhead of floating point operations and results in efficient
++ code at low precisions.  This implementation makes no attempt
++ to reuse storage, relying on the underlying system to do
++ \spadgloss{garbage collection}.  I estimate that the efficiency of this
++ package at low precisions could be improved by a factor of 2
++ if in-place operations were available.
++
++ Running times: in the following, n is the number of bits of precision
++      \spad{*}, \spad{/}, \spad{sqrt}, \spad{pi}, \spad{exp1}, \spad{log2}, \spad{log10}: \spad{ O( n^2 )}
++      \spad{exp}, \spad{log}, \spad{sin}, \spad{atan}:  \spad{ O( sqrt(n) n^2 )}
++ The other elementary functions are coded in terms of the ones above.


Float():
 Join(FloatingPointSystem, DifferentialRing, OpenMath, CoercibleTo DoubleFloat,
      ConvertibleTo InputForm, TranscendentalFunctionCategory, Hashable,
      arbitraryPrecision, arbitraryExponent) with
   normalize : % -> %
      ++ normalize(x) normalizes x at current precision.
   relerror : (%, %) -> %
      ++ relerror(x, y) computes the absolute value of \spad{(x - y)/y},
      ++ when \spad{y \~= 0}.
   shift : (%, I) -> %
      ++ shift(x, n) adds n to the exponent of float x.
   rationalApproximation : (%, N) -> RN
     ++ rationalApproximation(f, n) computes a rational approximation
     ++ r to f with relative error \spad{< 10^(-n)}.
   rationalApproximation : (%, N, N) -> RN
     ++ rationalApproximation(f, n, b) computes a rational
     ++ approximation r to f with relative error \spad{< b^(-n)}, that is
     ++ \spad{|(r-f)/f| < b^(-n)}.
   log2 : () -> %
      ++ log2() returns \spad{ln 2}, i.e. \spad{0.6931471805...}.
   log10 : () -> %
      ++ log10() returns \spad{ln 10}: \spad{2.3025809299...}.
   exp1 : () -> %
      ++ exp1() returns  exp 1: \spad{2.7182818284...}.
   atan : (%, %) -> %
      ++ atan(x, y) computes the arc tangent from x with phase y.
   log2 : % -> %
      ++ log2(x) computes the logarithm for x to base 2.
   log10 : % -> %
      ++ log10(x) computes the logarithm for x to base 10.
   convert : SF -> %
      ++ convert(x) converts a \spadtype{DoubleFloat} x to a \spadtype{Float}.
   outputFloating : () -> Void
      ++ outputFloating() sets the output mode to floating (scientific) notation, i.e.
      ++ \spad{mantissa * 10 exponent} is displayed as  \spad{0.mantissa E exponent}.
   outputFloating : N -> Void
      ++ outputFloating(n) sets the output mode to floating (scientific) notation
      ++ with n significant digits displayed after the decimal point.
   outputFixed : () -> Void
      ++ outputFixed() sets the output mode to fixed point notation;
      ++ the output will contain a decimal point.
   outputFixed : N -> Void
      ++ outputFixed(n) sets the output mode to fixed point notation,
      ++ with n digits displayed after the decimal point.
   outputGeneral : () -> Void
      ++ outputGeneral() sets the output mode (default mode) to general
      ++ notation; numbers will be displayed in either fixed or floating
      ++ (scientific) notation depending on the magnitude.
   outputGeneral : N -> Void
      ++ outputGeneral(n) sets the output mode to general notation
      ++ with n significant digits displayed.
   outputSpacing : N -> N
      ++ outputSpacing(n) inserts an underscore after n (default 10) digits
      ++ on output; outputSpacing(0) means no underscores are inserted.
      ++ Returns old setting.
   get_output_mode : () -> Record(mode : String, prec : Integer)
      ++ get_output_mode() returns current output mode and precision
   set_output_mode : (String, Integer) -> Void
      ++ set_output_mode(mode, precision) sets output mode and precision.
  == add
   BASE ==> 2
   BITS : PI := 68 -- 20 digits
   LENGTH(n) ==> qcoerce(length(n)$I)@N
   ISQRT ==> approxSqrt$IntegerRoots(I)
   Rep := Record( mantissa : I, exponent : I )
   StoredConstant ==> Record( precision : PI, value : % )
   UCA ==> Record( unit : %, coef : %, associate : % )
   inc ==> increasePrecision
   dec ==> decreasePrecision
   error1(msg, f) ==> error concat [msg, ": ", toString f]

   -- local utility operations
   shift2 : (I, I) -> I           -- WSP : fix bug in shift
   times : (%, %) -> %            -- multiply x and y with no rounding
   itimes : (I, %) -> %            -- multiply by a small integer
   chop : (%, PI) -> %             -- chop x at p bits of precision
   dvide : (%, %) -> %             -- divide x by y with no rounding
   square : (%, I) -> %            -- repeated squaring with chopping
   power : (%, I) -> %             -- x ^ n with chopping
   plus : (%, %) -> %              -- addition with no rounding
   sub : (%, %) -> %               -- subtraction with no rounding
   negate : % -> %                -- negation with no rounding
   ceillog10base2 : PI -> PI      -- rational approximation
   floorln2 : PI -> PI            -- rational approximation

   atanSeries : % -> %            -- atan(x) by taylor series |x| < 1/2
   atanInverse : I -> %           -- atan(1/n) for n an integer > 1
   sinSeries : % -> %             -- sin(x) by taylor series |x| < 1/2
   cosSeries : % -> %             -- cos(x) by taylor series |x| < 1/2
   piRamanujan : () -> %          -- pi using Ramanujans series

   writeOMFloat(dev : OpenMathDevice, x : %) : Void ==
      OMputApp(dev)
      OMputSymbol(dev, "bigfloat1", "bigfloat")
      OMputInteger(dev, mantissa x)
      OMputInteger(dev, 2)
      OMputInteger(dev, exponent x)
      OMputEndApp(dev)

   OMwrite(dev : OpenMathDevice, x : %, wholeObj : Boolean) : Void ==
      if wholeObj then
         OMputObject(dev)
      writeOMFloat(dev, x)
      if wholeObj then
         OMputEndObject(dev)

   shift2(x, y) == sign(x)*shift(sign(x)*x, y)

   asin x ==
      zero? x => 0
      negative? x => -asin(-x)
      (x = 1) => pi()/2
      x > 1 => error1("asin: argument > 1 in magnitude", x)
      inc 5; r := atan(x/sqrt(sub(1, times(x, x)))); dec 5
      normalize r

   acos x ==
      zero? x => pi()/2
      negative? x => (inc 3; r := pi()-acos(-x); dec 3; normalize r)
      (x = 1) => 0
      x > 1 => error1("acos: argument > 1 in magnitude", x)
      inc 5; r := atan(sqrt(sub(1, times(x, x)))/x); dec 5
      normalize r

   atan(x, y) ==
      x = 0 =>
         y > 0 => pi()/2
         y < 0 => -pi()/2
         0
      -- Only count on first quadrant being on principal branch.
      theta := atan abs(y/x)
      if x < 0 then theta := pi() - theta
      if y < 0 then theta := - theta
      theta

   atan x ==
      zero? x => 0
      negative? x => -atan(-x)
      if x > 1 then
         inc 4
         r := if zero? fractionPart x and x < [bits(), 0] then atanInverse wholePart x
                 else atan(1/x)
         r := pi/2 - r
         dec 4
         return normalize r
      -- make |x| < O( 2^(-sqrt p) ) < 1/2 to speed series convergence
      -- by using the formula  atan(x) = 2*atan(x/(1+sqrt(1+x^2)))
      k := ISQRT (bits()-100)::I quo 5
      k := max(0, 2 + k + order x)
      inc(2*k)
      for i in 1..k repeat x := x/(1+sqrt(1+x*x))
      t := atanSeries x
      dec(2*k)
      t := shift(t, k)
      normalize t

   atanSeries x ==
      -- atan(x) = x (1 - x^2/3 + x^4/5 - x^6/7 + ...)  |x| < 1
      p := bits() + LENGTH bits() + 2
      s : I := d : I := shift(1, p)
      y := times(x, x)
      t := m := - shift2(y.mantissa, y.exponent+p)
      for i in 3.. by 2 while t ~= 0 repeat
         s := s + t quo i
         t := (m * t) quo d
      x * [s, -p]

   atanInverse n ==
      -- compute atan(1/n) for an integer n > 1
      -- atan n = 1/n - 1/n^3/3 + 1/n^5/4 - ...
      --   pi = 16 atan(1/5) - 4 atan(1/239)
      n2 := -n*n
      e : I := bits() + LENGTH bits() + LENGTH n + 1
      s : I := shift(1, e) quo n
      t : I := s quo n2
      for k in 3.. by 2 while t ~= 0 repeat
         s := s + t quo k
         t := t quo n2
      normalize [s, -e]

   sin x ==
      s := sign x; x := abs x; p := bits(); inc 4
      if x > [6, 0] then (inc p; x := 2*pi*fractionPart(x/pi/2); bits p)
      if x > [3, 0] then (inc p; s := -s; x := x - pi; bits p)
      if x > [3, -1] then (inc p; x := pi - x; dec p)
      -- make |x| < O( 2^(-sqrt p) ) < 1/2 to speed series convergence
      -- by using the formula  sin(3*x/3) = 3 sin(x/3) - 4 sin(x/3)^3
      -- the running time is O( sqrt p M(p) ) assuming |x| < 1
      k := ISQRT (bits()-100)::I quo 4
      k := max(0, 2 + k + order x)
      if k > 0 then (inc k; x := x / 3^k::N)
      r := sinSeries x
      for i in 1..k repeat r := itimes(3, r)-shift(r^3, 2)
      bits p
      s * r

   sinSeries x ==
      -- sin(x) = x (1 - x^2/3! + x^4/5! - x^6/7! + ... |x| < 1/2
      p := bits() + LENGTH bits() + 2
      y := times(x, x)
      s : I := d : I := shift(1, p)
      m : I := - shift2(y.mantissa, y.exponent+p)
      t : I := m quo 6
      for i in 4.. by 2 while t ~= 0 repeat
         s := s + t
         t := (m * t) quo (i*(i+1))
         t := t quo d
      x * [s, -p]

   cos x ==
     s : I := 1; x := abs x; p := bits(); inc 4
     if x > [6, 0] then (inc p; x := 2*pi*fractionPart(x/pi/2); dec p)
     if x > [3, 0] then (inc p; s := -s; x := x-pi; dec p)
     if x > [1, 0] then
         -- take care of the accuracy problem near pi/2
         inc p; x := pi/2-x; bits p; x := normalize x
         return (s * sin x)
      -- make |x| < O( 2^(-sqrt p) ) < 1/2 to speed series convergence
      -- by using the formula  cos(2*x/2) = 2 cos(x/2)^2 - 1
      -- the running time is O( sqrt p M(p) ) assuming |x| < 1
     k := ISQRT (bits()-100)::I quo 3
     k := max(0, 2 + k + order x)
      -- need to increase precision by more than k, otherwise recursion
      -- causes loss of accuracy.
      -- Michael Monagan suggests adding a factor of log(k)
     if k > 0 then (inc(k+length(k)^2); x := shift(x, -k))
     r := cosSeries x
     for i in 1..k repeat r := shift(r*r, 1)-1
     bits p
     s * r



   cosSeries x ==
      -- cos(x) = 1 - x^2/2! + x^4/4! - x^6/6! + ... |x| < 1/2
      p := bits() + LENGTH bits() + 1
      y := times(x, x)
      s : I := d : I := shift(1, p)
      m : I := - shift2(y.mantissa, y.exponent+p)
      t : I := m quo 2
      for i in 3.. by 2 while t ~= 0 repeat
         s := s + t
         t := (m * t) quo (i*(i+1))
         t := t quo d
      normalize [s, -p]

   tan x ==
      s := sign x; x := abs x; p := bits(); inc 6
      if x > [3, 0] then (inc p; x := pi()*fractionPart(x/pi()); dec p)
      if x > [3, -1] then (inc p; x := pi()-x; s := -s; dec p)
      if x > 1 then (c := cos x; t := sqrt(1-c*c)/c)
      else (c := sin x; t := c/sqrt(1-c*c))
      bits p
      s * t

   P : StoredConstant := [1, [1, 2]]
   pi() ==
      -- We use Ramanujan's identity to compute pi.
      -- The running time is quadratic in the precision.
      -- This is about twice as fast as Machin's identity on Lisp/VM
      --   pi = 16 atan(1/5) - 4 atan(1/239)
      bits() <= P.precision => normalize P.value
      (P := [bits(), piRamanujan()]).value

   piRamanujan() ==
      -- Ramanujans identity for 1/pi
      -- Reference: Shanks and Wrench, Math Comp, 1962
      -- "Calculation of pi to 100,000 Decimals".
      n := bits() + LENGTH bits() + 11
      t : I := shift(1, n) quo 882
      d : I := 4*882^2
      s : I := 0
      for i in 2.. by 2 for j in 1123.. by 21460 while t ~= 0 repeat
         s := s + j*t
         m := -(i-1)*(2*i-1)*(2*i-3)
         t := (m*t) quo (d*i^3)
      1 / [s, -n-2]

   sinh x ==
      zero? x => 0
      lost : I := max(- order x, 0)
      2*lost > bits() => x
      inc(5+lost); e := exp x; s := (e-1/e)/2; dec(5+lost)
      normalize s

   cosh x ==
      (inc 5; e := exp x; c := (e+1/e)/2; dec 5; normalize c)

   tanh x ==
      zero? x => 0
      lost : I := max(- order x, 0)
      2*lost > bits() => x
      inc(6+lost); e := exp x; e := e*e; t := (e-1)/(e+1); dec(6+lost)
      normalize t

   asinh x ==
      p := min(0, order x)
      if zero? x or 2*p < -bits() then return x
      inc(5-p); r := log(x+sqrt(1+x*x)); dec(5-p)
      normalize r

   acosh x ==
      if x < 1 then error1("acosh: invalid argument", x)
      inc 5; r := log(x+sqrt(sub(times(x, x), 1))); dec 5
      normalize r

   atanh x ==
      if x > 1 or x < -1 then error1("atanh: invalid argument", x)
      p := min(0, order x)
      if zero? x or 2*p < -bits() then return x
      inc(5-p); r := log((x+1)/(1-x))/2; dec(5-p)
      normalize r

   log(x) == normalize(log(x::Rep, bits())$FloatElementaryFunctions)

   log2() == normalize(log2(bits())$FloatElementaryFunctions)

   log10() == normalize(log10(bits())$FloatElementaryFunctions)

   log2(x) ==
       b := bits() + 3
       r := quotient(log(x::Rep, b)$FloatElementaryFunctions,
                     log2(b)$FloatElementaryFunctions, b
                    )$FloatElementaryFunctions
       normalize(r)

   log10(x) ==
       b := bits() + 3
       r := quotient(log(x::Rep, b)$FloatElementaryFunctions,
                     log10(b)$FloatElementaryFunctions, b
                    )$FloatElementaryFunctions
       normalize(r)

   exp(x) == normalize(exp(x::Rep, bits())$FloatElementaryFunctions)

   exp1() == normalize(exp1(bits())$FloatElementaryFunctions)

   sqrt x ==
      negative? x => error1("sqrt: negative argument", x)
      m := x.mantissa; e := x.exponent
      l : Integer := LENGTH m
      p := 2 * bits() - l + 2
      if odd?(e-l) then p := p - 1
      i := shift2(x.mantissa, p)
      -- ISQRT uses a variable precision newton iteration
      i := ISQRT i
      normalize [i, (e-p) quo 2]

   bits() == BITS
   bits(n) == (t := BITS; BITS := n; t)
   precision() == bits()
   precision(n) == bits(n)
   increasePrecision n == (b := bits(); bits((b + n)::PI); b)
   decreasePrecision n == (b := bits(); bits((b - n)::PI); b)
   ceillog10base2 n == ((13301 * n + 4003) quo 4004) :: PI
   digits() == max(1, 4004 * (bits()-1) quo 13301)::PI
   digits(n) == (t := digits(); bits (1 + ceillog10base2 n); t)

   order(a) == LENGTH a.mantissa + a.exponent - 1
   relerror(a, b) == abs((a-b)/b)
   0 == [0, 0]
   1 == [1, 0]
   base() == BASE
   mantissa x == x.mantissa
   exponent x == x.exponent
   one? a == a = 1
   zero? a == zero?(a.mantissa)
   negative? a == negative?(a.mantissa)
   positive? a == positive?(a.mantissa)

   chop(x, p) ==
      e : I := LENGTH x.mantissa - p
      if e > 0 then x := [shift2(x.mantissa, -e), x.exponent+e]
      x
   float(m, e) == normalize [m, e]
   float(m, e, b) ==
      m = 0 => 0
      inc 4; r := m * [b, 0] ^ e; dec 4
      normalize r
   normalize x ==
      m := x.mantissa
      m = 0 => 0
      e : I := LENGTH m - bits()
      if e > 0 then
         y := shift2(m, 1-e)
         if odd? y then
            y := (if y>0 then y+1 else y-1) quo 2
            if LENGTH y > bits() then
               y := y quo 2
               e := e+1
         else y := y quo 2
         x := [y, x.exponent+e]
      x
   shift(x : %, n : I) == [x.mantissa, x.exponent+n]

   x = y ==
      x.exponent = y.exponent =>
          x.mantissa = y.mantissa
      order x = order y and sign x = sign y and zero? (x - y)
   x < y ==
      y.mantissa = 0 => x.mantissa < 0
      x.mantissa = 0 => y.mantissa > 0
      negative? x and positive? y => true
      negative? y and positive? x => false
      order x < order y => positive? x
      order x > order y => negative? x
      negative? (x-y)

   abs x == if negative? x then -x else normalize x
   ceiling x ==
      if negative? x then return (-floor(-x))
      if zero? fractionPart x then x else truncate x + 1
   wholePart x == shift2(x.mantissa, x.exponent)
   floor x == if negative? x then -ceiling(-x) else truncate x
   round x == (half := [sign x, -1]; truncate(x + half))
   sign x == if x.mantissa < 0 then -1 else 1
   truncate x ==
      if x.exponent >= 0 then return x
      normalize [shift2(x.mantissa, x.exponent), 0]
   recip(x) == if x = 0 then "failed" else 1/x
   differentiate x == 0

   - x == normalize negate x
   negate x == [-x.mantissa, x.exponent]
   x + y == normalize plus(x, y)
   x - y == normalize plus(x, negate y)
   sub(x, y) == plus(x, negate y)
   plus(x, y) ==
      mx := x.mantissa; my := y.mantissa
      mx = 0 => y
      my = 0 => x
      ex := x.exponent; ey := y.exponent
      ex = ey => [mx+my, ex]
      de := ex + LENGTH mx - ey - LENGTH my
      de > bits()+1 => x
      de < -(bits()+1) => y
      if ex < ey then (mx, my, ex, ey) := (my, mx, ey, ex)
      mw := my + shift2(mx, ex-ey)
      [mw, ey]

   x : % * y : % == normalize times (x, y)
   x : I * y : % ==
      if LENGTH x > bits() then normalize [x, 0] * y
      else normalize [x * y.mantissa, y.exponent]
   x : % / y : % == normalize dvide(x, y)
   x : % / y : I ==
      if LENGTH y > bits() then x / normalize [y, 0] else x / [y, 0]
   inv x == 1 / x

   times(x : %, y : %) == [x.mantissa * y.mantissa, x.exponent + y.exponent]
   itimes(n : I, y : %) == [n * y.mantissa, y.exponent]

   dvide(x, y) ==
      ew := LENGTH y.mantissa - LENGTH x.mantissa + bits() + 1
      mw := shift2(x.mantissa, ew) quo y.mantissa
      ew := x.exponent - y.exponent - ew
      [mw, ew]

   square(x, n) ==
      ma := x.mantissa; ex := x.exponent
      for k in 1..n repeat
         ma := ma * ma; ex := ex + ex
         l : I := bits()::I - LENGTH ma
         ma := shift2(ma, l); ex := ex - l
      [ma, ex]

   power(x, n) ==
      y : % := 1; z : % := x
      repeat
         if odd? n then y := chop( times(y, z), bits() )
         if (n := n quo 2) = 0 then return y
         z := chop( times(z, z), bits() )

   x : % ^ y : % ==
      x = 0 =>
         y = 0 => error "0^0 is undefined"
         y < 0 => error "division by 0"
         0
      y = 0 => 1
      y = 1 => x
      x = 1 => 1
      p := abs order y + 5
      inc p; r := exp(y*log(x)); dec p
      normalize r

   x : % ^ r : RN ==
      x = 0 =>
         r = 0 => 1
         r < 0 => error "division by 0"
         0
      r = 0 => 1
      r = 1 => x
      x = 1 => 1
      n := numer r
      d := denom r
      negative? x =>
         odd? d =>
            odd? n => return -((-x)^r)
            return ((-x)^r)
         error "negative root"
      if d = 2 then
         n = 1 => return sqrt(x)
         inc LENGTH n; y := sqrt(x); y := y^n; dec LENGTH n
         return normalize y
      y := [n, 0]/[d, 0]
      x ^ y

   x : % ^ n : I ==
      x = 0 =>
         n = 0 => 1
         n < 0 => error "division by 0"
         0
      n = 0 => 1
      n = 1 => x
      x = 1 => 1
      p := bits()
      bits(p + qcoerce(LENGTH(n))@PI + 2)
      y := power(x, abs n)
      if n < 0 then y := dvide(1, y)
      bits p
      normalize y

   --------------------------------
   -- Output routines for Floats --
   --------------------------------

   SPACING : N := 10
   OUTMODE : S := "general"
   OUTPREC : I := -1

   mode_Rec ==> Record(default? : B, trim_trailing_zeros? : B,
                       out_mode : S, spacing : I, separator : Character)

   outputSpacing n ==
       old_val := SPACING
       SPACING := n
       old_val

   outputFixed() == (OUTMODE := "fixed"; OUTPREC := -1)
   outputFixed n == (OUTMODE := "fixed"; OUTPREC := n::I)
   outputGeneral() == (OUTMODE := "general"; OUTPREC := -1)
   outputGeneral n == (OUTMODE := "general"; OUTPREC := n::I)
   outputFloating() == (OUTMODE := "floating"; OUTPREC := -1)
   outputFloating n == (OUTMODE := "floating"; OUTPREC := n::I)

   get_output_mode() : Record(mode : String, prec : Integer) ==
       [OUTMODE, OUTPREC]

   valid_modes : List(String) := ["fixed", "general", "floating"]

   set_output_mode(mode : String, prec : Integer) : Void ==
       prec < 0 and prec ~= -1 =>
           error "set_output_mode: invalid precision"
       not(member?(mode, valid_modes)) =>
           error "set_output_mode: invalid mode"
       OUTMODE := mode
       OUTPREC := prec

   convert(f) : S ==
       d : Integer :=
           OUTPREC = -1 and not zero? f =>
               max(1, 4004*(length(abs(mantissa(f))) - 1) quo 13301)
           OUTPREC
       mr := [OUTPREC = -1, OUTPREC = -1, OUTMODE, SPACING,
              underscore()$Character]$mode_Rec
       convert_mr(f::Rep, d, mr)$FloatingPointConvertion

   coerce(f) : OutputForm ==
     f >= 0 => message(convert(f)@S)
     - (coerce(-f)@OutputForm)

   convert(f) : InputForm ==
     convert [convert('float), convert mantissa f,
              convert exponent f, convert base()]$List(InputForm)

   -- Conversion routines
   convert(x : %) : Float == x pretend Float
   convert(x : %) : SF == makeSF(x.mantissa, x.exponent)$Lisp
   coerce(x : %) : SF == convert(x)@SF
   convert(sf : SF) : % == float(mantissa sf, exponent sf, base()$SF)

   retract(f : %) : RN == rationalApproximation(f, (bits()-1)::N, BASE)

   retractIfCan(f:%):Union(RN, "failed") ==
     rationalApproximation(f, (bits()-1)::N, BASE)

   retract(f : %) : I ==
     (f = (n := wholePart f)::%) => n
     error "Not an integer"

   retractIfCan(f:%):Union(I, "failed") ==
     (f = (n := wholePart f)::%) => n
     "failed"

   rationalApproximation(f, d) == rationalApproximation(f, d, 10)

   rationalApproximation(f, d, b) ==
      t : Integer
      nu := f.mantissa; ex := f.exponent
      if ex >= 0 then return ((nu*BASE^(ex::N))/1)
      de := BASE^((-ex)::N)
      if b < 2 then error "base must be > 1"
      tol := b^d
      s := nu; t := de
      p0, p1, q0, q1 : Integer
      p0 := 0; p1 := 1; q0 := 1; q1 := 0
      repeat
         (q, r) := divide(s, t)
         p2 := q*p1+p0
         q2 := q*q1+q0
         if r = 0 or tol*abs(nu*q2-de*p2) < de*abs(p2) then return (p2/q2)
         (p0, p1) := (p1, p2)
         (q0, q1) := (q1, q2)
         (s, t) := (t, r)

   hashUpdate!(s : HashState, x : %) : HashState ==
       m : I := x.mantissa
       e : I := x.exponent
       while (tmp := m exquo BASE) case I repeat
           m := tmp::I
           e := e + 1
       s := hashUpdate!(s, m)
       hashUpdate!(s, e)

--% Float: arbitrary precision floating point arithmetic domain

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--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 The Numerical ALgorithms Group Ltd. nor the
--      names of its 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.
