![[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.