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

12
libcompiler/simplifier.scm
View File

@ -331,12 +331,16 @@
,@(map (lambda (subform) ,@(map (lambda (subform)
(match subform (match subform
[`(%set! ,var (%lambda ,g-vars ,i-vars ,bind)) [`(%set! ,var (%lambda ,g-vars ,i-vars ,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 `(%set! ,var (%lambda ,g-vars ,i-vars
,(narrow-binds+promote ,(narrow-binds+promote
(let ([free-vars (free-variables bind)]) `(%bind (,@(second bind) ,@local-binds)
(define (free-var? v) (memq v free-vars)) ,@(cddr bind)))))))]
`(%bind (,@(second bind) ,@(filter free-var? extra-bindings))
,@(cddr bind))))))]
[_ subform])) [_ subform]))
(cddr flat-bind))))) (cddr flat-bind)))))

29
libcompiler/utilities.scm
View File

@ -163,26 +163,11 @@
#:call/cc [call/cc-fn call-fn] #:call/cc [call/cc-fn call-fn]
#:tail-call [tail-call-fn call-fn]) #:tail-call [tail-call-fn call-fn])
(define (recurse subform) (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 (cond
[(variable-value? form) (variable-fn recurse 'variable form)] [(variable-value? subform) (variable-fn recurse 'variable subform)]
[(literal-value? form) (literal-fn recurse 'literal form)] [(literal-value? subform) (literal-fn recurse 'literal subform)]
[else [else
(let ([handler (case (first form) (let ([handler (case (first subform)
[(%bind) bind-fn] [(%bind) bind-fn]
[(%lambda) lambda-fn] [(%lambda) lambda-fn]
[(%set!) set-fn] [(%set!) set-fn]
@ -191,10 +176,11 @@
[(%apply) apply-fn] [(%apply) apply-fn]
[(%call/cc) call/cc-fn] [(%call/cc) call/cc-fn]
[(%tail-call) tail-call-fn] [(%tail-call) tail-call-fn]
[else (if (primitive-form? form) [else (if (primitive-form? subform)
primitive-fn primitive-fn
other-fn)])]) other-fn)])])
(apply handler recurse form))])) (apply handler recurse subform))]))
(recurse form))
(define map-form (define map-form
(curry-keywords traverse-form (curry-keywords traverse-form
@ -256,8 +242,7 @@
(ormap recurse subforms))) (ormap recurse subforms)))
#:lambda (lambda (recurse op g-vars i-vars bind) #:lambda (lambda (recurse op g-vars i-vars bind)
(free-variable? variable bind input? output?)) (free-variable? variable bind input? output?))
#:primitive (lambda _ #f) #:primitive (lambda _ #f)))
#:simple (lambda _ #f)))
(define (form-captures-input? form var) (define (form-captures-input? form var)
(form-captures? form var #t #f)) (form-captures? form var #t #f))