diff --git a/basis/MATH.sml b/basis/MATH.sig similarity index 100% rename from basis/MATH.sml rename to basis/MATH.sig diff --git a/basis/RealSignature.sml b/basis/REAL.sig similarity index 100% rename from basis/RealSignature.sml rename to basis/REAL.sig diff --git a/basis/RealNumbersAsBits.ML b/basis/RealNumbersAsBits.ML new file mode 100644 index 00000000..822df9e3 --- /dev/null +++ b/basis/RealNumbersAsBits.ML @@ -0,0 +1,176 @@ +(* + Title: Standard Basis Library: Real number support + Author: David Matthews + Copyright David Matthews 2023 + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License version 2.1 as published by the Free Software Foundation. + + This library 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 + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +*) + +(* Extract the components of Real.real (double) and Real32.real (float). + The formats, particularly of Real32.real, differ between 32-bit and + 64-bit systems. *) + +structure RealNumbersAsBits: +sig + (* Floats. The mantissa will fit in a short int in both 32- and 64-bits . *) + val floatSignBit: Real32.real -> bool + and floatExponent: Real32.real -> FixedInt.int + and floatMantissa: Real32.real -> FixedInt.int + and floatFromBinary: {sign: bool, exp: FixedInt.int, mantissa: FixedInt.int} -> Real32.real + + (* Doubles. The mantissa is too large for a fixed int in 32-bit mode. *) + val doubleSignBit: real -> bool + and doubleExponent: real -> FixedInt.int + and doubleMantissa: real -> LargeInt.int + and doubleFromBinary: {sign: bool, exp: FixedInt.int, mantissa: LargeInt.int} -> real +end += +struct + + local + (* IEEE-754 format. + Float: 1 sign bit, 8 exponent bits, 23 mantissa bits. *) + (* In native 64-bit a float is implemented as a tagged value. The top + 32 bits contain the float, the lower 32-bits are zeros except for the tag. + Because word values are tagged this is equivalent to a shift of 31 bits in + ML. + In native 32-bit and 32-in-64 a float is implemented as a boxed value. *) + open LibrarySupport + val floatIsTagged = wordSize = 0w8 + val floatAsWord: Real32.real->word = RunCall.unsafeCast + val floatAsInt: Real32.real->FixedInt.int = RunCall.unsafeCast + val wordAsFloat: word->Real32.real = RunCall.unsafeCast + fun byte(r: Real32.real, b: word): Word8.word = + RunCall.loadByteFromImmutable(r, if bigEndian then b else 0w3-b) + and setByte(r: Real32.real, b: word, v: Word8.word) = + RunCall.storeByte(r, if bigEndian then b else 0w3-b, v) + in + fun floatSignBit (r: Real32.real): bool = + if floatIsTagged then floatAsInt r < 0 else byte(r, 0w0) >= 0w128 + + fun floatExponent (r: Real32.real): FixedInt.int = + if floatIsTagged + then FixedInt.fromInt(Word.toInt(Word.andb(Word.>>(floatAsWord r, 0w23+0w31), 0wxff))) + else FixedInt.fromInt( + Word8.toInt(Word8.andb(byte(r, 0w0), 0wx7f)) * 2 + + Word8.toInt(Word8.andb(byte(r, 0w1), 0wx80))) + + fun floatMantissa (r: Real32.real): FixedInt.int = + if floatIsTagged + then FixedInt.fromInt(Word.toInt(Word.andb(Word.>>(floatAsWord r, 0w31), 0wx7fffff))) + else + (FixedInt.fromInt(Word8.toInt(Word8.andb(byte(r, 0w1), 0wx7f))) * 256 + + FixedInt.fromInt(Word8.toInt(byte(r, 0w2)))) * 256 + + FixedInt.fromInt(Word8.toInt(byte(r, 0w3))) + + fun floatFromBinary{sign: bool, exp: FixedInt.int, mantissa: FixedInt.int}: Real32.real = + if floatIsTagged + then + let + val signBit = if sign then Word.<<(0w1, 0w31+0w31) else 0w0 + val expo = Word.<<(Word.fromInt(FixedInt.toInt exp), 0w23+0w31) + (* This assumes that the mantissa value is not too large. *) + val mant = Word.<<(Word.fromInt(FixedInt.toInt mantissa), 0w31) + in + wordAsFloat(Word.orb(signBit, Word.orb(expo, mant))) + end + else + let + val r: Real32.real = RunCall.allocateByteMemory(0w1, 0wx41) + val b0 = Word8.orb(if sign then 0wx80 else 0w0, Word8.fromInt(FixedInt.toInt(FixedInt.quot(exp, 2)))) + val () = setByte(r, 0w0, b0) + (* The low order 24 bits will always fit in a word. *) + val b = Word.orb(Word.<<(Word.fromInt(FixedInt.toInt exp), 0w23), + Word.fromInt(FixedInt.toInt mantissa)) + fun w8fromW x = Word8.fromLarge(Word.toLarge x) + val () = setByte(r, 0w1, w8fromW(Word.>>(b, 0w16))) + val () = setByte(r, 0w2, w8fromW(Word.>>(b, 0w8))) + val () = setByte(r, 0w3, w8fromW b) + val () = RunCall.clearMutableBit r + in + r + end + end + + local + (* IEEE-754 format. + Double: 1 sign bit, 11 exponent bits, 52 mantissa bits. *) + open LibrarySupport + (* In native 64-bit and 32-in-64 Real.real and LargeWord.word are both boxed + 64-bit quantities. *) + val realAsWord64: real -> LargeWord.word = RunCall.unsafeCast + and word64AsReal: LargeWord.word -> real = RunCall.unsafeCast + val realIsWord64 = sysWordSize = 0w8 + fun byte(r: real, b: word): Word8.word = + RunCall.loadByteFromImmutable(r, if bigEndian then b else 0w7-b) + and setByte(r: real, b: word, v: Word8.word) = + RunCall.storeByte(r, if bigEndian then b else 0w7-b, v) + (* We use this mask when LargeWord.word is 64-bits. We don't write out + the constant directly because it would cause an overflow when compiled in + 32-bit mode even though it's not used. *) + val doubleMantissaMask = LargeWord.>>(LargeWord.fromInt ~1, 0w12) + in + fun doubleSignBit (r: real) : bool = byte(r, 0w0) >= 0w128 + + fun doubleExponent (r: real): FixedInt.int = + FixedInt.fromInt( + Word8.toInt(Word8.andb(byte(r, 0w0), 0wx7f)) * 16 + + Word8.toInt(Word8.>>(byte(r, 0w1), 0w4))) + + fun doubleMantissa (r: real): LargeInt.int = + if realIsWord64 + then LargeWord.toLargeInt(LargeWord.andb(realAsWord64 r, doubleMantissaMask)) + else + (((((Word8.toLargeInt(Word8.andb(byte(r, 0w1), 0wxf)) * 256 + + Word8.toLargeInt(byte(r, 0w2))) * 256 + + Word8.toLargeInt(byte(r, 0w3))) * 256 + + Word8.toLargeInt(byte(r, 0w4))) * 256 + + Word8.toLargeInt(byte(r, 0w5))) * 256 + + Word8.toLargeInt(byte(r, 0w6))) * 256 + + Word8.toLargeInt(byte(r, 0w7)) + + fun doubleFromBinary{sign: bool, exp: FixedInt.int, mantissa: LargeInt.int}: real = + if realIsWord64 + then (* We can construct the value as a LargeWord.word and then cast it as a real. *) + let + val signBit = if sign then LargeWord.<<(0w1, 0w63) else 0w0 + val expo = LargeWord.<<(LargeWord.fromInt(FixedInt.toInt exp), 0w52) + (* This assumes that the mantissa value is not too large. *) + val mant = LargeWord.fromLargeInt mantissa + in + word64AsReal(LargeWord.orb(signBit, LargeWord.orb(expo, mant))) + end + else + let + val r: real = RunCall.allocateByteMemory(0w8 div wordSize, 0wx41) + val b0 = Word8.orb(if sign then 0wx80 else 0w0, Word8.fromInt(FixedInt.toInt(FixedInt.quot(exp, 16)))) + val () = setByte(r, 0w0, b0) + val b1 = + Word8.orb( + Word8.<<(Word8.fromInt(FixedInt.toInt(FixedInt.rem(exp, 16))), 0w4), + Word8.andb(Word8.fromLargeInt(IntInf.~>>(mantissa, 0w48)), 0wxf)) + val () = setByte(r, 0w1, b1) + val () = setByte(r, 0w2, Word8.fromLargeInt(IntInf.~>>(mantissa, 0w40))) + val () = setByte(r, 0w3, Word8.fromLargeInt(IntInf.~>>(mantissa, 0w32))) + val () = setByte(r, 0w4, Word8.fromLargeInt(IntInf.~>>(mantissa, 0w24))) + val () = setByte(r, 0w5, Word8.fromLargeInt(IntInf.~>>(mantissa, 0w16))) + val () = setByte(r, 0w6, Word8.fromLargeInt(IntInf.~>>(mantissa, 0w8))) + val () = setByte(r, 0w7, Word8.fromLargeInt mantissa) + val () = RunCall.clearMutableBit r + in + r + end + end + +end; \ No newline at end of file diff --git a/basis/RealToDecimalConversion.ML b/basis/RealToDecimalConversion.ML new file mode 100644 index 00000000..cf3ed606 --- /dev/null +++ b/basis/RealToDecimalConversion.ML @@ -0,0 +1,500 @@ +(* + Title: Standard Basis Library: Conversion from floating point to decimal + Author: David Matthews + + The underlying conversion code was translated from the C version of Ryu. + That code is Copyright 2018 Ulf Adams and is licensed under the terms of + the Apache License version 2.0 or Boost Software License, Version 1.0 + Boost Software License - Version 1.0 - August 17th, 2003 + + Boost Licence + Permission is hereby granted, free of charge, to any person or organization + obtaining a copy of the software and accompanying documentation covered by + this license (the "Software") to use, reproduce, display, distribute, + execute, and transmit the Software, and to prepare derivative works of the + Software, and to permit third-parties to whom the Software is furnished to + do so, all subject to the following: + + The copyright notices in the Software and this entire statement, including + the above license grant, this restriction and the following disclaimer, + must be included in all copies of the Software, in whole or in part, and + all derivative works of the Software, unless such copies or derivative + works are solely in the form of machine-executable object code generated by + a source language processor. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT + SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE + FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + + + The ML translation and related code is copyright David Matthews 2023 + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + Licence version 2.1 as published by the Free Software Foundation. + + This library 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 + Lesser General Public Licence for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +*) + +structure RealToDecimalConversion: +sig + val f2decimal: Real32.real -> {sign:bool, exponent: int, mantissa: int} + val d2decimal: real -> {sign:bool, exponent: int, mantissa: LargeInt.int} +end += +struct + (* Common functions *) + + (* Returns floor(log10(2^e)) for values of e between 0 and 1650. *) + fun log10Pow2 e = + if e < 0 orelse e > 1650 then raise General.Domain + else Int.quot(e * 78913, 0x40000) (* >> 18 *) + (* Returns floor(log10(5^e)) for values of e between 0 and 2620 *) + and log10Pow5 e = + if e < 0 orelse e > 2620 then raise General.Domain + else Int.quot(e * 732923, 0x100000) (* >> 20 *) + + fun pow5bits e = + if e < 0 orelse e > 3528 then raise General.Domain + else Int.quot(e * 1217359, 0x80000) (* >> 19 *) + 1 + + (* Float conversion. This generally uses int rather than LargeInt.int. *) + local + val floatBias = 127 (* This is the exponent value for 1.0 *) + val floatMantissaBits = 24 - 1 (* One bit is implicit *) + val floatImplicitBit = Word.toInt(Word.<<(0w1, Word.fromInt floatMantissaBits)) + + local + (* Keep dividing by 5 while the remainder is zero *) + fun p5 count value = + if Int.rem(value, 5) <> 0 + then count + else p5 (count+1) (Int.quot(value, 5)) + in + (* Returns whether value is divisible by 5 to the power p. *) + fun multipleOfPow5(value, e5) = + p5 0 value >= e5 + end + + fun multipleOfPowerOf2(value, p) = + Word.andb(Word.fromInt value, Word.<<(0w1, Word.fromInt p) - 0w1) = 0w0 + + local + val posTableSize = 47 and invTableSize = 55 + val pow5BitCount = 61 and pow5InvBitCount = 59 + + fun createInvSplit i = + let + val pow = IntInf.pow(5, i) + val pow5len = IntInf.log2 pow + 1 (* Bit length *) + val j = pow5len - 1 + pow5InvBitCount + val pow5inv = IntInf.<<(1, Word.fromInt j) div pow + 1 + in + pow5inv + end + + and createSplit i = + let + val pow = IntInf.pow(5, i) + val pow5len = IntInf.log2 pow + 1 (* Bit length *) + val shift = pow5len-pow5BitCount + val pow5 = + if shift < 0 + then IntInf.<<(pow, Word.fromInt(~shift)) + else IntInf.~>>(pow, Word.fromInt shift) + in + pow5 + end + + val floatPow5InvSplit = Vector.tabulate(invTableSize, createInvSplit) + and floatPow5Split = Vector.tabulate(posTableSize, createSplit) + + (* We don't have 64-bit arithmetic on 32-bit platforms so this uses arbitrary precision + arithmetic. It might be possible to select different versions depending on the + word length. + The Java version uses two tables of 31 bit values which would be an + alternative. *) + fun mulShift32(m: int, factor, shift: int): int = + if shift <= 32 then raise Fail "mulShift32" + else LargeInt.toInt(IntInf.~>>(factor*LargeInt.fromInt m, Word.fromInt shift)) + in + fun mulPow5InvDivPow2(m, q, j) = mulShift32(m, Vector.sub(floatPow5InvSplit, q), j) + and mulPow5DivPow2(m, i, j) = mulShift32(m, Vector.sub(floatPow5Split, i), j) + + val floatPow5InvBitCount = pow5InvBitCount + and floatPow5BitCount = pow5BitCount + end + + fun f2d(ieeeMantissa, ieeeExponent) = + let + (* Step 1: Normalise the value. Normalised values, with exponent non-zero, + have an implicit one in the top bit position. *) + val (e2, m2) = + if ieeeExponent = 0 + then (1-floatBias-floatMantissaBits-2, ieeeMantissa) + else (ieeeExponent-floatBias-floatMantissaBits-2, ieeeMantissa + floatImplicitBit) + + val isEven = Int.rem(m2, 2) = 0 + val acceptBounds = isEven + + (* Step 2: Determine the interval of valid decimal representations (??) *) + val mmShift = if ieeeMantissa <> 0 orelse ieeeExponent <= 1 then 1 else 0 + (* Presumably this is 4* because we've subtracted 2 from e2. *) + val mm = 4 * m2 - 1 - mmShift + val mv = 4 * m2 + val mp = 4 * m2 + 2 + + (* Step 3: Convert to a decimal power base *) + val (e10, vr, vp, vm, lastRemovedDigit, vrIsTrailingZeros, vmIsTrailingZeros) = + if e2 >= 0 + then + let + val q = log10Pow2 e2 + val e10 = q + val k = floatPow5InvBitCount + pow5bits q - 1 + val i = ~e2 + q + k + val vr = mulPow5InvDivPow2(mv, q, i) + and vp = mulPow5InvDivPow2(mp, q, i) + and vm = mulPow5InvDivPow2(mm, q, i) + in + if q > 9 + then (e10, vr, vp, vm, 0, false, false) (* Too large to be power of 5. *) + else if Int.rem(mv, 5) = 0 + then (e10, vr, vp, vm, 0, multipleOfPow5(mv, q), false) + else if acceptBounds + then (e10, vr, vp, vm, 0, false, multipleOfPow5(mm, q)) + else (e10, vr, vp - (if multipleOfPow5(mp, q) then 1 else 0), vm, 0, false, false) + end + else + let + val q = log10Pow5(~ e2) + val e10 = q + e2 + val i = ~e2 - q + val k = pow5bits i - floatPow5BitCount + val j = q - k + val vr = mulPow5DivPow2(mv, i, j) + and vp = mulPow5DivPow2(mp, i, j) + and vm = mulPow5DivPow2(mm, i, j) + val lastRemovedDigit = + if q <> 0 andalso Int.quot(vp-1, 10) <= Int.quot(vm, 10) + then + let + val j' = q-1-(pow5bits(i+1)-floatPow5BitCount) + val lrm = Int.rem(mulPow5DivPow2(mv, i+1, j'), 10) + in + lrm + end + else 0 + in + if q <= 1 + then if acceptBounds + then (e10, vr, vp, vm, lastRemovedDigit, true, mmShift = 1) + else (e10, vr, vp-1, vm, lastRemovedDigit, true, false) + else if q < 31 + then (e10, vr, vp, vm, lastRemovedDigit, multipleOfPowerOf2(mv, q-1), false) + else (e10, vr, vp, vm, lastRemovedDigit, false, false) + end + + (* Step 4: Find the shortest decimal representation in the interval *) + val (output, removed) = + if vmIsTrailingZeros orelse vrIsTrailingZeros + then + let + fun removeVrDigits(vr, vp, vm, removed, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) = + let + val vpDiv10 = Int.quot(vp, 10) + and vmDiv10 = Int.quot(vm, 10) + in + if vpDiv10 > vmDiv10 + then removeVrDigits(Int.quot(vr, 10), vpDiv10, vmDiv10, removed+1, Int.rem(vr, 10), + vmIsTrailingZeros andalso Int.rem(vm, 10) = 0, + vrIsTrailingZeros andalso lastRemovedDigit = 0) + else removeVmDigits(vr, vp, vm, removed, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) + end + + and removeVmDigits(vr, vp, vm, removed, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) = + let + in + if vmIsTrailingZeros andalso Int.rem(vm, 10) = 0 + then removeVmDigits(Int.quot(vr, 10), Int.quot(vp, 10), Int.quot(vm, 10), removed+1, Int.rem(vr, 10), + vmIsTrailingZeros, vrIsTrailingZeros andalso lastRemovedDigit = 0) + else + let + val lastRemovedDigit2 = + if vrIsTrailingZeros andalso lastRemovedDigit = 5 andalso Int.rem(vr, 2) = 0 + then 4 (* Don't round up *) + else lastRemovedDigit + val vrCorrect = + (vr = vm andalso (not acceptBounds orelse not vmIsTrailingZeros)) orelse lastRemovedDigit2 >= 5 + in + (vr + (if vrCorrect then 1 else 0), removed) + end + end + in + removeVrDigits(vr, vp, vm, 0, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) + end + else + let + fun removeDigits(vr, vp, vm, removed, lastRemovedDigit) = + let + val vpDiv10 = Int.quot(vp, 10) + and vmDiv10 = Int.quot(vm, 10) + in + if vpDiv10 > vmDiv10 + then removeDigits(Int.quot(vr, 10), vpDiv10, vmDiv10, removed+1, Int.rem(vr, 10)) + else (vr + (if vr = vm orelse lastRemovedDigit >= 5 then 1 else 0), removed) + end + in + removeDigits(vr, vp, vm, 0, lastRemovedDigit) + end + + in + {mantissa=output, exponent=e10+removed} + end + + in + fun f2decimal(f: Real32.real): {sign:bool, exponent: int, mantissa: int} = + let + open RealNumbersAsBits + val ieeeSign = floatSignBit f + and ieeeExponent = floatExponent f + and ieeeMantissa = floatMantissa f + in + if ieeeExponent = 255 + then raise General.Domain (* Infinities and NaN *) + else if ieeeExponent = 0 andalso ieeeMantissa = 0 + then {sign=ieeeSign, exponent=0, mantissa=0} + else + let + val {mantissa, exponent} = f2d(FixedInt.toInt ieeeMantissa, FixedInt.toInt ieeeExponent) + in + {sign=ieeeSign, exponent=exponent, mantissa=mantissa} + end + end + end + + (* Double conversion *) + local + val doubleBias = 1023 (* This is the exponent value for 1.0 *) + val doubleMantissaBits = 53 - 1 (* One bit is implicit *) + val doubleImplicitBit = IntInf.<<(1, Word.fromInt doubleMantissaBits) + + local + (* Keep dividing by 5 while the remainder is zero *) + fun p5 count value = + if LargeInt.rem(value, 5) <> 0 + then count + else p5 (count+1) (LargeInt.quot(value, 5)) + in + (* Returns whether value is divisible by 5 to the power p. *) + fun multipleOfPow5(value, e5) = + p5 0 value >= e5 + end + + fun multipleOfPowerOf2(value, p) = + IntInf.andb(value, IntInf.<<(1, Word.fromInt p) - 1) = 0 + + local + val posTableSize = 326 and invTableSize = 342 + val pow5BitCount = 125 and pow5InvBitCount = 125 + + fun createInvSplit i = + let + val pow = IntInf.pow(5, i) + val pow5len = IntInf.log2 pow + 1 (* Bit length *) + val j = pow5len - 1 + pow5InvBitCount + val pow5inv = IntInf.<<(1, Word.fromInt j) div pow + 1 + in + pow5inv + end + + and createSplit i = + let + val pow = IntInf.pow(5, i) + val pow5len = IntInf.log2 pow + 1 (* Bit length *) + val shift = pow5len-pow5BitCount + val pow5 = + if shift < 0 + then IntInf.<<(pow, Word.fromInt(~shift)) + else IntInf.~>>(pow, Word.fromInt shift) + in + pow5 + end + + val doublePow5InvSplit = Vector.tabulate(invTableSize, createInvSplit) + and doublePow5Split = Vector.tabulate(posTableSize, createSplit) + + (* We don't have 64-bit arithmetic on 32-bit platforms so this uses arbitrary precision + arithmetic. It might be possible to select different versions depending on the + word length. *) + fun mulShift(m: LargeInt.int, factor, shift: int): LargeInt.int = + if shift <= 32 then raise Fail "mulShift32" + else IntInf.~>>(factor*m, Word.fromInt shift) + in + fun mulPow5InvDivPow2(m, i, j) = mulShift(m, Vector.sub(doublePow5InvSplit, i), j) + and mulPow5DivPow2(m, i, j) = mulShift(m, Vector.sub(doublePow5Split, i), j) + + val doublePow5InvBitCount = pow5InvBitCount + and doublePow5BitCount = pow5BitCount + end + + fun d2d(ieeeMantissa: LargeInt.int, ieeeExponent: int) = + let + (* Step 1: Normalise the value. Normalised values, with exponent non-zero, + have an implicit one in the top bit position. *) + val (e2, m2) = + if ieeeExponent = 0 + then (1-doubleBias-doubleMantissaBits-2, ieeeMantissa) + else (ieeeExponent-doubleBias-doubleMantissaBits-2, ieeeMantissa + doubleImplicitBit) + + val isEven = LargeInt.rem(m2, 2) = 0 + val acceptBounds = isEven + + (* Step 2: Determine the interval of valid decimal representations *) + val mmShift = + if ieeeMantissa <> 0 orelse ieeeExponent <= 1 then 1 else 0 + + val mm = 4 * m2 - 1 - mmShift + val mv = 4 * m2 + val mp = 4 * m2 + 2 + + (* Step 3: Convert to a decimal power base *) + val (e10, vr, vp, vm, lastRemovedDigit, vrIsTrailingZeros, vmIsTrailingZeros) = + if e2 >= 0 + then + let + val q = log10Pow2 e2 + val e10 = q + val k = doublePow5InvBitCount + pow5bits q - 1 + val i = ~e2 + q + k + val vr = mulPow5InvDivPow2(mv, q, i) + and vp = mulPow5InvDivPow2(mp, q, i) + and vm = mulPow5InvDivPow2(mm, q, i) + in + if q > 21 + then (e10, vr, vp, vm, 0, false, false) (* Too large to be power of 5. *) + else if LargeInt.rem(mv, 5) = 0 + then (e10, vr, vp, vm, 0, multipleOfPow5(mv, q), false) + else if acceptBounds + then (e10, vr, vp, vm, 0, false, multipleOfPow5(mm, q)) + else (e10, vr, vp - (if multipleOfPow5(mp, q) then 1 else 0), vm, 0, false, false) + end + else + let + val q = log10Pow5(~ e2) + val e10 = q + e2 + val i = ~e2 - q + val k = pow5bits i - doublePow5BitCount + val j = q - k + val vr = mulPow5DivPow2(mv, i, j) + and vp = mulPow5DivPow2(mp, i, j) + and vm = mulPow5DivPow2(mm, i, j) + val lastRemovedDigit = + if q <> 0 andalso LargeInt.quot(vp-1, 10) <= LargeInt.quot(vm, 10) + then + let + val j' = q-1-(pow5bits(i+1)-doublePow5BitCount) + val lrm = LargeInt.rem(mulPow5DivPow2(mv, i+1, j'), 10) + in + lrm + end + else 0 + in + if q <= 1 + then if acceptBounds + then (e10, vr, vp, vm, lastRemovedDigit, true, mmShift = 1) + else (e10, vr, vp-1, vm, lastRemovedDigit, true, false) + else if q < 31 + then (e10, vr, vp, vm, lastRemovedDigit, multipleOfPowerOf2(mv, q-1), false) + else (e10, vr, vp, vm, lastRemovedDigit, false, false) + end + + (* Step 4: Find the shortest decimal representation in the interval *) + val (output, removed) = + if vmIsTrailingZeros orelse vrIsTrailingZeros + then + let + fun removeVrDigits(vr, vp, vm, removed, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) = + let + val vpDiv10 = LargeInt.quot(vp, 10) + and vmDiv10 = LargeInt.quot(vm, 10) + in + if vpDiv10 > vmDiv10 + then removeVrDigits(LargeInt.quot(vr, 10), vpDiv10, vmDiv10, removed+1, LargeInt.rem(vr, 10), + vmIsTrailingZeros andalso LargeInt.rem(vm, 10) = 0, + vrIsTrailingZeros andalso lastRemovedDigit = 0) + else removeVmDigits(vr, vp, vm, removed, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) + end + + and removeVmDigits(vr, vp, vm, removed, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) = + let + in + if vmIsTrailingZeros andalso LargeInt.rem(vm, 10) = 0 + then removeVmDigits(LargeInt.quot(vr, 10), LargeInt.quot(vp, 10), LargeInt.quot(vm, 10), removed+1, LargeInt.rem(vr, 10), + vmIsTrailingZeros, vrIsTrailingZeros andalso lastRemovedDigit = 0) + else + let + val lastRemovedDigit2 = + if vrIsTrailingZeros andalso lastRemovedDigit = 5 andalso LargeInt.rem(vr, 2) = 0 + then 4 (* Don't round up *) + else lastRemovedDigit + val vrCorrect = + (vr = vm andalso (not acceptBounds orelse not vmIsTrailingZeros)) orelse lastRemovedDigit2 >= 5 + in + (vr + (if vrCorrect then 1 else 0), removed) + end + end + in + removeVrDigits(vr, vp, vm, 0, lastRemovedDigit, vmIsTrailingZeros, vrIsTrailingZeros) + end + else + let + fun removeDigits(vr, vp, vm, removed, lastRemovedDigit) = + let + val vpDiv10 = LargeInt.quot(vp, 10) + and vmDiv10 = LargeInt.quot(vm, 10) + in + if vpDiv10 > vmDiv10 + then removeDigits(LargeInt.quot(vr, 10), vpDiv10, vmDiv10, removed+1, LargeInt.rem(vr, 10)) + else (vr + (if vr = vm orelse lastRemovedDigit >= 5 then 1 else 0), removed) + end + in + removeDigits(vr, vp, vm, 0, lastRemovedDigit) + end + + in + {mantissa=output, exponent=e10+removed} + end + in + fun d2decimal(r: real): {sign:bool, exponent: int, mantissa: LargeInt.int} = + let + open RealNumbersAsBits + val ieeeSign = doubleSignBit r + and ieeeExponent = doubleExponent r + and ieeeMantissa = doubleMantissa r + in + if ieeeExponent = 2047 + then raise General.Domain (* Infinities and NaN *) + else if ieeeExponent = 0 andalso ieeeMantissa = 0 + then {sign=ieeeSign, exponent=0, mantissa=0} + else + let + val {mantissa, exponent} = d2d(ieeeMantissa, FixedInt.toInt ieeeExponent) + in + {sign=ieeeSign, exponent=exponent, mantissa=mantissa} + end + end + end + +end; diff --git a/basis/build.sml b/basis/build.sml index df8acde0..f601b8e8 100644 --- a/basis/build.sml +++ b/basis/build.sml @@ -1,241 +1,242 @@ (* Title: Standard Basis Library: Commands to build the library Copyright David C.J. Matthews 2000, 2005, 2015-16, 2018-21 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (* Thread, Weak and Signal are Poly/ML extensions. *) val () = Bootstrap.use "basis/InitialBasis.ML"; val () = Bootstrap.use "basis/Universal.ML"; val () = Bootstrap.use "basis/General.sml"; val () = Bootstrap.use "basis/LibrarySupport.sml"; val () = Bootstrap.use "basis/PolyMLException.sml"; val () = Bootstrap.use "basis/Option.sml"; val () = Bootstrap.use "basis/ListSignature.sml"; val () = Bootstrap.use "basis/List.sml"; val () = Bootstrap.use "basis/VectorOperations.sml"; val () = Bootstrap.use "basis/PolyVectorOperations.sml"; val () = Bootstrap.use "basis/VectorSliceOperations.sml"; val () = Bootstrap.use "basis/MONO_VECTOR.sml"; val () = Bootstrap.use "basis/MONO_VECTOR_SLICE.sml"; val () = Bootstrap.use "basis/MONO_ARRAY.sml"; val () = Bootstrap.use "basis/MONO_ARRAY_SLICE.sml"; val () = Bootstrap.use "basis/StringSignatures.sml"; val () = Bootstrap.use "basis/String.sml"; structure Int = struct type int = int end; val () = Bootstrap.use "basis/INTEGER.sml"; val () = Bootstrap.use "basis/Int.sml"; val () = Bootstrap.use (if Bootstrap.intIsArbitraryPrecision then "basis/IntAsLargeInt.sml" else "basis/IntAsFixedInt.sml"); val () = case FixedInt.precision of SOME 31 => Bootstrap.use "basis/Int31.sml" | SOME 63 => Bootstrap.use "basis/Int63.sml" | _ => (); val () = Bootstrap.use "basis/WordSignature.sml"; val () = Bootstrap.use "basis/LargeWord.sml"; val () = Bootstrap.use "basis/VectorSignature.sml"; val () = Bootstrap.use "basis/VectorSliceSignature.sml"; val () = Bootstrap.use "basis/Vector.sml"; val () = Bootstrap.use "basis/ArraySignature.sml"; val () = Bootstrap.use "basis/ArraySliceSignature.sml"; (* Depends on VectorSlice. *) val () = Bootstrap.use "basis/Array.sml"; val () = Bootstrap.use "basis/Text.sml"; (* Declares Char, String, CharArray, CharVector *) val () = Bootstrap.use "basis/Bool.sml"; val () = Bootstrap.use "basis/ListPair.sml"; (* Declare the appropriate additional structures. *) (* The version of Word32 we use depends on whether this is 32-bit or 64-bit. *) val () = if LargeWord.wordSize = 32 then Bootstrap.use "basis/Word32.sml" else if Word.wordSize >= 32 then Bootstrap.use "basis/Word32In64.sml" else if LargeWord.wordSize = 64 then Bootstrap.use "basis/Word32InLargeWord64.sml" else (); val () = Bootstrap.use "basis/Word16.sml"; val () = Bootstrap.use "basis/Word8.sml"; val () = Bootstrap.use "basis/IntInf.sml"; val () = Bootstrap.use "basis/Int32.sml"; val () = Bootstrap.use "basis/Word8Array.sml"; val () = Bootstrap.use "basis/Byte.sml"; val () = Bootstrap.use "basis/BoolArray.sml"; val () = Bootstrap.use "basis/IntArray.sml"; val () = Bootstrap.use "basis/RealArray.sml"; val () = Bootstrap.use "basis/IEEE_REAL.sml"; val () = Bootstrap.use "basis/IEEEReal.sml"; -val () = Bootstrap.use "basis/MATH.sml"; -val () = Bootstrap.use "basis/MATH.sml"; +val () = Bootstrap.use "basis/RealNumbersAsBits.ML"; (* Support library. *) +val () = Bootstrap.use "basis/RealToDecimalConversion.ML"; (* Support library. *) +val () = Bootstrap.use "basis/MATH.sig"; structure LargeReal = struct type real = real end; -val () = Bootstrap.use "basis/RealSignature.sml"; +val () = Bootstrap.use "basis/REAL.sig"; val () = Bootstrap.use "basis/Real.sml"; val () = Bootstrap.use "basis/Real32.sml"; val () = Bootstrap.use "basis/Time.sml"; val () = Bootstrap.use "basis/DATE.sig"; val () = Bootstrap.use "basis/Date.sml"; val () = Bootstrap.use "basis/Thread.sml"; (* Non-standard. *) val () = Bootstrap.use "basis/ThreadLib.sml"; (* Non-standard. *) val () = Bootstrap.use "basis/Timer.sml"; val () = Bootstrap.use "basis/CommandLine.sml"; val () = Bootstrap.use "basis/ExnPrinter.sml"; val () = Bootstrap.use "basis/ForeignConstants.sml"; val () = Bootstrap.use "basis/ForeignMemory.sml"; val () = Bootstrap.useWithParms [Bootstrap.Universal.tagInject Bootstrap.maxInlineSizeTag 1000] "basis/Foreign.sml"; val () = Bootstrap.use "basis/IO.sml"; val () = Bootstrap.use "basis/OS.sml"; val () = Bootstrap.use "basis/PRIM_IO.sml"; val () = Bootstrap.use "basis/PrimIO.sml"; val () = Bootstrap.use "basis/LibraryIOSupport.sml"; val () = Bootstrap.use "basis/STREAM_IO.sml"; val () = Bootstrap.use "basis/BasicStreamIO.sml"; val () = Bootstrap.use "basis/IMPERATIVE_IO.sml"; val () = Bootstrap.use "basis/ImperativeIO.sml"; val () = Bootstrap.use "basis/TextIO.sml"; val () = Bootstrap.use "basis/BinIO.sml"; val () = Bootstrap.use "basis/Socket.sml"; val () = Bootstrap.use "basis/NetProtDB.sml"; val () = Bootstrap.use "basis/NetServDB.sml"; val () = Bootstrap.use "basis/GenericSock.sml"; val () = Bootstrap.use "basis/INetSock.sml"; val () = Bootstrap.use "basis/INet6Sock.sml"; val () = Bootstrap.use "basis/PackReal.sml"; val () = if Word.wordSize = 31 then Bootstrap.use "basis/PackReal32Boxed.sml" else Bootstrap.use "basis/PackReal32Tagged.sml"; val () = Bootstrap.use "basis/PackWord.sml"; val () = Bootstrap.use "basis/Array2Signature.sml"; val () = Bootstrap.use "basis/Array2.sml"; val () = Bootstrap.use "basis/IntArray2.sml"; val () = Bootstrap.use "basis/SML90.sml"; val () = Bootstrap.use "basis/Weak.sml"; val () = Bootstrap.use "basis/Signal.sml"; val () = Bootstrap.use "basis/BIT_FLAGS.sml"; val () = Bootstrap.use "basis/SingleAssignment.sml"; (* Build Windows or Unix structure as appropriate. *) local val getOS: int = LibrarySupport.getOSType() in val () = if getOS = 0 then ( Bootstrap.use "basis/Posix.sml"; Bootstrap.use "basis/Unix.sml"; Bootstrap.use "basis/UnixSock.sml" ) else if getOS = 1 then (Bootstrap.use "basis/Windows.sml") else () end; val () = Bootstrap.use "basis/HashArray.ML"; val () = Bootstrap.use "basis/UniversalArray.ML"; val () = Bootstrap.use "basis/PrettyPrinter.sml"; (* Add PrettyPrinter to PolyML structure. *) val () = Bootstrap.use "basis/ASN1.sml"; val () = Bootstrap.use "basis/Statistics.ML"; (* Add Statistics to PolyML structure. *) val () = Bootstrap.use "basis/InitialPolyML.ML"; (* Relies on OS. *) val () = Bootstrap.use "basis/FinalPolyML.sml"; val () = Bootstrap.use "basis/TopLevelPolyML.sml"; (* Add rootFunction to Poly/ML. *) val use = PolyML.use; (* Copy everything out of the original name space. *) (* Do this AFTER we've finished compiling PolyML and after adding "use". *) local val values = ["!", "*", "+", "-", "/", "::", ":=", "<", "<=", "<>", "=", ">", ">=", "@", "Bind", "Chr", "Div", "Domain", "EQUAL", "Empty", "Fail", "GREATER", "LESS", "Match", "NONE", "Option", "Overflow", "SOME", "Size", "Span", "Subscript", "^", "abs", "app", "before", "ceil", "chr", "concat", "div", "exnMessage", "exnName", "explode", "false", "floor", "foldl", "foldr", "getOpt", "hd", "ignore", "implode", "isSome", "length", "map", "mod", "nil", "not", "null", "o", "ord", "print", "quickSort", "real", "ref", "rev", "round", "size", "sort", "str", "substring", "tl", "true", "trunc", "use", "valOf", "vector", "~"] val fixes = ["*", "+", "-", "/", "::", ":=", "<", "<=", "<>", "=", ">", ">=", "@", "^", "before", "div", "mod", "o"] val sigs = ["ARRAY", "ARRAY2", "ARRAY_SLICE", "BIN_IO", "BIT_FLAGS", "BOOL", "BYTE", "CHAR", "COMMAND_LINE", "DATE", "GENERAL", "GENERIC_SOCK", "IEEE_REAL", "IMPERATIVE_IO", "INET6_SOCK", "INET_SOCK", "INTEGER", "INT_INF", "IO", "LIST", "LIST_PAIR", "MATH", "MONO_ARRAY", "MONO_ARRAY2", "MONO_ARRAY_SLICE", "MONO_VECTOR", "MONO_VECTOR_SLICE", "NET_HOST_DB", "NET_PROT_DB", "NET_SERV_DB", "OPTION", "OS", "OS_FILE_SYS", "OS_IO", "OS_PATH", "OS_PROCESS", "PACK_REAL", "PACK_WORD", "POSIX", "POSIX_ERROR", "POSIX_FILE_SYS", "POSIX_IO", "POSIX_PROCESS", "POSIX_PROC_ENV", "POSIX_SIGNAL", "POSIX_SYS_DB", "POSIX_TTY", "PRIM_IO", "REAL", "SIGNAL", "SML90", "SOCKET", "STREAM_IO", "STRING", "STRING_CVT", "SUBSTRING", "TEXT", "TEXT_IO", "TEXT_STREAM_IO", "THREAD", "TIME", "TIMER", "UNIX", "UNIX_SOCK", "VECTOR", "VECTOR_SLICE", "WEAK", "WINDOWS", "WORD"] val types = ["array", "bool", "char", "exn", "int", "list", "option", "order", "real", "ref", "string", "substring", "unit", "vector", "word"] val functs = ["ImperativeIO", "PrimIO", "StreamIO"] val structs = ["Array", "Array2", "ArraySlice", "Asn1", "BinIO", "BinPrimIO", "Bool", "BoolArray", "BoolArray2", "BoolVector", "Byte", "Char", "CharArray", "CharArray2", "CharArraySlice", "CharVector", "CharVectorSlice", "CommandLine", "Date", "FixedInt", "Foreign", "General", "GenericSock", "HashArray", "IEEEReal", "INet6Sock", "INetSock", "IO", "Int", "Int32", "Int63", "IntArray", "IntArray2", "IntArraySlice", "IntInf", "IntVector", "IntVectorSlice", "LargeInt", "LargeReal", "LargeWord", "List", "ListPair", "Math", "Net6HostDB", "NetHostDB", "NetProtDB", "NetServDB", "OS", "Option", "PackRealBig", "PackRealLittle", "PackReal32Big", "PackReal32Little", "PackWord16Big", "PackWord16Little", "PackWord32Big", "PackWord32Little", "PackWord8Big", "PackWord8Little", "PolyML", "Position", "Posix", "Real", "Real32", "RealArray", "RealArray2", "RealArraySlice", "RealVector", "RealVectorSlice", "RunCall", "SML90", "Signal", "SingleAssignment", "Socket", "String", "StringCvt", "Substring", "SysWord", "Text", "TextIO", "TextPrimIO", "Thread", "ThreadLib", "Time", "Timer", "Universal", "UniversalArray", "Unix", "UnixSock", "Vector", "VectorSlice", "Weak", "Windows", "Word", "Word16", "Word32", "Word64", "Word8", "Word8Array", "Word8Array2", "Word8ArraySlice", "Word8Vector", "Word8VectorSlice"] fun copyOver (enter, lookup) = let (* Copy over everything in the list if possible. Some items e.g. the Posix structure, may not be present. *) fun copy s = enter PolyML.globalNameSpace (s, valOf(lookup Bootstrap.globalSpace s)) handle Option => () in List.app copy end in val () = copyOver(#enterVal, #lookupVal) values val () = copyOver(#enterFix, #lookupFix) fixes val () = copyOver(#enterType, #lookupType) types val () = copyOver(#enterSig, #lookupSig) sigs val () = copyOver(#enterStruct, #lookupStruct) structs val () = copyOver(#enterFunct, #lookupFunct) functs end; (* Now we've created the new name space we must use PolyML.make/use. N.B. Unlike Bootstrap.use these don't automatically look at the -I option. *) diff --git a/polyml.pyp b/polyml.pyp index 060df268..e3b998fd 100644 --- a/polyml.pyp +++ b/polyml.pyp @@ -1,243 +1,245 @@ - + + - + +