How do I customize the printing of a procedure in Racket?

Viewed 132

Suppose I used the following procedures to implement a primitive class:

;;; 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))

I know that Racket has an object system, but I am making this just for educational purposes. My problem is: how do I customize the printing/displaying of a procedure? For example:

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

This displays something like #<procedure:...xxx/test.rkt:4:2>, which is not ideal. Is there a way to customize the output?

EDIT: I would like (displayln mypos) to display (POS (x 1) (y 2)).

1 Answers

There are 3 ways:

  1. statically naming the lambda
  2. dynamically naming the procedure
  3. making a struct with prop:procedure

Method (1) is very limited, where you can change #<procedure:...xxx/test.rkt:4:2> to #<procedure:my-constant-name> by naming the lambda:

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

Method (2) using procedure-rename lets you change the name dynamically, but it doesn't let you get rid of the #<procedure > part:

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

Method (3) using a struct is more powerful. It lets you change the printing to anything you want:

(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

If you want to display the s-expression representation of the lambda, you can do that:

(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) ....)

Update: displaying (POS (x 1) (y 2))

Using method (3) and a proc/get-sexpr struct (like the proc/sexpr struct above but with an extra lambda), you can get it to display as (POS (x 1) (y 2)) like this:

(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))

Using that, calling (make-pos 1 2) produces a value that displays as (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))
Related