src/Pure/Concurrent/thread_data_virtual.ML
author wenzelm
Wed, 06 Apr 2016 19:03:29 +0200
changeset 62893 fca40adc6342
child 62923 3a122e1e352a
permissions -rw-r--r--
virtual thread data via context, for proper support of Context.>> etc;
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
(* context 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
structure Data = Generic_Data
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    13
(
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    14
  type T = Universal.universal Inttab.table;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    15
  val empty = Inttab.empty;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    16
  val extend = I;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    17
  val merge = Inttab.merge (K true);
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    18
);
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
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
    21
with
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 var () : 'a var = Var (serial (), Universal.tag ());
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    24
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    25
fun get (Var (i, tag)) =
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    26
  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
    27
  |> Option.map (Universal.tagProject tag);
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    28
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    29
fun put (Var (i, tag)) data =
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    30
  (Context.>> o Data.map)
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    31
    (case data of
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    32
      NONE => Inttab.delete_safe i
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    33
    | 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
    34
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    35
fun setmp v data f x =
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    36
  Multithreading.uninterruptible (fn restore_attributes => fn () =>
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    37
    let
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    38
      val orig_data = get v;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    39
      val _ = put v data;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    40
      val result = Exn.capture (restore_attributes f) x;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    41
      val _ = put v orig_data;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    42
    in Exn.release result 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
end;
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
val is_virtual = true;
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    47
fca40adc6342 virtual thread data via context, for proper support of Context.>> etc;
wenzelm
parents:
diff changeset
    48
end;