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
svn: r18737
original commit: c5ac9f23ec
This commit is contained in:
parent
3832a4ae1a
commit
abd90494f9
|
@ -207,9 +207,9 @@
|
|||
,@(map (lambda (lam)
|
||||
(decompile-lam lam globs stack closed))
|
||||
lams))]
|
||||
[(struct let-one (rhs body flonum?))
|
||||
[(struct let-one (rhs body flonum? unused?))
|
||||
(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)])
|
||||
(if flonum?
|
||||
(list '#%as-flonum v)
|
||||
|
|
|
@ -160,7 +160,7 @@
|
|||
[(struct case-lam (name lams))
|
||||
(traverse-data name visit)
|
||||
(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 body visit)]
|
||||
[(struct let-void (count boxes? body))
|
||||
|
@ -297,7 +297,8 @@
|
|||
CPT_PATH
|
||||
CPT_CLOSURE
|
||||
CPT_DELAY_REF
|
||||
CPT_PREFAB)
|
||||
CPT_PREFAB
|
||||
CPT_LET_ONE_UNUSED)
|
||||
|
||||
(define-enum
|
||||
0
|
||||
|
@ -314,7 +315,7 @@
|
|||
APPVALS_EXPD
|
||||
SPLICE_EXPD)
|
||||
|
||||
(define CPT_SMALL_NUMBER_START 35)
|
||||
(define CPT_SMALL_NUMBER_START 36)
|
||||
(define CPT_SMALL_NUMBER_END 60)
|
||||
|
||||
(define CPT_SMALL_SYMBOL_START 60)
|
||||
|
@ -715,8 +716,12 @@
|
|||
(cons (or name null)
|
||||
lams)
|
||||
out)]
|
||||
[(struct let-one (rhs body flonum?))
|
||||
(out-byte (if flonum? CPT_LET_ONE_FLONUM CPT_LET_ONE) out)
|
||||
[(struct let-one (rhs body flonum? unused?))
|
||||
(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 body) out)]
|
||||
[(struct let-void (count boxes? body))
|
||||
|
|
|
@ -412,7 +412,8 @@
|
|||
[32 closure]
|
||||
[33 delayed]
|
||||
[34 prefab]
|
||||
[35 60 small-number]
|
||||
[35 let-one-unused]
|
||||
[36 60 small-number]
|
||||
[60 80 small-symbol]
|
||||
[80 92 small-marshalled]
|
||||
[92 ,(+ 92 small-list-max) small-proper-list]
|
||||
|
@ -766,9 +767,10 @@
|
|||
(if ppr null (read-compact cp)))
|
||||
(read-compact-list l ppr cp))
|
||||
(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)
|
||||
(eq? cpt-tag 'let-one-flonum))]
|
||||
(eq? cpt-tag 'let-one-flonum)
|
||||
(eq? cpt-tag 'let-one-unused))]
|
||||
[(branch)
|
||||
(make-branch (read-compact cp) (read-compact cp) (read-compact cp))]
|
||||
[(module-index) (module-path-index-join (read-compact cp) (read-compact cp))]
|
||||
|
|
|
@ -118,7 +118,7 @@
|
|||
(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 (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 (install-value expr) ([count exact-nonnegative-integer?]
|
||||
[pos exact-nonnegative-integer?]
|
||||
|
|
Loading…
Reference in New Issue
Block a user