diff --git a/get-module-bytecode.rkt b/get-module-bytecode.rkt index c7150be..c525b5b 100644 --- a/get-module-bytecode.rkt +++ b/get-module-bytecode.rkt @@ -2,7 +2,8 @@ (require racket/path racket/runtime-path syntax/modcode - "language-namespace.rkt") + "language-namespace.rkt" + "logger.rkt") (provide get-module-bytecode) @@ -12,6 +13,7 @@ (define (get-module-bytecode x) + (log-debug "grabbing module bytecode for ~s" x) (let ([compiled-code (cond ;; Assumed to be a path string diff --git a/logger.rkt b/logger.rkt new file mode 100644 index 0000000..bc005d3 --- /dev/null +++ b/logger.rkt @@ -0,0 +1,48 @@ +#lang racket/base + +;; A small module to provide logging for Whalesong. + + +(provide whalesong-logger) + +(define whalesong-logger (make-logger 'whalesong)) + + +(define (log-debug message . args) + (log-message whalesong-logger + 'debug + (apply format message args) + #f)) + + +(define (log-warning message . args) + (log-message whalesong-logger + 'warning + (apply format message args) + #f)) + +(define (log-error message . args) + (log-message whalesong-logger + 'error + (apply format message args) + #f)) + + + +(define should-print-logs? #t) +(define (set-whalesong-log-printing! v) + (set! should-print-logs? v)) + +(void (thread (lambda () + (let ([receiver + (make-log-receiver whalesong-logger 'debug)]) + (let loop ([msg (sync receiver)]) + (when should-print-logs? + (displayln msg)) + (loop)))))) + + + + +(provide whalesong-logger log-debug log-warning log-error + set-whalesong-log-printing!) \ No newline at end of file diff --git a/parameters.rkt b/parameters.rkt index 98fbb86..48841f6 100644 --- a/parameters.rkt +++ b/parameters.rkt @@ -5,6 +5,10 @@ "sets.rkt" racket/path) +(require/typed "logger.rkt" + [log-warning (String -> Void)]) + + (provide current-defined-name current-module-path @@ -31,8 +35,9 @@ (define current-warn-unimplemented-kernel-primitive (make-parameter (lambda: ([id : Symbol]) - (printf "WARNING: Primitive Kernel Value ~s has not been implemented\n" - id)))) + (log-warning + (format "WARNING: Primitive Kernel Value ~s has not been implemented\n" + id))))) (: current-kernel-module-locator? (Parameterof (ModuleLocator -> Boolean)))