simplify log functions

debug.rkt

@@ -1,4 +1,5 @@
 #lang racket/base
+(require (for-syntax racket/base racket/syntax))
 (require racket/date racket/string)
 (require sugar/debug sugar/define)
 
@@ -60,26 +61,18 @@
 (define-logger pollen) 
 
 
-;; todo: consolidate these two message functions
+(define-syntax (make-message-logger-functions stx)
-(define+provide (basic-message . items)
+  (syntax-case stx ()
-  (displayln (string-join `(,@(map (λ(x)(if (string? x) x (format "~v" x))) items))) (current-error-port)))
+    [(_ stem)
-
+     (with-syntax ([message-stem (format-id stx "message-~a" #'stem)]
-(define+provide (message . items)
+                   [log-pollen-stem (format-id stx "log-pollen-~a" #'stem)])
-  (log-pollen-debug (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))
+       #'(begin
-
+           ;; does file have particular extension
-(define (exn+stack->string exn)
+           (define+provide (message-stem . items)
-  (string-append 
+             (log-pollen-stem (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))))]))
-   (string-append "Exception: " (exn-message exn)) 
+
-   "\n"
+(make-message-logger-functions fatal)
-   "Stack:\n"
+(make-message-logger-functions error)
-   (string-join
+(make-message-logger-functions warning)
-    (map (lambda (x)
+(make-message-logger-functions info)
-           (format "'~a' ~a ~a"
+(make-message-logger-functions debug)
-                   (if (car x) (car x) "")
-                   (if (cdr x) (srcloc-source (cdr x)) "")
-                   (if (cdr x) (srcloc-line (cdr x)) "")))
-         (continuation-mark-set->context (exn-continuation-marks exn)))
-    "\n")))
-
-(define (display-stack-trace exn)
-  (displayln (exn+stack->string exn)))