From 7db26c7d8c2d6db3e0b1b7b527f6f3b0bee3c872 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 26 Dec 2015 23:26:07 -0500
Subject: [PATCH] Relocated threading functions

---
 scheme/base.sld | 41 -----------------------------------------
 srfi/18.sld     | 43 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+), 41 deletions(-)
 create mode 100644 srfi/18.sld

diff --git a/scheme/base.sld b/scheme/base.sld
index e3e06797..2f5d1b6f 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -1,16 +1,5 @@
 (define-library (scheme base)
   (export
-    ;; Thread functions. these are not standard, and may be relocated
-    ;; TODO: relocate to (scheme srfi 18) or such
-    thread?
-    make-thread
-    thread-name
-    thread-specific
-    thread-specific-set!
-    thread-start!
-    thread-yield!
-;    thread-terminate!
-    ;; END threads
     ; TODO: need filter for the next two. also, they really belong in SRFI-1, not here
     ;delete
     ;delete-duplicates
@@ -657,34 +646,4 @@
           (else 
              #f))))
 
-    ;; Threading
-    (define (thread? obj) 
-      (and (vector? obj) 
-           (> (vector-length obj) 0) 
-           (equal? 'cyc-thread-obj (vector-ref obj 0))))
-
-    (define (make-thread thunk . name)
-      (let ((name-str (if (pair? name)
-                          (car name)
-                          "")))
-        ;; Fields supported so far:
-        ;; - type marker (implementation-specific)
-        ;; - thunk
-        ;; - internal thread id (implementation-specific)
-        ;; - name
-        ;; - specific
-        (vector 'cyc-thread-obj thunk #f name-str #f)))
-
-    (define (thread-name t) (vector-ref t 3))
-    (define (thread-specific t) (vector-ref t 4))
-    (define (thread-specific-set! t obj) (vector-set! t 4 obj))
-; TODO:
-; current-thread - not sure how to look this up yet... may need a global list of running threads
-    (define (thread-start! t)
-      (let* ((thunk (vector-ref t 1)) 
-             (mutator-id (Cyc-spawn-thread! thunk)))
-        (vector-set! t 2 mutator-id)))
-    (define (thread-yield!) (thread-sleep! 1))
-;    (define (thread-terminate!) (Cyc-end-thread!))
-    ;; TODO: thread-join!
 ))
diff --git a/srfi/18.sld b/srfi/18.sld
new file mode 100644
index 00000000..5fc18bf1
--- /dev/null
+++ b/srfi/18.sld
@@ -0,0 +1,43 @@
+(define-library (srfi 18)
+  (export
+    thread?
+    make-thread
+    thread-name
+    thread-specific
+    thread-specific-set!
+    thread-start!
+    thread-yield!
+;    thread-terminate!
+  )
+  (begin
+    ;; Threading
+    (define (thread? obj) 
+      (and (vector? obj) 
+           (> (vector-length obj) 0) 
+           (equal? 'cyc-thread-obj (vector-ref obj 0))))
+
+    (define (make-thread thunk . name)
+      (let ((name-str (if (pair? name)
+                          (car name)
+                          "")))
+        ;; Fields supported so far:
+        ;; - type marker (implementation-specific)
+        ;; - thunk
+        ;; - internal thread id (implementation-specific)
+        ;; - name
+        ;; - specific
+        (vector 'cyc-thread-obj thunk #f name-str #f)))
+
+    (define (thread-name t) (vector-ref t 3))
+    (define (thread-specific t) (vector-ref t 4))
+    (define (thread-specific-set! t obj) (vector-set! t 4 obj))
+; TODO:
+; current-thread - not sure how to look this up yet... may need a global list of running threads
+    (define (thread-start! t)
+      (let* ((thunk (vector-ref t 1)) 
+             (mutator-id (Cyc-spawn-thread! thunk)))
+        (vector-set! t 2 mutator-id)))
+    (define (thread-yield!) (thread-sleep! 1))
+;    (define (thread-terminate!) (Cyc-end-thread!))
+    ;; TODO: thread-join!
+))