src/Pure/Concurrent/thread_data_virtual.ML
author wenzelm
Tue, 26 Dec 2023 20:06:30 +0100
changeset 79360 da22c8ab0112
parent 78720 909dc00766a0
permissions -rw-r--r--
tuned signature, following Proofterm.thm_header;
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 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
909dc00766a0 clarified signature;
wenzelm
parents: 78716
diff changeset
    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
97dfba4405e3 tuned signature;
wenzelm
parents: 74561
diff changeset
    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
909dc00766a0 clarified signature;
wenzelm
parents: 78716
diff changeset
    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;