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

50
collects/compiler/decompile.ss
View File

@ -115,7 +115,7 @@
,(let-values ([(globs defns) (decompile-prefix prefix)]) ,(let-values ([(globs defns) (decompile-prefix prefix)])
`(let () `(let ()
,@defns ,@defns
,(decompile-expr rhs globs '(#%globals)))))] ,(decompile-form rhs globs '(#%globals)))))]
[(struct def-for-syntax (ids rhs prefix max-let-depth)) [(struct def-for-syntax (ids rhs prefix max-let-depth))
`(define-values-for-syntax ,ids `(define-values-for-syntax ,ids
,(let-values ([(globs defns) (decompile-prefix prefix)]) ,(let-values ([(globs defns) (decompile-prefix prefix)])
@ -188,24 +188,13 @@
(if clear? (if clear?
`(#%sfs-clear ,e) `(#%sfs-clear ,e)
e)))] e)))]
[(struct lam (name flags num-params rest? closure-map max-let-depth body)) [(? lam?)
(let ([vars (for/list ([i (in-range num-params)]) `(lambda . ,(decompile-lam expr globs stack))]
(gensym (format "arg~a-" i)))] [(struct case-lam (name lams))
[rest-vars (if rest? (list (gensym 'rest)) null)] `(case-lambda
[captures (map (lambda (v) ,@(map (lambda (lam)
(list-ref/protect stack v)) (decompile-lam lam globs stack))
(vector->list closure-map))]) lams))]
`(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)))))]
[(struct let-one (rhs body)) [(struct let-one (rhs body))
(let ([id (or (extract-id rhs) (let ([id (or (extract-id rhs)
(gensym 'local))]) (gensym 'local))])
@ -222,7 +211,7 @@
,(decompile-expr body globs (append vars stack)))))] ,(decompile-expr body globs (append vars stack)))))]
[(struct let-rec (procs body)) [(struct let-rec (procs body))
`(begin `(begin
(set!-rec-values ,(for/list ([p (in-list procs)] (#%set!-rec-values ,(for/list ([p (in-list procs)]
[i (in-naturals)]) [i (in-naturals)])
(list-ref/protect stack i)) (list-ref/protect stack i))
,@(map (lambda (proc) ,@(map (lambda (proc)
@ -274,6 +263,27 @@
'???)] '???)]
[else `(quote ,expr)])) [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)] [(0) (read-define-values v)]
[(1) (read-define-syntax v)] [(1) (read-define-syntax v)]
[(2) (read-set! v)] [(2) (read-set! v)]
[(3) (read-case-lambda v)] [(3) v] ; a case-lam already
[(4) (read-begin0 v)] [(4) (read-begin0 v)]
[(5) (read-boxenv v)] [(5) (read-boxenv v)]
[(6) (read-module-wrap v)] [(6) (read-module-wrap v)]