56 lines
1.7 KiB
Racket
56 lines
1.7 KiB
Racket
|
|
#lang scheme/base
|
|
(require scheme/pretty)
|
|
(provide write-debug-file
|
|
load-debug-file)
|
|
|
|
(define (write-debug-file file exn events)
|
|
(with-output-to-file file
|
|
(lambda ()
|
|
(pretty-print
|
|
`(list ,@(map (lambda (e) (serialize-datum e)) events)))
|
|
(newline)
|
|
(write (exn-message exn))
|
|
(newline)
|
|
(pretty-print
|
|
(map serialize-context-frame
|
|
(continuation-mark-set->context
|
|
(exn-continuation-marks exn)))))
|
|
#:exists 'replace))
|
|
|
|
(define (serialize-datum d)
|
|
(cond [(number? d) `(quote ,d)]
|
|
[(boolean? d) `(quote ,d)]
|
|
[(symbol? d) `(quote ,d)]
|
|
[(string? d) `(quote ,d)]
|
|
[(pair? d) `(cons ,(serialize-datum (car d)) ,(serialize-datum (cdr d)))]
|
|
[(null? d) ''()]
|
|
[(exn? d) `(make-exn ,(exn-message d) (current-continuation-marks))]
|
|
[(syntax? d) `(datum->syntax #f ',(syntax->datum d))]
|
|
#;[(syntax? d) `(eval (quote ,(compile `(,#'quote-syntax ,d))))]
|
|
[else (error 'serialize-datum "got ~s" d)]))
|
|
|
|
(define (serialize-context-frame frame)
|
|
(cons (car frame)
|
|
(if (cdr frame)
|
|
(serialize-srcloc (cdr frame))
|
|
null)))
|
|
|
|
(define (serialize-srcloc s)
|
|
(list (let ([src (srcloc-source s)])
|
|
(cond [(path? src) (path->string src)]
|
|
[(string? src) src]
|
|
[else '?]))
|
|
(srcloc-line s)
|
|
(srcloc-column s)))
|
|
|
|
(define (load-debug-file file)
|
|
(parameterize ((read-accept-compiled #t))
|
|
(with-input-from-file file
|
|
(lambda ()
|
|
(let* ([events-expr (read)]
|
|
[exnmsg (read)]
|
|
[ctx (read)])
|
|
(let ([events (eval events-expr)])
|
|
(values events exnmsg ctx)))))))
|