mlton/atoms/int-size.fun

   1 (* Copyright (C) 2009 Matthew Fluet.
   2  * Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 functor IntSize (S: INT_SIZE_STRUCTS): INT_SIZE =
  10 struct
  11
  12 open S
  13
  14 datatype t = T of {bits: Bits.t}
  15
  16 fun bits (T {bits, ...}) = bits
  17
  18 fun compare (s, s') = Bits.compare (bits s, bits s')
  19
  20 val {equals, ...} = Relation.compare compare
  21
  22 fun isValidSize (i: int) =
  23    (1 <= i andalso i <= 32) orelse i = 64
  24
  25 val sizes: Bits.t list =
  26    Vector.toList
  27    (Vector.keepAllMap
  28     (Vector.tabulate (65, fn i => if isValidSize i
  29                                      then SOME (Bits.fromInt i)
  30                                   else NONE),
  31      fn i => i))
  32
  33 fun make i = T {bits = i}
  34
  35 val allVector = Vector.tabulate (65, fn i =>
  36                                   if isValidSize i
  37                                      then SOME (make (Bits.fromInt i))
  38                                   else NONE)
  39
  40 fun fromBits (b: Bits.t): t =
  41    case Vector.sub (allVector, Bits.toInt b) handle Subscript => NONE of
  42       NONE => Error.bug (concat ["IntSize.fromBits: strange int size: ", Bits.toString b])
  43     | SOME s => s
  44
  45 val all = List.map (sizes, fromBits)
  46
  47 val memoize: (t -> 'a) -> t -> 'a =
  48    fn f =>
  49    let
  50       val v = Vector.map (allVector, fn opt => Option.map (opt, f))
  51    in
  52       fn T {bits = b, ...} => valOf (Vector.sub (v, Bits.toInt b))
  53    end
  54
  55 end