suzanne.soy/macro-debugger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

macro-debugger: improve internal error debugging support

Browse Source 
original commit: 4b6c71eaae5f0be8c9b8285ce6ccead122c7f863
This commit is contained in:
Ryan Culpepper 2012-03-14 22:39:45 -06:00
parent 890768b3c8
commit b4086e0783
1 changed files with 40 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/macro-debugger/view/debug-format.rkt
View File

@ -1,13 +1,13 @@
#lang racket/base #lang racket/base
(require racket/pretty) (require racket/pretty)
(provide write-debug-file (provide write-debug-file
load-debug-file) load-debug-file
serialize-datum)
(define (write-debug-file file exn events) (define (write-debug-file file exn events)
(with-output-to-file file (with-output-to-file file
(lambda () (lambda ()
(pretty-print (pretty-write (serialize-datum events))
`(list ,@(map (lambda (e) (serialize-datum e)) events)))
(newline) (newline)
(write (exn-message exn)) (write (exn-message exn))
(newline) (newline)
@ -17,17 +17,44 @@
(exn-continuation-marks exn))))) (exn-continuation-marks exn)))))
#:exists 'replace)) #:exists 'replace))
(define (quoted? x) (and (pair? x) (eq? (car x) 'quote)))
(define (serialize-datum d) (define (serialize-datum d)
(cond [(number? d) `(quote ,d)] (list 'quasiquote (serialize-datum* d)))
[(boolean? d) `(quote ,d)]
[(symbol? d) `(quote ,d)] (define (serialize-datum* d)
[(string? d) `(quote ,d)] (define (UNQUOTE x) (list 'unquote x))
[(pair? d) `(cons ,(serialize-datum (car d)) ,(serialize-datum (cdr d)))] (cond [(number? d) d]
[(null? d) ''()] [(boolean? d) d]
[(exn? d) `(make-exn ,(exn-message d) (current-continuation-marks))] [(symbol? d)
[(syntax? d) `(datum->syntax #f ',(syntax->datum d))] (case d
#;[(syntax? d) `(eval (quote ,(compile `(,#'quote-syntax ,d))))] ((unquote) (UNQUOTE '(quote unquote)))
[else (error 'serialize-datum "got ~s" d)])) ((unquote-splicing) (UNQUOTE '(quote unquote-splicing)))
(else d))]
[(string? d) d]
[(bytes? d) d]
[(null? d) d]
[(pair? d)
(cons (serialize-datum* (car d)) (serialize-datum* (cdr d)))]
[(exn? d) (UNQUOTE `(make-exn ,(exn-message d) (current-continuation-marks)))]
[(syntax? d) (UNQUOTE `(datum->syntax #f ',(syntax->datum d)))]
[(module-path-index? d)
(define-values (path rel)
(module-path-index-split d))
(UNQUOTE `(module-path-index-join
,(serialize-datum path)
,(serialize-datum rel)))]
[(resolved-module-path? d)
(UNQUOTE `(make-resolved-module-path
,(serialize-datum
(resolved-module-path-name d))))]
[(path? d)
(UNQUOTE `(bytes->path
,(serialize-datum (path->bytes d))
,(serialize-datum (path-convention-type d))))]
[else
(eprintf "unserializable value: ~e" d)
`(UNSERIALIZABLE ,(format "~s" d))]))
(define (serialize-context-frame frame) (define (serialize-context-frame frame)
(cons (car frame) (cons (car frame)