Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006, 2008 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 | functor ArrayFiniteFunction(): ARRAY_FINITE_FUNCTION = | |
9 | struct | |
10 | ||
11 | structure Domain = | |
12 | struct | |
13 | type 'a t = | |
14 | {size: int, fromInt: int -> 'a, toInt: 'a -> int} | |
15 | ||
16 | fun pair({size, fromInt, toInt}: 'a1 t, | |
17 | {size=size', fromInt=fromInt', toInt=toInt'}: 'a2 t, | |
18 | inj: 'a1 -> 'a, | |
19 | inj': 'a2 -> 'a, | |
20 | out: 'a * ('a1 -> int) * ('a2 -> int) -> int) = | |
21 | {size = size + size', | |
22 | toInt = fn d => out(d, toInt, fn d' => size + toInt' d'), | |
23 | fromInt = fn n => if n < size then inj(fromInt n) | |
24 | else inj'(fromInt'(n - size))} | |
25 | end | |
26 | ||
27 | datatype ('a, 'b) t = | |
28 | T of {domain: 'a Domain.t, | |
29 | array: 'b Array.t} | |
30 | ||
31 | fun empty(domain: 'a Domain.t) = | |
32 | T{domain = domain, | |
33 | array = Array.new(#size domain, NONE)} | |
34 | ||
35 | fun new(domain: 'a Domain.t, x) = | |
36 | T{domain = domain, | |
37 | array = Array.new(#size domain, x)} | |
38 | ||
39 | fun tabulate(domain as {size, fromInt, ...}: 'a Domain.t, f) = | |
40 | T{domain = domain, | |
41 | array = Array.tabulate(size, f o fromInt)} | |
42 | ||
43 | fun size(T{domain={size, ...}, ...}) = size | |
44 | ||
45 | fun lookup(T{domain={toInt, ...}, array}, x) = Array.sub(array, toInt x) | |
46 | ||
47 | fun foreach(T{domain={fromInt, ...}, array}, f) = | |
48 | Array.foreachIndex(array, fn (i, x) => f(fromInt i, x)) | |
49 | ||
50 | fun set(T{domain={toInt, ...}, array}, x, y) = | |
51 | Array.update(array, toInt x, y) | |
52 | ||
53 | fun toFunction f a = lookup(f, a) | |
54 | ||
55 | end | |
56 | ||
57 | structure ArrayFiniteFunction = ArrayFiniteFunction() |