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:

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

53
libcompiler/utilities.scm
View File

@ -163,38 +163,24 @@
#: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. (cond
(traverse-form subform [(variable-value? subform) (variable-fn recurse 'variable subform)]
#:bind bind-fn [(literal-value? subform) (literal-fn recurse 'literal subform)]
#:lambda lambda-fn [else
#:set set-fn (let ([handler (case (first subform)
#:value-list value-list-fn [(%bind) bind-fn]
#:primitive primitive-fn [(%lambda) lambda-fn]
#:other other-fn [(%set!) set-fn]
#:values values-fn [(%value-list) value-list-fn]
#:variable variable-fn [(%values) values-fn]
#:literal literal-fn [(%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? subform)
primitive-fn
(cond other-fn)])])
[(variable-value? form) (variable-fn recurse 'variable form)] (apply handler recurse subform))]))
[(literal-value? form) (literal-fn recurse 'literal form)] (recurse 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))]))
(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))