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 /MLRISC/releases/release-110.60/library/undoable-ref.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.60/library/undoable-ref.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/library/undoable-ref.sml

1 : monnier 245 (*
2 :     * A reference that allows undo.
3 :     *)
4 :    
5 :     signature UNDOABLE_REF =
6 :     sig
7 :     eqtype 'a uref
8 :     val uref : 'a -> 'a uref
9 :     val ! : 'a uref -> 'a
10 :     val := : 'a uref * 'a -> unit
11 :     end
12 :    
13 :     functor UndoableRefFn (Log : TRANSACTION_LOG) : UNDOABLE_REF =
14 :     struct
15 :    
16 :     type 'a uref = 'a ref * Log.version ref
17 :    
18 :     fun uref a = (ref a, ref(!Log.version))
19 :    
20 :     fun !! (r,_) = !r
21 :    
22 :     fun commit (x,v) = fn ver => v := ver
23 :    
24 :     fun rollback (x,v) =
25 :     let val x' = !x
26 :     in fn ver => (x := x'; v := ver)
27 :     end
28 :    
29 :     fun ::= (r as (x,v),y) =
30 :     let val ver = !Log.version
31 :     in if !v <> ver then (Log.add_object{rollback = rollback r,
32 :     commit = commit r
33 :     };
34 :     v := ver)
35 :     else ();
36 :     x := y
37 :     end
38 :    
39 :     val ! = !!
40 :     val op := = ::=
41 :     end
42 :    
43 :     (*
44 :     * $Log$
45 :     *)

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