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

zo-marshal fixes and read.c fix for hash tables in symbol table

Browse Source 
original commit: 9599304ca9
This commit is contained in:
Blake Johnson 2010-08-20 13:47:03 -06:00 committed by Jay McCarthy
parent 817b3186d9
commit ae4b770939
3 changed files with 28 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,7 +8,9 @@
racket/local racket/local
racket/list racket/list
racket/dict racket/dict
racket/function) racket/function
racket/pretty
racket/path)
(provide/contract (provide/contract
[zo-marshal (compilation-top? . -> . bytes?)] [zo-marshal (compilation-top? . -> . bytes?)]
@ -305,8 +307,8 @@
(list* path phase export-name (encode-nominal-path nominal-path) nominal-export-name)]))) (list* path phase export-name (encode-nominal-path nominal-path) nominal-export-name)])))
encoded-bindings) encoded-bindings)
(define encode-all-from-module (define (encode-all-from-module afm)
(match-lambda (match afm
[(struct all-from-module (path phase src-phase #f #f)) [(struct all-from-module (path phase src-phase #f #f))
(list* path phase src-phase)] (list* path phase src-phase)]
[(struct all-from-module (path phase src-phase exns #f)) [(struct all-from-module (path phase src-phase exns #f))
@ -814,7 +816,7 @@
(lambda (v mode port) (lambda (v mode port)
(display "#^" port) (display "#^" port)
(write (path->bytes (make-relative v)) port))]) (write (path->bytes (make-relative v)) port))])
(pretty-write expr s)) (pretty-write v s))
(out-byte CPT_ESCAPE out) (out-byte CPT_ESCAPE out)
(let ([bstr (get-output-bytes s)]) (let ([bstr (get-output-bytes s)])
(out-number (bytes-length bstr) out) (out-number (bytes-length bstr) out)
@ -986,5 +988,12 @@
(define-struct svector (vec)) (define-struct svector (vec))
(define (make-relative v)
(let ([r (current-write-relative-directory)])
(if r
(find-relative-path r v)
v)))
;; ---------------------------------------- ;; ----------------------------------------

4
collects/compiler/zo-parse.rkt
View File

@ -1043,10 +1043,10 @@
(for ([i (in-range 1 symtabsize)]) (for ([i (in-range 1 symtabsize)])
(read-sym cp i)) (read-sym cp i))
(for ([i (in-naturals)] #;(for ([i (in-naturals)]
[v (in-vector debug-symrefs)]) [v (in-vector debug-symrefs)])
(printf "~a: ~a~n" i v)) (printf "~a: ~a~n" i v))
#;(printf "SYMBOL TABLE:~n~n")
#;(for ([i (in-naturals)] #;(for ([i (in-naturals)]
[v (in-vector (cport-symtab cp))]) [v (in-vector (cport-symtab cp))])
(printf "~a: ~s~n~n" i (placeholder-get v))) (printf "~a: ~s~n~n" i (placeholder-get v)))

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

@ -9,23 +9,33 @@
(define (roundtrip ct) (define (roundtrip ct)
(define bs (zo-marshal ct)) (define bs (zo-marshal ct))
(with-output-to-file "test_rkt.zo" (λ () (write-bytes bs)) #:exists 'replace)
(test #:failure-prefix (format "~S" ct) (test #:failure-prefix (format "~S" ct)
(test bs (test bs
(zo-parse (open-input-bytes bs)) => ct (zo-parse (open-input-bytes bs)) => ct
(read-compiled-bytes bs)))) (read-compiled-bytes bs))))
(define mpi (module-path-index-join #f #f))
(test (test
(roundtrip #;(roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(current-directory))) (current-directory)))
(roundtrip #;(roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(list (current-directory)))) (list (current-directory))))
(local [(define (hash-test make-hash-placeholder) (roundtrip
(compilation-top
0
(prefix 0 empty empty)
(cons #hasheq()
#hasheq())))
#;(local [(define (hash-test make-hash-placeholder)
(roundtrip (roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)