parallel: Small steps

retropikzel/parallel-srfi-18.scm

@@ -1,34 +1,19 @@
-(define thread-count 4)
-(define thread-proc (lambda () #t))
+(define thread-proc (lambda (x) #t))
 
 (define (new-thread)
-  (let ((thread (make-thread
+  (make-thread
     (lambda ()
       (thread-specific-set!
-                      (result (apply thread-proc
-                                     (thread-specific (current-thread)))))))))
-    thread))
+        (current-thread)
+        (thread-proc (thread-specific (current-thread)))))))
+
 (define threads (make-list thread-count (new-thread)))
 
-(define (parallel-map thunk lst)
-  (letrec*
-    ((lst-length (length lst))
-     (result '())
-     (looper (index)
-        (when (< index lst-length)
-  (for-each
-    (lambda (thread)
-      (when (< (+ index thread-index) lst-length)
-        (thread-specific-set! thread (list-ref lst (+ index thread-index)))))
-    threads '(0 1 2 3)) ;; FIXME Make thread-index dynamic
-  (for-each
-    (lambda (thread)
-      (when (< (+ index thread-index) lst-length)
-        thread-start! thread))
-    threads '(0 1 2 3))
-  (for-each thread-join! threads)
-  (map
-    (lambda (thread)
-      (thread-specific thread))
-    threads '(0 1 2 3))
-  )
+(define-syntax parallel-map
+  (syntax-rules ()
+    ((_ env (l args body ...) lst)
+     (let* ((lst-length (length lst))
+            (thread-proc (eval `(lambda args body ...)
+                               (apply environment 'env))))
+       (map thread-proc lst)
+       ))))

retropikzel/parallel.scm

@@ -1,5 +1,6 @@
 (define-syntax parallel-map
   (syntax-rules ()
     ((_ env (l args body ...) lst)
-     (let ((l (eval `(lambda args body ...) (apply environment 'env))))
-       (map l lst)))))
+     (let* ((lst-length (length lst))
+            (proc (eval `(lambda args body ...) (apply environment 'env))))
+       (map proc lst)))))

retropikzel/parallel.sld

@@ -5,8 +5,9 @@
           (scheme eval)
           (retropikzel hardware-info)
           (retropikzel purer))
+  (include "parallel/shared.scm")
   (cond-expand
-    #;((library (srfi 18))
+    ((library (srfi 18))
      (import (srfi 18))
      (include "parallel-srfi-18.scm"))
     (else

retropikzel/parallel/shared.scm

@@ -0,0 +1 @@
+(define thread-count (guard (condition (else 4)) (cpu-count)))