| 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 |