author | wenzelm |
Fri, 05 Jul 2013 15:38:03 +0200 | |
changeset 52530 | 99dd8b4ef3fe |
parent 43761 | e72ba84ae58f |
child 52537 | 4b5941730bd8 |
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 |
||
52530
99dd8b4ef3fe
explicit module Document_ID as source of globally unique identifiers across ML/Scala;
wenzelm
parents:
43761
diff
changeset
|
72 |
(*NB: ML ticks forwards, JVM ticks backwards*) |
40449 | 73 |
fun counter () = |
74 |
let |
|
43727 | 75 |
val counter = var "counter" (0: int); |
40449 | 76 |
fun next () = |
77 |
change_result counter |
|
78 |
(fn i => |
|
43727 | 79 |
let val j = i + (1: int) |
40449 | 80 |
in (j, j) end); |
81 |
in next end; |
|
82 |
||
28578 | 83 |
end; |