scheme - 如何在 Racket 中自定义程序的打印？

Question

假设我使用以下过程来实现一个原始类:

;;; Constructor.
(define (make-pos x y)
  (lambda (msg)
    (cond [(eq? msg 'get-x) x]
          [(eq? msg 'get-y) y]
          [(eq? msg 'set-x) (lambda (v) (set! x v))]
          [(eq? msg 'set-y) (lambda (v) (set! y v))]
          [else (error "POS invalid msg" msg)])))

;;; Getters and setters.
(define (pos-x pos) (pos 'get-x))
(define (pos-y pos) (pos 'get-y))
(define (set-pos-x! pos x) ((pos 'set-x) x))
(define (set-pos-y! pos y) ((pos 'set-y) y))

我知道 Racket 有一个对象系统，但我这样做只是为了教育目的。我的问题是:如何自定义程序的打印/显示？例如:

(define mypos (make-pos 1 2))
(displayln mypos)

这显示类似 #<procedure:...xxx/test.rkt:4:2> 的内容，这并不理想。有没有办法自定义输出？

编辑:我想要(displayln mypos)显示(POS (x 1) (y 2)) .

Answer 1

有3种方法:

1. 静态命名 lambda
2. 动态命名过程
3. 使用prop:procedure创建一个结构体

方法(1)非常有限，可以更改#<procedure:...xxx/test.rkt:4:2>至#<procedure:my-constant-name>通过命名 lambda:

(define my-constant-name
  (lambda (msg) ....))
my-constant-name
; #<procedure:my-constant-name>

方法(2)使用procedure-rename允许您动态更改名称，但它不会让您摆脱 #<procedure >部分:

(procedure-rename
 (lambda (msg) ....)
 'my-new-name)
; #<procedure:my-new-name>

使用结构体的方法(3)更强大。它可以让您将打印更改为您想要的任何内容:

(struct proc/print [proc print]
  #:property prop:procedure (struct-field-index proc)
  #:methods gen:custom-write
  [(define (write-proc self out mode)
     ((proc/print-print self) out))])
(proc/print
 (lambda (msg) ....)
 (lambda (out)
   (display "whatever you want" out)))
; whatever you want

如果您想显示 lambda 的 s 表达式表示形式，您可以这样做:

(struct proc/sexpr [proc sexpr]
  #:property prop:procedure (struct-field-index proc)
  #:methods gen:custom-write
  [(define (write-proc self out mode)
     (write (proc/sexpr-sexpr self) out))])
(define-simple-macro (lam stuff ...)
  (proc/sexpr (lambda stuff ...) '(lam stuff ...)))
(lam (msg) ....)
; (lam (msg) ....)

更新:显示(POS (x 1) (y 2))

使用方法(3)和proc/get-sexpr struct(类似于上面的 proc/sexpr 结构，但带有一个额外的 lambda)，您可以将其显示为 (POS (x 1) (y 2))像这样:

(struct proc/get-sexpr [proc get-sexpr]
  #:property prop:procedure (struct-field-index proc)
  #:methods gen:custom-write
  [(define (write-proc self out mode)
     (write ((proc/get-sexpr-get-sexpr self)) out))])

(define (make-pos x y)
  (proc/get-sexpr
    (lambda (msg)
      (cond [(eq? msg 'get-x) x]
            [(eq? msg 'get-y) y]
            [(eq? msg 'set-x) (lambda (v) (set! x v))]
            [(eq? msg 'set-y) (lambda (v) (set! y v))]
            [else (error "POS invalid msg" msg)]))
    (lambda () `(POS (x ,x) (y ,y)))))

;;; Getters and setters.
(define (pos-x pos) (pos 'get-x))
(define (pos-y pos) (pos 'get-y))
(define (set-pos-x! pos x) ((pos 'set-x) x))
(define (set-pos-y! pos y) ((pos 'set-y) y))

使用它，调用 (make-pos 1 2)生成一个显示为 (POS (x 1) (y 2)) 的值.

> (define x (make-pos 1 2))
> x
(POS (x 1) (y 2))
> ((x 'set-x) 10)
> x
(POS (x 10) (y 2))