fix bytecode-writing inconsistencies related to syntax objects and paths
and improve organization of the docs
original commit: 0d9f5016ba
This commit is contained in:
parent
f907cbf361
commit
4b9635cb70
|
@ -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?)]
|
||||||
|
@ -901,6 +903,7 @@
|
||||||
CPT_BYTE_STRING
|
CPT_BYTE_STRING
|
||||||
#f
|
#f
|
||||||
out)]
|
out)]
|
||||||
|
#;
|
||||||
[(path? expr)
|
[(path? expr)
|
||||||
(out-as-bytes expr
|
(out-as-bytes expr
|
||||||
path->bytes
|
path->bytes
|
||||||
|
@ -1024,7 +1027,20 @@
|
||||||
(if (quoted? expr)
|
(if (quoted? expr)
|
||||||
(out-data (quoted-v expr) out)
|
(out-data (quoted-v expr) out)
|
||||||
(let ([s (open-output-bytes)])
|
(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)
|
(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)
|
||||||
|
@ -1041,5 +1057,11 @@
|
||||||
|
|
||||||
(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)))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
|
|
@ -732,7 +732,23 @@
|
||||||
[read-decimal-as-inexact #t]
|
[read-decimal-as-inexact #t]
|
||||||
[read-accept-dot #t]
|
[read-accept-dot #t]
|
||||||
[read-accept-infix-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))))]
|
(read/recursive (open-input-bytes s))))]
|
||||||
[(reference)
|
[(reference)
|
||||||
(make-primval (read-compact-number cp))]
|
(make-primval (read-compact-number cp))]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user