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