Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/ml-nlffigen/hash.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-nlffigen/hash.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1096 - (view) (download)

1 : blume 1062 (*
2 :     * hash.sml - Generating unique hash codes for C function types and
3 :     * for ML types.
4 :     *
5 :     * (C) 2002, Lucent Technologies, Bell Labs
6 :     *
7 :     * author: Matthias Blume (blume@research.bell-labs.com)
8 :     *)
9 :     structure Hash : sig
10 :     val mkFHasher : unit -> Spec.cft -> int
11 :     val mkTHasher : unit -> PrettyPrint.mltype -> int
12 :     end = struct
13 :    
14 :     structure S = Spec
15 :     structure PP = PrettyPrint
16 :     structure SM = StringMap
17 :     structure LM = IntListMap
18 :    
19 :     fun tyConId S.SCHAR = 0
20 :     | tyConId S.UCHAR = 1
21 :     | tyConId S.SINT = 2
22 :     | tyConId S.UINT = 3
23 :     | tyConId S.SSHORT = 4
24 :     | tyConId S.USHORT = 5
25 :     | tyConId S.SLONG = 6
26 :     | tyConId S.ULONG = 7
27 :     | tyConId S.FLOAT = 8
28 :     | tyConId S.DOUBLE = 9
29 :     | tyConId S.VOIDPTR = 10
30 :     | tyConId _ = raise Fail "tyConId"
31 :    
32 :     fun conConId S.RW = 0
33 :     | conConId S.RO = 1
34 :    
35 :     fun look (next, find, insert) tab k =
36 :     case find (!tab, k) of
37 :     SOME i => i
38 :     | NONE => let
39 :     val i = !next
40 :     in
41 :     next := i + 1;
42 :     tab := insert (!tab, k, i);
43 :     i
44 :     end
45 :    
46 :     fun mkFHasher () = let
47 :     val stab = ref SM.empty
48 :     val utab = ref SM.empty
49 : blume 1096 val etab = ref SM.empty
50 : blume 1062 val ltab = ref LM.empty
51 :    
52 :     val next = ref 11
53 :    
54 :     val tlook = look (next, SM.find, SM.insert)
55 :     val llook = look (next, LM.find, LM.insert) ltab
56 :    
57 :     fun hash (S.STRUCT t) = tlook stab t
58 :     | hash (S.UNION t) = tlook utab t
59 : blume 1096 | hash (S.ENUM (t, _)) = tlook etab t
60 : blume 1062 | hash (S.FPTR x) = cfthash x
61 :     | hash (S.PTR (c, ty)) = llook [1, conConId c, hash ty]
62 :     | hash (S.ARR { t, d, esz }) = llook [2, hash t, d, esz]
63 :     | hash ty = tyConId ty
64 :    
65 :     and cfthash { args, res } = llook (0 :: opthash res :: map hash args)
66 :    
67 :     and opthash NONE = 0
68 :     | opthash (SOME ty) = 1 + hash ty
69 :     in
70 :     cfthash
71 :     end
72 :    
73 :     fun mkTHasher () = let
74 :     val stab = ref SM.empty
75 :     val ltab = ref LM.empty
76 :    
77 :     val next = ref 0
78 :    
79 :     val slook = look (next, SM.find, SM.insert) stab
80 :     val llook = look (next, LM.find, LM.insert) ltab
81 :    
82 :     fun hash (PP.ARROW (t, t')) = llook [0, hash t, hash t']
83 :     | hash (PP.TUPLE tl) = llook (1 :: map hash tl)
84 :     | hash (PP.CON (c, tl)) = llook (2 :: slook c :: map hash tl)
85 :     | hash (PP.RECORD pl) = llook (3 :: map phash pl)
86 :    
87 :     and phash (n, t) = llook [4, slook n, hash t]
88 :     in
89 :     hash
90 :     end
91 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0