nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More compiler performance tweaks.

This commit is contained in:
Jesse D. McDonald 2010-05-06 00:22:27 -05:00
parent e375edfc83
commit 5d8a302225
3 changed files with 32 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compiler.scm
View File

@ -9,6 +9,8 @@
(require (file "libcompiler/compiler.scm"))
(require (file "libcompiler/writer.scm"))
;(require profile)
;(profile (begin
(define map-bytecode? (make-parameter #t))
(define source-file
@ -38,5 +40,6 @@
(write-rla-value (compile-function source-module))
(write-char #\Newline))
(pretty-print (reduce-function source-module)))
;) #:delay 0.002)
; vim:set sw=2 expandtab:

16
libcompiler/simplifier.scm
View File

@ -331,12 +331,16 @@
,@(map (lambda (subform)
(match subform
[`(%set! ,var (%lambda ,g-vars ,i-vars ,bind))
`(%set! ,var (%lambda ,g-vars ,i-vars
,(narrow-binds+promote
(let ([free-vars (free-variables bind)])
(define (free-var? v) (memq v free-vars))
`(%bind (,@(second bind) ,@(filter free-var? extra-bindings))
,@(cddr bind))))))]
(define (free-var? v) (free-variable? v bind))
(define local-binds (filter free-var? extra-bindings))
(if (null? local-binds)
subform
(begin
(set! extra-bindings (remove* local-binds extra-bindings))
`(%set! ,var (%lambda ,g-vars ,i-vars
,(narrow-binds+promote
`(%bind (,@(second bind) ,@local-binds)
,@(cddr bind)))))))]
[_ subform]))
(cddr flat-bind)))))

53
libcompiler/utilities.scm
View File

@ -163,38 +163,24 @@
#:call/cc [call/cc-fn call-fn]
#:tail-call [tail-call-fn call-fn])
(define (recurse subform)
; Can skip #:primitive, #:call, and #:simple, which only set defaults.
(traverse-form subform
#:bind bind-fn
#:lambda lambda-fn
#:set set-fn
#:value-list value-list-fn
#:primitive primitive-fn
#:other other-fn
#:values values-fn
#:variable variable-fn
#:literal literal-fn
#:apply apply-fn
#:call/cc call/cc-fn
#:tail-call tail-call-fn))
(cond
[(variable-value? form) (variable-fn recurse 'variable form)]
[(literal-value? form) (literal-fn recurse 'literal form)]
[else
(let ([handler (case (first form)
[(%bind) bind-fn]
[(%lambda) lambda-fn]
[(%set!) set-fn]
[(%value-list) value-list-fn]
[(%values) values-fn]
[(%apply) apply-fn]
[(%call/cc) call/cc-fn]
[(%tail-call) tail-call-fn]
[else (if (primitive-form? form)
primitive-fn
other-fn)])])
(apply handler recurse form))]))
(cond
[(variable-value? subform) (variable-fn recurse 'variable subform)]
[(literal-value? subform) (literal-fn recurse 'literal subform)]
[else
(let ([handler (case (first subform)
[(%bind) bind-fn]
[(%lambda) lambda-fn]
[(%set!) set-fn]
[(%value-list) value-list-fn]
[(%values) values-fn]
[(%apply) apply-fn]
[(%call/cc) call/cc-fn]
[(%tail-call) tail-call-fn]
[else (if (primitive-form? subform)
primitive-fn
other-fn)])])
(apply handler recurse subform))]))
(recurse form))
(define map-form
(curry-keywords traverse-form
@ -256,8 +242,7 @@
(ormap recurse subforms)))
#:lambda (lambda (recurse op g-vars i-vars bind)
(free-variable? variable bind input? output?))
#:primitive (lambda _ #f)
#:simple (lambda _ #f)))
#:primitive (lambda _ #f)))
(define (form-captures-input? form var)
(form-captures? form var #t #f))