1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 15:00:21 +02:00

Add closure effects

* module/language/cps/effects-analysis.scm: Add closure effects, to
  enable hoisting/CSE of free-ref/free-set!.
This commit is contained in:
Andy Wingo 2015-07-27 15:11:09 +02:00
parent 90c11483e6
commit 48412395c6

View file

@ -63,6 +63,7 @@
&struct &struct
&string &string
&bytevector &bytevector
&closure
&object &object
&field &field
@ -180,7 +181,10 @@
;; Indicates that an expression depends on the contents of a ;; Indicates that an expression depends on the contents of a
;; bytevector. We cannot be more precise, as bytevectors may alias ;; bytevector. We cannot be more precise, as bytevectors may alias
;; other bytevectors. ;; other bytevectors.
&bytevector) &bytevector
;; Indicates a dependency on a free variable of a closure.
&closure)
(define-inlinable (&field kind field) (define-inlinable (&field kind field)
(ash (logior (ash field &memory-kind-bits) kind) &effect-kind-bits)) (ash (logior (ash field &memory-kind-bits) kind) &effect-kind-bits))
@ -373,6 +377,17 @@ is or might be a read or a write to the same location as A."
((bv-f32-set! bv n x) (&write-object &bytevector) &type-check) ((bv-f32-set! bv n x) (&write-object &bytevector) &type-check)
((bv-f64-set! bv n x) (&write-object &bytevector) &type-check)) ((bv-f64-set! bv n x) (&write-object &bytevector) &type-check))
;; Closures.
(define (closure-field n constants)
(indexed-field &closure n constants))
(define (read-closure-field n constants)
(logior &read (closure-field n constants)))
(define (write-closure-field n constants)
(logior &write (closure-field n constants)))
(define-primitive-effects* constants
((free-ref closure idx) (read-closure-field idx constants))
((free-set! closure idx val) (write-closure-field idx constants)))
;; Modules. ;; Modules.
(define-primitive-effects (define-primitive-effects
((current-module) (&read-object &module)) ((current-module) (&read-object &module))