| author | Lukas Bartl | 
| Thu, 09 Jan 2025 13:18:37 +0100 | |
| changeset 81757 | 4d15005da582 | 
| parent 78720 | 909dc00766a0 | 
| permissions | -rw-r--r-- | 
| 62893 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 1 | (* Title: Pure/Concurrent/thread_data_virtual.ML | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 2 | Author: Makarius | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 3 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 4 | Thread-local data -- virtual version with context management. | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 5 | *) | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 6 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 7 | structure Thread_Data_Virtual: THREAD_DATA = | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 8 | struct | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 9 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 10 | structure Data = Generic_Data | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 11 | ( | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 12 | type T = Universal.universal Inttab.table; | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 13 | val empty = Inttab.empty; | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 14 | val merge = Inttab.merge (K true); | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 15 | ); | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 16 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 17 | abstype 'a var = Var of serial * 'a Universal.tag | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 18 | with | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 19 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 20 | fun var () : 'a var = Var (serial (), Universal.tag ()); | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 21 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 22 | fun get (Var (i, tag)) = | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 23 | Inttab.lookup (Data.get (Context.the_generic_context ())) i | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 24 | |> Option.map (Universal.tagProject tag); | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 25 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 26 | fun put (Var (i, tag)) data = | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 27 | (Context.>> o Data.map) | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 28 | (case data of | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 29 | NONE => Inttab.delete_safe i | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 30 | | SOME x => Inttab.update (i, Universal.tagInject tag x)); | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 31 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 32 | fun setmp v data f x = | 
| 78720 | 33 | Thread_Attributes.uninterruptible_body (fn run => | 
| 62893 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 34 | let | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 35 | val orig_data = get v; | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 36 | val _ = put v data; | 
| 78716 | 37 | val result = Exn.capture (run f) x; | 
| 62893 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 38 | val _ = put v orig_data; | 
| 78720 | 39 | in Exn.release result end); | 
| 62893 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 40 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 41 | end; | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 42 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 43 | val is_virtual = true; | 
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 44 | |
| 
fca40adc6342
virtual thread data via context, for proper support of Context.>> etc;
 wenzelm parents: diff
changeset | 45 | end; |