src/Pure/Concurrent/thread_data_virtual.ML
author wenzelm
Thu, 14 Jun 2018 17:50:23 +0200
changeset 68449 6d0f1a5a16ea
parent 62923 3a122e1e352a
child 74561 8e6c973003c8
permissions -rw-r--r--
auto update;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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 extend = I;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    15
  val merge = Inttab.merge (K true);
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
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    18
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
    19
with
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    20
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    21
fun var () : 'a var = Var (serial (), Universal.tag ());
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    22
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    23
fun get (Var (i, tag)) =
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    24
  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
    25
  |> Option.map (Universal.tagProject tag);
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    26
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    27
fun put (Var (i, tag)) data =
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    28
  (Context.>> o Data.map)
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    29
    (case data of
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    30
      NONE => Inttab.delete_safe i
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    31
    | 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
    32
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    33
fun setmp v data f x =
62923
3a122e1e352a clarified bootstrap;
wenzelm
parents: 62893
diff changeset
    34
  Thread_Attributes.uninterruptible (fn restore_attributes => fn () =>
62893
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    35
    let
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    36
      val orig_data = get v;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    37
      val _ = put v data;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    38
      val result = Exn.capture (restore_attributes f) x;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    39
      val _ = put v orig_data;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    40
    in Exn.release result end) ();
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    41
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    42
end;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    43
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    44
val is_virtual = true;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    45
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    46
end;