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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (view) (download)

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

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