From 1c9e8d2b32bc2958d1b3a2321c5fcc0b9514c95d Mon Sep 17 00:00:00 2001
From: ESL <der.magen@hotmail.com>
Date: Wed, 10 Jul 2024 11:02:56 -0400
Subject: [PATCH] once hack (mucho kluge!)

---
 src/t.scm | 31 ++++++++++++++++++++++++++++++-
 t.c       | 16 ++++++++++------
 2 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/src/t.scm b/src/t.scm
index d269a9d..01dacff 100644
--- a/src/t.scm
+++ b/src/t.scm
@@ -2055,7 +2055,7 @@
 (define *verbose* #f)
 (define *quiet* #f)
 
-(define (repl-compile-and-run-core-expr core)
+#;(define (repl-compile-and-run-core-expr core)
   (when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline))
   (unless (val-core? core) (x-error "unexpected transformed output" core))
   (let ([code (compile-to-thunk-code core)] [start #f])
@@ -2069,6 +2069,35 @@
         (display " ms.") (newline))
       (unless (eq? res (void)) (write res) (newline)))))      
 
+(define (repl-compile-and-run-core-expr core)
+  (define start #f)
+  (define (compile-and-run core)
+    (define code (compile-to-thunk-code core))
+    (define cl (closure (deserialize-code code)))
+    (define vals (call-with-values cl list))
+    (for-each (lambda (v) (unless (void? v) (write v) (newline))) vals))
+  (when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline))
+  (unless (val-core? core) (x-error "unexpected transformed output" core))
+  (set! start (current-jiffy))
+  (let loop ([cores (list core)])
+    (unless (null? cores)
+      (let ([first (car cores)] [rest (cdr cores)])
+        (record-case first
+          [begin exps 
+           (loop (append exps rest))]
+          [once (gid exp)
+           (compile-and-run first)
+           ; this 'once' is done and there is no need to keep it around
+           (set-car! first 'begin) (set-cdr! first '()) ; mucho kluge!
+           (loop rest)]
+          [else 
+           (compile-and-run first) 
+           (loop rest)]))))
+  (when *verbose* 
+    (display "Elapsed time: ") (write (* 1000 (/ (- (current-jiffy) start) (jiffies-per-second))))
+    (display " ms.") (newline)))      
+
+
 (define (repl-eval-top-form x env)
   (if (pair? x)
       (let ([hval (xform #t (car x) env)]) ; returns <core>
diff --git a/t.c b/t.c
index f0d34a6..65265d8 100644
--- a/t.c
+++ b/t.c
@@ -1299,12 +1299,16 @@ char *t_code[] = {
   "f@!(y7:*quiet*)",
 
   "P", "repl-compile-and-run-core-expr",
-  "%1@(y9:*verbose*)?{Po,'(s12:TRANSFORM =>)W4PoW6Po,.1W5PoW6}.0p~?{${.2,"
-  "'(s29:unexpected transformed output),@(y7:x-error)[02}}f,${.3,@(y21:co"
-  "mpile-to-thunk-code)[01},#1@(y9:*verbose*)?{Po,'(s20:COMPILE-TO-STRING"
-  " =>)W4PoW6Po,.1W4PoW6Po,'(s17:DECODE+EXECUTE =>)W4PoW6Z3.!1}.0U4,U91,$"
-  "{.2[00},@(y9:*verbose*)?{Po,'(s14:Elapsed time: )W4Po,Z4,.5^,Z3-/,'(i1"
-  "000)*W5Po,'(s4: ms.)W4PoW6}Y9,.1q~?{Po,.1W5PoW6]5}]5",
+  "%1,,#0#1f.!0&0{%1,,,#0#1#2${.5,@(y21:compile-to-thunk-code)[01}.!0.0^U"
+  "4,U91.!1${@(y4:list),.4^,@(y16:call-with-values)[02}.!2.2^,&0{%1.0Y8~?"
+  "{Po,.1W5PoW6]1}]1},@(y10:%25for-each1)[42}.!1@(y9:*verbose*)?{Po,'(s12"
+  ":TRANSFORM =>)W4PoW6Po,.3W5PoW6}.2p~?{${.4,'(s29:unexpected transforme"
+  "d output),@(y7:x-error)[02}}Z3.!0${.4,l1,,#0.0,.6,&2{%1.0u~?{.0d,.1a,'"
+  "(y5:begin),.1aq?{.0d,.2,:1,&2{%!0:1,.1L6,:0^[11},@(y13:apply-to-list)["
+  "32}'(y4:once),.1aq?{.0d,:1,.3,.3,:0,&4{%2${:1,:0^[01}'(y5:begin),:1san"
+  ",:1sd:2,:3^[21},@(y13:apply-to-list)[32}${.2,:0^[01}.1,:1^[31}]1}.!0.0"
+  "^_1[01}@(y9:*verbose*)?{Po,'(s14:Elapsed time: )W4Po,Z4,.2^,Z3-/,'(i10"
+  "00)*W5Po,'(s4: ms.)W4PoW6]3}]3",
 
   "P", "repl-eval-top-form",
   "%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1."