mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Allow targets to preclude unbound variables

Browse source 
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.
This commit is contained in:
Andy Wingo 2023-11-23 12:31:38 +01:00
parent 83449a8683
commit 5ef0ea30fa
2 changed files with 32 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

5
module/language/cps/guile-vm.scm
View file

@ -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)

40
module/language/tree-il/compile-cps.scm
View file

@ -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)