如何在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

有三种方法：

1. 静态命名lambda
2. 动态命名过程
3. 用prop:procedure构造结构

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

(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结构(类似于上面的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))