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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
(* hash.sml
* 2005 Matthew Fluet (mfluet@acm.org)
* Adapted for MLton.
*)
(*
* hash.sml - Generating unique hash codes for C function types and
* for ML types.
*
* (C) 2002, Lucent Technologies, Bell Labs
*
* author: Matthias Blume (blume@research.bell-labs.com)
*)
structure Hash : sig
val mkFHasher : unit -> Spec.cft -> int
val mkTHasher : unit -> PrettyPrint.mltype -> int
end = struct
structure S = Spec
structure PP = PrettyPrint
structure SM = StringMap
structure LM = IntListMap
fun tyConId S.SCHAR = 0
| tyConId S.UCHAR = 1
| tyConId S.SSHORT = 2
| tyConId S.USHORT = 3
| tyConId S.SINT = 4
| tyConId S.UINT = 5
| tyConId S.SLONG = 6
| tyConId S.ULONG = 7
| tyConId S.SLONGLONG = 8
| tyConId S.ULONGLONG = 9
| tyConId S.FLOAT = 10
| tyConId S.DOUBLE = 11
fun conConId S.RW = 0
| conConId S.RO = 1
fun look (next, find, insert) tab k =
case find (!tab, k) of
SOME i => i
| NONE => let
val i = !next
in
next := i + 1;
tab := insert (!tab, k, i);
i
end
fun mkFHasher () = let
val stab = ref SM.empty
val utab = ref SM.empty
val etab = ref SM.empty
val ltab = ref LM.empty
val next = ref 13
val tlook = look (next, SM.find, SM.insert)
val llook = look (next, LM.find, LM.insert) ltab
fun hash (S.STRUCT t) = tlook stab t
| hash (S.UNION t) = tlook utab t
| hash (S.ENUM (t, _)) = tlook etab t
| hash (S.FPTR x) = cfthash x
| hash (S.PTR (c, ty)) = llook [1, conConId c, hash ty]
| hash (S.ARR { t, d, esz }) = llook [2, hash t, d, esz]
| hash (S.BASIC ty) = tyConId ty
| hash (S.VOIDPTR) = 12
| hash _ = raise Fail "hash"
and cfthash { args, res } = llook (0 :: opthash res :: map hash args)
and opthash NONE = 0
| opthash (SOME ty) = 1 + hash ty
in
cfthash
end
fun mkTHasher () = let
val stab = ref SM.empty
val ltab = ref LM.empty
val next = ref 0
val slook = look (next, SM.find, SM.insert) stab
val llook = look (next, LM.find, LM.insert) ltab
fun hash (PP.ARROW (t, t')) = llook [0, hash t, hash t']
| hash (PP.TUPLE tl) = llook (1 :: map hash tl)
| hash (PP.CON (c, tl)) = llook (2 :: slook c :: map hash tl)
| hash (PP.RECORD pl) = llook (3 :: map phash pl)
and phash (n, t) = llook [4, slook n, hash t]
in
hash
end
end
|
