Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | (*-------------------------------------------------------------------*) | |
8 | (* Number *) | |
9 | (*-------------------------------------------------------------------*) | |
10 | ||
11 | functor Number(structure I : INTEGER | |
12 | structure R : REAL | |
13 | val intToReal : I.t -> R.t) : NUMBER = | |
14 | struct | |
15 | ||
16 | structure I = I | |
17 | structure F = R | |
18 | structure R = Rational(I) | |
19 | ||
20 | datatype t = | |
21 | Int of I.t | |
22 | | Rat of R.t | |
23 | | Real of F.t | |
24 | ||
25 | val intToRat = R.fromInt | |
26 | ||
27 | fun ratToReal p = F./(intToReal(R.numerator p), | |
28 | intToReal(R.denominator p)) | |
29 | ||
30 | fun toReal(Int m) = intToReal m | |
31 | | toReal(Rat p) = ratToReal p | |
32 | | toReal(Real x) = x | |
33 | ||
34 | fun unary(i,r,f) = | |
35 | fn Int m => i m | |
36 | | Rat p => r p | |
37 | | Real x => f x | |
38 | ||
39 | fun binary(i,r,f) = | |
40 | let fun intRat(m,p) = r(p,intToRat m) | |
41 | fun intReal(m,x) = f(x,intToReal m) | |
42 | fun ratReal(p,x) = f(x,ratToReal p) | |
43 | in fn (Int m,Int n) => i(m,n) | |
44 | | (Rat p,Rat q) => r(p,q) | |
45 | | (Real x,Real y) => f(x,y) | |
46 | | (Int m,Rat p) => intRat(m,p) | |
47 | | (Rat p,Int m) => intRat(m,p) | |
48 | | (Int m,Real x) => intReal(m,x) | |
49 | | (Real x,Int m) => intReal(m,x) | |
50 | | (Rat p,Real x) => ratReal(p,x) | |
51 | | (Real x,Rat p) => ratReal(p,x) | |
52 | end | |
53 | ||
54 | structure OF : BASIC_ORDERED_FIELD = | |
55 | struct | |
56 | type t = t | |
57 | val zero = Int(I.zero) | |
58 | val one = Int(I.one) | |
59 | ||
60 | fun rat p = if R.isInt p then Int(R.toInt p) else Rat p | |
61 | fun close(g,i,r,f) = g(Int o i,rat o r,Real o f) | |
62 | val (op +) = close(binary,I.+,R.+,F.+) | |
63 | val (op ~) = close(unary,I.~,R.~,F.~) | |
64 | val (op * ) = close(binary,I.*,R.*,F.* ) | |
65 | val inverse = unary(Rat o R.inverse o intToRat, | |
66 | Rat o R.inverse, | |
67 | Real o F.inverse) | |
68 | ||
69 | val compare = binary(I.compare,R.compare,F.compare) | |
70 | val op < = binary(I.<, R.<, F.<) | |
71 | val op = = binary(I.=, R.=, F.=) | |
72 | val op <= = binary(I.<=, R.<=, F.<=) | |
73 | val op > = binary(I.>, R.>, F.>) | |
74 | val op >= = binary(I.>=, R.>=, F.>=) | |
75 | ||
76 | fun output(Int m,out) = I.output(m,out) | |
77 | | output(Rat p,out) = R.output(p,out) | |
78 | | output(Real x,out) = F.output(x,out) | |
79 | end | |
80 | ||
81 | structure Field = OrderedField(OF) | |
82 | open OF Field | |
83 | ||
84 | fun isZero z = z = zero | |
85 | fun isPositive z = z > zero | |
86 | fun isNegative z = z < zero | |
87 | ||
88 | (*----------------------------------------*) | |
89 | (* Integers *) | |
90 | (*----------------------------------------*) | |
91 | ||
92 | exception UnaryIntOnly | |
93 | fun unaryIntOnly i = | |
94 | fn Int m => i m | |
95 | | _ => raise UnaryIntOnly | |
96 | ||
97 | exception BinaryIntOnly | |
98 | fun binaryIntOnly i = | |
99 | fn (Int m,Int n) => Int(i(m,n)) | |
100 | | _ => raise BinaryIntOnly | |
101 | ||
102 | val (op mod) = binaryIntOnly I.mod | |
103 | val (op quot) = binaryIntOnly I.quot | |
104 | val (op rem) = binaryIntOnly I.rem | |
105 | val (op div) = binaryIntOnly I.div | |
106 | val factorial = unaryIntOnly (Int o I.factorial) | |
107 | val choose = binaryIntOnly I.choose | |
108 | val gcd = binaryIntOnly I.gcd | |
109 | val lcm = binaryIntOnly I.lcm | |
110 | ||
111 | fun isEven z = isZero(z mod two) | |
112 | val isOdd = not o isEven | |
113 | ||
114 | (*----------------------------------------*) | |
115 | (* Rationals *) | |
116 | (*----------------------------------------*) | |
117 | ||
118 | exception UnaryRatOnly | |
119 | fun unaryRatOnly r = | |
120 | fn Rat p => r p | |
121 | | _ => raise UnaryRatOnly | |
122 | ||
123 | val numerator = unaryRatOnly R.numerator | |
124 | val denominator = unaryRatOnly R.denominator | |
125 | ||
126 | (*----------------------------------------*) | |
127 | (* Reals *) | |
128 | (*----------------------------------------*) | |
129 | ||
130 | fun toRealUnary f z = Real(f(toReal z)) | |
131 | fun toRealBinary f (z,z')= Real(f(toReal z,toReal z')) | |
132 | ||
133 | val ln = toRealUnary F.ln | |
134 | val exp = toRealUnary F.exp | |
135 | val log = toRealBinary F.log | |
136 | val log2 = toRealUnary F.log2 | |
137 | ||
138 | val (op ^) = fn (z,z') => | |
139 | if isZero z' then one | |
140 | else case (z,z') of | |
141 | (Int m,Int n) => if I.isPositive n | |
142 | then Int(I.^(m,n)) | |
143 | else Rat(R.inverse | |
144 | (intToRat(I.^(m,I.~ n)))) | |
145 | | (Int m,_) => Real(F.^(intToReal m,toReal z')) | |
146 | | _ => Real(F.^(toReal z,toReal z')) | |
147 | ||
148 | fun random(Int m,Int n) = Int(I.random(m,n)) | |
149 | | random(z,z') = Real(F.random(toReal z,toReal z')) | |
150 | ||
151 | val toReal = F.toReal o toReal | |
152 | val fromReal = Real o F.fromReal | |
153 | val toInt = unaryIntOnly I.toInt | |
154 | val fromInt = Int o I.fromInt | |
155 | ||
156 | exception Input | |
157 | fun input _ = raise Input | |
158 | ||
159 | exception ToString | |
160 | fun toString _ = raise ToString | |
161 | ||
162 | exception FromString | |
163 | fun fromString _ = raise FromString | |
164 | ||
165 | end | |
166 | ||
167 | (* | |
168 | structure Number = Number(structure I = BigInteger | |
169 | structure R = FloatReal | |
170 | val intToReal = I.toReal) | |
171 | *) |