~ chicken-core (chicken-5) 4f04803b4b67f329b336beb37142fe8e6be710e3

commit 4f04803b4b67f329b336beb37142fe8e6be710e3
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Jul 3 11:15:20 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jul 3 11:15:20 2011 +0200

    added optional evaluator procedure to repl (as suggested by John Cowan)

diff --git a/csi.scm b/csi.scm
index fec57a2b..bdaa518a 100644
--- a/csi.scm
+++ b/csi.scm
@@ -55,7 +55,7 @@ EOF
   (hide parse-option-string bytevector-data member* canonicalize-args 
 	describer-table dirseparator? circular-list? improper-pairs?
 	show-frameinfo selected-frame select-frame copy-from-frame
-	findall command-table default-editor) )
+	findall command-table default-editor csi-eval) )
 
 
 ;;; Parameters:
@@ -286,7 +286,7 @@ EOF
 	 (set! command-table (cons (list name proc help) command-table))))
   (##sys#void))
 
-(set! ##sys#repl-eval-hook
+(set! csi-eval
   (let ((eval eval)
 	(load-noisily load-noisily)
 	(read read)
@@ -1087,7 +1087,7 @@ EOF
       (do ([args args (cdr args)])
 	  ((null? args)
 	   (unless batch 
-	     (repl)
+	     (repl csi-eval)
 	     (##sys#write-char-0 #\newline ##sys#standard-output) ) )
 	(let* ((arg (car args)))
 	  (cond ((member arg simple-options))
diff --git a/eval.scm b/eval.scm
index dfad23e9..0ff35fcb 100644
--- a/eval.scm
+++ b/eval.scm
@@ -30,7 +30,7 @@
   (uses expand)
   (hide ##sys#r4rs-environment ##sys#r5rs-environment 
 	##sys#interaction-environment pds pdss pxss d) 
-  (not inline ##sys#repl-eval-hook ##sys#repl-read-hook ##sys#repl-print-hook 
+  (not inline ##sys#repl-read-hook ##sys#repl-print-hook 
        ##sys#read-prompt-hook ##sys#alias-global-hook ##sys#user-read-hook
        ##sys#syntax-error-hook))
 
@@ -1506,7 +1506,6 @@
 
 ;;;; Read-Eval-Print loop:
 
-(define ##sys#repl-eval-hook #f)
 (define ##sys#repl-print-length-limit #f)
 (define ##sys#repl-read-hook #f)
 (define ##sys#repl-recent-call-chain #f) ; used in csi for ,c command
@@ -1530,7 +1529,7 @@
 	(read read)
 	(call-with-current-continuation call-with-current-continuation)
 	(string-append string-append))
-    (lambda ()
+    (lambda (#!optional (evaluator eval))
 
       (define (write-err xs)
 	(for-each (cut ##sys#repl-print-hook <> ##sys#standard-error) xs) )
@@ -1610,7 +1609,7 @@
 		   (##sys#read-char-0 ##sys#standard-input) )
 		 (##sys#clear-trace-buffer)
 		 (set! ##sys#unbound-in-eval '())
-		 (receive result ((or ##sys#repl-eval-hook eval) exp)
+		 (receive result (evaluator exp)
 		   (when (and ##sys#warnings-enabled (pair? ##sys#unbound-in-eval))
 		     (let loop ((vars ##sys#unbound-in-eval) (u '()))
 		       (cond ((null? vars)
diff --git a/manual/Unit eval b/manual/Unit eval
index ab6611bb..7392f8ee 100644
--- a/manual/Unit eval	
+++ b/manual/Unit eval	
@@ -102,13 +102,16 @@ this facility is mainly of interest when accessing foreign code.
 
 ==== repl
 
-<procedure>(repl)</procedure>
+<procedure>(repl [EVALUATOR])</procedure>
 
 Start a new read-eval-print loop. Sets the {{reset-handler}} so that
 any invocation of {{reset}} restarts the read-eval-print loop. Also
 changes the current exception-handler to display a message, write
 any arguments to the value of {{(current-error-port)}} and reset.
 
+If {{EVALUATOR}} is given, it should be a procedure of one argument that
+is used in place of {{eval}} to evaluate each entered expression.
+
 
 === Loading extension libraries
 
diff --git a/types.db b/types.db
index de0d3a0b..aecee858 100644
--- a/types.db
+++ b/types.db
@@ -393,7 +393,7 @@
 (register-feature! (procedure register-feature! (#!rest symbol) undefined))
 (remprop! (procedure remprop! (symbol symbol) undefined))
 (rename-file (procedure rename-file (string string) string))
-(repl (procedure repl () undefined))
+(repl (procedure repl (#!optional (procedure (*) *)) undefined))
 (repl-prompt (procedure repl-prompt (#!optional procedure) procedure))
 (repository-path (procedure repository-path (#!optional *) *))
 (require (procedure require (#!rest *) undefined))