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 115 - (view) (download)
Original Path: trunk/src/compiler/common/rational.sml

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

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