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

fix letrec compilation when call/cc is used on the RHS of something that otherwise looks like it could be let*; add #%in annotations to decompiler output

Browse Source 
svn: r11329

original commit: ebab4270bf
This commit is contained in:
Matthew Flatt 2008-08-19 15:18:09 +00:00
parent ba41523036
commit 9ed7e7ba98
1 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/compiler/decompile.ss
View File

@ -237,10 +237,11 @@
[(struct application (rator rands))
(let ([stack (append (for/list ([i (in-list rands)]) (gensym 'rand))
stack)])
(annotate-inline
`(,(decompile-expr rator globs stack)
,@(map (lambda (rand)
(decompile-expr rand globs stack))
rands)))]
rands))))]
[(struct apply-values (proc args-expr))
`(#%apply-values ,(decompile-expr proc globs stack)
,(decompile-expr args-expr globs stack))]
@ -284,6 +285,28 @@
,(decompile-expr body globs (append captures
(append vars rest-vars)))))]))
(define (annotate-inline a)
(if (and (symbol? (car a))
(case (length a)
[(2) (memq (car a) '(not null? pair? mpair? symbol?
syntax? char? boolean?
number? real? exact-integer?
fixnum? inexact-real?
procedure? vector? box? string? bytes? eof-object?
zero? negative? exact-nonnegative-integer?
exact-positive-integer?
car cdr caar cadr cdar cddr
mcar mcdr unbox syntax-e
add1 sub1 - abs bitwise-not))]
[(3) (memq (car a) '(eq? = <= < >= >
bitwise-bit-set? char=?
+ - * / min max bitwise-and bitwise-ior
arithmetic-shift vector-ref string-ref bytes-ref
set-mcar! set-mcdr! cons mcons))]
[(4) (memq (car a) '(vector-set! string-set! bytes-set!))]))
(cons '#%in a)
a))
;; ----------------------------------------
#;