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

cs: improve raco dec output

Browse Source 
Handle `--linklet` mode better and show fasled arguments to compiled
linklet functions.
This commit is contained in:
Matthew Flatt 2020-06-26 12:11:53 -06:00
parent a76380a343
commit 4ad93bcca0
2 changed files with 23 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/compiler-lib/compiler/decompile.rkt
View File

@ -84,7 +84,8 @@
(list '#:key k '#:value (decompile v #:to-linklets? to-linklets?))]))))] (list '#:key k '#:value (decompile v #:to-linklets? to-linklets?))]))))]
[else [else
(decompile-module top)])] (decompile-module top)])]
[(linkl? top) [(or (linkl? top)
(linklet? top))
(decompile-linklet top)] (decompile-linklet top)]
[(faslable-correlated-linklet? top) [(faslable-correlated-linklet? top)
(strip-correlated (faslable-correlated-linklet-expr top))] (strip-correlated (faslable-correlated-linklet-expr top))]
@ -257,7 +258,10 @@
(case fmt (case fmt
[(compile) [(compile)
(define proc ((vm-eval `(load-compiled-from-port (open-bytevector-input-port ,uncompressed-code))))) (define proc ((vm-eval `(load-compiled-from-port (open-bytevector-input-port ,uncompressed-code)))))
(decompile-chez-procedure (if (null? args) proc (apply proc args)))] (let ([proc (decompile-chez-procedure (if (null? args) proc (apply proc args)))])
(if (null? args)
proc
(cons proc (map (vm-primitive 'force-unfasl) args))))]
[(interpret) [(interpret)
(define bytecode (vm-eval `(fasl-read (open-bytevector-input-port ,uncompressed-code)))) (define bytecode (vm-eval `(fasl-read (open-bytevector-input-port ,uncompressed-code))))
(list `(#%interpret ,(unwrap-chez-interpret-jitified bytecode)))] (list `(#%interpret ,(unwrap-chez-interpret-jitified bytecode)))]

29
racket/src/schemify/path-and-fasl.rkt
View File

@ -125,20 +125,25 @@
[else (relative-path-elements->path e)])) [else (relative-path-elements->path e)]))
(define (force-unfasl tf) (define (force-unfasl tf)
(define vb (to-fasl-vb tf))
(define v (unbox vb))
(cond (cond
[(bytes? v) [(not (to-fasl? tf))
(define v2 (parameterize ([current-load-relative-directory (to-fasl-wrt tf)]) ;; act as identity on other values for the benefit of `raco decompile`
(fasl->s-exp v tf]
#:datum-intern? #t
#:external-lifts (to-fasl-lifts tf))))
(box-cas! vb v v2)
(set-to-fasl-wrt! tf #f)
(unbox vb)]
[else [else
;; already forced (or never fasled) (define vb (to-fasl-vb tf))
v])) (define v (unbox vb))
(cond
[(bytes? v)
(define v2 (parameterize ([current-load-relative-directory (to-fasl-wrt tf)])
(fasl->s-exp v
#:datum-intern? #t
#:external-lifts (to-fasl-lifts tf))))
(box-cas! vb v v2)
(set-to-fasl-wrt! tf #f)
(unbox vb)]
[else
;; already forced (or never fasled)
v])]))
(define (cannot-fasl v) (define (cannot-fasl v)
(error 'write (error 'write