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

zo-marshal supports module forms

Browse Source 
svn: r14637
This commit is contained in:
Matthew Flatt 2009-04-28 13:13:22 +00:00
parent 15701f0868
commit 39d405fe6e
5 changed files with 226 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/compiler/decompile.ss
View File

@ -90,7 +90,8 @@
(define (decompile-module mod-form stack)
(match mod-form
[(struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
[(struct mod (name self-modidx prefix provides requires body syntax-body unexported
max-let-depth dummy lang-info internal-context))
(let-values ([(globs defns) (decompile-prefix prefix)]
[(stack) (append '(#%modvars) stack)]
[(closed) (make-hasheq)])
@ -135,6 +136,8 @@
`(begin ,@(map (lambda (form)
(decompile-form form globs stack closed))
forms))]
[(struct req (reqs dummy))
`(#%require . (#%decode-syntax ,reqs))]
[else
(decompile-expr form globs stack closed)]))

121
collects/compiler/zo-marshal.ss
View File

@ -71,23 +71,26 @@
(define (traverse-prefix a-prefix visit)
(match a-prefix
[(struct prefix (num-lifts toplevels stxs))
(for-each (lambda (stx) (traverse-toplevel stx visit)) stxs)
(for-each (lambda (stx) (traverse-toplevel stx visit)) toplevels)
(for-each (lambda (stx) (traverse-stx stx visit)) stxs)]))
(define (traverse-module mod-form visit)
(match mod-form
[(struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
(error "cannot handle modules, yet")
[(struct mod (name self-modidx prefix provides requires body syntax-body unexported
max-let-depth dummy lang-info internal-context))
(traverse-data name visit)
(traverse-data self-modidx visit)
(traverse-prefix prefix visit)
(for-each (lambda (f) (map (lambda (v) (traverse-data v visit)) (cdr f))) requires)
(for-each (lambda (f) (traverse-form f prefix)) body)
(for-each (lambda (f) (traverse-form f prefix)) syntax-body)]))
(for-each (lambda (f) (traverse-form f prefix)) syntax-body)
(traverse-data lang-info visit)
(traverse-data internal-context visit)]))
(define (traverse-toplevel tl visit)
(match tl
[#f (void)]
[(? symbol?) (visit tl)]
[(? symbol?) (traverse-data tl visit)]
[(struct global-bucket (name))
(void)]
[(struct module-variable (modidx sym pos phase))
@ -180,9 +183,13 @@
(keyword? expr)
(string? expr)
(bytes? expr)
(path? expr)
(module-path-index? expr))
(path? expr))
(visit expr)]
[(module-path-index? expr)
(visit expr)
(let-values ([(name base) (module-path-index-split expr)])
(traverse-data name visit)
(traverse-data base visit))]
[(pair? expr)
(traverse-data (car expr) visit)
(traverse-data (cdr expr) visit)]
@ -213,6 +220,7 @@
(define top-type-num 87)
(define case-lambda-sequence-type-num 96)
(define begin0-sequence-type-num 97)
(define module-type-num 100)
(define prefix-type-num 103)
(define-syntax define-enum
@ -363,10 +371,80 @@
(list->vector stxs)))
out)]))
(define-struct module-decl (content))
(define (out-module mod-form out)
(match mod-form
[(struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
(error "cannot write modules, yet")]))
[(struct mod (name self-modidx prefix provides requires body syntax-body unexported
max-let-depth dummy lang-info internal-context))
(out-syntax MODULE_EXPD
(let* ([lookup-req (lambda (phase)
(let ([a (assq phase requires)])
(if a
(cdr a)
null)))]
[other-requires (filter (lambda (l)
(not (memq (car l) '(#f -1 0 1))))
requires)]
[extract-protects
(lambda (phase)
(let ([a (assq phase provides)])
(and a
(let ([p (map provided-protected? (append (cadr a)
(caddr a)))])
(if (ormap values p)
(list->vector p)
#f)))))]
[list->vector/#f (lambda (default l)
(if (andmap (lambda (x) (equal? x default)) l)
#f
(list->vector l)))]
[l (map cdr other-requires)]
[l (cons (length other-requires) l)]
[l (cons (lookup-req #f) l)] ; dt-requires
[l (cons (lookup-req -1) l)] ; tt-requires
[l (cons (lookup-req 1) l)] ; et-requires
[l (cons (lookup-req 0) l)] ; requires
[l (cons (list->vector body) l)]
[l (cons (list->vector syntax-body) l)]
[l (append (apply
append
(map (lambda (l)
(let ([phase (car l)]
[all (append (cadr l) (caddr l))])
(list phase
(list->vector/#f #f (map provided-insp all))
(list->vector/#f 0 (map (lambda (p) (= 1 (provided-src-phase p)))
all))
(list->vector/#f #f (map (lambda (p)
(if (eq? (provided-nom-src p)
(provided-src p))
#f ; #f means "same as src"
(provided-nom-src p)))
all))
(list->vector (map provided-src-name all))
(list->vector (map provided-src all))
(list->vector (map provided-name all))
(length (cadr l))
(length all))))
provides))
l)]
[l (cons (length provides) l)] ; number of provide sets
[l (cons (extract-protects 0) l)] ; protects
[l (cons (extract-protects 1) l)] ; et protects
[l (list* (list->vector (car unexported)) (length (car unexported)) l)] ; indirect-provides
[l (list* (list->vector (cadr unexported)) (length (cadr unexported)) l)] ; indirect-syntax-provides
[l (list* (list->vector (caddr unexported)) (length (caddr unexported)) l)] ; indirect-et-provides
[l (cons prefix l)]
[l (cons dummy l)]
[l (cons max-let-depth l)]
[l (cons internal-context l)] ; module->namespace syntax
[l (list* #f #f l)] ; obsolete `functional?' info
[l (cons lang-info l)] ; lang-info
[l (cons self-modidx l)]
[l (cons name l)])
(make-module-decl l))
out)]))
(define (out-toplevel tl out)
(match tl
@ -422,6 +500,9 @@
(out-marshaled sequence-type-num (map protect-quote forms) out)]
[(struct splice (forms))
(out-syntax SPLICE_EXPD (make-seq forms) out)]
[(struct req (reqs dummy))
(error "cannot handle top-level `require', yet")
(out-syntax REQUIRE_EXPD (cons dummy reqs) out)]
[else
(out-expr form out)]))
@ -605,11 +686,12 @@
l)
out))]))
(define (out-as-bytes expr ->bytes CPT out)
(define (out-as-bytes expr ->bytes CPT len2 out)
(out-shared expr out (lambda ()
(let ([s (->bytes expr)])
(out-byte CPT out)
(out-number (bytes-length s) out)
(when len2 (out-number len2 out))
(out-bytes s out)))))
(define (out-data expr out)
@ -625,26 +707,31 @@
(out-as-bytes expr
(compose string->bytes/utf-8 symbol->string)
CPT_SYMBOL
#f
out)]
[(keyword? expr)
(out-as-bytes expr
(compose string->bytes/utf-8 keyword->string)
CPT_KEYWORD
#f
out)]
[(string? expr)
(out-as-bytes expr
string->bytes/utf-8
CPT_CHAR_STRING
(string-length expr)
out)]
[(bytes? expr)
(out-as-bytes expr
values
CPT_BYTE_STRING
#f
out)]
[(path? expr)
(out-as-bytes expr
path->bytes
CPT_PATH
#f
out)]
[(char? expr)
(out-byte CPT_CHAR out)
@ -690,10 +777,16 @@
(for ([n (in-range (sub1 (vector-length vec)) -1 -1)])
(out-number (vector-ref vec n) out)))]
[(module-path-index? expr)
(out-byte CPT_MODULE_INDEX out)
(let-values ([(name base) (module-path-index-split expr)])
(out-data name out)
(out-data base out))]
(out-shared expr out
(lambda ()
(out-byte CPT_MODULE_INDEX out)
(let-values ([(name base) (module-path-index-split expr)])
(out-data name out)
(out-data base out))))]
[(module-decl? expr)
(out-marshaled module-type-num
(module-decl-content expr)
out)]
[else
(out-byte CPT_QUOTE out)
(let ([s (open-output-bytes)])

46
collects/compiler/zo-parse.ss
View File

@ -34,7 +34,8 @@
(define-form-struct form ())
(define-form-struct (expr form) ())
(define-form-struct (mod form) (name self-modidx prefix provides requires body syntax-body max-let-depth))
(define-form-struct (mod form) (name self-modidx prefix provides requires body syntax-body unexported
max-let-depth dummy lang-info internal-context))
(define-form-struct (lam expr) (name flags num-params param-types rest? closure-map max-let-depth body)) ; `lambda'
(define-form-struct (closure expr) (code gen-id)) ; a static closure (nothing to close over)
@ -74,6 +75,9 @@
(define-struct indirect ([v #:mutable]) #:prefab)
(provide (struct-out indirect))
;; A provided identifier
(define-form-struct provided (name src src-name nom-src src-phase protected? insp))
;; ----------------------------------------
;; Bytecode unmarshalers for various forms
@ -232,7 +236,37 @@
,requires ,syntax-requires ,template-requires ,label-requires
,more-requires-count . ,more-requires)
(make-mod name self-modidx
prefix phase-data
prefix (let loop ([l phase-data])
(if (null? l)
null
(let ([num-vars (list-ref l 7)]
[ps (for/list ([name (in-vector (list-ref l 6))]
[src (in-vector (list-ref l 5))]
[src-name (in-vector (list-ref l 4))]
[nom-src (or (list-ref l 3)
(in-cycle (in-value #f)))]
[src-phase (or (list-ref l 2)
(in-cycle (in-value #f)))]
[protected? (or (case (car l)
[(0) protects]
[(1) et-protects]
[else #f])
(in-cycle (in-value #f)))]
[insp (or (list-ref l 1)
(in-cycle (in-value #f)))])
(make-provided name src src-name
(or nom-src src)
(if src-phase 1 0)
protected?
insp))])
(if (null? ps)
(loop (list-tail l 9))
(cons
(list
(car l)
(take ps num-vars)
(drop ps num-vars))
(loop (list-tail l 9)))))))
(list*
(cons 0 requires)
(cons 1 syntax-requires)
@ -248,7 +282,13 @@
make-def-syntaxes)
ids expr prefix max-let-depth)]))
(vector->list syntax-body))
max-let-depth)]))]))
(list (vector->list indirect-provides)
(vector->list indirect-syntax-provides)
(vector->list indirect-et-provides))
max-let-depth
dummy
lang-info
rename)]))]))
(define (read-module-wrap v)
v)

7
collects/scribblings/mzc/decompile.scrbl
View File

@ -3,7 +3,7 @@
"common.ss"
(for-label scheme/base
compiler/decompile
(only-in compiler/zo-parse compilation-top?)
(only-in compiler/zo-parse compilation-top? req)
compiler/zo-marshal))
@title[#:tag "decompile"]{Decompiling Bytecode}
@ -112,5 +112,6 @@ Consumes the result of parsing bytecode and returns an S-expression
@defproc[(zo-marshal [top compilation-top?]) bytes?]{
Consumes a representation of bytecode and generates a byte string for
the marshaled bytecode. Currently, modules and quoted syntax objects
with @scheme[top] are not supported.}
the marshaled bytecode. Currently, syntax objects are not supported,
including in @scheme[req] for a top-level @scheme[#%require].}

94
collects/scribblings/mzc/zo-parse.scrbl
View File

@ -180,34 +180,13 @@ values. The @scheme[max-let-depth] field indicates the maximum size of
the stack that will be created by @scheme[rhs] (not counting
@scheme[prefix]).}
@defstruct+[(req form) ([reqs (listof module-path?)]
@defstruct+[(req form) ([reqs syntax?]
[dummy toplevel?])]{
Represents a top-level @scheme[require] form (but not one in a
@scheme[module] form). The @scheme[dummy] variable is used to access
to the top-level namespace.}
@defstruct+[(mod form) ([name symbol?]
[self-modidx module-path-index?]
[prefix prefix?]
[provides (listof symbol?)]
[requires (listof (cons/c (or/c exact-integer? #f)
(listof module-path-index?)))]
[body (listof (or/c form? indirect? any/c))]
[syntax-body (listof (or/c def-syntaxes? def-for-syntax?))]
[max-let-depth exact-nonnegative-integer?])]{
Represents a @scheme[module] declaration. The @scheme[body] forms use
@scheme[prefix], rather than any prefix in place for the module
declaration itself (and each @scheme[syntax-body] has its own
prefix). The @scheme[body] field contains the module's run-time code,
and @scheme[syntax-body] contains the module's compile-time code. The
@scheme[max-let-depth] field indicates the maximum stack depth created
by @scheme[body] forms (not counting the @scheme[prefix] array).
After each form in @scheme[body] is evaluated, the stack is restored
to its depth from before evaluating the form.}
Represents a top-level @scheme[#%require] form (but not one in a
@scheme[module] form) with a sequence of specifications
@scheme[reqs]. The @scheme[dummy] variable is used to access to the
top-level namespace.}
@defstruct+[(seq form) ([forms (listof (or/c form? indirect? any/c))])]{
@ -230,6 +209,69 @@ After each form in @scheme[forms] is evaluated, the stack is restored
to its depth from before evaluating the form.}
@defstruct+[(mod form) ([name symbol?]
[self-modidx module-path-index?]
[prefix prefix?]
[provides (listof (list/c (or/c exact-integer? #f)
(listof provided?)
(listof provided?)))]
[requires (listof (cons/c (or/c exact-integer? #f)
(listof module-path-index?)))]
[body (listof (or/c form? indirect? any/c))]
[syntax-body (listof (or/c def-syntaxes? def-for-syntax?))]
[unexported (list/c (listof symbol?) (listof symbol?)
(listof symbol?))]
[max-let-depth exact-nonnegative-integer?]
[dummy toplevel?]
[lang-info (or/c #f (vector/c module-path? symbol? any/c))]
[internal-context (or/c #f #t syntax?)])]{
Represents a @scheme[module] declaration. The @scheme[body] forms use
@scheme[prefix], rather than any prefix in place for the module
declaration itself (and each @scheme[syntax-body] has its own
prefix).
The @scheme[provides] and @scheme[requires] lists are each an
association list from phases to exports or imports. In the case of
@scheme[provides], each phase maps to two lists: one for exported
variables, and another for exported syntax. In the case of
@scheme[requires], each phase maps to a list of imported module paths.
The @scheme[body] field contains the module's run-time code, and
@scheme[syntax-body] contains the module's compile-time code. After
each form in @scheme[body] or @scheme[syntax-body] is evaluated, the
stack is restored to its depth from before evaluating the form.
The @scheme[unexported] list contains lists of symbols for unexported
definitions that can be accessed through macro expansion. The first
list is phase-0 variables, the second is phase-0 syntax, and the last
is phase-1 variables.
The @scheme[max-let-depth] field indicates the maximum stack depth
created by @scheme[body] forms (not counting the @scheme[prefix]
array). The @scheme[dummy] variable is used to access to the
top-level namespace.
The @scheme[lang-info] value specifies an optional module path that
provides information about the module's implementation language.
The @scheme[internal-module-context] value describes the lexical
context of the body of the module. This value is used by
@scheme[module->namespace]. A @scheme[#f] value means that the context
is unavailable or empty. A @scheme[#t] value means that the context is
computed by re-importing all required modules. A syntax-object value
embeds an arbitrary lexical context.}
@defstruct+[provided ([name symbol?]
[src (or/c module-path-index? #f)]
[src-name symbol?]
[nom-mod (or/c module-path-index? #f)]
[src-phase (or/c 0 1)]
[protected? boolean?]
[insp (or #t #f (void))])]{
Describes an individual provided identifier within a @scheme[mod] instance.}
@; --------------------------------------------------
@section{Expressions}