(module debug-logging

(current-debug-port debug-log-prefix
 (debug display-prefix) (debug* display-prefix))

(import chicken scheme)
(use (only extras fprintf))

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(define (display-prefix)
  (display (debug-log-prefix) (current-debug-port)))

(define-syntax debug
  (syntax-rules ()
    ((_ fmt args ...)
     (cond-expand
      (debug-logging-on
       (display-prefix)
       (fprintf (current-debug-port) fmt args ...)
       (newline (current-debug-port)))
      (else)))))

(define-syntax debug*
  (syntax-rules ()
    ((_ args ... last)
     (cond-expand
      (debug-logging-on
       (begin
         (display-prefix)
         (pp args (current-debug-port))) ...
       (let ((last* last))
         (display-prefix)
         (pp last* (current-debug-port))
         last*))
      (else last)))))

)