31 lines
816 B
Scheme
31 lines
816 B
Scheme
(define debug?
|
|
(and (get-environment-variable "SCM_DEBUG")
|
|
(equal? (get-environment-variable "SCM_DEBUG") "1")))
|
|
|
|
(define print
|
|
(lambda args
|
|
(map (lambda (item) (display item (current-error-port))) args)))
|
|
|
|
(define-syntax debug-display
|
|
(syntax-rules ()
|
|
((_ obj)
|
|
(begin
|
|
(when debug? (print "[DEBUG] " 'obj ": " obj #\newline))
|
|
obj))))
|
|
|
|
(define-syntax debug
|
|
(syntax-rules ()
|
|
((_ obj)
|
|
(begin
|
|
(when debug? (print "[DEBUG] " 'obj ": " obj #\newline))
|
|
obj))))
|
|
|
|
(define-syntax debug-proc
|
|
(syntax-rules ()
|
|
((_ proc arg ...)
|
|
(begin
|
|
(when debug? (print "[DEBUG] Calling: " 'proc ", arguments: " '(arg ...)))
|
|
(let ((result (apply proc (list arg ...))))
|
|
(when debug? (print ", returned: " result #\newline))
|
|
result)))))
|