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 | structure Types = | |
9 | struct | |
10 | type ('a, 'b) power = | |
11 | {layout: 'a -> Layout.t, | |
12 | one: 'a, | |
13 | times: 'a * 'a -> 'a} | |
14 | -> 'a * 'b | |
15 | -> 'a | |
16 | ||
17 | type ('a, 'b) simultaneous = | |
18 | {layout: 'a -> Layout.t, | |
19 | one: 'a, | |
20 | times: 'a * 'a -> 'a} | |
21 | -> ('a * 'b) list | |
22 | -> 'a | |
23 | end | |
24 | ||
25 | structure Power: | |
26 | sig | |
27 | val power: ('a, Pervasive.Int.int) Types.power | |
28 | val powerInf: ('a, Pervasive.IntInf.int) Types.power | |
29 | val simultaneous: ('a, Pervasive.Int.int) Types.simultaneous | |
30 | val simultaneousInf: ('a, Pervasive.IntInf.int) Types.simultaneous | |
31 | end = | |
32 | struct | |
33 | ||
34 | open Types | |
35 | ||
36 | structure Int = Pervasive.Int | |
37 | structure Array = Pervasive.Array | |
38 | ||
39 | fun for(a: Int.int, b: Int.int, f: Int.int -> unit) = | |
40 | let fun loop i = if i >= b then () else (f i; loop(i + 1)) | |
41 | in loop a | |
42 | end | |
43 | ||
44 | type 'a exponent = {isZero: 'a -> bool, | |
45 | divMod: 'a * 'a -> 'a * 'a, | |
46 | two: 'a} | |
47 | ||
48 | type 'a base = {one: 'a, | |
49 | times: 'a * 'a -> 'a, | |
50 | layout: 'a -> Layout.t} | |
51 | ||
52 | fun ('a, 'b) make | |
53 | ({isZero, divMod, two}: 'a exponent) | |
54 | ({one, times, layout = _}: 'b base) = | |
55 | let | |
56 | val op * = times | |
57 | (* Repeated squaring. *) | |
58 | fun power(b: 'b, n: 'a): 'b = | |
59 | let | |
60 | (* The loop has been carefully unrolled once to avoid overflow when | |
61 | * 'a is a fixed size integer. | |
62 | *) | |
63 | fun loop(c, b, n) = | |
64 | (* c * b^2n = b0^n0 *) | |
65 | if isZero n then c else next(c, b * b, n) | |
66 | and next(c, b, n) = | |
67 | (* c * b^n = b0^n0 *) | |
68 | let val (d, m) = divMod(n, two) | |
69 | in loop(if isZero m then c else c * b, b, d) | |
70 | end | |
71 | in if isZero n | |
72 | then one | |
73 | else next(one, b, n) | |
74 | end | |
75 | (* Based on page 618 of Handbook of Applied Cryptography. *) | |
76 | fun simultaneous(ges: ('b * 'a) list): 'b = | |
77 | let | |
78 | fun twoPowerWord i : Word.t = Word.<<(0w1, Word.fromInt i) | |
79 | val twoPower = Word.toInt o twoPowerWord | |
80 | fun doit ges = | |
81 | let | |
82 | val n = List.length ges | |
83 | val tableSize = twoPower n | |
84 | val table = Array.array(tableSize, one) | |
85 | val _ = | |
86 | List.foreachi | |
87 | (ges, fn (i, (g, _)) => | |
88 | let val min = twoPower i | |
89 | in for(min, twoPower(i + 1), fn i => | |
90 | Array.update(table, i, | |
91 | g * Array.sub(table, i - min))) | |
92 | end) | |
93 | fun loop(ews: ('a * Word.t) list, Gs: 'b list): 'b list = | |
94 | case ews of | |
95 | [] => Gs | |
96 | | _ => | |
97 | let | |
98 | val (ews, w) = | |
99 | List.fold | |
100 | (ews, ([], 0w0: Word.t), | |
101 | fn ((e, w'), (ews, w)) => | |
102 | let | |
103 | val (e, m) = divMod(e, two) | |
104 | val ews = | |
105 | if isZero e then ews else (e, w') :: ews | |
106 | val w = | |
107 | if isZero m then w else Word.orb(w', w) | |
108 | in (ews, w) | |
109 | end) | |
110 | in loop(ews, Array.sub(table, Word.toInt w) :: Gs) | |
111 | end | |
112 | val ews = List.mapi (ges, fn (i, (_, e)) => | |
113 | (e, twoPowerWord i)) | |
114 | val Gs = loop (ews, []) | |
115 | in List.fold (Gs, one, fn (G, A) => A * A * G) | |
116 | end | |
117 | val window = 9 | |
118 | fun split l = | |
119 | let | |
120 | fun loop(l, n, ac) = | |
121 | if n <= 0 | |
122 | then (rev ac, l) | |
123 | else (case l of | |
124 | [] => (rev ac, []) | |
125 | | x :: l => loop(l, n - 1, x :: ac)) | |
126 | in loop(l, window, []) | |
127 | end | |
128 | fun loop(ges: ('b * 'a) list, ac: 'b): 'b = | |
129 | case ges of | |
130 | [] => ac | |
131 | | [(g, e)] => ac * power(g, e) | |
132 | | _ => let val (ges, rest) = split ges | |
133 | in loop(rest, ac * doit ges) | |
134 | end | |
135 | in loop(ges, one) | |
136 | end | |
137 | in {power = power, simultaneous = simultaneous} | |
138 | end | |
139 | ||
140 | val intExp: Int.int exponent = | |
141 | {isZero = fn n => n = 0, | |
142 | divMod = fn (a, b) => (a div b, a mod b), | |
143 | two = 2} | |
144 | ||
145 | fun power z = #power(make intExp z) | |
146 | fun simultaneous z = #simultaneous(make intExp z) | |
147 | ||
148 | val intInfExp = | |
149 | let open Pervasive.IntInf | |
150 | val zero = fromInt 0 | |
151 | in {isZero = fn n => n = zero, | |
152 | divMod = divMod, | |
153 | two = fromInt 2} | |
154 | end | |
155 | ||
156 | fun powerInf z = #power(make intInfExp z) | |
157 | fun simultaneousInf z = #simultaneous(make intInfExp z) | |
158 | ||
159 | end |