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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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

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