diff options
author | Andy Wingo <wingo@pobox.com> | 2020-01-14 09:39:28 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-01-14 09:39:28 +0100 |
commit | b6dfc84fd4b2be4db9199b86cf6607a10b2ecf99 (patch) | |
tree | ecdc52ac3c655ab70516c4faf4d9c7f4b4ad4605 | |
parent | b47bf2434c656eb7fb6be0894dac3bea8b53ac05 (diff) | |
download | guile-b6dfc84fd4b2be4db9199b86cf6607a10b2ecf99.tar.gz |
Declarative variables optimization limits eta-expansion
* module/language/tree-il/letrectify.scm (compute-procedures-without-identity):
(letrectify): Only eta-expand lambda references that appear outside
the operator position more than once. This should restore peoples'
expectations that (eqv? f f) without penalizing optimization.
-rw-r--r-- | module/language/tree-il/letrectify.scm | 34 |
1 files changed, 32 insertions, 2 deletions
diff --git a/module/language/tree-il/letrectify.scm b/module/language/tree-il/letrectify.scm index aecfa3128..09b1cde17 100644 --- a/module/language/tree-il/letrectify.scm +++ b/module/language/tree-il/letrectify.scm @@ -160,12 +160,41 @@ declarative) private)) +;; A declarative procedure has a distinct identity if it appears outside +;; the operator position in a call in more than one place. Otherwise we +;; will eta-expand its uses, if any. +(define (compute-procedures-without-identity expr declarative) + (define counts (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! counts k 0)) declarative) + (tree-il-for-each + (lambda (x) + (match x + (($ <toplevel-ref> src mod name) + (let ((k (cons mod name))) + (match (hash-ref counts k) + (#f #f) + (count (hash-set! counts k (1+ count)))))) + (($ <call> _ ($ <toplevel-ref> src mod name)) + (let ((k (cons mod name))) + (match (hash-ref counts k) + (#f #f) + (count (hash-set! counts k (1- count)))))) + (_ #f))) + expr) + (define no-identity (make-hash-table)) + (hash-for-each (lambda (k count) + (when (<= count 1) + (hash-set! no-identity k #t))) + counts) + no-identity) + (define* (letrectify expr #:key (seal-private-bindings? #f)) (define declarative (compute-declarative-toplevels expr)) (define private (if seal-private-bindings? (compute-private-toplevels declarative) (make-hash-table))) + (define no-identity (compute-procedures-without-identity expr declarative)) (define declarative-box+value (let ((tab (make-hash-table))) (hash-for-each (lambda (key val) @@ -220,8 +249,9 @@ ;; permitted by R6RS as procedure equality is explicitly ;; unspecified, but if it's an irritation in practice, we could ;; disable this transformation. - (($ <lambda> src1 meta - ($ <lambda-case> src2 req #f rest #f () syms body #f)) + ((and (? (lambda _ (hash-ref no-identity (cons mod name)))) + ($ <lambda> src1 meta + ($ <lambda-case> src2 req #f rest #f () syms body #f))) (let* ((syms (map gensym (map symbol->string syms))) (args (map (lambda (req sym) (make-lexical-ref src2 req sym)) (if rest (append req (list rest)) req) |