Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/common/stamp.sml
ViewVC logotype

Annotation of /trunk/src/common/stamp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 9 - (view) (download)

1 : jhr 9 (* stamp.sml
2 :     *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Stamps are locally unique identifiers used in the compiler to
7 :     * distinguish different types, variables, etc. For a given compilation,
8 :     * the stamp assigned to an object is guaranteed to be unique, although
9 :     * an object may have different stamps assigned to it in different compiles.
10 :     *)
11 :    
12 :     structure Stamp :> sig
13 :    
14 :     type stamp
15 :    
16 :     val new : unit -> stamp
17 :    
18 :     val same : (stamp * stamp) -> bool
19 :     val compare : (stamp * stamp) -> order
20 :     val hash : stamp -> word
21 :    
22 :     val toString : stamp -> string
23 :    
24 :     structure Set : ORD_SET where type Key.ord_key = stamp
25 :     structure Map : ORD_MAP where type Key.ord_key = stamp
26 :     structure Tbl : MONO_HASH_TABLE where type Key.hash_key = stamp
27 :    
28 :     end = struct
29 :    
30 :     structure W = Word
31 :    
32 :     datatype stamp = STAMP of {
33 :     id : Word.word
34 :     }
35 :    
36 :     val cnt = ref 0w0
37 :    
38 :     fun new () = let val w = !cnt in cnt := w+0w1; STAMP{id = w} end
39 :    
40 :     fun same (STAMP{id, ...}, STAMP{id=id', ...}) = (id = id')
41 :     fun compare (STAMP{id, ...}, STAMP{id=id', ...}) = W.compare(id, id')
42 :     fun hash (STAMP{id, ...}) = id
43 :    
44 :     fun toString (STAMP{id, ...}) =
45 :     concat["<", StringCvt.padLeft #"0" 4 (W.toString id), ">"]
46 :    
47 :     structure Key =
48 :     struct
49 :     type ord_key = stamp
50 :     val compare = compare
51 :     end
52 :     structure Map = RedBlackMapFn (Key)
53 :     structure Set = RedBlackSetFn (Key)
54 :    
55 :     structure Tbl = HashTableFn (struct
56 :     type hash_key = stamp
57 :     fun hashVal (STAMP{id}) = id
58 :     fun sameKey (STAMP{id=a}, STAMP{id=b}) = (a = b)
59 :     end)
60 :    
61 :     end
62 :    

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