wingo pushed a commit to branch wip-whippet
in repository guile.
commit 4b96e2509e140ec3c8055cb2c37171db4aee17e1
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Mon Jun 16 11:41:15 2025 +0200
Move REPL-related hooks to their own module
* guile-readline/ice-9/readline.scm: Import hooks and reader modules.
(activate-readline): Install via set-repl-reader!.
* module/ice-9/boot-9.scm (abort-hook, before-backtrace-hook)
(after-backtrace-hook): Move to (ice-9 scm-style-repl).
(before-error-hook, after-error-hook, before-read-hook)
(after-read-hook, before-eval-hook, after-eval-hook)
(before-print-hook, after-print-hook, exit-hook): Move to (system repl
hooks).
(repl-reader): Move to (system repl reader).
* module/system/repl/hooks.scm:
* module/system/repl/reader.scm: New files.
* am/bootstrap.am (SOURCES): Add the new files.
* module/system/repl/repl.scm:
* module/system/repl/server.scm:
* module/system/vm/inspect.scm:
* module/system/repl/error-handling.scm:
* module/system/repl/debug.scm:
* module/system/repl/common.scm:
* module/system/repl/command.scm:
* module/ice-9/top-repl.scm:
* module/ice-9/scm-style-repl.scm:
* module/ice-9/history.scm:
* module/ice-9/deprecated.scm: Adapt to import new modules.
---
am/bootstrap.am | 8 +++--
guile-readline/ice-9/readline.scm | 6 ++--
module/ice-9/boot-9.scm | 46 ---------------------------
module/ice-9/deprecated.scm | 37 +++++++++++++++++++++-
module/ice-9/history.scm | 3 +-
module/ice-9/scm-style-repl.scm | 15 +++++++--
module/ice-9/top-repl.scm | 2 +-
module/system/repl/command.scm | 4 ++-
module/system/repl/common.scm | 3 +-
module/system/repl/debug.scm | 3 +-
module/system/repl/error-handling.scm | 3 +-
module/system/repl/hooks.scm | 46 +++++++++++++++++++++++++++
module/system/repl/reader.scm | 59 +++++++++++++++++++++++++++++++++++
module/system/repl/repl.scm | 4 ++-
module/system/repl/server.scm | 1 +
module/system/vm/inspect.scm | 3 +-
16 files changed, 181 insertions(+), 62 deletions(-)
diff --git a/am/bootstrap.am b/am/bootstrap.am
index 8d14e1bd1..e11ff0ad4 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -374,13 +374,15 @@ SOURCES = \
system/foreign-library.scm \
system/foreign-object.scm \
\
+ system/repl/command.scm \
+ system/repl/common.scm \
+ system/repl/coop-server.scm \
system/repl/debug.scm \
system/repl/error-handling.scm \
- system/repl/common.scm \
- system/repl/command.scm \
+ system/repl/hooks.scm \
+ system/repl/reader.scm \
system/repl/repl.scm \
system/repl/server.scm \
- system/repl/coop-server.scm \
\
system/vm/assembler.scm \
system/vm/coverage.scm \
diff --git a/guile-readline/ice-9/readline.scm
b/guile-readline/ice-9/readline.scm
index df2edaf77..3f2a1b7aa 100644
--- a/guile-readline/ice-9/readline.scm
+++ b/guile-readline/ice-9/readline.scm
@@ -1,7 +1,7 @@
;;;; readline.scm --- support functions for command-line editing
;;;;
;;;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2006, 2009, 2010, 2011,
-;;;; 2013, 2014 Free Software Foundation, Inc.
+;;;; 2013, 2014, 2025 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@@ -28,6 +28,8 @@
#:use-module (ice-9 session)
#:use-module (ice-9 regex)
#:use-module (ice-9 buffered-input)
+ #:use-module (system repl hooks)
+ #:use-module (system repl reader)
#:no-backtrace
#:export (filename-completion-function
add-history
@@ -242,7 +244,7 @@
(if (isatty? (current-input-port))
(begin
(set-current-input-port (readline-port))
- (set! repl-reader readline-repl-reader)
+ (set-repl-reader! readline-repl-reader)
(set! (using-readline?) #t))))
(define-public (make-completion-function strings)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index d7cef2177..65a1fe915 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3635,52 +3635,6 @@ but it fails to load."
(define (gc-run-time)
(cdr (assq 'gc-time-taken (gc-stats))))
-(define abort-hook (make-hook))
-(define before-error-hook (make-hook))
-(define after-error-hook (make-hook))
-(define before-backtrace-hook (make-hook))
-(define after-backtrace-hook (make-hook))
-
-(define before-read-hook (make-hook))
-(define after-read-hook (make-hook))
-(define before-eval-hook (make-hook 1))
-(define after-eval-hook (make-hook 1))
-(define before-print-hook (make-hook 1))
-(define after-print-hook (make-hook 1))
-
-;;; This hook is run at the very end of an interactive session.
-;;;
-(define exit-hook (make-hook))
-
-;;; The default repl-reader function. We may override this if we've
-;;; the readline library.
-(define repl-reader
- (lambda* (prompt #:optional (reader (fluid-ref current-reader)))
- (if (not (char-ready?))
- (begin
- (display (if (string? prompt) prompt (prompt)))
- ;; An interesting situation. The printer resets the column to
- ;; 0 by printing a newline, but we then advance it by printing
- ;; the prompt. However the port-column of the output port
- ;; does not typically correspond with the actual column on the
- ;; screen, because the input is echoed back! Since the
- ;; input is line-buffered and thus ends with a newline, the
- ;; output will really start on column zero. So, here we zero
- ;; it out. See bug 9664.
- ;;
- ;; Note that for similar reasons, the output-line will not
- ;; reflect the actual line on the screen. But given the
- ;; possibility of multiline input, the fix is not as
- ;; straightforward, so we don't bother.
- ;;
- ;; Also note that the readline implementation papers over
- ;; these concerns, because it's readline itself printing the
- ;; prompt, and not Guile.
- (set-port-column! (current-output-port) 0)))
- (force-output)
- (run-hook before-read-hook)
- ((or reader read) (current-input-port))))
-
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index c67cfa1e6..848258b7d 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -21,6 +21,9 @@
#:use-module (ice-9 source-properties)
#:use-module (ice-9 weak-tables)
#:use-module (ice-9 arrays)
+ #:use-module (ice-9 scm-style-repl)
+ #:use-module (system repl hooks)
+ #:use-module (system repl reader)
#:use-module (srfi srfi-14)
#:export ((make-guardian* . make-guardian)
module-observe-weak
@@ -108,7 +111,20 @@
(char-set:blank* . char-set:blank)
(char-set:ascii* . char-set:ascii)
(char-set:empty* . char-set:empty)
- (char-set:full* . char-set:full)))
+ (char-set:full* . char-set:full)
+ (abort-hook* . abort-hook)
+ (before-backtrace-hook* . before-backtrace-hook)
+ (after-backtrace-hook* . after-backtrace-hook)
+ (before-error-hook* . before-error-hook)
+ (after-error-hook* . after-error-hook)
+ (before-read-hook* . before-read-hook)
+ (after-read-hook* . after-read-hook)
+ (before-eval-hook* . before-eval-hook)
+ (after-eval-hook* . after-eval-hook)
+ (before-print-hook* . before-print-hook)
+ (after-print-hook* . after-print-hook)
+ (exit-hook* . exit-hook)
+ (repl-reader* . repl-reader)))
(define-syntax define-deprecated/stx
(lambda (stx)
@@ -308,3 +324,22 @@
char-set:ascii
char-set:empty
char-set:full)
+
+(define-deprecated*/stx (system repl hooks)
+ before-error-hook
+ after-error-hook
+ before-read-hook
+ after-read-hook
+ before-eval-hook
+ after-eval-hook
+ before-print-hook
+ after-print-hook
+ exit-hook)
+
+(define-deprecated*/stx (system repl reader)
+ repl-reader)
+
+(define-deprecated*/stx (ice-9 scm-style-repl)
+ abort-hook
+ before-backtrace-hook
+ after-backtrace-hook)
diff --git a/module/ice-9/history.scm b/module/ice-9/history.scm
index ebf609bf3..f281c4c0e 100644
--- a/module/ice-9/history.scm
+++ b/module/ice-9/history.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2000, 2001, 2004, 2006, 2010 Free Software Foundation,
Inc.
+;;;; Copyright (C) 2000, 2001, 2004, 2006, 2010, 2025 Free Software
Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -18,6 +18,7 @@
;;;; A simple value history support
(define-module (ice-9 history)
+ #:use-module (system repl hooks)
#:export (value-history-enabled? enable-value-history! disable-value-history!
clear-value-history!))
diff --git a/module/ice-9/scm-style-repl.scm b/module/ice-9/scm-style-repl.scm
index 12c446317..c8c6cb57b 100644
--- a/module/ice-9/scm-style-repl.scm
+++ b/module/ice-9/scm-style-repl.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C)
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2014
+;;;; Copyright (C)
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2014,2025
;;;; Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -18,6 +18,8 @@
(define-module (ice-9 scm-style-repl)
#:use-module (ice-9 save-stack)
+ #:use-module (system repl hooks)
+ #:use-module (system repl reader)
#:export (scm-repl-silent
scm-repl-print-unspecified
@@ -32,7 +34,16 @@
error-catching-loop
error-catching-repl
scm-style-repl
- handle-system-error))
+ handle-system-error)
+
+ ;; FIXME: #:export instead of #:replace when deprecated code removed.
+ #:replace (abort-hook
+ before-backtrace-hook
+ after-backtrace-hook))
+
+(define abort-hook (make-hook))
+(define before-backtrace-hook (make-hook))
+(define after-backtrace-hook (make-hook))
(define scm-repl-silent #f)
(define (assert-repl-silence v) (set! scm-repl-silent v))
diff --git a/module/ice-9/top-repl.scm b/module/ice-9/top-repl.scm
index 27881e791..263d2caa8 100644
--- a/module/ice-9/top-repl.scm
+++ b/module/ice-9/top-repl.scm
@@ -18,8 +18,8 @@
;;;;
(define-module (ice-9 top-repl)
- #:use-module (ice-9 top-repl)
#:use-module ((system repl repl) #:select (start-repl))
+ #:use-module (system repl hooks)
#:export (top-repl))
(define call-with-sigint
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 5b575f368..6390fe6d1 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -1,6 +1,6 @@
;;; Repl commands
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2020, 2021 Free Software
Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2020, 2021, 2025 Free
Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -24,6 +24,8 @@
#:autoload (system base compile) (compile-file)
#:use-module (system repl common)
#:use-module (system repl debug)
+ #:use-module (system repl hooks)
+ #:use-module (system repl reader)
#:autoload (system vm disassembler) (disassemble-image
disassemble-program
disassemble-file)
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 46d0d5c04..d77814d22 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -1,6 +1,6 @@
;;; Repl common routines
-;; Copyright (C) 2001, 2008-2016, 2019-2022, 2024 Free Software Foundation,
Inc.
+;; Copyright (C) 2001, 2008-2016, 2019-2022, 2024, 2025 Free Software
Foundation, Inc.
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -22,6 +22,7 @@
#:use-module (system base syntax)
#:use-module (system base compile)
#:use-module (system base language)
+ #:use-module (system repl hooks)
#:use-module (system vm loader)
#:use-module (ice-9 control)
#:use-module (ice-9 copy-tree)
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 036481edb..661b71dc9 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -1,6 +1,6 @@
;;; Guile VM debugging facilities
-;;; Copyright (C) 2001, 2009-2011, 2013-2015, 2023-2024 Free Software
Foundation, Inc.
+;;; Copyright (C) 2001, 2009-2011, 2013-2015, 2023-2025 Free Software
Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -25,6 +25,7 @@
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (system vm program)
+ #:use-module (system repl hooks)
#:export (<debug>
make-debug debug?
debug-frames debug-index debug-error-message
diff --git a/module/system/repl/error-handling.scm
b/module/system/repl/error-handling.scm
index c12ca6f4a..ad1444fa3 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -1,6 +1,6 @@
;;; Error handling in the REPL
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2025 Free Software
Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -22,6 +22,7 @@
(define-module (system repl error-handling)
#:use-module (system vm trap-state)
#:use-module (system repl debug)
+ #:use-module (system repl hooks)
#:use-module (ice-9 format)
#:export (call-with-error-handling
with-error-handling))
diff --git a/module/system/repl/hooks.scm b/module/system/repl/hooks.scm
new file mode 100644
index 000000000..2ab3e2fe2
--- /dev/null
+++ b/module/system/repl/hooks.scm
@@ -0,0 +1,46 @@
+;;; Copyright (C) 2025 Free Software Foundation, Inc.
+;;;
+;;; This library is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;;
+;;; Code:
+
+
+(define-module (system repl hooks)
+ ;; FIXME: #:export instead of #:replace once deprecated code is
+ ;; removed.
+ #:replace (before-error-hook
+ after-error-hook
+ before-read-hook
+ after-read-hook
+ before-eval-hook
+ after-eval-hook
+ before-print-hook
+ after-print-hook
+ exit-hook))
+
+(define before-error-hook (make-hook))
+(define after-error-hook (make-hook))
+
+(define before-read-hook (make-hook))
+(define after-read-hook (make-hook))
+(define before-eval-hook (make-hook 1))
+(define after-eval-hook (make-hook 1))
+(define before-print-hook (make-hook 1))
+(define after-print-hook (make-hook 1))
+
+(define exit-hook (make-hook))
diff --git a/module/system/repl/reader.scm b/module/system/repl/reader.scm
new file mode 100644
index 000000000..86849bc9c
--- /dev/null
+++ b/module/system/repl/reader.scm
@@ -0,0 +1,59 @@
+;;; Copyright (C) 2025 Free Software Foundation, Inc.
+;;;
+;;; This library is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;;
+;;; Code:
+
+
+(define-module (system repl reader)
+ #:use-module (system repl hooks)
+ ;; FIXME: #:export instead of #:replace once deprecated code is
+ ;; removed.
+ #:replace (repl-reader)
+ #:export (set-repl-reader!))
+
+;;; The default repl-reader function. We may override this if we've
+;;; the readline library.
+(define repl-reader
+ (lambda* (prompt #:optional (reader (fluid-ref current-reader)))
+ (unless (char-ready?)
+ (display (if (string? prompt) prompt (prompt)))
+ ;; An interesting situation. The printer resets the column to 0
+ ;; by printing a newline, but we then advance it by printing the
+ ;; prompt. However the port-column of the output port does not
+ ;; typically correspond with the actual column on the screen,
+ ;; because the input is echoed back! Since the input is
+ ;; line-buffered and thus ends with a newline, the output will
+ ;; really start on column zero. So, here we zero it out. See bug
+ ;; 9664.
+ ;;
+ ;; Note that for similar reasons, the output-line will not reflect
+ ;; the actual line on the screen. But given the possibility of
+ ;; multiline input, the fix is not as straightforward, so we don't
+ ;; bother.
+ ;;
+ ;; Also note that the readline implementation papers over these
+ ;; concerns, because it's readline itself printing the prompt, and
+ ;; not Guile.
+ (set-port-column! (current-output-port) 0))
+ (force-output)
+ (run-hook before-read-hook)
+ ((or reader read) (current-input-port))))
+
+(define (set-repl-reader! reader)
+ (set! repl-reader reader))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 1c3407159..4b8a1a7ff 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -1,7 +1,7 @@
;;; Read-Eval-Print Loop
;; Copyright (C) 2001, 2009, 2010, 2011, 2013,
-;; 2014 Free Software Foundation, Inc.
+;; 2014, 2025 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -25,6 +25,8 @@
#:use-module (system repl error-handling)
#:use-module (system repl common)
#:use-module (system repl command)
+ #:use-module (system repl hooks)
+ #:use-module (system repl reader)
#:use-module (ice-9 control)
#:export (start-repl run-repl %inhibit-welcome-message))
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index af6c67fd7..af0d50ed5 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -21,6 +21,7 @@
(define-module (system repl server)
#:use-module (system repl repl)
+ #:use-module (system repl hooks)
#:use-module (ice-9 threads)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
diff --git a/module/system/vm/inspect.scm b/module/system/vm/inspect.scm
index 4825fa234..83b82fcb3 100644
--- a/module/system/vm/inspect.scm
+++ b/module/system/vm/inspect.scm
@@ -1,6 +1,6 @@
;;; Guile VM debugging facilities
-;;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2011, 2013, 2025 Free Software Foundation,
Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -23,6 +23,7 @@
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 format)
#:use-module (system vm program)
+ #:use-module (system repl reader)
#:export (inspect))
