2 * 2005 Matthew
Fluet (mfluet@acm
.org
)
7 * hash
.sml
- Generating unique hash codes for C function types
and
10 * (C
) 2002, Lucent Technologies
, Bell Labs
12 * author
: Matthias
Blume (blume@research
.bell
-labs
.com
)
15 val mkFHasher
: unit
-> Spec
.cft
-> int
16 val mkTHasher
: unit
-> PrettyPrint
.mltype
-> int
20 structure PP
= PrettyPrint
21 structure SM
= StringMap
22 structure LM
= IntListMap
24 fun tyConId S
.SCHAR
= 0
26 | tyConId S
.SSHORT
= 2
27 | tyConId S
.USHORT
= 3
32 | tyConId S
.SLONGLONG
= 8
33 | tyConId S
.ULONGLONG
= 9
34 | tyConId S
.FLOAT
= 10
35 | tyConId S
.DOUBLE
= 11
40 fun look (next
, find
, insert
) tab k
=
41 case find (!tab
, k
) of
47 tab
:= insert (!tab
, k
, i
);
51 fun mkFHasher () = let
52 val stab
= ref SM
.empty
53 val utab
= ref SM
.empty
54 val etab
= ref SM
.empty
55 val ltab
= ref LM
.empty
59 val tlook
= look (next
, SM
.find
, SM
.insert
)
60 val llook
= look (next
, LM
.find
, LM
.insert
) ltab
62 fun hash (S
.STRUCT t
) = tlook stab t
63 |
hash (S
.UNION t
) = tlook utab t
64 |
hash (S
.ENUM (t
, _
)) = tlook etab t
65 |
hash (S
.FPTR x
) = cfthash x
66 |
hash (S
.PTR (c
, ty
)) = llook
[1, conConId c
, hash ty
]
67 |
hash (S
.ARR
{ t
, d
, esz
}) = llook
[2, hash t
, d
, esz
]
68 |
hash (S
.BASIC ty
) = tyConId ty
69 |
hash (S
.VOIDPTR
) = 12
70 | hash _
= raise Fail
"hash"
72 and cfthash
{ args
, res
} = llook (0 :: opthash res
:: map hash args
)
75 |
opthash (SOME ty
) = 1 + hash ty
80 fun mkTHasher () = let
81 val stab
= ref SM
.empty
82 val ltab
= ref LM
.empty
86 val slook
= look (next
, SM
.find
, SM
.insert
) stab
87 val llook
= look (next
, LM
.find
, LM
.insert
) ltab
89 fun hash (PP
.ARROW (t
, t
')) = llook
[0, hash t
, hash t
']
90 |
hash (PP
.TUPLE tl
) = llook (1 :: map hash tl
)
91 |
hash (PP
.CON (c
, tl
)) = llook (2 :: slook c
:: map hash tl
)
92 |
hash (PP
.RECORD pl
) = llook (3 :: map phash pl
)
94 and phash (n
, t
) = llook
[4, slook n
, hash t
]