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

document 'mzc --decompile'

Browse Source 
svn: r11317

original commit: 76cf25fc12
This commit is contained in:
Matthew Flatt 2008-08-19 00:50:52 +00:00
parent 436c1a119a
commit ba41523036
2 changed files with 36 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/compiler/decompile.ss
View File

@ -115,7 +115,7 @@
,(let-values ([(globs defns) (decompile-prefix prefix)])
`(let ()
,@defns
,(decompile-expr rhs globs '(#%globals)))))]
,(decompile-form rhs globs '(#%globals)))))]
[(struct def-for-syntax (ids rhs prefix max-let-depth))
`(define-values-for-syntax ,ids
,(let-values ([(globs defns) (decompile-prefix prefix)])
@ -188,24 +188,13 @@
(if clear?
`(#%sfs-clear ,e)
e)))]
[(struct lam (name flags num-params rest? closure-map max-let-depth body))
(let ([vars (for/list ([i (in-range num-params)])
(gensym (format "arg~a-" i)))]
[rest-vars (if rest? (list (gensym 'rest)) null)]
[captures (map (lambda (v)
(list-ref/protect stack v))
(vector->list closure-map))])
`(lambda (,@vars . ,(if rest?
(car rest-vars)
null))
,@(if name
`(',name)
null)
,@(if (null? captures)
null
`('(captures: ,@captures)))
,(decompile-expr body globs (append captures
(append vars rest-vars)))))]
[(? lam?)
`(lambda . ,(decompile-lam expr globs stack))]
[(struct case-lam (name lams))
`(case-lambda
,@(map (lambda (lam)
(decompile-lam lam globs stack))
lams))]
[(struct let-one (rhs body))
(let ([id (or (extract-id rhs)
(gensym 'local))])
@ -222,12 +211,12 @@
,(decompile-expr body globs (append vars stack)))))]
[(struct let-rec (procs body))
`(begin
(set!-rec-values ,(for/list ([p (in-list procs)]
[i (in-naturals)])
(list-ref/protect stack i))
,@(map (lambda (proc)
(decompile-expr proc globs stack))
procs))
(#%set!-rec-values ,(for/list ([p (in-list procs)]
[i (in-naturals)])
(list-ref/protect stack i))
,@(map (lambda (proc)
(decompile-expr proc globs stack))
procs))
,(decompile-expr body globs stack))]
[(struct install-value (count pos boxes? rhs body))
`(begin
@ -274,6 +263,27 @@
'???)]
[else `(quote ,expr)]))
(define (decompile-lam expr globs stack)
(match expr
[(struct lam (name flags num-params rest? closure-map max-let-depth body))
(let ([vars (for/list ([i (in-range num-params)])
(gensym (format "arg~a-" i)))]
[rest-vars (if rest? (list (gensym 'rest)) null)]
[captures (map (lambda (v)
(list-ref/protect stack v))
(vector->list closure-map))])
`((,@vars . ,(if rest?
(car rest-vars)
null))
,@(if (and name (not (null? name)))
`(',name)
null)
,@(if (null? captures)
null
`('(captures: ,@captures)))
,(decompile-expr body globs (append captures
(append vars rest-vars)))))]))
;; ----------------------------------------
#;

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

@ -235,7 +235,7 @@
[(0) (read-define-values v)]
[(1) (read-define-syntax v)]
[(2) (read-set! v)]
[(3) (read-case-lambda v)]
[(3) v] ; a case-lam already
[(4) (read-begin0 v)]
[(5) (read-boxenv v)]
[(6) (read-module-wrap v)]