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

61
libcompiler/utilities.scm
View File

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