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/compiler/Semant/basics/stamps.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Semant/basics/stamps.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 249 (* Copyright 1996 by AT&T Bell Laboratories *)
2 : blume 587 (* Re-written by Matthias Blume (3/2000) *)
3 : monnier 249 (* stamps.sml *)
4 :    
5 : blume 587 structure Stamps :> STAMPS =
6 : monnier 249 struct
7 : blume 587 type pid = PersStamps.persstamp (* for global stamps *)
8 : monnier 249
9 : blume 587 datatype stamp =
10 :     Special of string
11 :     | Global of { pid: pid, cnt: int }
12 :     | Fresh of int
13 : monnier 249
14 : blume 587 type ord_key = stamp
15 : monnier 249
16 : blume 587 fun compare (Fresh i, Fresh i') = Int.compare (i, i')
17 :     | compare (Fresh _, _) = GREATER
18 :     | compare (_, Fresh _) = LESS
19 :     | compare (Special s, Special s') = String.compare (s, s')
20 :     | compare (Special _, _) = GREATER
21 :     | compare (_, Special _) = LESS
22 :     | compare (Global g, Global g') =
23 :     (case Int.compare (#cnt g, #cnt g') of
24 :     EQUAL => PersStamps.compare (#pid g, #pid g')
25 :     | unequal => unequal)
26 : monnier 249
27 : blume 587 fun eq (s, s') = compare (s, s') = EQUAL
28 : monnier 249
29 : blume 587 type generator = int ref
30 :     fun newGenerator () = ref 0
31 :     fun fresh r = let val i = !r in r := i + 1; Fresh i end
32 :     val special = Special
33 :     val global = Global
34 : monnier 249
35 : blume 587 local
36 :     structure M = IntRedBlackMap
37 :     in
38 :     type converter = int M.map ref * int ref
39 :     fun newConverter () = (ref M.empty, ref 0)
40 :     fun Case _ (Special s) { fresh, global, special } = special s
41 :     | Case _ (Global g) { global, ... } = global g
42 :     | Case (m, n) (Fresh i) { fresh, ... } =
43 :     (case M.find (!m, i) of
44 :     SOME i' => fresh i'
45 :     | NONE => let val i' = !n
46 :     in
47 :     n := i' + 1; m := M.insert (!m, i, i');
48 :     fresh i'
49 :     end)
50 : monnier 249 end
51 :    
52 : blume 587 fun isFresh (Fresh _) = true
53 :     | isFresh _ = false
54 : monnier 249
55 : blume 587 fun toString (Fresh i) = concat ["FSTAMP(", Int.toString i, ")"]
56 :     | toString (Global { pid, cnt }) =
57 :     concat ["GSTAMP(", PersStamps.toHex pid, ",", Int.toString cnt, ")"]
58 :     | toString (Special s) = concat ["SSTAMP(", s, ")"]
59 : monnier 249
60 : blume 587 fun toShortString (Fresh i) = "#F" ^ Int.toString i
61 :     | toShortString (Special s) = "#S:" ^ s
62 :     | toShortString (Global { pid, cnt }) = let
63 :     fun trim3 s = substring (s, size s - 3, 3)
64 :     in
65 :     concat ["#G", trim3 (PersStamps.toHex pid), ".", Int.toString cnt]
66 :     end
67 :     end

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