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/trunk/library/transaction-log.sml
ViewVC logotype

Annotation of /MLRISC/trunk/library/transaction-log.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2126 - (view) (download)

1 : monnier 411 (*
2 :     * This implements a transaction log. This is used
3 :     * for undoable data structures.
4 :     *
5 :     * -- Allen
6 :     *)
7 :    
8 : monnier 245 structure TransactionLog : TRANSACTION_LOG =
9 :     struct
10 :     exception TransactionLog
11 :    
12 :     type version = int
13 :     val version = ref 0
14 :     val log = ref [] : (version * { rollback : version -> unit,
15 :     commit : version -> unit
16 :     } list ref) list ref
17 :     fun add_object f =
18 :     case !log of
19 :     (ver,trail)::_ => trail := f :: !trail
20 :     | [] => raise TransactionLog
21 :    
22 :     fun init() = (version := 0; log := [])
23 :    
24 :     fun begin () =
25 :     let val new_ver = !version+1
26 :     in version := new_ver;
27 :     log := (new_ver,ref []) :: !log
28 :     end
29 :    
30 :     fun abort () =
31 :     let val old_ver = !version - 1
32 :     in case !log of
33 :     (_,ref trail)::rest =>
34 :     (app (fn {rollback,...} => rollback old_ver) trail;
35 :     version := old_ver;
36 :     log := rest)
37 :     | [] => raise TransactionLog
38 :     end
39 :    
40 :     fun commit () =
41 :     let val old_ver = !version - 1
42 :     in case !log of
43 :     (_,ref trail)::rest =>
44 :     (app (fn {commit,...} => commit old_ver) trail;
45 :     version := old_ver;
46 :     log := rest)
47 :     | [] => raise TransactionLog
48 :     end
49 :     end
50 :    

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