#lang scheme

(define-values
  (*debug* *info* *warning* *error*) (apply values (build-list 4 (λ (i) i))))

(define port (make-parameter (current-error-port)))

(define level (make-parameter *info*))

(define names
  (list->vector
   '(debug info warning error)))

(define (log fmt #:level [other-level *info*] . args)
  (when (>= other-level (level))
    (parameterize
        ([current-output-port (port)])
      (display (vector-ref names other-level))
      (display ": ")
      (display (apply format fmt args))
      (display "\n")
      (flush-output))))

(define info log)

(define (error fmt . args)
  (apply log fmt #:level *error* args))

(define (warning fmt . args)
  (apply log fmt #:level *warning* args))

(define (debug fmt . args)
  (apply log fmt #:level *debug* args))

(provide log port level)
(provide *debug* *info* *warning* *error*)
(provide  debug   info   warning   error)