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

better compiler handling of unused local bindings where the RHS either doesn't obviously produce a single value or is discovered to be unused late in bytecode compilation; initial Scribble support for printing qq-style results

Browse Source 
svn: r18737

original commit: c5ac9f23ec
This commit is contained in:
Matthew Flatt 2010-04-06 15:52:36 +00:00
parent 3832a4ae1a
commit abd90494f9
4 changed files with 18 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/compiler/decompile.ss
View File

@ -207,9 +207,9 @@
,@(map (lambda (lam) ,@(map (lambda (lam)
(decompile-lam lam globs stack closed)) (decompile-lam lam globs stack closed))
lams))] lams))]
[(struct let-one (rhs body flonum?)) [(struct let-one (rhs body flonum? unused?))
(let ([id (or (extract-id rhs) (let ([id (or (extract-id rhs)
(gensym 'local))]) (gensym (if unused? 'unused 'local)))])
`(let ([,id ,(let ([v (decompile-expr rhs globs (cons id stack) closed)]) `(let ([,id ,(let ([v (decompile-expr rhs globs (cons id stack) closed)])
(if flonum? (if flonum?
(list '#%as-flonum v) (list '#%as-flonum v)

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

@ -160,7 +160,7 @@
[(struct case-lam (name lams)) [(struct case-lam (name lams))
(traverse-data name visit) (traverse-data name visit)
(for-each (lambda (lam) (traverse-lam lam visit)) lams)] (for-each (lambda (lam) (traverse-lam lam visit)) lams)]
[(struct let-one (rhs body flonum?)) [(struct let-one (rhs body flonum? unused?))
(traverse-expr rhs visit) (traverse-expr rhs visit)
(traverse-expr body visit)] (traverse-expr body visit)]
[(struct let-void (count boxes? body)) [(struct let-void (count boxes? body))
@ -297,7 +297,8 @@
CPT_PATH CPT_PATH
CPT_CLOSURE CPT_CLOSURE
CPT_DELAY_REF CPT_DELAY_REF
CPT_PREFAB) CPT_PREFAB
CPT_LET_ONE_UNUSED)
(define-enum (define-enum
0 0
@ -314,7 +315,7 @@
APPVALS_EXPD APPVALS_EXPD
SPLICE_EXPD) SPLICE_EXPD)
(define CPT_SMALL_NUMBER_START 35) (define CPT_SMALL_NUMBER_START 36)
(define CPT_SMALL_NUMBER_END 60) (define CPT_SMALL_NUMBER_END 60)
(define CPT_SMALL_SYMBOL_START 60) (define CPT_SMALL_SYMBOL_START 60)
@ -715,8 +716,12 @@
(cons (or name null) (cons (or name null)
lams) lams)
out)] out)]
[(struct let-one (rhs body flonum?)) [(struct let-one (rhs body flonum? unused?))
(out-byte (if flonum? CPT_LET_ONE_FLONUM CPT_LET_ONE) out) (out-byte (cond
[flonum? CPT_LET_ONE_FLONUM]
[unused? CPT_LET_ONE_UNUSED]
[else CPT_LET_ONE])
out)
(out-expr (protect-quote rhs) out) (out-expr (protect-quote rhs) out)
(out-expr (protect-quote body) out)] (out-expr (protect-quote body) out)]
[(struct let-void (count boxes? body)) [(struct let-void (count boxes? body))

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

@ -412,7 +412,8 @@
[32 closure] [32 closure]
[33 delayed] [33 delayed]
[34 prefab] [34 prefab]
[35 60 small-number] [35 let-one-unused]
[36 60 small-number]
[60 80 small-symbol] [60 80 small-symbol]
[80 92 small-marshalled] [80 92 small-marshalled]
[92 ,(+ 92 small-list-max) small-proper-list] [92 ,(+ 92 small-list-max) small-proper-list]
@ -766,9 +767,10 @@
(if ppr null (read-compact cp))) (if ppr null (read-compact cp)))
(read-compact-list l ppr cp)) (read-compact-list l ppr cp))
(loop l ppr)))] (loop l ppr)))]
[(let-one let-one-flonum) [(let-one let-one-flonum let-one-unused)
(make-let-one (read-compact cp) (read-compact cp) (make-let-one (read-compact cp) (read-compact cp)
(eq? cpt-tag 'let-one-flonum))] (eq? cpt-tag 'let-one-flonum)
(eq? cpt-tag 'let-one-unused))]
[(branch) [(branch)
(make-branch (read-compact cp) (read-compact cp) (read-compact cp))] (make-branch (read-compact cp) (read-compact cp) (read-compact cp))]
[(module-index) (module-path-index-join (read-compact cp) (read-compact cp))] [(module-index) (module-path-index-join (read-compact cp) (read-compact cp))]

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

@ -118,7 +118,7 @@
(define-form-struct (closure expr) ([code lam?] [gen-id symbol?])) ; a static closure (nothing to close over) (define-form-struct (closure expr) ([code lam?] [gen-id symbol?])) ; a static closure (nothing to close over)
(define-form-struct (case-lam expr) ([name (or/c symbol? vector? empty?)] [clauses (listof (or/c lam? indirect?))])) ; each clause is a lam (added indirect) (define-form-struct (case-lam expr) ([name (or/c symbol? vector? empty?)] [clauses (listof (or/c lam? indirect?))])) ; each clause is a lam (added indirect)
(define-form-struct (let-one expr) ([rhs (or/c expr? seq? indirect? any/c)] [body (or/c expr? seq? indirect? any/c)] [flonum? boolean?])) ; pushes one value onto stack (define-form-struct (let-one expr) ([rhs (or/c expr? seq? indirect? any/c)] [body (or/c expr? seq? indirect? any/c)] [flonum? boolean?] [unused? boolean?])) ; pushes one value onto stack
(define-form-struct (let-void expr) ([count exact-nonnegative-integer?] [boxes? boolean?] [body (or/c expr? seq? indirect? any/c)])) ; create new stack slots (define-form-struct (let-void expr) ([count exact-nonnegative-integer?] [boxes? boolean?] [body (or/c expr? seq? indirect? any/c)])) ; create new stack slots
(define-form-struct (install-value expr) ([count exact-nonnegative-integer?] (define-form-struct (install-value expr) ([count exact-nonnegative-integer?]
[pos exact-nonnegative-integer?] [pos exact-nonnegative-integer?]