[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Declarative variables optimization limits eta-exp
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/02: Declarative variables optimization limits eta-expansion |
Date: |
Tue, 14 Jan 2020 03:46:55 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit b6dfc84fd4b2be4db9199b86cf6607a10b2ecf99
Author: Andy Wingo <address@hidden>
AuthorDate: Tue Jan 14 09:39:28 2020 +0100
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.
---
module/language/tree-il/letrectify.scm | 34 ++++++++++++++++++++++++++++++++--
1 file changed, 32 insertions(+), 2 deletions(-)
diff --git a/module/language/tree-il/letrectify.scm
b/module/language/tree-il/letrectify.scm
index aecfa31..09b1cde 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)