--- 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;
--- 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;
--- /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;
+