(define (print-raw-char c port) (display c port))
(define (print-raw s port) (display s port))

(define (print-boolean b port)
  (print-raw (if b "#t" "#f") port))

(define (print-digit n port)
  (print-raw-char (integer->char (+ n (char->integer #\0))) port))

(define (print-positive-integer n port)
  (unless (zero? n)
    (print-positive-integer (quotient n 10) port)
    (print-digit (remainder n 10) port)))

(define (print-number n port)
  (cond ((negative? n)
         (print-raw "-" port)
         (print-positive-integer (- n) port))
        ((zero? n)
         (print-raw "0" port))
        (else
          (print-positive-integer n port))))

(define (print-symbol s port)
  (print-raw (symbol->string s) port))

(define (print-char c port)
  (case c
    ((#\newline) (print-raw "#\\newline" port))
    ((#\space)   (print-raw "#\\space" port))
    ((#\tab)   (print-raw "#\\tab" port))
    (else
      (print-raw "#\\" port)
      (print-raw-char c port))))

(define (print-string s port)
  (define (special-escape? c)
    (case (char->integer c)
      ((10 13 9) #t)
      (else #f)))
  (define (print-special-escape c)
    (case (char->integer c)
      ((10) (print-raw "\\n" port))
      ((13) (print-raw "\\r" port))
      ((9)  (print-raw "\\t" port))))
  (define (non-printable? c)
    (let ((n (char->integer c)))
      (cond ((< n 32) #t)
            ((> n 127) #t)
            (else #f))))
  (define (print-hex-digit n)
    (print-raw (number->string n 16) port))
  (define (print-hex-char c)
    (let* ((n (char->integer c))
           (n1 (quotient n 16))
           (n2 (remainder n 16)))
      (print-raw "\\x" port)
      (print-hex-digit n1)
      (print-hex-digit n2)))
  (define (normal-escape? c)
    (case c
      ((#\\ #\") #t)
      (else #f)))
  (define (print-normal-escape c)
    (case c
      ((#\\) (print-raw "\\\\" port))
      ((#\") (print-raw "\\\"" port))))
  (define (print-one-char c)
    (cond ((special-escape? c) (print-special-escape c))
          ((non-printable? c)  (print-hex-char c))
          ((normal-escape? c)  (print-normal-escape c))
          (else (print-raw-char c port))))
  (let ((n (string-length s)))
    (define (print-string-body i)
      (unless (= i n)
        (print-one-char (string-ref s i))
        (print-string-body (+ i 1))))
    (print-raw-char #\" port)
    (print-string-body 0)
    (print-raw-char #\" port)))

(define (print-list lis port)
  (define (print-list-body lis)
    (cond ((null? lis))
          ((pair? lis)
           (print-raw " " port)
           (print (car lis) port)
           (print-list-body (cdr lis)))
          (else
            (print-raw " . " port)
            (print lis port))))
  (print-raw "(" port)
  (when (pair? lis)
    (print (car lis) port)
    (print-list-body (cdr lis)))
  (print-raw ")" port))

(define (print-vector vec port)
  (let ((n (vector-length vec)))
    (define (print-vector-body i)
      (unless (= i n)
        (if (> i 0) (print-raw " " port))
        (print (vector-ref vec i) port)
        (print-vector-body (+ i 1))))
    (print-raw "#(" port)
    (print-vector-body 0)
    (print-raw ")" port)))

(define (print obj port)
  (cond ((boolean? obj) (print-boolean obj port))
        ((number? obj)  (print-number obj port))
        ((symbol? obj)  (print-symbol obj port))
        ((char? obj)    (print-char obj port))
        ((string? obj)  (print-string obj port))
        ((pair? obj)    (print-list obj port))
        ((null? obj)    (print-list obj port))
        ((vector? obj)  (print-vector obj port))
        (else (error "unknown data type: " obj))))

(define (print-to-string obj)
  (let ((out (open-output-string)))
    (print obj out)
    (get-output-string out)))