#lang scheme/base (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 (if fmt (apply format fmt args) (car 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)