diff options
author | Andy Wingo <wingo@pobox.com> | 2011-09-21 23:59:02 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-09-24 19:00:53 +0200 |
commit | b8a2b628e9c663ff58d442a895c4d20541d54b1f (patch) | |
tree | 305d560ed7357a7cccb142e3a0dcfed173c79c61 /module/language/tree-il/optimize.scm | |
parent | 1eb4886ffa9c4c81c946af7fed8fb39020fcde12 (diff) | |
download | guile-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.scm | 45 |
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 |