From 3f67950050ac6e60cdd42feb6982ea0e8c3f6397 Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Wed, 8 Jul 2026 19:08:37 +0300
Subject: [PATCH] parallel: Small steps

---
 retropikzel/parallel-srfi-18.scm | 45 +++++++++++---------------------
 retropikzel/parallel.scm         |  5 ++--
 retropikzel/parallel.sld         |  3 ++-
 retropikzel/parallel/shared.scm  |  1 +
 4 files changed, 21 insertions(+), 33 deletions(-)

diff --git a/retropikzel/parallel-srfi-18.scm b/retropikzel/parallel-srfi-18.scm
index 11cb757..ff85d62 100644
--- a/retropikzel/parallel-srfi-18.scm
+++ b/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
-                  (lambda ()
-                    (thread-specific-set!
-                      (result (apply thread-proc
-                                     (thread-specific (current-thread)))))))))
-    thread))
+  (make-thread
+    (lambda ()
+      (thread-specific-set!
+        (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)
+       ))))
diff --git a/retropikzel/parallel.scm b/retropikzel/parallel.scm
index 83b1d73..4040fbd 100644
--- a/retropikzel/parallel.scm
+++ b/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)))))
diff --git a/retropikzel/parallel.sld b/retropikzel/parallel.sld
index 5c71a30..9b578e2 100644
--- a/retropikzel/parallel.sld
+++ b/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
diff --git a/retropikzel/parallel/shared.scm b/retropikzel/parallel/shared.scm
index e69de29..9beb729 100644
--- a/retropikzel/parallel/shared.scm
+++ b/retropikzel/parallel/shared.scm
@@ -0,0 +1 @@
+(define thread-count (guard (condition (else 4)) (cpu-count)))