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

document compiler/zo-parse and compiler/decompile

Browse Source 
svn: r12947

original commit: 7aec6b8761
This commit is contained in:
Matthew Flatt 2008-12-28 18:57:13 +00:00
parent 8432051c18
commit c53917fa4f
2 changed files with 53 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/compiler/decompile.ss
View File

@ -23,7 +23,7 @@
(close-output-port out)
in)))])
(let ([n (match v
[(struct compilation-top (_ prefix (struct primitive (n)))) n]
[(struct compilation-top (_ prefix (struct primval (n)))) n]
[else #f])])
(hash-set! table n (car b)))))
table))
@ -77,7 +77,7 @@
lift-ids)
(map (lambda (stx id)
`(define ,id ,(if stx
`(#%decode-syntax ,stx #;(stx-encoded stx))
`(#%decode-syntax ,(stx-encoded stx))
#f)))
stxs stx-ids)))]
[else (error 'decompile-prefix "huh?: ~e" a-prefix)]))
@ -126,7 +126,7 @@
`(let ()
,@defns
,(decompile-expr rhs globs '(#%globals) closed))))]
[(struct sequence (forms))
[(struct seq (forms))
`(begin ,@(map (lambda (form)
(decompile-form form globs stack closed))
forms))]
@ -179,7 +179,7 @@
`(#%checked ,id)))]
[(struct topsyntax (depth pos midpt))
(list-ref/protect globs (+ midpt pos) 'topsyntax)]
[(struct primitive (id))
[(struct primval (id))
(hash-ref primitive-table id)]
[(struct assign (id rhs undef-ok?))
`(set! ,(decompile-expr id globs stack closed)
@ -249,7 +249,7 @@
[(struct apply-values (proc args-expr))
`(#%apply-values ,(decompile-expr proc globs stack closed)
,(decompile-expr args-expr globs stack closed))]
[(struct sequence (exprs))
[(struct seq (exprs))
`(begin ,@(for/list ([expr (in-list exprs)])
(decompile-expr expr globs stack closed)))]
[(struct beg0 (exprs))

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

@ -7,11 +7,18 @@
;; ----------------------------------------
;; Structures to represent bytecode
(define-syntax-rule (define-form-struct id (field-id ...))
(define-syntax-rule (define-form-struct* id id+par (field-id ...))
(begin
(define-struct id (field-id ...) #:transparent)
(define-struct id+par (field-id ...) #:transparent)
(provide (struct-out id))))
(define-syntax define-form-struct
(syntax-rules ()
[(_ (id sup) . rest)
(define-form-struct* id (id sup) . rest)]
[(_ id . rest)
(define-form-struct* id id . rest)]))
(define-form-struct compilation-top (max-let-depth prefix code)) ; compiled code always wrapped with this
(define-form-struct prefix (num-lifts toplevels stxs)) ; sets up top-level and syntax-object array
@ -21,43 +28,46 @@
(define-form-struct module-variable (modidx sym pos phase)) ; direct access to exported id
;; In stxs of prefix:
(define-form-struct stx (encoded)) ; todo: decode syntax objects
(define-form-struct stx (encoded))
(define-form-struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
(define-form-struct form ())
(define-form-struct (expr form) ())
(define-form-struct lam (name flags num-params rest? closure-map max-let-depth body)) ; `lambda'
(define-form-struct closure (code gen-id)) ; a static closure (nothing to close over)
(define-form-struct case-lam (name clauses)) ; each clause is an lam
(define-form-struct (mod form) (name self-modidx prefix provides requires body syntax-body max-let-depth))
(define-form-struct let-one (rhs body)) ; pushes one value onto stack
(define-form-struct let-void (count boxes? body)) ; create new stack slots
(define-form-struct install-value (count pos boxes? rhs body)) ; set existing stack slot(s)
(define-form-struct let-rec (procs body)) ; put `letrec'-bound closures into existing stack slots
(define-form-struct boxenv (pos body)) ; box existing stack element
(define-form-struct (lam expr) (name flags num-params rest? closure-map max-let-depth body)) ; `lambda'
(define-form-struct (closure expr) (code gen-id)) ; a static closure (nothing to close over)
(define-form-struct (case-lam expr) (name clauses)) ; each clause is an lam
(define-form-struct localref (unbox? offset clear?)) ; access local via stack
(define-form-struct (let-one expr) (rhs body)) ; pushes one value onto stack
(define-form-struct (let-void expr) (count boxes? body)) ; create new stack slots
(define-form-struct (install-value expr) (count pos boxes? rhs body)) ; set existing stack slot(s)
(define-form-struct (let-rec expr) (procs body)) ; put `letrec'-bound closures into existing stack slots
(define-form-struct (boxenv expr) (pos body)) ; box existing stack element
(define-form-struct toplevel (depth pos const? ready?)) ; access binding via prefix array (which is on stack)
(define-form-struct topsyntax (depth pos midpt)) ; access syntax object via prefix array (which is on stack)
(define-form-struct (localref expr) (unbox? pos clear?)) ; access local via stack
(define-form-struct application (rator rands)) ; function call
(define-form-struct branch (test then else)) ; `if'
(define-form-struct with-cont-mark (key val body)) ; `with-continuation-mark'
(define-form-struct beg0 (seq)) ; `begin0'
(define-form-struct sequence (forms)) ; `begin'
(define-form-struct splice (forms)) ; top-level `begin'
(define-form-struct varref (toplevel)) ; `#%variable-reference'
(define-form-struct assign (id rhs undef-ok?)) ; top-level or module-level set!
(define-form-struct apply-values (proc args-expr)) ; `(call-with-values (lambda () ,args-expr) ,proc)
(define-form-struct primitive (id)) ; direct preference to a kernel primitive
(define-form-struct (toplevel expr) (depth pos const? ready?)) ; access binding via prefix array (which is on stack)
(define-form-struct (topsyntax expr) (depth pos midpt)) ; access syntax object via prefix array (which is on stack)
(define-form-struct (application expr) (rator rands)) ; function call
(define-form-struct (branch expr) (test then else)) ; `if'
(define-form-struct (with-cont-mark expr) (key val body)) ; `with-continuation-mark'
(define-form-struct (beg0 expr) (seq)) ; `begin0'
(define-form-struct (seq form) (forms)) ; `begin'
(define-form-struct (splice form) (forms)) ; top-level `begin'
(define-form-struct (varref expr) (toplevel)) ; `#%variable-reference'
(define-form-struct (assign expr) (id rhs undef-ok?)) ; top-level or module-level set!
(define-form-struct (apply-values expr) (proc args-expr)) ; `(call-with-values (lambda () ,args-expr) ,proc)
(define-form-struct (primval expr) (id)) ; direct preference to a kernel primitive
;; Definitions (top level or within module):
(define-form-struct def-values (ids rhs))
(define-form-struct def-syntaxes (ids rhs prefix max-let-depth))
(define-form-struct def-for-syntax (ids rhs prefix max-let-depth))
(define-form-struct (def-values form) (ids rhs))
(define-form-struct (def-syntaxes form) (ids rhs prefix max-let-depth))
(define-form-struct (def-for-syntax form) (ids rhs prefix max-let-depth))
;; Top-level `require'
(define-form-struct req (reqs dummy))
(define-form-struct (req form) (reqs dummy))
;; A static closure can refer directly to itself, creating a cycle
(define-struct indirect ([v #:mutable]) #:prefab)
@ -145,7 +155,7 @@
(make-with-cont-mark key val body)]))
(define (read-sequence v)
(make-sequence v))
(make-seq v))
(define (read-define-values v)
(make-def-values
@ -173,7 +183,7 @@
(define (read-begin0 v)
(match v
[(struct sequence (exprs))
[(struct seq (exprs))
(make-beg0 exprs)]))
(define (read-boxenv v)
@ -429,9 +439,12 @@
;; Synatx unmarshaling
(define-form-struct wrapped (datum wraps certs))
(define-form-struct lexical-rename (alist))
(define-form-struct phase-shift (amt src dest))
(define-form-struct module-rename (phase kind set-id unmarshals renames mark-renames plus-kern?))
(define-form-struct wrap ())
(define-form-struct (lexical-rename wrap) (alist))
(define-form-struct (phase-shift wrap) (amt src dest))
(define-form-struct (module-rename wrap) (phase kind set-id unmarshals renames mark-renames plus-kern?))
(define-form-struct all-from-module (path phase src-phase exceptions prefix))
(define-form-struct module-binding (path mod-phase import-phase id nominal-path nominal-phase nominal-id))
@ -696,7 +709,7 @@
[read-accept-quasiquote #t])
(read (open-input-bytes s))))]
[(reference)
(make-primitive (read-compact-number cp))]
(make-primval (read-compact-number cp))]
[(small-list small-proper-list)
(let* ([l (- ch cpt-start)]
[ppr (eq? cpt-tag 'small-proper-list)])