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/cm/util/dyn-tstamp.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/util/dyn-tstamp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 295 - (view) (download)

1 : blume 295 (*
2 :     * "Time" stamps for dynamic envirenments.
3 :     *
4 :     * Copyright (c) 1998 by Lucent, Bell Laboratories
5 :     *
6 :     * author: Matthias Blume (blume@cs.princeton.edu)
7 :     *)
8 :     signature DYNTSTAMP = sig
9 :    
10 :     type dts
11 :    
12 :     val bogus: dts
13 :     val ancient: dts
14 :    
15 :     val reset: unit -> unit
16 :     val new: unit -> unit
17 :    
18 :     val current: unit -> dts
19 :     val noshare: string -> dts
20 :    
21 :     val outdated: { context: dts, oldresult: dts } -> bool
22 :     val join: dts * dts -> dts
23 :     val can'tShare: dts -> string list option
24 :     end
25 :    
26 :     structure DynTStamp :> DYNTSTAMP = struct
27 :    
28 :     datatype dts =
29 :     SHARE of int
30 :     | NOSHARE of StringSet.set
31 :    
32 :     local
33 :     val era = ref 0
34 :     in
35 :     fun current () = SHARE (!era)
36 :     fun reset () = era := 0
37 :     fun new () = era := (!era) + 1
38 :     end
39 :    
40 :     val bogus = SHARE 0
41 :     val ancient = SHARE (~1)
42 :    
43 :     fun noshare s = NOSHARE (StringSet.singleton s)
44 :    
45 :     fun outdated { context = SHARE c, oldresult = SHARE r } = c > r
46 :     | outdated _ = true
47 :    
48 :     fun join (SHARE x, SHARE y) = SHARE (if x > y then x else y)
49 :     | join (x as NOSHARE _, SHARE _) = x
50 :     | join (SHARE _, x as NOSHARE _) = x
51 :     | join (NOSHARE x, NOSHARE y) = NOSHARE (StringSet.union (x, y))
52 :    
53 :     fun can'tShare (NOSHARE s) = SOME (StringSet.listItems s)
54 :     | can'tShare _ = NONE
55 :     end

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