summaryrefslogtreecommitdiff
path: root/module/language/tree-il/optimize.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-09-21 23:59:02 +0200
committerAndy Wingo <wingo@pobox.com>2011-09-24 19:00:53 +0200
commitb8a2b628e9c663ff58d442a895c4d20541d54b1f (patch)
tree305d560ed7357a7cccb142e3a0dcfed173c79c61 /module/language/tree-il/optimize.scm
parent1eb4886ffa9c4c81c946af7fed8fb39020fcde12 (diff)
downloadguile-b8a2b628e9c663ff58d442a895c4d20541d54b1f.tar.gz
peval: pre-analyze mutated or reffed-once lexicals
* module/language/tree-il/optimize.scm (<var>, build-var-table, peval): Before going into peval, build a table indicating refcounts and a set? flag for all lexicals. Add to the table when introducing new bindings (via alpha-renaming).
Diffstat (limited to 'module/language/tree-il/optimize.scm')
-rw-r--r--module/language/tree-il/optimize.scm45
1 files changed, 45 insertions, 0 deletions
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index b96e80104..2e119d969 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -26,6 +26,7 @@
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (optimize!))
@@ -194,6 +195,39 @@ lexical references."
(or (proc (vlist-ref vlist i))
(lp (1+ i)))))))
+(define-record-type <var>
+ (make-var name gensym refcount set?)
+ var?
+ (name var-name)
+ (gensym var-gensym)
+ (refcount var-refcount set-var-refcount!)
+ (set? var-set? set-var-set?!))
+
+(define* (build-var-table exp #:optional (table vlist-null))
+ (tree-il-fold
+ (lambda (exp res)
+ (match exp
+ (($ <lexical-ref> src name gensym)
+ (let ((var (vhash-assq gensym res)))
+ (if var
+ (begin
+ (set-var-refcount! (cdr var) (1+ (var-refcount (cdr var))))
+ res)
+ (vhash-consq gensym (make-var name gensym 1 #f) res))))
+ (_ res)))
+ (lambda (exp res)
+ (match exp
+ (($ <lexical-set> src name gensym exp)
+ (let ((var (vhash-assq gensym res)))
+ (if var
+ (begin
+ (set-var-set?! (cdr var) #t)
+ res)
+ (vhash-consq gensym (make-var name gensym 0 #t) res))))
+ (_ res)))
+ (lambda (exp res) res)
+ table exp))
+
(define* (peval exp #:optional (cenv (current-module)) (env vlist-null))
"Partially evaluate EXP in compilation environment CENV, with
top-level bindings from ENV and return the resulting expression. Since
@@ -228,6 +262,17 @@ it does not handle <fix> and <let-values>, it should be called before
(define (local-toplevel? name)
(vhash-assq name local-toplevel-env))
+ (define var-table (build-var-table exp))
+ (define (record-lexicals! x)
+ (set! var-table (build-var-table x var-table))
+ x)
+ (define (assigned-lexical? sym)
+ (let ((v (vhash-assq sym var-table)))
+ (and v (var-set? (cdr v)))))
+ (define (unreferenced-lexical? sym)
+ (let ((v (vhash-assq sym var-table)))
+ (if v (zero? (var-refcount (cdr v))) #t)))
+
(define (apply-primitive name args)
;; todo: further optimize commutative primitives
(catch #t