| author | huffman | 
| Thu, 29 Mar 2012 14:39:05 +0200 | |
| changeset 47194 | 6e53f2a718c2 | 
| parent 43761 | e72ba84ae58f | 
| child 52530 | 99dd8b4ef3fe | 
| permissions | -rw-r--r-- | 
| 28578 | 1  | 
(* Title: Pure/Concurrent/synchronized.ML  | 
2  | 
Author: Fabian Immler and Makarius  | 
|
3  | 
||
4  | 
State variables with synchronized access.  | 
|
5  | 
*)  | 
|
6  | 
||
7  | 
signature SYNCHRONIZED =  | 
|
8  | 
sig  | 
|
9  | 
type 'a var  | 
|
10  | 
val var: string -> 'a -> 'a var  | 
|
| 28580 | 11  | 
val value: 'a var -> 'a  | 
12  | 
  val timed_access: 'a var -> ('a -> Time.time option) -> ('a -> ('b * 'a) option) -> 'b option
 | 
|
13  | 
  val guarded_access: 'a var -> ('a -> ('b * 'a) option) -> 'b
 | 
|
| 28578 | 14  | 
  val change_result: 'a var -> ('a -> 'b * 'a) -> 'b
 | 
15  | 
  val change: 'a var -> ('a -> 'a) -> unit
 | 
|
| 40449 | 16  | 
val counter: unit -> unit -> int  | 
| 28578 | 17  | 
end;  | 
18  | 
||
19  | 
structure Synchronized: SYNCHRONIZED =  | 
|
20  | 
struct  | 
|
21  | 
||
22  | 
(* state variables *)  | 
|
23  | 
||
| 
35015
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
24  | 
abstype 'a var = Var of  | 
| 28578 | 25  | 
 {name: string,
 | 
26  | 
lock: Mutex.mutex,  | 
|
27  | 
cond: ConditionVar.conditionVar,  | 
|
| 
35015
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
28  | 
var: 'a Unsynchronized.ref}  | 
| 
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
29  | 
with  | 
| 28578 | 30  | 
|
31  | 
fun var name x = Var  | 
|
32  | 
 {name = name,
 | 
|
33  | 
lock = Mutex.mutex (),  | 
|
34  | 
cond = ConditionVar.conditionVar (),  | 
|
| 32738 | 35  | 
var = Unsynchronized.ref x};  | 
| 28578 | 36  | 
|
| 
32592
 
e29c0b7dcf66
Synchronized.value does not require locking, since assigments are atomic;
 
wenzelm 
parents: 
32295 
diff
changeset
 | 
37  | 
fun value (Var {var, ...}) = ! var;
 | 
| 28580 | 38  | 
|
| 28578 | 39  | 
|
40  | 
(* synchronized access *)  | 
|
41  | 
||
| 
35015
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
42  | 
fun timed_access (Var {name, lock, cond, var}) time_limit f =
 | 
| 
37216
 
3165bc303f66
modernized some structure names, keeping a few legacy aliases;
 
wenzelm 
parents: 
35015 
diff
changeset
 | 
43  | 
Simple_Thread.synchronized name lock (fn () =>  | 
| 28578 | 44  | 
let  | 
| 28580 | 45  | 
fun try_change () =  | 
46  | 
let val x = ! var in  | 
|
47  | 
(case f x of  | 
|
| 
33060
 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 
wenzelm 
parents: 
32738 
diff
changeset
 | 
48  | 
NONE =>  | 
| 
32295
 
400cc493d466
renamed Multithreading.regular_interrupts to Multithreading.public_interrupts;
 
wenzelm 
parents: 
32286 
diff
changeset
 | 
49  | 
(case Multithreading.sync_wait NONE (time_limit x) cond lock of  | 
| 
43761
 
e72ba84ae58f
tuned signature -- corresponding to Scala version;
 
wenzelm 
parents: 
43727 
diff
changeset
 | 
50  | 
Exn.Res true => try_change ()  | 
| 
 
e72ba84ae58f
tuned signature -- corresponding to Scala version;
 
wenzelm 
parents: 
43727 
diff
changeset
 | 
51  | 
| Exn.Res false => NONE  | 
| 
33060
 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 
wenzelm 
parents: 
32738 
diff
changeset
 | 
52  | 
| Exn.Exn exn => reraise exn)  | 
| 
 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 
wenzelm 
parents: 
32738 
diff
changeset
 | 
53  | 
| SOME (y, x') =>  | 
| 
35015
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
54  | 
uninterruptible (fn _ => fn () =>  | 
| 
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
55  | 
(var := x'; ConditionVar.broadcast cond; SOME y)) ())  | 
| 28580 | 56  | 
end;  | 
| 
35015
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
57  | 
in try_change () end);  | 
| 
33060
 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 
wenzelm 
parents: 
32738 
diff
changeset
 | 
58  | 
|
| 28580 | 59  | 
fun guarded_access var f = the (timed_access var (K NONE) f);  | 
60  | 
||
61  | 
||
62  | 
(* unconditional change *)  | 
|
63  | 
||
64  | 
fun change_result var f = guarded_access var (SOME o f);  | 
|
| 28578 | 65  | 
fun change var f = change_result var (fn x => ((), f x));  | 
66  | 
||
| 
35015
 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 
wenzelm 
parents: 
33060 
diff
changeset
 | 
67  | 
end;  | 
| 
33060
 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 
wenzelm 
parents: 
32738 
diff
changeset
 | 
68  | 
|
| 40449 | 69  | 
|
70  | 
(* unique identifiers > 0 *)  | 
|
71  | 
||
72  | 
fun counter () =  | 
|
73  | 
let  | 
|
| 43727 | 74  | 
val counter = var "counter" (0: int);  | 
| 40449 | 75  | 
fun next () =  | 
76  | 
change_result counter  | 
|
77  | 
(fn i =>  | 
|
| 43727 | 78  | 
let val j = i + (1: int)  | 
| 40449 | 79  | 
in (j, j) end);  | 
80  | 
in next end;  | 
|
81  | 
||
| 28578 | 82  | 
end;  |