diff options
author | Andy Wingo <wingo@pobox.com> | 2023-11-23 12:31:38 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-11-23 12:31:38 +0100 |
commit | 5ef0ea30faf9fa980681e3b6e24eb9a3884ec83d (patch) | |
tree | 8321ba6af9628cde4e53747b44460730b983545d /module/language | |
parent | 83449a8683abee5b71961f7fe891f3b8c894e14b (diff) | |
download | guile-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.scm | 5 | ||||
-rw-r--r-- | module/language/tree-il/compile-cps.scm | 40 |
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) |