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

raco decompile: support non-module programs

Browse Source
This commit is contained in:
Matthew Flatt 2018-02-27 19:39:58 -07:00
parent bd231cd75d
commit 3e5e2cc30d
3 changed files with 49 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -58,8 +58,14 @@
(list '#:name k '#:bundle (decompile v #:to-linklets? to-linklets?)))))]
[else
(define main (hash-ref (linkl-directory-table top) '() #f))
(unless main (error 'decompile "cannot find main module"))
(decompile-module-with-submodules top '() main)])]
(cond
[(and main
(hash-ref (linkl-bundle-table main) 'decl #f))
(decompile-module-with-submodules top '() main)]
[main
(decompile-single-top main)]
[else
(decompile-multi-top top)])])]
[(linkl-bundle? top)
(cond
[to-linklets?
@ -116,7 +122,7 @@
(values (instance-variable-value data-i '.mpi-vector)
(instance-variable-value decl-i 'requires)
(instance-variable-value decl-i 'provides))]
[else (values '#() '() '())])))
[else (values '#() '() '#hasheqv())])))
(define (phase-wrap phase l)
(case phase
[(0) l]
@ -176,6 +182,21 @@
....)))
null))))
(define (decompile-single-top b)
(define forms (decompile-linklet (hash-ref (linkl-bundle-table b) 0) #:just-body? #t))
(if (= (length forms) 1)
(car forms)
`(begin ,@forms)))
(define (decompile-multi-top ld)
`(begin
,@(let loop ([i 0])
(define b (hash-ref (linkl-directory-table ld) (list (string->symbol (format "~a" i))) #f))
(define l (and b (hash-ref (linkl-bundle-table b) 0 #f)))
(cond
[l (append (decompile-linklet l #:just-body? #t)
(loop (add1 i)))]
[else null]))))
(define (decompile-linklet l #:just-body? [just-body? #f])
(match l

2
pkgs/racket-doc/scribblings/reference/linklet.scrbl
View File

@ -21,7 +21,7 @@ linklet. A linklet is also used for metadata such as the @tech{module
path index}es for a module's @racket[require]s. These linklets, plus
some other metadata, are combined to form a @deftech{linklet bundle}.
Information in a @tech{linklet bundle} is keyed by either a symbol or
a @tech{fixnum}. A @tech{linklet directory} contiaining
a @tech{fixnum}. A @tech{linklet directory} containing
@tech{linklet}s can be marshaled to and from a byte stream by
@racket[write] and (with @racket[read-accept-compiled] is enabled)
@racket[read].

42
pkgs/zo-lib/compiler/zo-parse.rkt
View File

@ -755,25 +755,31 @@
len))
<
#:key sub-info-start))
(define (remove-empty-root ht)
;; A linklet for top-level forms will have '() mapped to #f
(if (hash-ref ht '() #f)
ht
(hash-remove ht '())))
(linkl-directory
(for/hash ([sub-info (in-list sub-infos)])
(define pos (file-position port))
(unless (= (- pos init-pos) (sub-info-start sub-info))
(error 'zo-parse
"next bundle expected at ~a, currently at ~a"
(+ init-pos (sub-info-start sub-info)) pos))
(define tag (read-prefix port #t))
(define sub
(cond
[(not tag) #f]
[else
(unless (eq? tag #\B)
(error 'zo-parse "expected a bundle"))
(define sub (and tag (zo-parse-top port #f)))
(unless (hash? sub)
(error 'zo-parse "expected a bundle hash"))
(linkl-bundle sub)]))
(values (sub-info-name sub-info) sub)))]
(remove-empty-root
(for/hash ([sub-info (in-list sub-infos)])
(define pos (file-position port))
(unless (= (- pos init-pos) (sub-info-start sub-info))
(error 'zo-parse
"next bundle expected at ~a, currently at ~a"
(+ init-pos (sub-info-start sub-info)) pos))
(define tag (read-prefix port #t))
(define sub
(cond
[(not tag) #f]
[else
(unless (eq? tag #\B)
(error 'zo-parse "expected a bundle"))
(define sub (and tag (zo-parse-top port #f)))
(unless (hash? sub)
(error 'zo-parse "expected a bundle hash"))
(linkl-bundle sub)]))
(values (sub-info-name sub-info) sub))))]
[else
(error 'zo-parse "bad file format specifier")]))