| 33 |
* not lexical order! |
* not lexical order! |
| 34 |
*) |
*) |
| 35 |
fun compare (ATOM{hash=h1, id=id1}, ATOM{hash=h2, id=id2}) = |
fun compare (ATOM{hash=h1, id=id1}, ATOM{hash=h2, id=id2}) = |
| 36 |
if (h1 = h2) |
if h1 = h2 then String.compare (id1, id2) |
| 37 |
then if (id1 = id2) |
else if h1 < h2 then LESS |
|
then EQUAL |
|
|
else if (id1 < id2) |
|
|
then LESS |
|
|
else GREATER |
|
|
else if (h1 < h2) |
|
|
then LESS |
|
| 38 |
else GREATER |
else GREATER |
| 39 |
|
|
| 40 |
(* the unique name hash table *) |
(* the unique name hash table *) |
| 42 |
val table = ref(Array.array(tableSz, [] : atom list)) |
val table = ref(Array.array(tableSz, [] : atom list)) |
| 43 |
val numItems = ref 0 |
val numItems = ref 0 |
| 44 |
|
|
| 45 |
(* Map a string to the corresponding unique atom. *) |
infix % |
| 46 |
fun atom s = let |
fun h % m = Word.toIntX (Word.andb (h, m)) |
| 47 |
val h = HashString.hashString s |
|
| 48 |
fun isName (ATOM{hash, id}) = (hash = h) andalso (id = s) |
(* Map a string or substring s to the corresponding unique atom. *) |
| 49 |
fun mk () = let |
fun atom0 (toString, hashString, sameString) s = |
| 50 |
|
let val h = hashString s |
| 51 |
val tbl = !table |
val tbl = !table |
| 52 |
val sz = Array.length tbl |
val sz = Array.length tbl |
| 53 |
(* grow the table by doubling its size *) |
val indx = h % (Word.fromInt sz - 0w1) |
| 54 |
fun growTable () = let |
fun look ((a as ATOM { hash, id }) :: rest) = |
| 55 |
val newSz = sz+sz |
if hash = h andalso sameString (s, id) then a else look rest |
| 56 |
|
| look [] = |
| 57 |
|
let fun new (tbl, indx) = |
| 58 |
|
let val a = ATOM { hash = h, id = toString s } |
| 59 |
|
in Array.update (tbl, indx, a :: Array.sub (tbl, indx)); |
| 60 |
|
a |
| 61 |
|
end |
| 62 |
|
in if !numItems < sz then new (tbl, indx) |
| 63 |
|
else let val newSz = sz + sz |
| 64 |
val newMask = Word.fromInt newSz - 0w1 |
val newMask = Word.fromInt newSz - 0w1 |
| 65 |
val newTbl = Array.array(newSz, []) |
val newTbl = Array.array(newSz, []) |
| 66 |
fun ins (item as ATOM{hash, ...}) = let |
fun ins (item as ATOM { hash, ... }) = |
| 67 |
val indx = Word.toIntX(Word.andb(hash, newMask)) |
let val indx = hash % newMask |
| 68 |
in |
in Array.update |
| 69 |
Array.update (newTbl, indx, |
(newTbl, indx, |
| 70 |
item :: Array.sub(newTbl, indx)) |
item :: Array.sub(newTbl, indx)) |
| 71 |
end |
end |
| 72 |
val appins = app ins |
in Array.app (app ins) tbl; |
| 73 |
fun insert i = (appins (Array.sub(tbl, i)); insert(i+1)) |
table := newTbl; |
| 74 |
in |
new (newTbl, h % newMask) |
|
(insert 0) handle _ => (); |
|
|
table := newTbl |
|
|
end |
|
|
in |
|
|
if (!numItems >= sz) |
|
|
then (growTable(); mk()) |
|
|
else let |
|
|
val indx = Word.toIntX(Word.andb(h, Word.fromInt sz - 0w1)) |
|
|
fun look [] = let |
|
|
val newName = ATOM{hash = h, id = s} |
|
|
in |
|
|
numItems := !numItems + 1; |
|
|
Array.update(tbl, indx, newName :: Array.sub(tbl, indx)); |
|
|
newName |
|
| 75 |
end |
end |
|
| look (name::r) = if (isName name) then name else look r |
|
|
in |
|
|
look (Array.sub(tbl, indx)) |
|
| 76 |
end |
end |
| 77 |
end |
in look (Array.sub (tbl, indx)) |
|
in |
|
|
mk() |
|
| 78 |
end |
end |
| 79 |
|
|
| 80 |
(* eventually, we should hash the substring and check for prior definition |
(* instantiate atom0 for the string case *) |
| 81 |
* before creating the string. |
val atom = atom0 (fn s => s, HashString.hashString, op = ) |
| 82 |
*) |
|
| 83 |
fun atom' ss = atom(Substring.string ss) |
(* instantiate atom0 for the substring case *) |
| 84 |
|
val atom' = atom0 (Substring.string, |
| 85 |
|
HashString.hashString', |
| 86 |
|
fn (ss, s) => Substring.compare (ss, Substring.full s) |
| 87 |
|
= EQUAL) |
| 88 |
|
|
| 89 |
end (* signature ATOM *) |
end (* signature ATOM *) |
Parent Directory
| 
Revision Log
| 
Patch
