Adding logger.

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

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!)

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"
+            (log-warning
-                    id))))
+             (format "WARNING: Primitive Kernel Value ~s has not been implemented\n"
+                     id)))))
 
 
 (: current-kernel-module-locator? (Parameterof (ModuleLocator -> Boolean)))