summaryrefslogtreecommitdiff
path: root/module/language
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2023-11-23 12:31:38 +0100
committerAndy Wingo <wingo@pobox.com>2023-11-23 12:31:38 +0100
commit5ef0ea30faf9fa980681e3b6e24eb9a3884ec83d (patch)
tree8321ba6af9628cde4e53747b44460730b983545d /module/language
parent83449a8683abee5b71961f7fe891f3b8c894e14b (diff)
downloadguile-5ef0ea30faf9fa980681e3b6e24eb9a3884ec83d.tar.gz
Allow targets to preclude unbound variables
Allowing variables to hold an unbound value and requiring a check on each load is suboptimal; the fixing letrec boolean check is better. So other runtimes (hoot) might preclude unbound variables by construction. Allow them to do so. * module/language/cps/guile-vm.scm (target-has-unbound-boxes?): New definition. * module/language/tree-il/compile-cps.scm (target-has-unbound-boxes?): (%box-ref): Only residualize an unbound check if the target has unbound boxes.
Diffstat (limited to 'module/language')
-rw-r--r--module/language/cps/guile-vm.scm5
-rw-r--r--module/language/tree-il/compile-cps.scm40
2 files changed, 32 insertions, 13 deletions
diff --git a/module/language/cps/guile-vm.scm b/module/language/cps/guile-vm.scm
index 772783349..193907f2b 100644
--- a/module/language/cps/guile-vm.scm
+++ b/module/language/cps/guile-vm.scm
@@ -31,7 +31,8 @@
#:export (make-lowerer
available-optimizations
target-symbol-hash
- target-symbol-hash-bits))
+ target-symbol-hash-bits
+ target-has-unbound-boxes?))
;; This hash function is originally from
;; http://burtleburtle.net/bob/c/lookup3.c by Bob Jenkins, May 2006,
@@ -107,3 +108,5 @@
(define (available-optimizations)
'())
+
+(define target-has-unbound-boxes? #t)
diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index 58e4ab9b7..8f638fd53 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -486,20 +486,36 @@
($continue k src
($primcall 'set-cdr! #f (pair val)))))))))
+(define target-has-unbound-boxes?
+ (let ((cache (make-hash-table)))
+ (lambda ()
+ (let ((rt (target-runtime)))
+ (match (hashq-get-handle cache rt)
+ ((k . v) v)
+ (#f (let ((iface (resolve-interface `(language cps ,rt))))
+ (define v (module-ref iface 'target-has-unbound-boxes?))
+ (hashq-set! cache rt v)
+ v)))))))
+
(define-primcall-converter %box-ref
(lambda (cps k src op param box)
- (define unbound
- #(misc-error "variable-ref" "Unbound variable: ~S"))
- (with-cps cps
- (letv val)
- (letk kunbound ($kargs () () ($throw src 'throw/value unbound (box))))
- (letk kbound ($kargs () () ($continue k src ($values (val)))))
- (letk ktest
- ($kargs ('val) (val)
- ($branch kbound kunbound src 'undefined? #f (val))))
- (build-term
- ($continue ktest src
- ($primcall 'box-ref #f (box)))))))
+ (cond
+ ((target-has-unbound-boxes?)
+ (define unbound
+ #(misc-error "variable-ref" "Unbound variable: ~S"))
+ (with-cps cps
+ (letv val)
+ (letk kunbound ($kargs () () ($throw src 'throw/value unbound (box))))
+ (letk kbound ($kargs () () ($continue k src ($values (val)))))
+ (letk ktest
+ ($kargs ('val) (val)
+ ($branch kbound kunbound src 'undefined? #f (val))))
+ (build-term
+ ($continue ktest src
+ ($primcall 'box-ref #f (box))))))
+ (else
+ (with-cps cps
+ ($continue k src ($primcall 'box-ref #f (box))))))))
(define-primcall-converter %box-set!
(lambda (cps k src op param box val)