author | hoelzl |
Wed, 02 Apr 2014 18:35:01 +0200 | |
changeset 56369 | 2704ca85be98 |
parent 52537 | 4b5941730bd8 |
child 56685 | 535d59d4ed12 |
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 |
|
16 |
end; |
|
17 |
||
18 |
structure Synchronized: SYNCHRONIZED = |
|
19 |
struct |
|
20 |
||
21 |
(* state variables *) |
|
22 |
||
35015
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
23 |
abstype 'a var = Var of |
28578 | 24 |
{name: string, |
25 |
lock: Mutex.mutex, |
|
26 |
cond: ConditionVar.conditionVar, |
|
35015
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
27 |
var: 'a Unsynchronized.ref} |
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
28 |
with |
28578 | 29 |
|
30 |
fun var name x = Var |
|
31 |
{name = name, |
|
32 |
lock = Mutex.mutex (), |
|
33 |
cond = ConditionVar.conditionVar (), |
|
32738 | 34 |
var = Unsynchronized.ref x}; |
28578 | 35 |
|
32592
e29c0b7dcf66
Synchronized.value does not require locking, since assigments are atomic;
wenzelm
parents:
32295
diff
changeset
|
36 |
fun value (Var {var, ...}) = ! var; |
28580 | 37 |
|
28578 | 38 |
|
39 |
(* synchronized access *) |
|
40 |
||
35015
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
41 |
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
|
42 |
Simple_Thread.synchronized name lock (fn () => |
28578 | 43 |
let |
28580 | 44 |
fun try_change () = |
45 |
let val x = ! var in |
|
46 |
(case f x of |
|
33060
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents:
32738
diff
changeset
|
47 |
NONE => |
32295
400cc493d466
renamed Multithreading.regular_interrupts to Multithreading.public_interrupts;
wenzelm
parents:
32286
diff
changeset
|
48 |
(case Multithreading.sync_wait NONE (time_limit x) cond lock of |
43761
e72ba84ae58f
tuned signature -- corresponding to Scala version;
wenzelm
parents:
43727
diff
changeset
|
49 |
Exn.Res true => try_change () |
e72ba84ae58f
tuned signature -- corresponding to Scala version;
wenzelm
parents:
43727
diff
changeset
|
50 |
| Exn.Res false => NONE |
33060
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents:
32738
diff
changeset
|
51 |
| Exn.Exn exn => reraise exn) |
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents:
32738
diff
changeset
|
52 |
| SOME (y, x') => |
35015
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
53 |
uninterruptible (fn _ => fn () => |
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
54 |
(var := x'; ConditionVar.broadcast cond; SOME y)) ()) |
28580 | 55 |
end; |
35015
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
56 |
in try_change () end); |
33060
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents:
32738
diff
changeset
|
57 |
|
28580 | 58 |
fun guarded_access var f = the (timed_access var (K NONE) f); |
59 |
||
60 |
||
61 |
(* unconditional change *) |
|
62 |
||
63 |
fun change_result var f = guarded_access var (SOME o f); |
|
28578 | 64 |
fun change var f = change_result var (fn x => ((), f x)); |
65 |
||
35015
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
wenzelm
parents:
33060
diff
changeset
|
66 |
end; |
33060
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents:
32738
diff
changeset
|
67 |
|
28578 | 68 |
end; |