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

fix bytecode-writing inconsistencies related to syntax objects and paths

Browse Source 
and improve organization of the docs

original commit: 0d9f5016ba
This commit is contained in:
Matthew Flatt 2010-08-17 17:18:24 -06:00
parent f907cbf361
commit 4b9635cb70
2 changed files with 41 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,7 +8,9 @@
racket/local
racket/list
racket/dict
racket/function)
racket/function
racket/pretty
racket/path)
(provide/contract
[zo-marshal (compilation-top? . -> . bytes?)]
@ -901,6 +903,7 @@
CPT_BYTE_STRING
#f
out)]
#;
[(path? expr)
(out-as-bytes expr
path->bytes
@ -1024,7 +1027,20 @@
(if (quoted? expr)
(out-data (quoted-v expr) out)
(let ([s (open-output-bytes)])
(write expr s)
;; print `expr' to a string, but print paths
;; in a special way
(parameterize ([pretty-print-size-hook
(lambda (v mode port)
(and (path? v)
(let ([v (make-relative v)])
(+ 2 (let ([p (open-output-bytes)])
(write (path->bytes v) p)
(bytes-length (get-output-bytes p)))))))]
[pretty-print-print-hook
(lambda (v mode port)
(display "#^" port)
(write (path->bytes (make-relative v)) port))])
(pretty-write expr s))
(out-byte CPT_ESCAPE out)
(let ([bstr (get-output-bytes s)])
(out-number (bytes-length bstr) out)
@ -1041,5 +1057,11 @@
(define-struct svector (vec))
(define (make-relative v)
(let ([r (current-write-relative-directory)])
(if r
(find-relative-path r v)
v)))
;; ----------------------------------------

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

@ -732,7 +732,23 @@
[read-decimal-as-inexact #t]
[read-accept-dot #t]
[read-accept-infix-dot #t]
[read-accept-quasiquote #t])
[read-accept-quasiquote #t]
;; Use a readtable for special path support in escaped:
[current-readtable
(make-readtable
#f
#\^
'dispatch-macro
(lambda (char port src line col pos)
(let ([b (read port)])
(unless (bytes? b)
(error 'read-escaped-path
"expected a byte string after #^"))
(let ([p (bytes->path b)])
(if (and (relative-path? p)
(current-load-relative-directory))
(build-path (current-load-relative-directory) p)
p)))))])
(read/recursive (open-input-bytes s))))]
[(reference)
(make-primval (read-compact-number cp))]