# HG changeset patch
# User wenzelm
# Date 1220802404 -7200
# Node ID c1277547d59f8278700fa752773dc592161223f1
# Parent  61f9c918b410a736d7092acbe160d2017458f61e
*** empty log message ***

diff -r 61f9c918b410 -r c1277547d59f src/Pure/ML-Systems/polyml-5.1.ML
--- a/src/Pure/ML-Systems/polyml-5.1.ML	Sun Sep 07 17:46:43 2008 +0200
+++ b/src/Pure/ML-Systems/polyml-5.1.ML	Sun Sep 07 17:46:44 2008 +0200
@@ -4,12 +4,9 @@
 Compatibility wrapper for Poly/ML 5.1.
 *)
 
-structure PolyML_Thread = Thread;
+open Thread;
 use "ML-Systems/polyml_common.ML";
-
-open PolyML_Thread;
 use "ML-Systems/multithreading_polyml.ML";
-
 use "ML-Systems/polyml_old_compiler5.ML";
 
 val pointer_eq = PolyML.pointerEq;
diff -r 61f9c918b410 -r c1277547d59f src/Pure/ML-Systems/polyml.ML
--- a/src/Pure/ML-Systems/polyml.ML	Sun Sep 07 17:46:43 2008 +0200
+++ b/src/Pure/ML-Systems/polyml.ML	Sun Sep 07 17:46:44 2008 +0200
@@ -4,10 +4,8 @@
 Compatibility wrapper for Poly/ML (after 5.1).
 *)
 
-structure PolyML_Thread = Thread;
+open Thread;
 use "ML-Systems/polyml_common.ML";
-
-open PolyML_Thread;
 use "ML-Systems/multithreading_polyml.ML";
 
 val pointer_eq = PolyML.pointerEq;
diff -r 61f9c918b410 -r c1277547d59f src/Pure/ML-Systems/thread_dummy.ML
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Pure/ML-Systems/thread_dummy.ML	Sun Sep 07 17:46:44 2008 +0200
@@ -0,0 +1,82 @@
+(*  Title:      Pure/ML-Systems/thread_dummy.ML
+    ID:         $Id$
+    Author:     Makarius
+
+Default (mostly dummy) implementation of thread structures
+(cf. polyml/basis/Thread.sml).
+*)
+
+exception Thread of string;
+
+local fun fail _ = raise Thread "No multithreading support on this ML platform" in
+
+structure Mutex =
+struct
+  type mutex = unit;
+  fun mutex _ = ();
+  fun lock _ = fail ();
+  fun unlock _ = fail ();
+  fun trylock _ = fail ();
+end;
+
+structure ConditionVar =
+struct
+  type conditionVar = unit;
+  fun conditionVar _ = ();
+  fun wait _ = fail ();
+  fun waitUntil _ = fail ();
+  fun signal _ = fail ();
+  fun broadcast _ = fail ();
+end;
+
+structure Thread =
+struct
+  type thread = unit;
+
+  datatype threadAttribute = EnableBroadcastInterrupt of bool | InterruptState of interruptState
+    and interruptState = InterruptDefer | InterruptSynch | InterruptAsynch | InterruptAsynchOnce;
+
+  fun fork _ = fail ();
+  fun exit _ = fail ();
+  fun isActive _ = fail ();
+
+  fun equal _ = fail ();
+  fun self _ = fail ();
+
+  fun interrupt _ = fail ();
+  fun broadcastInterrupt _ = fail ();
+  fun testInterrupt _ = fail ();
+
+  fun kill _ = fail ();
+
+  fun setAttributes _ = fail ();
+  fun getAttributes _ = fail ();
+
+  fun numProcessors _ = fail ();
+
+
+(* thread data *)
+
+local
+
+val data = ref ([]: Universal.universal ref list);
+
+fun find_data tag =
+  let
+    fun find (r :: rs) = if Universal.tagIs tag (! r) then SOME r else find rs
+      | find [] = NONE;
+  in find (! data) end;
+
+in
+
+fun getLocal tag = Option.map (Universal.tagProject tag o !) (find_data tag);
+
+fun setLocal (tag, x) =
+  (case find_data tag of
+    SOME r => r := Universal.tagInject tag x
+  | NONE => data := ref (Universal.tagInject tag x) :: ! data);
+
+end;
+end;
+end;
+