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

Simplify some compiler functions, while tuning for performance.

This commit is contained in:
Jesse D. McDonald 2010-05-04 01:37:55 -05:00
parent 269a512e20
commit b1add2caf1
2 changed files with 55 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
libcompiler/simplifier.scm
View File

@ -145,13 +145,12 @@
(define (bound-var? var) (and (memq var vars) #t)) (define (bound-var? var) (and (memq var vars) #t))
; If the value of any binding refers to one of the variable names being bound... ; If the value of any binding refers to one of the variable names being bound...
(if (ormap (lambda (value) (ormap bound-var? (free-variables value))) (if (ormap bound-var? (free-variables `(%bind () ,@(map second (filter has-value? bindings)))))
(map second (filter has-value? bindings)))
; ...then bind the values to temps first, before binding the real names. ; ...then bind the values to temps first, before binding the real names.
(let ([temp-bindings (map (lambda (binding) (let ([temp-bindings (map (lambda (binding)
(let ([tmp (gensym)]) (let ([tmp (gensym)])
(list tmp (list tmp
(simplify-form `(set! ,tmp ,(second binding))) (simplify-set! `(set! ,tmp ,(second binding)))
`(%set! ,(first binding) ,tmp)))) `(%set! ,(first binding) ,tmp))))
(filter has-value? bindings))]) (filter has-value? bindings))])
`(%bind ,(map first temp-bindings) `(%bind ,(map first temp-bindings)
@ -279,12 +278,10 @@
(if (eq? var variable) `(%unbox ,variable) var)))) (if (eq? var variable) `(%unbox ,variable) var))))
(define (is-shared-var? var forms) (define (is-shared-var? var forms)
(define captured-input? (ormap (lambda (f) (form-captures-input? f var)) forms))
(define captured-output? (ormap (lambda (f) (form-captures-output? f var)) forms))
(define (set-after-first-capture?) (define (set-after-first-capture?)
(let/cc return (let/cc return
(foldr (lambda (form set-after?) (foldr (lambda (form set-after?)
(if (or set-after? (form-sets? form var captured-output?)) (if (or set-after? (form-sets? form var #f))
(if (form-captures-input? form var) (if (form-captures-input? form var)
(return #t) (return #t)
#t) #t)
@ -292,9 +289,8 @@
#f #f
forms) forms)
#f)) #f))
(or captured-output? (or (ormap (lambda (f) (form-captures-output? f var)) forms)
(and captured-input? (set-after-first-capture?)))
(set-after-first-capture?))))
(define (promote-shared-variables nested-bind) (define (promote-shared-variables nested-bind)
(define flat-bind (flatten-binds nested-bind)) (define flat-bind (flatten-binds nested-bind))
@ -312,8 +308,8 @@
(define flat-bind (flatten-binds nested-bind)) (define flat-bind (flatten-binds nested-bind))
(define (at-top-level? var) (define (at-top-level? var)
(or (ormap (lambda (x) (form-sets? x var #f)) (cddr flat-bind)) (or (ormap (lambda (x) (form-uses? x var #f)) (cddr flat-bind))
(ormap (lambda (x) (form-uses? x var #f)) (cddr flat-bind)))) (ormap (lambda (x) (form-sets? x var #f)) (cddr flat-bind))))
(define (captured-twice? var) (define (captured-twice? var)
(let/cc return (let/cc return
@ -321,7 +317,7 @@
(if (form-captures? subform var) (if (form-captures? subform var)
(if once? (return #t) #t) (if once? (return #t) #t)
once?)) once?))
(at-top-level? var) #f
(cddr flat-bind)) (cddr flat-bind))
#f)) #f))
@ -337,13 +333,10 @@
[`(%set! ,var (%lambda ,g-vars ,i-vars ,bind)) [`(%set! ,var (%lambda ,g-vars ,i-vars ,bind))
`(%set! ,var (%lambda ,g-vars ,i-vars `(%set! ,var (%lambda ,g-vars ,i-vars
,(narrow-binds+promote ,(narrow-binds+promote
(foldl (lambda (var temp-bind) (let ([free-vars (free-variables bind)])
(if (memq var (free-variables temp-bind)) (define (free-var? v) (memq v free-vars))
`(%bind (,@(second temp-bind) ,var) `(%bind (,@(second bind) ,@(filter free-var? extra-bindings))
,@(cddr temp-bind)) ,@(cddr bind))))))]
temp-bind))
bind
extra-bindings))))]
[_ subform])) [_ subform]))
(cddr flat-bind))))) (cddr flat-bind)))))

61
libcompiler/utilities.scm
View File

@ -32,6 +32,9 @@
free-variables free-variables
free-input-variables free-input-variables
free-output-variables free-output-variables
free-variable?
free-input-variable?
free-output-variable?
value-used?) value-used?)
(define (trace fn . args) (define (trace fn . args)
@ -231,25 +234,30 @@
#:set (lambda (recurse op var value-form) #:set (lambda (recurse op var value-form)
(or (eq? var variable) (or (eq? var variable)
(recurse value-form))) (recurse value-form)))
#:primitive (lambda _ #f)
#:call (lambda _ call-may-set?))) #:call (lambda _ call-may-set?)))
(define (form-uses? form variable [call-may-use? #t]) (define (form-uses? form variable [call-may-use? #t])
(search-form form (search-form form
#:bind (lambda (recurse op vars . subforms) #:bind (lambda (recurse op vars . subforms)
(and (not (memq variable vars)) (and (not (memq variable vars))
(ormap recurse subforms))) (ormap recurse subforms)))
#:lambda (lambda (recurse . form) #f) #:lambda (lambda (recurse . form) #f)
#:call (lambda (recurse op . simple-values) #:primitive (lambda (recurse op . simple-values)
(or call-may-use? (ormap recurse simple-values))) (and (memq variable simple-values) #t))
#:variable (lambda (recurse op var) (eq? var variable)))) #:call (lambda (recurse op . simple-values)
(or call-may-use? (and (memq variable simple-values) #t)))
#:variable (lambda (recurse op var) (eq? var variable))))
(define (form-captures? form variable [input? #t] [output? #t]) (define (form-captures? form variable [input? #t] [output? #t])
(search-form form (search-form form
#:bind (lambda (recurse op vars . subforms) #:bind (lambda (recurse op vars . subforms)
(and (not (memq variable vars)) (and (not (memq variable vars))
(ormap recurse subforms))) (ormap recurse subforms)))
#:lambda (lambda (recurse op g-vars i-vars bind) #:lambda (lambda (recurse op g-vars i-vars bind)
(and (memq variable (free-variables bind input? output?)) #t)))) (free-variable? variable bind input? output?))
#: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))
@ -258,12 +266,12 @@
(form-captures? form var #f #t)) (form-captures? form var #f #t))
(define (value-used? variable forms) (define (value-used? variable forms)
(cond (and (not (null? forms))
[(null? forms) #f] (let ([form (first forms)])
[(form-captures-input? (first forms) variable) #t] (or (form-captures-input? form variable)
[(form-uses? (first forms) variable #f) #t] (form-uses? form variable #f)
[(form-sets? (first forms) variable #f) #f] (and (not (form-sets? form variable #f))
[else (value-used? variable (cdr forms))])) (value-used? variable (cdr forms)))))))
(define (subst-var old-var new-var form) (define (subst-var old-var new-var form)
(map-form form (map-form form
@ -337,4 +345,21 @@
(define (free-output-variables form) (define (free-output-variables form)
(free-variables form #f #t)) (free-variables form #f #t))
(define (free-variable? variable form [input? #t] [output? #t])
(search-form form
#:bind (lambda (recurse op vars . subforms)
(and (not (memq variable vars))
(ormap recurse subforms)))
#:set (lambda (recurse op var value)
(or (and output? (eq? var variable))
(recurse value)))
#:variable (lambda (recurse kind var)
(and input? (eq? var variable)))))
(define (free-input-variable? var form)
(free-variable? var form #t #f))
(define (free-output-variable? var form)
(free-variable? var form #f #t))
; vim:set sw=2 expandtab: ; vim:set sw=2 expandtab: