~ chicken-core (chicken-5) 64f670949586f053f07dac73ea3eda784bff1010

commit 64f670949586f053f07dac73ea3eda784bff1010
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Nov 21 12:52:03 2021 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Nov 22 08:38:49 2021 +1300

    Export toplevel expression handler from chicken.csi module
    
    This patch also fixes two bugs: EOF in a repl should invoke "quit"
    (not "exit") to properly return to the outer caller, and disabled
    notices would result in incomplete warning messages for references to
    unbound variables in expressions read into the repl.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/csi.scm b/csi.scm
index f22a42b9..503d5cec 100644
--- a/csi.scm
+++ b/csi.scm
@@ -41,7 +41,7 @@ EOF
 ) )
 
 (module chicken.csi
-  (editor-command toplevel-command set-describer!)
+  (editor-command toplevel-command set-describer! default-evaluator)
 
 (import scheme
 	chicken.base
@@ -279,7 +279,7 @@ EOF
 	 (set! command-table (cons (list name proc help) command-table))))
   (##sys#void))
 
-(define csi-eval
+(define default-evaluator
   (let ((eval eval)
 	(load-noisily load-noisily)
 	(read read)
@@ -291,7 +291,7 @@ EOF
 	(pretty-print pretty-print)
 	(values values) )
     (lambda (form)
-      (cond ((eof-object? form) (exit))
+      (cond ((eof-object? form) (quit))
 	    ((and (pair? form)
 		  (eq? 'unquote (##sys#slot form 0)) )
 	     (let ((cmd (cadr form)))
@@ -1092,9 +1092,9 @@ EOF
 	(set! ##sys#notices-enabled #f))
       (do ([args args (cdr args)])
 	  ((null? args)
+	   (register-repl-history!)
 	   (unless batch
-	     (register-repl-history!)
-	     (repl csi-eval)
+	     (repl default-evaluator)
 	     (##sys#write-char-0 #\newline ##sys#standard-output) ) )
 	(let* ((arg (car args)))
 	  (cond ((member arg simple-options))
diff --git a/manual/Module (chicken csi) b/manual/Module (chicken csi)
index 0518ed25..3b8ec30f 100644
--- a/manual/Module (chicken csi)	
+++ b/manual/Module (chicken csi)	
@@ -39,6 +39,17 @@ example:
  a point with x=1 and y=2
 
 
+=== default-evaluator
+
+<procedure>(default-evaluator EXPR)</procedure>
+
+Takes {{EXPR}} and processes any of the built-in toplevel commands provided
+by {{csi}}. If {{EXPR}} is not a toplevel command, then it is evaluated using
+{{eval}}. This procedure is intended to be passed as an argument to {{repl}}
+to allow using {{csi}}s toplevel commands and history management in user-defined
+read-eval-print loops.
+
+
 === editor-command
 
 <parameter>editor-command</parameter>
diff --git a/manual/Module (chicken repl) b/manual/Module (chicken repl)
index 2a4b5cd5..faf2b366 100644
--- a/manual/Module (chicken repl)	
+++ b/manual/Module (chicken repl)	
@@ -19,6 +19,7 @@ If {{EVALUATOR}} is given, it should be a procedure of one argument that
 is used in place of {{eval}} to evaluate each entered expression.
 
 You can use {{quit}} to terminate the current read-eval-print loop.
+Encountering end-of-file also terminates the current REPL.
 
 
 === repl-prompt
diff --git a/repl.scm b/repl.scm
index 670a17ba..a76c836a 100644
--- a/repl.scm
+++ b/repl.scm
@@ -92,6 +92,7 @@
 	    (stderr ##sys#standard-error)
 	    (ehandler (##sys#error-handler))
 	    (rhandler (##sys#reset-handler))
+	    (notices ##sys#notices-enabled)
 	    (lv #f)
 	    (qh quit-hook)
 	    (uie ##sys#unbound-in-eval))
@@ -113,6 +114,7 @@
 	      (set! lv (load-verbose))
 	      (set! quit-hook (lambda (result) (k result)))
 	      (load-verbose #t)
+	      (set! ##sys#notices-enabled #t)
 	      (##sys#error-handler
 	       (lambda (msg . args)
 		 (resetports)
@@ -161,19 +163,20 @@
 				   (u '()))
 			  (cond ((null? vars)
 				 (when (pair? u)
-				   (##sys#notice
-				    "the following toplevel variables are referenced but unbound:\n")
-				   (for-each
-				    (lambda (v)
-				      (##sys#print "  " #f ##sys#standard-error)
-				      (##sys#print (car v) #t ##sys#standard-error)
-				      (when (cdr v)
-					(##sys#print " (in " #f ##sys#standard-error)
-					(##sys#print (cdr v) #t ##sys#standard-error)
-					(##sys#write-char-0 #\) ##sys#standard-error))
-				      (##sys#write-char-0 #\newline ##sys#standard-error))
-				    u)
-				   (##sys#flush-output ##sys#standard-error)))
+				   (when ##sys#notices-enabled
+				     (##sys#notice
+				      "the following toplevel variables are referenced but unbound:\n")
+				     (for-each
+				      (lambda (v)
+					(##sys#print "  " #f ##sys#standard-error)
+					(##sys#print (car v) #t ##sys#standard-error)
+					(when (cdr v)
+					  (##sys#print " (in " #f ##sys#standard-error)
+					  (##sys#print (cdr v) #t ##sys#standard-error)
+					  (##sys#write-char-0 #\) ##sys#standard-error))
+					(##sys#write-char-0 #\newline ##sys#standard-error))
+				      u)
+				     (##sys#flush-output ##sys#standard-error))))
 				((or (memq (caar vars) u)
 				     (##core#inline "C_u_i_namespaced_symbolp" (caar vars))
 				     (##sys#symbol-has-toplevel-binding? (caar vars)))
@@ -184,6 +187,7 @@
 	    (lambda ()
 	      (load-verbose lv)
 	      (set! quit-hook qh)
+	      (set! ##sys#notices-enabled notices)
 	      (set! ##sys#unbound-in-eval uie)
 	      (##sys#error-handler ehandler)
 	      (##sys#reset-handler rhandler))))))))))