|
|
@ -1,4 +1,5 @@
|
|
|
|
#lang racket/base
|
|
|
|
#lang racket/base
|
|
|
|
|
|
|
|
(require (for-syntax racket/base racket/syntax))
|
|
|
|
(require racket/date racket/string)
|
|
|
|
(require racket/date racket/string)
|
|
|
|
(require sugar/debug sugar/define)
|
|
|
|
(require sugar/debug sugar/define)
|
|
|
|
|
|
|
|
|
|
|
@ -60,26 +61,18 @@
|
|
|
|
(define-logger pollen)
|
|
|
|
(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)]
|
|
|
|
|
|
|
|
[log-pollen-stem (format-id stx "log-pollen-~a" #'stem)])
|
|
|
|
|
|
|
|
#'(begin
|
|
|
|
|
|
|
|
;; does file have particular extension
|
|
|
|
|
|
|
|
(define+provide (message-stem . items)
|
|
|
|
|
|
|
|
(log-pollen-stem (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))))]))
|
|
|
|
|
|
|
|
|
|
|
|
(define+provide (message . items)
|
|
|
|
(make-message-logger-functions fatal)
|
|
|
|
(log-pollen-debug (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))
|
|
|
|
(make-message-logger-functions error)
|
|
|
|
|
|
|
|
(make-message-logger-functions warning)
|
|
|
|
(define (exn+stack->string exn)
|
|
|
|
(make-message-logger-functions info)
|
|
|
|
(string-append
|
|
|
|
(make-message-logger-functions debug)
|
|
|
|
(string-append "Exception: " (exn-message exn))
|
|
|
|
|
|
|
|
"\n"
|
|
|
|
|
|
|
|
"Stack:\n"
|
|
|
|
|
|
|
|
(string-join
|
|
|
|
|
|
|
|
(map (lambda (x)
|
|
|
|
|
|
|
|
(format "'~a' ~a ~a"
|
|
|
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|