tarot-viewing/compiler/std/display.scm

(define (display-symbol form) (%display form))

(define (display-char ch) (%display ch))
(define (display-chars ch) (for-each display-char ch))

(define (display-boolean form)
  (if form
      (display-chars '(#\# #\t))
      (display-chars '(#\# #\f))))

(define (display-int form) (%display form))

(define (display-aux readable? form)
  (cond ((symbol? form) (display-symbol form))
	((string? form)
	 (when readable?
	   (display-char #\"))
	 (%display form) ;; TODO escaping
	 (when readable?
	   (display-char #\")))
        ((char? form)
	 (when readable?
	   (display-chars '(#\# #\\)))
	 (display-char form)) ;; TODO newlien space etc.
        ((boolean? form) (display-boolean form))
        ((number? form) (display-int form))
        ((null? form) (display-chars '(#\( #\))))
	((vector? form)
	 (display-char #\#)
	 (display-aux readable? (vector->list form)))
	((pair? form)
	 (display-char #\()
	 (let loop ((form form))
	   (display-aux readable? (car form))
	   (cond ((null? (cdr form))
		  (display-char #\)))
		 ((pair? (cdr form))
		  (display-char #\space)
		  (loop (cdr form)))
		 (else (display-chars '(#\space #\. #\space))
		       (display-aux readable? (cdr form))
		       (display-char #\))))))
	(else
	 (%display "[????]"))))

(define (display p) (display-aux #f p))
(define (write p) (display-aux #t p))

(define (print p) (display-aux #t p) (newline))