1(* 2 Title: Rebuild the basis library: Real and StringCvt 3 Copyright David C.J. Matthews 2016 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License version 2.1 as published by the Free Software Foundation. 8 9 This library is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17*) 18 19(* Real *) 20useBasis "IEEE_REAL.sml"; 21structure IEEEReal: IEEE_REAL = 22struct 23 open IEEEReal 24 type decimal_approx = 25 { class : float_class, sign : bool, digits : int list, exp : int } 26 27 local 28 fun toNewDA {class, sign, digits, exp } : decimal_approx = 29 {class=class, sign=sign, digits = map FixedInt.toLarge digits, exp = FixedInt.toLarge exp } 30 and fromNewDA ({class, sign, digits, exp } : decimal_approx) = 31 {class=class, sign=sign, digits = map FixedInt.fromLarge digits, exp = FixedInt.fromLarge exp } 32 in 33 val toString = toString o fromNewDA 34 val scan = fn getc => fn src => Option.map(fn (v, c) => (toNewDA v, c)) (scan getc src) 35 and fromString = (Option.map toNewDA) o fromString 36 end 37end; 38 39(* There's a complication. We need access to both the old and new versions of 40 the StringCvt.realfmt datatype. *) 41local 42 structure OldStringCvt = StringCvt 43in 44 structure StringCvt: STRING_CVT = 45 struct 46 open StringCvt 47 48 datatype realfmt 49 = SCI of int option 50 | FIX of int option 51 | GEN of int option 52 | EXACT 53 54 val padRight = fn c => fn i => padRight c (FixedInt.fromInt i) 55 and padLeft = fn c => fn i => padLeft c (FixedInt.fromInt i) 56 end; 57 58 structure Real = 59 struct 60 open Real 61 val radix = FixedInt.toLarge radix 62 val precision = FixedInt.toLarge precision 63 val sign = FixedInt.toLarge o sign 64 val toManExp = fn r => let val {man, exp} = toManExp r in {man=man, exp= FixedInt.toLarge exp} end 65 and fromManExp = fn {man, exp} => fromManExp{man=man, exp=FixedInt.fromLarge exp } 66 val toInt = toLargeInt 67 and fromInt = fromLargeInt 68 69 val floor = toLargeInt IEEEReal.TO_NEGINF 70 and ceil = toLargeInt IEEEReal.TO_POSINF 71 and trunc = toLargeInt IEEEReal.TO_ZERO 72 and round = toLargeInt IEEEReal.TO_NEAREST 73 74 val toDecimal = 75 fn r => 76 let 77 val {class, sign, digits, exp } = toDecimal r 78 in 79 {class=class, sign=sign, digits = map FixedInt.toLarge digits, exp = FixedInt.toLarge exp } 80 end 81 82 val fromDecimal = 83 fn {class, sign, digits, exp } => 84 fromDecimal {class=class, sign=sign, digits = map FixedInt.fromLarge digits, exp = FixedInt.fromLarge exp } 85 86 local 87 fun rfmt (StringCvt.SCI(SOME s)) r = fmt (OldStringCvt.SCI(SOME(FixedInt.fromLarge s))) r 88 | rfmt (StringCvt.SCI NONE) r = fmt (OldStringCvt.SCI NONE) r 89 | rfmt (StringCvt.FIX(SOME s)) r = fmt (OldStringCvt.FIX(SOME(FixedInt.fromLarge s))) r 90 | rfmt (StringCvt.FIX NONE) r = fmt (OldStringCvt.FIX NONE) r 91 | rfmt (StringCvt.GEN(SOME s)) r = fmt (OldStringCvt.GEN(SOME(FixedInt.fromLarge s))) r 92 | rfmt (StringCvt.GEN NONE) r = fmt (OldStringCvt.GEN NONE) r 93 | rfmt StringCvt.EXACT r = fmt OldStringCvt.EXACT r 94 in 95 val fmt = rfmt 96 end 97 end 98end; 99 100useBasis "RealSignature.sml"; (* This uses IEEEReal and the new StringCvt and decimal_approx *) 101structure Real: REAL = Real; 102structure LargeReal = Real; 103 104val real : int -> real = Real.fromInt 105val trunc : real -> int = Real.trunc 106val floor : real -> int = Real.floor 107val ceil : real -> int = Real.ceil 108val round : real -> int =Real.round; 109