summaryrefslogtreecommitdiff
path: root/hashtable.sml
blob: 822d1fd6424449a521c1e6ad6440e0c7adaa9b48 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
structure Hashtable: HASHTABLE = struct
  open Array
  open Word

  (* buf * taken * mask *)
  type 'a t = (string * 'a) option array * int * word

  val ` = Word.fromInt
  val ! = Word.toInt

  infixr 4 <<
  infix 5 andb
  infixr 6 +
  infixr 7 *

  fun createLog log =
  let
    val size = `1 << `log
    val mask = size - `1
  in
    (array (Word.toInt size, NONE), 0, mask)
  end

  exception Full and Exists

  fun hash key =
    List.foldl (fn (c, s) => s * `31 + `(ord c)) (`17) (explode key)

  fun checkFreeSpace (array, taken, _) =
  let
    open Real
    val ` = fromInt
  in
    if `taken / `(length array) > 0.75 then
      raise Full
    else
      ()
  end

  fun next idx mask = (idx + `1) andb mask

  fun lookup2 (array, _, mask) key f g =
  let
    fun find idx =
      case sub (array, !idx) of
           NONE => g ()
         | SOME (key', v) =>
             if key' = key then
               case f v of
                    (NONE, res) => res
                  | (SOME v, res) =>
                      (update (array, !idx, SOME (key, v)); res)
             else
               find (next idx mask)
  in
    find (hash key andb mask)
  end

  fun lookup H key = lookup2 H key (fn v => (NONE, SOME v)) (fn () => NONE)

  fun insert (H as (array, _, mask)) key v =
  let
    val () = checkFreeSpace H;
    fun find idx =
      case sub (array, !idx) of
           NONE => update (array, !idx, SOME (key, v))
         | SOME (key', _) =>
             if key' = key then
               raise Exists
             else
               find (next idx mask)
  in
    find (hash key andb mask)
  end
end