如何在Guile Scheme中全局自定义REPL输出格式？

问题描述 #

原问题《How to have objects print nicely in Guile scheme repl》聚焦于自定义特定用户定义对象（如GOOPS类）的打印格式，但我需要全局覆盖REPL的打印机，让所有类型的对象都按特定格式显示，不管其类型或来源。

例如：

• 求值1时，希望输出：

  1 (number)
  

• 求值'(guix build gnu-build-system)时，希望输出：

  #<list>
    Item: guix (symbol)
    Item: build (symbol)
    Item: gnu-build-system (symbol)
  

我已经编写了repl-inspect函数（简化版代码如下），可以按预期格式处理对象：

(use-modules (ice-9 pretty-print)) ; For pretty-printing
(use-modules (srfi srfi-1))        ; For list utilities
(use-modules (system repl repl))   ; For repl-print

;; ANSI color codes
(define *color-red* "\x1b[31m")
(define *color-green* "\x1b[32m")
(define *color-yellow* "\x1b[33m")
(define *color-blue* "\x1b[34m")
(define *color-magenta* "\x1b[35m")
(define *color-cyan* "\x1b[36m")
(define *color-reset* "\x1b[0m")

;; Custom type-of function
(define (type-of obj)
  (cond
    ((struct? obj) 'struct)
    ((hash-table? obj) 'hash-table)
    ((variable? obj) 'variable)
    ((list? obj) 'list)
    ((pair? obj) 'pair)
    ((string? obj) 'string)
    ((symbol? obj) 'symbol)
    ((number? obj) 'number)
    ((boolean? obj) 'boolean)
    ((procedure? obj) 'procedure)
    ((char? obj) 'char)
    ((null? obj) 'null)
    (else 'unknown)))

;; Helper to convert value to string and trim trailing whitespace
(define (value->string value)
  (string-trim-right
   (call-with-output-string
    (lambda (port)
      (pretty-print value port)))
   #\newline))

;; Your inspect function
(define (repl-inspect obj depth)
  (define (indent)
    (display (make-string (* depth 2) #\space)))

  (define (color-print color text)
    (display color)
    (display text)
    (display *color-reset*))

  (define (print-with-type value)
    (display " (")
    (color-print *color-yellow* (symbol->string (type-of value)))
    (display ")"))

  (cond
    ;; Handle structs
    ((struct? obj)
     (indent)
     (color-print *color-cyan* "#<struct>\n")
     (let ((vtable (struct-vtable obj)))
       (indent)
       (color-print *color-yellow* "Vtable: ")
       (display (value->string vtable))
       (print-with-type vtable)
       (newline)
       (indent)
       (color-print *color-yellow* "Fields:\n")
       (catch #t
         (lambda ()
           (let loop ((index 0))
             (catch #t
               (lambda ()
                 (let ((field-value (struct-ref obj index)))
                   (indent)
                   (color-print *color-green* "  Field ")
                   (display index)
                   (color-print *color-green* ": ")
                   (repl-inspect field-value (+ depth 1)) ; Recursively inspect each field
                   (loop (+ index 1))))
               (lambda (key . args)
                 (indent)
                 (color-print *color-red* "  (End of fields)\n")
                 (indent)
                 (color-print *color-red* "  Error details: ")
                 (pretty-print (cons key args))))))
         (lambda (key . args)
           (indent)
           (color-print *color-red* "  (Cannot access struct fields)\n")
           (indent)
           (color-print *color-red* "  Error details: ")
           (pretty-print (cons key args))))))
    ;; Handle hash tables
    ((hash-table? obj)
     (indent)
     (color-print *color-magenta* "#<hash-table>\n")
     (hash-for-each (lambda (key value)
                      (indent)
                      (color-print *color-green* "  Key: ")
                      (display (value->string key))
                      (print-with-type key)
                      (newline)
                      (indent)
                      (color-print *color-green* "  Value: ")
                      (repl-inspect value (+ depth 1))) ; Recursively inspect the value
                    obj))
    ;; Handle variables
    ((variable? obj)
     (indent)
     (color-print *color-blue* "#<variable>\n")
     (indent)
     (color-print *color-green* "  Value: ")
     (repl-inspect (variable-ref obj) (+ depth 1))) ; Inspect the value stored in the variable
    ;; Handle lists
    ((list? obj)
     (indent)
     (color-print *color-yellow* "#<list>\n")
     (for-each (lambda (item)
                 (indent)
                 (color-print *color-green* "  Item: ")
                 (repl-inspect item (+ depth 1))) ; Recursively inspect each item
               obj))
    ;; Handle pairs (e.g., cons cells)
    ((pair? obj)
     (indent)
     (color-print *color-cyan* "#<pair>\n")
     (indent)
     (color-print *color-green* "  Car: ")
     (repl-inspect (car obj) (+ depth 1))
     (indent)
     (color-print *color-green* "  Cdr: ")
     (repl-inspect (cdr obj) (+ depth 1)))
    ;; Handle other types (base case)
    (else
     (indent)
     (display (value->string obj))
     (print-with-type obj)
     (newline))))
     
;; Example usage
;(define interface (resolve-interface '(guix build gnu-build-system)))
;(repl-inspect interface 0)

现在需要解决的问题是：如何配置Guile REPL，使其使用repl-inspect函数显示求值表达式的结果？是否可以覆盖默认REPL打印机或挂钩到REPL的输出机制？

解决方案 #

Guile的REPL允许通过修改repl-print变量直接替换默认打印逻辑，具体步骤如下：

1. 适配自定义函数到REPL接口 #

默认的repl-print函数接收两个参数：待打印对象和输出端口。需要将你的repl-inspect包装成符合该接口的函数：

(define (custom-repl-print obj port)
  (parameterize ((current-output-port port))
    (repl-inspect obj 0)))

2. 替换REPL默认打印函数 #

使用set!修改repl-print变量，让REPL使用自定义逻辑：

(set! repl-print custom-repl-print)

3. 持久化配置（可选） #

如果希望每次启动REPL自动加载配置，可将上述代码添加到Guile初始化文件：

• 针对当前用户：编辑~/.guile文件，将代码追加到末尾
• 全局配置：编辑/etc/guile/guile.conf（路径可能因系统而异）

额外注意事项 #

• 若需保留原打印行为，可先备份默认函数：

  (define original-repl-print repl-print)
  

  后续通过(set! repl-print original-repl-print)即可恢复默认逻辑
• ANSI颜色码在非终端环境（如文件输出）会显示异常，可通过isatty?判断是否启用颜色：

  (define (color-print color text)
    (if (isatty? (current-output-port))
        (begin
          (display color)
          (display text)
          (display *color-reset*))
        (display text)))
  

内容的提问来源于stack exchange，提问作者Rainb