Annotation of /trunk/src/compiler/fields/rational.sml

Parent Directory | Revision Log

---

Revision 3349 - (view) (download)

1 :	jhr	115	(* rational.sml
2 :			*
3 :	jhr	3349	* This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :			*
5 :			* COPYRIGHT (c) 2015 The University of Chicago
6 :	jhr	115	* All rights reserved.
7 :			*
8 :			* Support for rational numbers.
9 :			*)
10 :
11 :			signature RATIONAL =
12 :			sig
13 :
14 :			eqtype rat
15 :
16 :	jhr	138	val zero : rat
17 :
18 :	jhr	461	val explode : rat -> {sign : int, num : IntInf.int, denom : IntInf.int}
19 :
20 :	jhr	115	val ~ : rat -> rat
21 :			val + : rat * rat -> rat
22 :			val - : rat * rat -> rat
23 :			val * : rat * rat -> rat
24 :			val div : rat * rat -> rat
25 :
26 :			(*
27 :			val min : rat * rat -> rat
28 :			val max : rat * rat -> rat
29 :			*)
30 :			val abs : rat -> rat
31 :
32 :			val sign : rat -> int
33 :			val sameSign : rat * rat -> bool
34 :
35 :			(*
36 :			val > : rat * rat -> bool
37 :			val >= : rat * rat -> bool
38 :			val < : rat * rat -> bool
39 :			val <= : rat * rat -> bool
40 :	jhr	118	*)
41 :	jhr	115
42 :	jhr	2356	val isZero : rat -> bool
43 :
44 :			val same : rat * rat -> bool
45 :	jhr	115	val compare : rat * rat -> order
46 :
47 :			val / : LargeInt.int * LargeInt.int -> rat
48 :
49 :			val fromInt : int -> rat
50 :			val fromLargeInt : LargeInt.int -> rat
51 :
52 :			val toString : rat -> string
53 :
54 :	jhr	138	val toReal : rat -> real
55 :
56 :	jhr	115	end
57 :
58 :			structure Rational :> RATIONAL =
59 :			struct
60 :
61 :			structure II = IntInf
62 :
63 :			(* invariants:
64 :			* denom > 0
65 :			* gcd(num, denom) = 1
66 :			*)
67 :			datatype rat = R of {num : II.int, denom : II.int}
68 :
69 :	jhr	466	fun explode (R{num, denom}) =
70 :	jhr	461	if (num < 0)
71 :	jhr	466	then {sign = ~1, num = ~num, denom = denom}
72 :	jhr	461	else if (num = 0)
73 :			then {sign = 0, num = 0, denom = 0}
74 :			else {sign = 1, num = num, denom = denom}
75 :
76 :	jhr	115	val zero = R{num=0, denom=1}
77 :
78 :	jhr	2356	fun isZero (R{num, ...}) = (num = 0)
79 :
80 :	jhr	115	fun gcd (a : II.int, 0) = a
81 :			| gcd (a, b) = if (a > b)
82 :			then gcd(a-b, b)
83 :			else gcd(a, b-a)
84 :
85 :			fun mkRat (0, _) = zero
86 :			| mkRat (n, 1) = R{num=n, denom=1}
87 :			| mkRat (num, denom) = let
88 :			val d = gcd(II.abs num, denom)
89 :			in
90 :			R{num = num div d, denom = denom div d}
91 :			end
92 :
93 :			fun neg (R{num, denom}) = R{num = ~num, denom = denom}
94 :
95 :			fun add (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = let
96 :			val d = gcd(d1, d2)
97 :			val a1 = d2 div d
98 :			val a2 = d1 div d
99 :			val lcm = a1 * d1
100 :			in
101 :	jhr	116	mkRat (a1*n1 + a2*n2, lcm)
102 :	jhr	115	end
103 :
104 :			fun sub (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = let
105 :			val d = gcd(d1, d2)
106 :			val a1 = d2 div d
107 :			val a2 = d1 div d
108 :			val lcm = a1 * d1
109 :			in
110 :	jhr	116	mkRat (a1*n1 - a2*n2, lcm)
111 :	jhr	115	end
112 :
113 :			fun mul (R{num=n1, denom=d1}, R{num=n2, denom=d2}) =
114 :			mkRat (n1*n2, d1*d2)
115 :
116 :			fun divide (_, R{num=0, ...}) = raise Div
117 :			| divide (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = let
118 :			val n = n1 * d2
119 :			val d = n2 * d1
120 :			in
121 :			if (d < 0) then mkRat(~n, ~d) else mkRat(n, d)
122 :			end
123 :
124 :			fun abs (R{num, denom}) = R{num = II.abs num, denom = denom}
125 :
126 :			fun sign (R{num, ...}) = II.sign num
127 :
128 :			fun sameSign (R{num=n1, ...}, R{num=n2, ...}) = II.sameSign(n1, n2)
129 :
130 :	jhr	2356	fun same (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = (n1 = n2) andalso (d1 = d2)
131 :
132 :	jhr	118	fun compare (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = (
133 :			case Int.compare(II.sign n1, II.sign n2)
134 :			of EQUAL =>
135 :			if (d1 = d2)
136 :			then II.compare(n1, n2)
137 :			else let
138 :			val d = gcd(d1, d2)
139 :			val a1 = d2 div d
140 :			val a2 = d1 div d
141 :			in
142 :			II.compare(a1*n1, a2*n2)
143 :			end
144 :			| order => order
145 :			(* end case *))
146 :
147 :	jhr	115	(*
148 :			val > : rat * rat -> bool
149 :			val >= : rat * rat -> bool
150 :			val < : rat * rat -> bool
151 :			val <= : rat * rat -> bool
152 :
153 :			val min : rat * rat -> rat
154 :			val max : rat * rat -> rat
155 :			*)
156 :
157 :			fun fromInt n = mkRat(II.fromInt n, 1)
158 :			fun fromLargeInt n = mkRat(n, 1)
159 :
160 :			fun toString (R{num, denom = 1}) = II.toString num
161 :			| toString (R{num, denom}) =
162 :			String.concat[II.toString num, "/", II.toString denom]
163 :
164 :	jhr	138	fun toReal (R{num, denom = 1}) = Real.fromLargeInt num
165 :			| toReal (R{num, denom}) = Real.fromLargeInt num / Real.fromLargeInt denom
166 :
167 :			fun op / (_, 0) = raise Div
168 :			| op / (a, b) = if (b < 0)
169 :			then mkRat(~a, ~b)
170 :			else mkRat(a, b)
171 :
172 :	jhr	115	(* bind operators *)
173 :			val ~ : rat -> rat = neg
174 :			val op + : rat * rat -> rat = add
175 :			val op - : rat * rat -> rat = sub
176 :			val op * : rat * rat -> rat = mul
177 :			val op div : rat * rat -> rat = divide
178 :			(*
179 :			val > : rat * rat -> bool
180 :			val >= : rat * rat -> bool
181 :			val < : rat * rat -> bool
182 :			val <= : rat * rat -> bool
183 :			*)
184 :
185 :			end

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0