src/Pure/ML-Systems/thread_dummy.ML
author wenzelm
Sat Nov 27 16:29:53 2010 +0100 (2010-11-27 ago)
changeset 40748 591b6778d076
parent 39616 8052101883c3
permissions -rw-r--r--
removed bash from ML system bootstrap, and past the Secure ML barrier;
wenzelm@28152
     1
(*  Title:      Pure/ML-Systems/thread_dummy.ML
wenzelm@28152
     2
    Author:     Makarius
wenzelm@28152
     3
wenzelm@28152
     4
Default (mostly dummy) implementation of thread structures
wenzelm@28152
     5
(cf. polyml/basis/Thread.sml).
wenzelm@28152
     6
*)
wenzelm@28152
     7
wenzelm@28152
     8
exception Thread of string;
wenzelm@28152
     9
wenzelm@28152
    10
local fun fail _ = raise Thread "No multithreading support on this ML platform" in
wenzelm@28152
    11
wenzelm@28152
    12
structure Mutex =
wenzelm@28152
    13
struct
wenzelm@28152
    14
  type mutex = unit;
wenzelm@28152
    15
  fun mutex _ = ();
wenzelm@28152
    16
  fun lock _ = fail ();
wenzelm@28152
    17
  fun unlock _ = fail ();
wenzelm@28152
    18
  fun trylock _ = fail ();
wenzelm@28152
    19
end;
wenzelm@28152
    20
wenzelm@28152
    21
structure ConditionVar =
wenzelm@28152
    22
struct
wenzelm@28152
    23
  type conditionVar = unit;
wenzelm@28152
    24
  fun conditionVar _ = ();
wenzelm@28152
    25
  fun wait _ = fail ();
wenzelm@28152
    26
  fun waitUntil _ = fail ();
wenzelm@28152
    27
  fun signal _ = fail ();
wenzelm@28152
    28
  fun broadcast _ = fail ();
wenzelm@28152
    29
end;
wenzelm@28152
    30
wenzelm@28152
    31
structure Thread =
wenzelm@28152
    32
struct
wenzelm@28152
    33
  type thread = unit;
wenzelm@28152
    34
wenzelm@28152
    35
  datatype threadAttribute = EnableBroadcastInterrupt of bool | InterruptState of interruptState
wenzelm@28152
    36
    and interruptState = InterruptDefer | InterruptSynch | InterruptAsynch | InterruptAsynchOnce;
wenzelm@28152
    37
wenzelm@32736
    38
  fun unavailable () = fail ();
wenzelm@32736
    39
wenzelm@28152
    40
  fun fork _ = fail ();
wenzelm@28152
    41
  fun exit _ = fail ();
wenzelm@28152
    42
  fun isActive _ = fail ();
wenzelm@28152
    43
wenzelm@28152
    44
  fun equal _ = fail ();
wenzelm@28152
    45
  fun self _ = fail ();
wenzelm@28152
    46
wenzelm@28152
    47
  fun interrupt _ = fail ();
wenzelm@28152
    48
  fun broadcastInterrupt _ = fail ();
wenzelm@28152
    49
  fun testInterrupt _ = fail ();
wenzelm@28152
    50
wenzelm@28152
    51
  fun kill _ = fail ();
wenzelm@28152
    52
wenzelm@28152
    53
  fun setAttributes _ = fail ();
wenzelm@28152
    54
  fun getAttributes _ = fail ();
wenzelm@28152
    55
wenzelm@28152
    56
  fun numProcessors _ = fail ();
wenzelm@28152
    57
wenzelm@28152
    58
wenzelm@28152
    59
(* thread data *)
wenzelm@28152
    60
wenzelm@28152
    61
local
wenzelm@28152
    62
wenzelm@39616
    63
val data = ref ([]: Universal.universal  ref list);
wenzelm@28152
    64
wenzelm@28152
    65
fun find_data tag =
wenzelm@28152
    66
  let
wenzelm@28152
    67
    fun find (r :: rs) = if Universal.tagIs tag (! r) then SOME r else find rs
wenzelm@28152
    68
      | find [] = NONE;
wenzelm@28152
    69
  in find (! data) end;
wenzelm@28152
    70
wenzelm@28152
    71
in
wenzelm@28152
    72
wenzelm@28152
    73
fun getLocal tag = Option.map (Universal.tagProject tag o !) (find_data tag);
wenzelm@28152
    74
wenzelm@28152
    75
fun setLocal (tag, x) =
wenzelm@28152
    76
  (case find_data tag of
wenzelm@28152
    77
    SOME r => r := Universal.tagInject tag x
wenzelm@39616
    78
  | NONE => data :=  ref (Universal.tagInject tag x) :: ! data);
wenzelm@28152
    79
wenzelm@28152
    80
end;
wenzelm@28152
    81
end;
wenzelm@28152
    82
end;