Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/compiler/fields/rational.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log 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