From bebd3ef9f5e7b734b226363fa475c97e45806b86 Mon Sep 17 00:00:00 2001 From: LdBeth Date: Mon, 29 Nov 2021 23:04:12 +0800 Subject: [PATCH] Add arbitrary precision decimal floating point Improve conformance to decarith; add testcase And fix Makefile.in update. fix bug in division DecimalFloat support in SPAD fix obvious problems in divide and sqrt fix sqrt new exp wip still need exp1 add cached exp1 stage changes --- src/algebra/Makefile.in | 5 +- src/algebra/decimal.spad | 496 +++++++++++++++++++++++++++++++++++++++ src/algebra/float.spad | 5 +- src/input/Makefile.in | 2 +- src/input/decimal.input | 46 ++++ src/interp/compiler.boot | 4 + src/interp/i-intern.boot | 4 + src/interp/setq.lisp | 3 +- 8 files changed, 560 insertions(+), 5 deletions(-) create mode 100644 src/algebra/decimal.spad create mode 100644 src/input/decimal.input diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in index 98db0e9c3..935d032ea 100644 --- a/src/algebra/Makefile.in +++ b/src/algebra/Makefile.in @@ -37,7 +37,7 @@ SPAD_SRCS= \ computil constant contfrac \ coordsys cra crfp curve cycles \ cyclo cyclotom cyldec ddfact defaults defintef defintrf \ - derham dhmatrix dirichlet discrgrp distro divisor \ + derham decimal dhmatrix dirichlet discrgrp distro divisor \ dpolcat drawopt drawpak draw efstruc efuls efupxs \ eigen elemntry elfuts equation1 error \ evalut expexpan export3D expps expr2ups exprode expr extred \ @@ -131,7 +131,8 @@ SPADLIST1=\ SPADLIST2=\ DBASE DBLRESP DDFACT \ - DECIMAL DEFINTEF DEFINTRF DEGRED DELTAC DELTCF DEQUEUE DERHAM DFELEM \ + DECIMAL DECFLOAT \ + DEFINTEF DEFINTRF DEGRED DELTAC DELTCF DEQUEUE DERHAM DFELEM \ DFINTTLS DFLOAT DFMAT DFVEC DFSFUN DFSFUN2 DGRPH DHMATRIX DIAGG DIFEXT \ DIFRING DIHGRP DIOPS DIOSP DIRPCAT DIRPROD2 DIRPROD DIRRING \ DISPLAY DISTCAT DISTEX DISTLAT DISTPOL DISTRO DISTRO2 DIVRING DJBP \ diff --git a/src/algebra/decimal.spad b/src/algebra/decimal.spad new file mode 100644 index 000000000..5eecfee4c --- /dev/null +++ b/src/algebra/decimal.spad @@ -0,0 +1,496 @@ +)abbrev domain DECFLOAT DecimalFloat + +B ==> Boolean +I ==> Integer +S ==> String +PI ==> PositiveInteger +RN ==> Fraction Integer +SF ==> DoubleFloat +N ==> NonNegativeInteger + +++ Author: LdBeth +++ Date Created: November 2021 +++ Basic Operations: outputFloating, outputGeneral, outputSpacing, +++ convert, log10, rescale, reduce, rationalApproximation, +++ Keywords: float, floating point, number, decimal +++ Description: \spadtype{DecimalFloat} implements arbitrary precision +++ floating point arithmetic in decimal. +++ This is similar to \spadtype{Float}, however the +++ \spadfunFrom{base}{FloatingPointSystem} has been set to 10 rather +++ than 2, hence \spad{Record(m: mantissa, e: exponent)} represents +++ the number \spad{m * 10 ^ e}. \spadtype{DecimalFloat} enjoys the +++ property of having an exact correspondence between the displayed +++ form and internal representation, at the cost of losing some of +++ the calculation efficiency. +++ +++ The arithmetic operations implemented resembles Mike Cowlishaw's +++ General Decimal Arithmetic, except special values such as NaN, +++ Infinity, ... are not handled, and sign is encoded with mantissa +++ rather than having a seperated bit, to match the behavor of +++ \spadtype{Float} and \spadtype{DoubleFloat}. +++ +++ The rounding mode been taken is round-half-up, means discarded digits +++ representing value of 0.5 and above are carried, otherswise they are +++ ignored. The default precision is 20 digits. The algorithms for +++ elementary functions are ported from the \spadtype{Float}. + +DecimalFloat(): + Join(FloatingPointSystem, CoercibleTo DoubleFloat, + ConvertibleTo InputForm, ElementaryFunctionCategory, + arbitraryPrecision, arbitraryExponent) with + rescale : (%, I) -> % + ++ rescale(x, n) sets the exponent of x to n and adjusts mantissa of x. + reduce : % -> % + ++ reduce(x) return x in its simplest form, that + ++ removes trailing zeros in mantissa of 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)}. + log10 : % -> % + ++ log10(x) computes the logarithm for x to base 10. + 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}. + 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. + outputSpacing : N -> Void + ++ outputSpacing(n) inserts a space after n (default 10) digits on output; + ++ outputSpacing(0) means no spaces are inserted. + == add + BASE ==> 10 + Rep := Record( mantissa : I, exponent : I ) + StoredConstant ==> Record( precision : PI, value : % ) + DIGS : PI := 20 + inc ==> increasePrecision + dec ==> decreasePrecision + LENGTH(n) ==> length10(n) + ISQRT ==> approxSqrt$IntegerRoots(I) + POW10(n) ==> (10^(n::N)) + error1(msg, f) ==> error concat [msg, ": ", toString f] + + -- local utility operations + length10 : I -> I -- integer log10 plus 1 + shift10 : (I, I) -> I -- decimal based shift + chop : (%, PI) -> % -- chop x at p bits of precision + power : (%, I) -> % -- x ^ n with chopping + plus : (%, %) -> % -- addition with no rounding + sub : (%, %) -> % -- subtraction with no rounding + negate : % -> % -- negation with no rounding + times : (%, %) -> % -- multiply x and y with no rounding + dvide : (%, %) -> % -- divide x by y with special normalizing + square : (%, I) -> % -- repeated squaring with chopping + expInverse : I -> % -- exp(1/n) for n an integer + expSeries : % -> % -- exp(x) by taylor series |x| < 1/2 + logSeries : % -> % -- log(x) by taylor series 1/2 < x < 2 + exp1 : () -> % -- constants for exp and log + clog2 : () -> % + clog10 : () -> % + ceillog10base2 : PI -> PI -- rational approximation + + length10 x == + i : N := (4004 * ((length(x)$I)-1) quo 13301) :: N + n : I := abs(x) quo POW10(i) + while n > 0 repeat + n := n quo 10 + i := i + 1 + i + + shift10(a, b) == + b < 0 => a quo POW10(abs b) + b = 0 => a + a * POW10(b) + + expSeries x == + nfac:I := 2 + n:I := 3 + s := xp := x + repeat + nx := xp * x + ns := s + (nx / [nfac, 0]) + if s = ns then return 1 + s + s := ns + nfac := nfac * n + n := 1 + n + xp := nx + + exp x == + -- exp(n+x) = exp(1)^n exp(x) for n such that |x| < 1 + p := digits(); inc 2; e1 : % := 1 + if (n := wholePart x) ~= 0 then + inc LENGTH n; e1 := exp1() ^ n; dec LENGTH n + x := fractionPart x + if zero? x then (digits p; return round e1) + -- make |x| < O( 2^(-sqrt p) ) < 1/2 to speed series convergence + -- by repeated use of the formula exp(2*x/2) = exp(x/2)^2 + -- results in an overall running time of O( sqrt p M(p) ) + k := ISQRT (p-100)::I quo 3 + k := max(0, 2 + k + order x) + if k > 0 then (inc k; x := x / (2^k::N)) + e := expSeries x + if k > 0 then e := square(e, k) + digits p + e * e1 + + E : StoredConstant := [1, [2, 0]] + exp1() == + if digits() > E.precision then E := [digits(), expSeries 1] + round E.value + + log x == + negative? x => error1("log: negative argument", x) + zero? x => error "log 0 generated" + one? x => 0 + [0, 0] + + log10 x == [0, 0] + + chop(x, p) == + e : I := LENGTH x.mantissa - p + if e > 0 then x := [(x.mantissa quo POW10(e)), x.exponent+e] + x + float(m, e) == round [m, e] + float(m, e, b) == + b = 10 => float(m, e) + inc 1; r := m * [b, 0] ^ e; dec 1 + round r + + sqrt x == + negative? x => error1("sqrt: negative argument", x) + m := x.mantissa; e := x.exponent + if odd? e then + m := m * 10 + e := e - 1 + (a := ISQRT m) * a = m => [a, e quo 2] + l : I := LENGTH m + p := 2 * digits() - l + if odd? (l-e) then p := p - 1 + i := x.mantissa * POW10(p) + -- ISQRT uses a variable precision newton iteration + i := ISQRT i + e := (e-p) quo 2 + round [i, e] + + bits() == 1 + ceillog10base2 digits() + bits(n) == (t := bits(); digits (max(1, 4004 * (n-1) quo 13301)::PI); t) + increasePrecision n == (b := digits(); digits((b + n)::PI); b) + decreasePrecision n == (b := digits(); digits((b - n)::PI); b) + round x == + m := x.mantissa + m = 0 => x + e := LENGTH m - digits() + if e > 0 then + y := m quo POW10(e-1) + (sign(m) * 5) + y := y quo 10 + if LENGTH y > digits() then + y := y quo 10 + e := e+1 + x := [y, x.exponent+e] + x + rescale (x, n) == + m := x.mantissa + e := x.exponent + e < n => + y := m quo POW10(n-e-1) + (sign(m) * 5) + y := y quo 10 + x := [y, n] + round [m * POW10(e-n), n] + reduce x == + m := x.mantissa; + m = 0 => 0 + e := x.exponent + while (m rem 10) = 0 repeat + m := m quo 10 + e := e + 1 + [m, e] + + order(a) == LENGTH(a.mantissa) + a.exponent - 1 + ceillog10base2 n == ((13301 * n + 4003) quo 4004) :: PI + digits() == DIGS + digits(n) == (t := DIGS; DIGS := n; t) + precision() == digits() + precision(n) == digits(n) + + 0 == [0, 0] + 1 == [1, 0] + base() == 10 + 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) + + 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 round x + wholePart x == shift10(x.mantissa ,x.exponent) + sign x == if x.mantissa < 0 then -1 else 1 + + - x == negate x + negate x == [-x.mantissa, x.exponent] + x + y == round plus(x, y) + x - y == round plus(x, negate y) + plus(x, y) == + mx := x.mantissa; my := y.mantissa + ex := x.exponent; ey := y.exponent + ex = ey => [mx+my, ex] + de := ex + LENGTH mx - ey - LENGTH my + de > digits()+1 => x + de < -(digits()+1) => y + if ex < ey then (mx, my, ex, ey) := (my, mx, ey, ex) + mw := my + mx * POW10(ex-ey) + [mw, ey] + + x : % * y : % == round times(x, y) + x : I * y : % == + if LENGTH x > digits() then round [x, 0] * y + else round [x * y.mantissa, y.exponent] + x : % / y : % == dvide(x, y) + x : % / y : I == + if LENGTH y > digits() then x / round [y, 0] else x / [y, 0] + + times(x : %, y : %) == [x.mantissa * y.mantissa, x.exponent + y.exponent] + shorten(q : I, eq : I, adjust : I) : % == + while adjust > 0 repeat + (q1, r1) := divide(q, 10) + r1 ~= 0 => break + q := q1 + adjust := adjust - 1 + round([q, eq - adjust]) + dvide(x, y) == + mx := x.mantissa + my := y.mantissa + ex := x.exponent + ey := y.exponent + adjust := max(LENGTH(my) - LENGTH(mx) + digits() + 1, 0) + (q, r) := divide(mx*POW10(adjust), my) + -- if inexact, then just round + r ~= 0 => round([q, ex - ey - adjust]) + shorten(q, ex - ey, adjust) + square(x, n) == + ma := x.mantissa; ex := x.exponent + for k in 1..n repeat + ma := ma * ma; ex := ex + ex + l : I := digits() - LENGTH ma + ma := shift10(ma, l); ex := ex - l + [ma, ex] + power(x, n) == + y : % := 1; z : % := x + repeat + if odd? n then y := chop( times(y, z), digits() ) + if (n := n quo 2) = 0 then return y + z := chop( times(z, z), digits() ) + + 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 + 2 + inc p; r := exp(y*log(x)); dec p + round 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 round 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 := LENGTH(n) + 2 + inc p + y := power(x, abs n) + if n < 0 then y := dvide(1, y) + dec p + round y + + -- Output routines + zero ==> char("0") + separator ==> escape()$Character + + SPACING : N := 10 + OUTMODE : S := "general" + + floating : % -> S + general : % -> S + + padFromLeft(s : S) : S == + zero? SPACING => s + n : I := #s - 1 + t := new( (n + 1 + n quo SPACING) :: N , separator ) + for i in 0..n for j in minIndex t .. repeat + t.j := s.(i + minIndex s) + if (i+1) rem SPACING = 0 then j := j+1 + t + padFromRight(s : S) : S == + SPACING = 0 => s + n : I := #s - 1 + t := new( (n + 1 + n quo SPACING) :: N , separator ) + for i in n..0 by -1 for j in maxIndex t .. by -1 repeat + t.j := s.(i + minIndex s) + if (n-i+1) rem SPACING = 0 then j := j-1 + t + + floating f == + negative? f => concat("-", floating abs f) + t:S := if zero? SPACING then "E" else " E " + concat [convert(mantissa f), t, convert(exponent f)@S] + + general f == + e := exponent f + zero? mantissa f => + e = 0 => "0" + e < 0 and e >= -6 => + concat("0.", padFromLeft new((abs e)::N, zero)) + t:S := if zero? SPACING then "E" else " E " + concat ["0",t,convert(e)@S] + negative? f => concat("-", general abs f) + s := convert(mantissa f)@S + -- Adjusted exponent + e = 0 => + padFromRight s + ae := e + (n := #s) - 1 + e < 0 and ae >= -6 => + if ae < 0 then s := concat(new((abs ae)::N, zero),s) + t := padFromLeft s((maxIndex s + e + 1) .. maxIndex s) + s := padFromRight s(minIndex s .. maxIndex s + e) + concat [s,".",t] + f:S := if zero? SPACING then "E" else " E " + n = 1 => concat [s,f,convert(ae)@S] + t := padFromLeft s((minIndex s + 1) .. maxIndex s) + concat [s(minIndex s)::S,".",t,f,convert(ae)@S] + + outputSpacing n == SPACING := n + outputGeneral() == OUTMODE := "general" + outputFloating() == OUTMODE := "floating" + + convert(f) : S == + OUTMODE = "floating" => floating f + OUTMODE = "general" => general f + error "bad output mode" + + 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 == float(mantissa x, exponent x, BASE)$Float + convert(x : %) : SF == float(mantissa x, exponent x, BASE)$SF + coerce(x : %) : SF == convert(x)@SF + + retract(f : %) : RN == rationalApproximation(f, (digits()-1)::N, BASE) + + retractIfCan(f:%):Union(RN, "failed") == + rationalApproximation(f, (digits()-1)::N, BASE) + + retractIfCan(f:%):Union(I, "failed") == + (f = (n := wholePart f)::%) => n + "failed" + + 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) + +--% DecimalFloat: 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. diff --git a/src/algebra/float.spad b/src/algebra/float.spad index a71cffdb5..4ecbf5344 100644 --- a/src/algebra/float.spad +++ b/src/algebra/float.spad @@ -80,7 +80,7 @@ N ==> NonNegativeInteger Float(): Join(FloatingPointSystem, DifferentialRing, OpenMath, CoercibleTo DoubleFloat, - ConvertibleTo InputForm, TranscendentalFunctionCategory, + ConvertibleTo DecimalFloat, ConvertibleTo InputForm, TranscendentalFunctionCategory, arbitraryPrecision, arbitraryExponent) with normalize : % -> % ++ normalize(x) normalizes x at current precision. @@ -937,6 +937,9 @@ Float(): -- Conversion routines convert(x : %) : Float == x pretend Float + convert(x : %) : DecimalFloat == + g := convert10(x, digits::I) + float(g.mantissa, g.exponent)$DecimalFloat 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) diff --git a/src/input/Makefile.in b/src/input/Makefile.in index a44de1446..211818ea9 100644 --- a/src/input/Makefile.in +++ b/src/input/Makefile.in @@ -68,7 +68,7 @@ OUTS= algaggr.output algfacob.output \ collect.output constant.output contfrac.output \ cycles.output \ cyfactor.output \ - danzwill.output defintef.output \ + danzwill.output defintef.output decimal.output \ dhtri.output \ divisor.output \ dpol.output \ diff --git a/src/input/decimal.input b/src/input/decimal.input new file mode 100644 index 000000000..4ee6b3231 --- /dev/null +++ b/src/input/decimal.input @@ -0,0 +1,46 @@ +-- this demonstrates DecimalFloats +)set break resume +)expose UnittestCount UnittestAux Unittest + +testsuite "decimalfloat" + +DF ==> DecimalFloat + +-- set 9 digits of accuracy +-- which follows General Decimal Arithmetic +digits(9)$DF + +testcase "float display" + +f1 := float(5,-6)$DF +f2 := float(50,-7)$DF +f3 := float(5,-7)$DF +testEquals("f1", "0.000005") +testEquals("f2", "0.0000050") +testEquals("f3", "5 E -7") + +testcase "arithmetics" + +a := 12@DF +b := a + 7.00@DF +testEquals("b", "19.00") +-- division should give extact result if possible +a2 := 2@DF / 3@DF +testEquals("a2", "0.666666667") +b2 := 2.400@DF / 2.0@DF +testEquals("b2", "1.20") + +testEquals("exp(-1@DF)", "0.367879441") +testEquals("exp(0@DF)", "1") +testEquals("exp(0.693147181@DF)", "2.00000000") + +testEquals("log(1.000@DF)", "0") +testEquals("log(2.71828183@DF)", "1.00000000") + +testEquals("log10(1.000@DF)", "0") +testEquals("log10(10@DF)" ,"1") +testEquals("log10(70@DF)" ,"1.84509804") + +testEquals("2@DF ^ -3", "0.125") + +statistics() diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 9c4a23931..462cabb1f 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -429,6 +429,10 @@ compSel1(domain, op, argl, m, e) == domain=$Float and op="float" and m=$DoubleFloat => argl is [mant, exp, 10] => try_constant_DF(mant, exp, m, e) nil + domain=$Float and op="float" and m=$DecimalFloat => + argl is [mant, exp, 10] => + [["Sel", ["DecimalFloat"], "float"], mant, exp], m, e] + nil e := domain is ['Mapping, :.] => augModemapsFromDomain1(domain, domain, e) diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 9a3a23cf8..8c6ddf571 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -181,6 +181,10 @@ mkAtree2(x,op,argl) == v := mkAtreeNode $immediateDataSymbol putValue(v,getBasicObject float expr) v + t = '(DecimalFloat) and expr is [['_$elt, '(Float), 'float], :args] => + mkAtree1 [['_$elt, '(DecimalFloat), 'float], :args] + t = '(DecimalFloat) and INTEGERP expr => + mkAtree1 ["::", expr, t] t = '(Float) and INTEGERP expr => mkAtree1 ["::", expr, t] typeIsASmallInteger(t) and INTEGERP expr => diff --git a/src/interp/setq.lisp b/src/interp/setq.lisp index ea7529076..b3c025581 100644 --- a/src/interp/setq.lisp +++ b/src/interp/setq.lisp @@ -105,6 +105,7 @@ (|%e| . (|exp| 1)) (|%pi| . (|pi|)) (|SF| . (|DoubleFloat|)) + (|DF| . (|DecimalFloat|)) (|%infinity| . (|infinity|)) (|%plusInfinity| . (|plusInfinity|)) (|%minusInfinity| . (|minusInfinity|)))) @@ -334,6 +335,7 @@ (SETQ |$OutputForm| '(|OutputForm|)) (SETQ |$Float| '(|Float|)) (SETQ |$DoubleFloat| '(|DoubleFloat|)) +(SETQ |$DecimalFloat| '(|DecimalFloat|)) (SETQ |$Integer| '(|Integer|)) (SETQ |$ComplexInteger| (LIST '|Complex| |$Integer|)) @@ -345,7 +347,6 @@ (SETQ |$Void| '(|Void|)) (SETQ |$QuotientField| '|Fraction|) (SETQ |$FunctionalExpression| '|Expression|) -(SETQ |$DoubleFloat| '(|DoubleFloat|)) (SETQ |$SingleInteger| '(|SingleInteger|)) (SETQ |$InteractiveFrame| (LIST (LIST NIL)))