diff --git a/quad/quad/log.rkt b/quad/quad/log.rkt new file mode 100644 index 00000000..04920d03 --- /dev/null +++ b/quad/quad/log.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require racket/logging) +(provide (all-defined-out)) + +;; creates `quad-logger` and associated functions: +;; log-quad-fatal, log-quad-error, log-quad-warning, +;; log-quad-info, and log-quad-debug +(define-logger quad) \ No newline at end of file diff --git a/quad/quad/wrap.rkt b/quad/quad/wrap.rkt index 7046574a..924f3867 100644 --- a/quad/quad/wrap.rkt +++ b/quad/quad/wrap.rkt @@ -1,12 +1,16 @@ #lang debug racket (require racket/list racket/match sugar/debug sugar/list - "param.rkt" "quad.rkt" "atomize.rkt" "position.rkt" "ocm.rkt") + "param.rkt" "quad.rkt" "atomize.rkt" "position.rkt" "ocm.rkt" "log.rkt") (provide wrap) (define-syntax (debug-report stx) (syntax-case stx () - [(_ EXPR ...) (with-syntax ([debug (datum->syntax stx 'debug)]) - #'(when debug (report EXPR ...)))])) + [(_ SYM) + (with-syntax ([DEBUG (datum->syntax stx 'debug)]) + #'(when DEBUG (log-quad-debug (format "~a" SYM))))] + [(_ VAL SYM) + (with-syntax ([DEBUG (datum->syntax stx 'debug)]) + #'(when DEBUG (log-quad-debug (format "~a: ~a" SYM VAL))))])) (define (nonprinting-at-start? x) (not (printable? x 'start))) (define (nonprinting-at-end? x) (not (printable? x 'end)))