| author | wenzelm | 
| Wed, 16 Apr 2014 14:16:22 +0200 | |
| changeset 56606 | 68b7a6db4a32 | 
| 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: 
33060diff
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: 
33060diff
changeset | 27 | var: 'a Unsynchronized.ref} | 
| 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 wenzelm parents: 
33060diff
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: 
32295diff
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: 
33060diff
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: 
35015diff
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: 
32738diff
changeset | 47 | NONE => | 
| 32295 
400cc493d466
renamed Multithreading.regular_interrupts to Multithreading.public_interrupts;
 wenzelm parents: 
32286diff
changeset | 48 | (case Multithreading.sync_wait NONE (time_limit x) cond lock of | 
| 43761 
e72ba84ae58f
tuned signature -- corresponding to Scala version;
 wenzelm parents: 
43727diff
changeset | 49 | Exn.Res true => try_change () | 
| 
e72ba84ae58f
tuned signature -- corresponding to Scala version;
 wenzelm parents: 
43727diff
changeset | 50 | | Exn.Res false => NONE | 
| 33060 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 wenzelm parents: 
32738diff
changeset | 51 | | Exn.Exn exn => reraise exn) | 
| 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 wenzelm parents: 
32738diff
changeset | 52 | | SOME (y, x') => | 
| 35015 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 wenzelm parents: 
33060diff
changeset | 53 | uninterruptible (fn _ => fn () => | 
| 
efafb3337ef3
removed slightly adhoc single-assignment feature, cf. structure Single_Assignment;
 wenzelm parents: 
33060diff
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: 
33060diff
changeset | 56 | in try_change () end); | 
| 33060 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 wenzelm parents: 
32738diff
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: 
33060diff
changeset | 66 | end; | 
| 33060 
e66b41782cb5
support single-assigment variables -- based on magic RTS operations by David Matthews;
 wenzelm parents: 
32738diff
changeset | 67 | |
| 28578 | 68 | end; |