[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/03: At optimization level -O3, seal declarative modul
From: |
Andy Wingo |
Subject: |
[Guile-commits] 03/03: At optimization level -O3, seal declarative module-private bindings |
Date: |
Wed, 28 Aug 2019 04:49:08 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 887aac28d204c378bb2610241cb03326d6f9bd27
Author: Andy Wingo <address@hidden>
Date: Wed Aug 28 10:30:44 2019 +0200
At optimization level -O3, seal declarative module-private bindings
* module/language/tree-il/letrectify.scm (compute-private-toplevels):
New function; computes the subset of declarative bindings that are
private to a module. If the module exports a macro, all bindings are
public, as we have no way to know what binding might be exported.
(letrectify): Add #:seal-private-bindings? keyword arg. If true, avoid
making boxes for private definitions.
* module/language/tree-il/optimize.scm (optimize): Add
-Oseal-private-bindings, enabled at -O3.
---
module/language/tree-il/letrectify.scm | 49 ++++++++++++++++++++++++++++++++--
module/language/tree-il/optimize.scm | 6 ++++-
2 files changed, 52 insertions(+), 3 deletions(-)
diff --git a/module/language/tree-il/letrectify.scm
b/module/language/tree-il/letrectify.scm
index 8842025..aecfa31 100644
--- a/module/language/tree-il/letrectify.scm
+++ b/module/language/tree-il/letrectify.scm
@@ -125,12 +125,54 @@
defined)
declarative))
-(define (letrectify expr)
+(define (compute-private-toplevels declarative)
+ ;; Set of variables exported by the modules of declarative bindings in
+ ;; this compilation unit.
+ (define exports (make-hash-table))
+ ;; If a module exports a macro, that macro could implicitly export any
+ ;; top-level binding in a module; we have to avoid sealing private
+ ;; bindings in that case.
+ (define exports-macro? (make-hash-table))
+ (hash-for-each
+ (lambda (k _)
+ (match k
+ ((mod . name)
+ (unless (hash-get-handle exports-macro? mod)
+ (hash-set! exports-macro? mod #f)
+ (let ((i (module-public-interface (resolve-module mod))))
+ (when i
+ (module-for-each
+ (lambda (k v)
+ (hashq-set! exports v k)
+ (when (and (variable-bound? v) (macro? (variable-ref v)))
+ (hash-set! exports-macro? mod #t)))
+ i)))))))
+ declarative)
+ (let ((private (make-hash-table)))
+ (hash-for-each
+ (lambda (k _)
+ (match k
+ ((mod . name)
+ (unless (or (hash-ref exports-macro? mod)
+ (hashq-ref exports
+ (module-local-variable (resolve-module mod)
name)))
+ (hash-set! private k #t)))))
+ declarative)
+ private))
+
+(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 declarative-box+value
(let ((tab (make-hash-table)))
(hash-for-each (lambda (key val)
- (hash-set! tab key (cons (gensym) (gensym))))
+ (let ((box (and (not (hash-ref private key))
+ (gensym)))
+ (val (gensym)))
+ (hash-set! tab key (cons box val))))
declarative)
(lambda (mod name)
(hash-ref tab (cons mod name)))))
@@ -210,6 +252,9 @@
(($ <toplevel-define> src mod name exp)
(match (declarative-box+value mod name)
(#f (values (visit-expr expr) mod-vars))
+ ((#f . value)
+ (values (add-binding name value (visit-expr exp) (make-void src))
+ mod-vars))
((box . value)
(match (assoc-ref mod-vars mod)
(#f
diff --git a/module/language/tree-il/optimize.scm
b/module/language/tree-il/optimize.scm
index c252e54..96ccc75 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -47,10 +47,13 @@
(set! x (maybe-verify (pass x)))))
(define (resolve* x) (resolve-primitives x env))
(define (peval* x) (peval x env))
+ (define (letrectify* x)
+ (let ((seal? (kw-arg-ref opts #:seal-private-bindings? #f)))
+ (letrectify x #:seal-private-bindings? seal?)))
(maybe-verify x)
(run-pass resolve* #:resolve-primitives? #t)
(run-pass expand-primitives #:expand-primitives? #t)
- (run-pass letrectify #:letrectify? #t)
+ (run-pass letrectify* #:letrectify? #t)
(set! x (fix-letrec x))
(run-pass peval* #:partial-eval? #t)
x)
@@ -67,4 +70,5 @@
'((#:resolve-primitives? 2)
(#:expand-primitives? 1)
(#:letrectify? 2)
+ (#:seal-private-bindings? 3)
(#:partial-eval? 1)))