![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to realconst.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / bignums|
Return to realconst.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / bignums |
1.1 ! root 1: (* Copyright 1989 by AT&T Bell Laboratories *) ! 2: (* ! 3: RealConst: generate ML real constants. ! 4: RealConst uses long multiplication to find the correct bit pattern for ! 5: the real. This method is slow, but accurate, and works to any precision, ! 6: which means that floats can be cross-compiled correctly. ! 7: ! 8: The function emitreal should take (int * bool array * int) which represents ! 9: a real value as (sign * fraction * exponent). ! 10: The sign is 0 if the real is positive, 1 if negative. ! 11: The fraction is a boolean array representing the bits; note that the most ! 12: significant bit is in position 0. ! 13: The exponent is the binary exponent of the normalized fraction. ! 14: "Normalized" here means a number between 0 and 1. ! 15: ! 16: The algorithm works inefficient on forms like 10000000.0; forms like 1E7 (with ! 17: no bogus zeros) are better. Also inefficient on forms like 0E23 or 1E~212. ! 18: *) ! 19: ! 20: signature PRIMREAL = sig ! 21: val significant : int ! 22: val outofrange : string -> unit ! 23: val emitreal : (int * bool array * int) -> unit ! 24: end ! 25: ! 26: signature REALCONST = sig ! 27: val realconst : string -> unit ! 28: end ! 29: ! 30: functor RealConst(P : PRIMREAL) : REALCONST = ! 31: struct ! 32: ! 33: open P ! 34: ! 35: (* Use more than the required precision, then round at the end. Because ! 36: bigints are signed, this is actually one bit less precision than you might ! 37: think. This criterion works well enough for the 53 bits required by ! 38: Vax G format and IEEE double format, but has not been tested with other ! 39: values of significant. *) ! 40: val precision = significant + 16 - ((significant + 8) mod 8) ! 41: ! 42: (* A float is a WHOLE "fraction" and an exponent base TWO. *) ! 43: type float = {frac : Bigint.bigint, exp : int} ! 44: ! 45: val bigint = Bigint.bigint ! 46: val plus = Bigint.+ ! 47: val times = Bigint.* ! 48: infix plus times ! 49: ! 50: (* Take a bigint and return a bool array of bits which will represent the ! 51: fraction. The high (1/2) bit is in array position 0. Assumes that ! 52: the bigint is positive. This will work if the bigint is smaller than ! 53: the array or vice versa; however, the number will be truncated, not ! 54: rounded. *) ! 55: fun makebits (f,n) = ! 56: let val s = Bigint.size f ! 57: val bits = array(n,false) ! 58: fun onebit b = Bigint.getbit(f,s-1-b) ! 59: fun copybit n = (update(bits,n,onebit n); copybit (n+1)) ! 60: handle Subscript => () ! 61: in copybit 0; ! 62: bits ! 63: end ! 64: ! 65: (* round a float to n significant digits *) ! 66: local val one = bigint 1 in ! 67: fun round (float as {frac=f,exp=e},n) = ! 68: let val shift = Bigint.size f + 1 - n ! 69: in ! 70: if shift <= 0 then float ! 71: else {frac = if Bigint.getbit(f,shift-1) ! 72: then Bigint.>>(f, shift) plus one ! 73: else Bigint.>>(f, shift), ! 74: exp = e + shift} ! 75: end ! 76: end ! 77: ! 78: (* maketenth: create the float of one tenth, to any number of significant ! 79: digits, with no rounding on the last digit. *) ! 80: local val zero = bigint 0 and one = bigint 1 and two = bigint 2 in ! 81: fun maketenth 1 = {frac=one,exp= ~4} ! 82: | maketenth n = ! 83: let val {frac,exp} = maketenth(n-1) ! 84: val rec tenthbit = fn 0 => zero | 1 => one ! 85: | 2 => one | 3 => zero | n => tenthbit(n mod 4) ! 86: val f = (frac times two) plus tenthbit n ! 87: val e = exp - 1 ! 88: in ! 89: {frac=f,exp=e} ! 90: end ! 91: end ! 92: ! 93: (* float values ten and one tenth, to the correct precision. *) ! 94: val ten = {frac=bigint 5, exp = 1} ! 95: val tenth = round(maketenth(precision+1),precision) ! 96: ! 97: (* Multiplies two floats together to the correct precision *) ! 98: fun mult {frac=f1,exp=e1} {frac=f2,exp=e2} = ! 99: let val f = f1 times f2 ! 100: val e : int = e1 + e2 ! 101: (* shouldn't need the type constraint, our comp bug *) ! 102: in ! 103: round({frac=f,exp=e},precision) ! 104: end ! 105: ! 106: (* Create a dynamic array of powers of ten *) ! 107: structure DFA = Dynamic(struct open Array ! 108: type float = {frac : Bigint.bigint, exp : int} ! 109: type elem = unit->float ! 110: type array = elem array ! 111: end) ! 112: local open DFA ! 113: exception Unknown ! 114: fun makelem e = (fn () => e) ! 115: val one = {frac=bigint 1,exp=0} ! 116: in ! 117: val pos10 = array(fn () => raise Unknown) (* 10^2^n *) ! 118: val _ = update(pos10,0,makelem ten) ! 119: val neg10 = array(fn () => raise Unknown) (* 10^~2^n *) ! 120: val _ = update(neg10,0,makelem tenth) ! 121: fun access(arr,n) = (arr sub n) () ! 122: handle Unknown => let val last = access(arr,n-1) ! 123: val new = mult last last ! 124: in update(arr,n,makelem new); ! 125: new ! 126: end ! 127: ! 128: fun pow10_2 0 = one ! 129: | pow10_2 n = if n > 0 then access(pos10,n-1) else access(neg10,~n-1) ! 130: fun raisepower(f,0) = f ! 131: | raisepower(f,e) = ! 132: let val sign = if e<0 then ~1 else 1 ! 133: fun power(f,p) = mult f (pow10_2(sign*p)) ! 134: fun raisep(f,0,_) = f ! 135: | raisep(f,e,p) = ! 136: if Bits.andb(e,1) = 1 then raisep(power(f,p),Bits.rshift(e,1),p+1) ! 137: else raisep(f,Bits.rshift(e,1),p+1) ! 138: in raisep(f,abs e,1) ! 139: end ! 140: end ! 141: ! 142: (* Takes a string list of the form {digit*.[digit*]}, and returns a bigint and ! 143: the exponent base 10. Requires that the list contain a decimal point and ! 144: no trailing zeros (useless zeros after the decimal point). *) ! 145: local val ten = bigint 10 and zero = bigint 0 in ! 146: fun reducefrac f = ! 147: let fun getexp nil = 0 ! 148: | getexp ("."::_) = 0 ! 149: | getexp (_::tl) = getexp tl - 1 ! 150: fun getwhole nil = zero ! 151: | getwhole ("."::tl) = getwhole tl ! 152: | getwhole ("0"::tl) = ten times getwhole tl ! 153: | getwhole (n::tl) = bigint(ord n - ord "0") plus (ten times getwhole tl) ! 154: val backwards = rev f ! 155: val whole = getwhole backwards ! 156: val exp = getexp backwards ! 157: in ! 158: (whole,exp) ! 159: end ! 160: end ! 161: ! 162: exception Toobig ! 163: ! 164: (* Takes a legal ML float string and returns an (int * bigint * int) ! 165: which is the sign, whole "fraction", and power of ten exponent *) ! 166: fun getparts s = ! 167: let datatype trailing = SIGNIFICANT | TRAILING ! 168: (* separate the fraction from the exponent, adding a decimal point if ! 169: there is none and eliminating trailing zeros *) ! 170: fun separate (nil,s) = (nil,nil,s) ! 171: | separate ("E"::tl,SIGNIFICANT) = (["."],tl,SIGNIFICANT) ! 172: | separate ("E"::tl,TRAILING) = (nil,tl,TRAILING) ! 173: | separate ("0"::tl,s) = ! 174: let val (r,e,s) = separate(tl,s) ! 175: in case s of TRAILING => (r,e,TRAILING) ! 176: | SIGNIFICANT => ("0"::r,e,SIGNIFICANT) ! 177: end ! 178: | separate ("."::tl,_) = ! 179: let val (r,e,_) = separate(tl,TRAILING) ! 180: in ("."::r,e,SIGNIFICANT) ! 181: end ! 182: | separate (hd::tl,s) = ! 183: let val (r,e,_) = separate(tl,s) ! 184: in (hd::r,e,SIGNIFICANT) ! 185: end ! 186: val (unsigned,sign) = case explode s of "~"::more => (more,1) ! 187: | other => (other,0) ! 188: val (frac_s,exp_s,_) = separate(unsigned,SIGNIFICANT) ! 189: fun atoi strlist = ! 190: let val numlist = map (fn n => ord n - ord "0") strlist ! 191: in List.revfold (fn (a:int,b) => b*10 + a) numlist 0 ! 192: end ! 193: val exp10 = (case exp_s of nil => 0 ! 194: | "~"::more => ~(atoi more) ! 195: | other => atoi other) ! 196: handle Overflow => raise Toobig ! 197: val (frac,exp) = reducefrac frac_s ! 198: in ! 199: (sign,frac,exp10 + exp) ! 200: end ! 201: ! 202: (* Takes a legal ML float string and returns an (int * bool array * int) ! 203: which is the sign, fraction (with the high(1/2) bit in array posn 0), ! 204: and exponent. This is the form expected by the functor parameter ! 205: emitreal. *) ! 206: fun makereal f = ! 207: let val (sign,frac10,exp10) = getparts f ! 208: val float = raisepower(round({frac=frac10,exp=0},precision),exp10) ! 209: val (newf as {frac,exp}) = round(float,significant+1) ! 210: val size = Bigint.size frac ! 211: val bits = makebits(frac,significant) ! 212: in ! 213: case size of 0 => (0,bits,0) ! 214: | _ => (sign,bits,exp + size) ! 215: end ! 216: ! 217: fun realconst f = emitreal(makereal f) ! 218: handle Toobig => (outofrange f; emitreal(makereal "0.0")) ! 219: ! 220: end (* functor RealConst *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.