From a32cc7b100e5ebac4d7eaa9b60d85d669715b504 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Mon, 16 Jun 2025 17:40:15 +0900
Subject: [PATCH] make repl configurable

---
 lib/chibi/repl.scm    | 31 ++++++++++++++++++++-----------
 lib/srfi/231/test.sld | 19 +++++++++++--------
 2 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/lib/chibi/repl.scm b/lib/chibi/repl.scm
index 5da914ab..542a20be 100644
--- a/lib/chibi/repl.scm
+++ b/lib/chibi/repl.scm
@@ -176,12 +176,15 @@
 
 (define-record-type Repl
   (make-repl
-   in out escape module env meta-env make-prompt history-file history raw?)
+   in out escape module reader eval printer env meta-env make-prompt history-file history raw?)
   repl?
   (in repl-in repl-in-set!)
   (out repl-out repl-out-set!)
   (escape repl-escape repl-escape-set!)
   (module repl-module repl-module-set!)
+  (reader repl-reader repl-reader-set!)
+  (eval repl-eval repl-eval-set!)
+  (printer repl-printer repl-printer-set!)
   (env repl-env repl-env-set!)
   (meta-env repl-meta-env  repl-meta-env-set!)
   (make-prompt repl-make-prompt repl-make-prompt-set!)
@@ -429,27 +432,26 @@
                 (lambda ()
                   (if (or (identifier? expr)
                           (pair? expr)
-                          (null? expr))
-                      (eval expr (repl-env rp))
+                          (null? expr)
+                          (not (eq? eval (repl-eval rp))))
+                      ((or (repl-eval rp) eval) expr (repl-env rp))
                       expr))
               (lambda res-values
                 (cond
                  ((not (or (null? res-values)
                            (equal? res-values (list undefined-value))))
                   (push-history-value-maybe! res-values)
-                  (repl-print (car res-values) out)
+                  ((or (repl-printer rp) repl-print) (car res-values) out)
                   (for-each
                    (lambda (res)
                      (write-char #\space out)
-                     (repl-print res out))
+                     ((or (repl-printer rp) repl-print) res out))
                    (cdr res-values))
                   (newline out))))))
           expr-list))))))
 
-(define (repl/eval-string rp str)
-  (repl/eval
-   rp
-   (protect (exn (else (print-exception exn (current-error-port))))
+(define (repl-string->sexps rp str)
+  (protect (exn (else (print-exception exn (current-error-port))))
      ;; Ugly wrapper to account for the implicit state mutation
      ;; implied by the #!fold-case read syntax.
      (let ((in (repl-in rp))
@@ -458,7 +460,10 @@
        (set-port-line! in2 (port-line in))
        (let ((expr-list (read/ss/all in2)))
          (set-port-fold-case! in (port-fold-case? in2))
-         expr-list)))))
+         expr-list))))
+
+(define (repl/eval-string rp str)
+  (repl/eval rp ((repl-reader rp) rp str)))
 
 (define (keywords->repl ls)
   (let-keywords* ls
@@ -466,6 +471,9 @@
        (out out: (current-output-port))
        (escape escape: #\@)
        (module module: #f)
+       (reader reader: repl-string->sexps)
+       (eval eval: eval)
+       (printer printer: repl-print)
        (env
         environment:
         (if module
@@ -489,7 +497,8 @@
              (member (get-environment-variable "TERM") '("emacs" "dumb")))
        (meta-env meta-env: (module-env (load-module '(meta)))))
     (make-repl
-     in out escape module env meta-env make-prompt history-file history raw?)))
+     in out escape module reader eval printer env meta-env
+     make-prompt history-file history raw?)))
 
 (define (repl/edit-line rp)
   (let ((prompt ((repl-make-prompt rp) (repl-module rp)))
diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld
index fc4bb599..3a2692ac 100644
--- a/lib/srfi/231/test.sld
+++ b/lib/srfi/231/test.sld
@@ -3351,7 +3351,7 @@
                (make-interval (quote #(1 -6 -1 3))
                               (quote #(5 -5 5 8)))
                '(3 1 6 2 8 0 8 1 2 6 7 2 9 4 6 5 2 4 5 4 5 2 6 6 0 6 4 2 1 3 4 6 9 6 7 2 4 8 4 3 5 5 8 0 6 4 6 3 7 6 3 4 1 6 2 3 1 9 1 0 3 1 5 0 3 5 8 1 8 0 2 3 1 5 0 4 9 5 3 2 0 7 6 5 5 9 4 8 5 3 2 5 1 4 8 4 5 7 4 6 1 5 8 2 0 1 5 0 8 3 0 4 6 1 7 1 7 1 6 9)))))
-        (test-assert
+        '(test-assert
             (array-append
              0
              (list 
@@ -3787,16 +3787,19 @@
                             '#(2 1))
               (make-interval '#(8))
               #t)))
-        (test '(() ())
-            (array->list*
-             (specialized-array-reshape
-              (make-specialized-array (make-interval '#(1 2 0 4)))
-              (make-interval '#(2 0 4)))))
+        (let ((a (specialized-array-reshape
+                  (make-specialized-array (make-interval '#(1 2 0 4)))
+                  (make-interval '#(2 0 4)))))
+          (test '((0 0 0) (2 0 4))
+              (list (interval-lower-bounds->list (array-domain a))
+                    (interval-upper-bounds->list (array-domain a))))
+          (test '(() ())
+              (array->list* a)))
         (test 'foo
             (array->list*
              (specialized-array-reshape ;; Reshape to a zero-dimensional array
-              (array-extract            ;; Restrict to the first element
-               (make-specialized-array-from-data  ;; One-dimensional array
+              (array-extract ;; Restrict to the first element
+               (make-specialized-array-from-data ;; One-dimensional array
                 (vector 'foo 'bar 'baz))
                (make-interval '#(1)))
               (make-interval '#()))))