lib/mlton/env/array-finite-function.fun

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