You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
pollen/debug.rkt

85 lines
2.9 KiB
Racket

11 years ago
#lang racket/base
(require racket/date racket/string)
(require sugar/debug sugar/define "world.rkt")
11 years ago
11 years ago
(provide (all-from-out sugar/debug))
11 years ago
; todo: contracts, tests, docs
11 years ago
; debug utilities
(define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
11 years ago
(define last-message-time #f)
(define (seconds-since-last-message)
(define now (current-seconds))
(define then last-message-time)
(set! last-message-time now)
(if then
11 years ago
(- now then)
11 years ago
"0"))
11 years ago
11 years ago
(define (zero-fill str count)
(set! str (format "~a" str))
11 years ago
(if (> (string-length str) count)
str
(string-append (make-string (- count (string-length str)) #\0) str)))
11 years ago
(define+provide (make-datestamp)
11 years ago
(define date (current-date))
(define date-fields (map (λ(x) (zero-fill x 2))
(list
(date-day date)
(list-ref months (sub1 (date-month date)))
(date-year date)
)))
(string-join date-fields "-"))
11 years ago
(define+provide (make-timestamp)
11 years ago
(define date (current-date))
(define time-fields (map (λ(x) (zero-fill x 2))
(list
; (date-day date)
; (list-ref months (sub1 (date-month date)))
(if (<= (date-hour date) 12)
(date-hour date) ; am hours + noon hour
(modulo (date-hour date) 12)) ; pm hours after noon hour
(date-minute date)
(date-second date)
)))
(string-append (string-join time-fields ":") (if (< (date-hour date) 12) "am" "pm")))
(define (make-debug-timestamp)
11 years ago
(format "[~a ∆~as]" (make-timestamp) (seconds-since-last-message)))
11 years ago
11 years ago
;; todo: consolidate these two message functions
11 years ago
(define+provide (basic-message . items)
(displayln (string-join `(,@(map (λ(x)(if (string? x) x (format "~v" x))) items))) (current-error-port)))
11 years ago
11 years ago
(define+provide (message . items)
(apply message-threshold world:threshold-normal items))
(define+provide (message-threshold threshold . items)
(when (threshold . <= . (world:current-message-threshold))
(displayln (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items))) (current-error-port))))
11 years ago
(define (exn+stack->string exn)
(string-append
(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)))