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 249 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/Semant/basics/stamps.sml

1 : monnier 249 (* Copyright 1996 by AT&T Bell Laboratories *)
2 :     (* stamps.sml *)
3 :    
4 :     structure Stamps : STAMPS =
5 :     struct
6 :    
7 :     datatype stamp_scope
8 :     = LOCAL
9 :     | GLOBAL of PersStamps.persstamp
10 :     | SPECIAL of string
11 :    
12 :     datatype stamp = STAMP of {scope : stamp_scope, count : int}
13 :    
14 :     fun new () =
15 :     let val i = ref 0
16 :     in fn () => STAMP{scope=LOCAL, count= !i before i := !i + 1}
17 :     end
18 :    
19 :     fun eq (a:stamp, b) = a = b
20 :    
21 :     fun cmp (STAMP{scope=a1,count=b1}, STAMP{scope=a2,count=b2}) =
22 :     (case Int.compare (b1, b2)
23 :     of EQUAL => (case (a1, a2)
24 :     of (LOCAL, LOCAL) => EQUAL
25 :     | (LOCAL, _) => LESS
26 :     | (_, LOCAL) => GREATER
27 :     | (GLOBAL pid1, GLOBAL pid2) =>
28 :     PersStamps.compare(pid1, pid2)
29 :     | (GLOBAL _, _) => GREATER
30 :     | (_, GLOBAL _) => LESS
31 :     | (SPECIAL s1, SPECIAL s2) => String.compare(s1, s2)
32 :     (* end case *))
33 :     | order => order)
34 :    
35 :     fun special s = STAMP{scope=SPECIAL s, count=0}
36 :    
37 :     fun stampToString (STAMP{scope, count}) =
38 :     let val scope' = (case scope
39 :     of LOCAL => "LOCAL"
40 :     | (GLOBAL pid) => PersStamps.toHex pid
41 :     | (SPECIAL s) => s)
42 :     in String.concat["STAMP(", scope', ",", Int.toString count, ")"]
43 :     end
44 :    
45 :     fun stampToShortString (STAMP{scope, count}) =
46 :     let val scope' =
47 :     case scope
48 :     of LOCAL => ["#L"]
49 :     | GLOBAL pid =>
50 :     let val s = PersStamps.toHex pid
51 :     val l = String.size s
52 :     in ["#G",String.substring(s,l-3,3)]
53 :     end
54 :     | SPECIAL s => ["#S:",s]
55 :     in String.concat(scope'@[".",Int.toString count])
56 :     end
57 :    
58 :     type 'a stampMap = (stamp * 'a) list Intmap.intmap * exn
59 :    
60 :     fun newMap ex = (Intmap.new(20, ex), ex)
61 :    
62 :     fun applyMap((m,ex), st as STAMP{count,...}) =
63 :     let fun f((a,b)::r) = if eq(a,st) then b else f r
64 :     | f nil = raise ex
65 :     in f(Intmap.map m count)
66 :     end
67 :    
68 :     fun updateMap (m,ex) (st as STAMP{count=n,...}, v) =
69 :     let val old = Intmap.map m n handle _ => nil
70 :     in Intmap.add m (n, (st,v)::old)
71 :     end
72 :    
73 :     end (* structure Stamps *)
74 :    
75 :     (*
76 :     * $Log$
77 :     *)

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