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

never sharing hashes and trace debugging

Browse Source
This commit is contained in:
Blake Johnson 2010-09-06 23:39:05 -06:00 committed by Jay McCarthy
parent 32a9e60abe
commit 0d136ba4c7
2 changed files with 34 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/compiler/zo-marshal.rkt
View File

@ -77,6 +77,7 @@
(out-compilation-top (out-compilation-top
(λ (v #:error? [error? #f]) (λ (v #:error? [error? #f])
(cond (cond
[(hash? v) (error 'create-symbol-table "current type trace: ~a" (current-type-trace))]
[(closure? v) [(closure? v)
(let ([pos (share! v)]) (let ([pos (share! v)])
(if (encountered? v) (if (encountered? v)
@ -101,6 +102,8 @@
(define-values (symbol-table shared-obj-pos) (define-values (symbol-table shared-obj-pos)
(create-symbol-table)) (create-symbol-table))
(got-here 2) (got-here 2)
#;(printf "symtab[998] = ~a\n" (vector-ref symbol-table 998))
#;(for ([v (in-vector symbol-table)]) #;(for ([v (in-vector symbol-table)])
(printf "v = ~a~n" v)) (printf "v = ~a~n" v))
@ -469,7 +472,7 @@
(define (shareable? v) (define (shareable? v)
(define never-share-this? (define never-share-this?
(or-pred? v char? maybe-same-as-fixnum? empty? boolean? void?)) (or-pred? v char? maybe-same-as-fixnum? empty? boolean? void? hash? ))
(define always-share-this? (define always-share-this?
(or-pred? v closure?)) (or-pred? v closure?))
(or always-share-this? (or always-share-this?
@ -481,7 +484,26 @@
(and (exact-integer? v) (and (exact-integer? v)
(and (v . >= . -1073741824) (v . <= . 1073741823)))) (and (v . >= . -1073741824) (v . <= . 1073741823))))
(define (current-type-trace)
(reverse (continuation-mark-set->list (current-continuation-marks) 'zo)))
(define (typeof v)
(cond
[(pair? v) 'cons]
[(hash? v) 'hash]
[(prefab-struct-key v) => (λ (key) key)]
[(vector? v) 'vector]
[else v]))
(define-syntax with-type-trace
(syntax-rules ()
[(_ v body ...)
(begin body ...)
#;(with-continuation-mark 'zo (typeof v)
(begin0 (begin body ...) (void)))]))
(define (out-anything v out) (define (out-anything v out)
(with-type-trace v
(out-shared (out-shared
v out v out
(λ () (λ ()
@ -858,7 +880,7 @@
(out-byte CPT_ESCAPE out) (out-byte CPT_ESCAPE out)
(define bstr (get-output-bytes s)) (define bstr (get-output-bytes s))
(out-number (bytes-length bstr) out) (out-number (bytes-length bstr) out)
(out-bytes bstr out)])))) (out-bytes bstr out)])))))
(define-struct module-decl (content)) (define-struct module-decl (content))

14
collects/tests/compiler/zo-exs.rkt
View File

@ -23,7 +23,7 @@
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(list 1 (list 2 3) (list 2 3) 4 5))) (list 1 (list 2 3) (list 2 3) 4 5)))
(roundtrip #;(roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(let* ([ph (make-placeholder #f)] (let* ([ph (make-placeholder #f)]
@ -84,12 +84,18 @@
(prefix 0 empty empty) (prefix 0 empty empty)
(list (current-directory)))) (list (current-directory))))
#;(roundtrip (roundtrip
(compilation-top (compilation-top
0 0
(prefix 0 empty empty) (prefix 0 empty empty)
(cons #hasheq() (cons #hash()
#hasheq()))) #hash())))
(roundtrip
(compilation-top
0
(prefix 0 empty empty)
#hash()))
#;(local [(define (hash-test make-hash-placeholder) #;(local [(define (hash-test make-hash-placeholder)
(roundtrip (roundtrip