mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 21:10:27 +02:00
fix @slot-ref / @slot-set! compilation
* module/language/tree-il/compile-glil.scm: Add primcall compilers for @slot-ref and @slot-set. * module/language/tree-il/optimize.scm (add-interesting-primitive!): New export. Creates an association between a variable in the current module and a primitive name. * module/oop/goops.scm: Rework compiler hooks to work with tree-il and not ghil.
This commit is contained in:
parent
c11f46afe1
commit
ad9b8c451b
3 changed files with 14 additions and 33 deletions
|
@ -32,7 +32,6 @@
|
|||
;;
|
||||
;; call-with-values -> mv-bind
|
||||
;; compile-time-environment
|
||||
;; GOOPS' @slot-ref, @slot-set
|
||||
;; basic degenerate-case reduction
|
||||
|
||||
;; allocation:
|
||||
|
@ -81,7 +80,9 @@
|
|||
((null? . 1) . null?)
|
||||
((list? . 1) . list?)
|
||||
(list . list)
|
||||
(vector . vector)))
|
||||
(vector . vector)
|
||||
((@slot-ref . 2) . slot-ref)
|
||||
((@slot-set! . 3) . slot-set)))
|
||||
|
||||
(define (make-label) (gensym ":L"))
|
||||
|
||||
|
|
|
@ -23,7 +23,7 @@
|
|||
#:use-module (system base syntax)
|
||||
#:use-module (language tree-il)
|
||||
#:use-module (language tree-il inline)
|
||||
#:export (optimize!))
|
||||
#:export (optimize! add-interesting-primitive!))
|
||||
|
||||
(define (env-module e)
|
||||
(if e (car e) (current-module)))
|
||||
|
@ -65,12 +65,13 @@
|
|||
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
|
||||
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr))
|
||||
|
||||
(define *interesting-primitive-vars*
|
||||
(let ((h (make-hash-table)))
|
||||
(for-each (lambda (x)
|
||||
(hashq-set! h (module-variable the-root-module x) x))
|
||||
*interesting-primitive-names*)
|
||||
h))
|
||||
(define (add-interesting-primitive! name)
|
||||
(hashq-set! *interesting-primitive-vars*
|
||||
(module-variable (current-module) name) name))
|
||||
|
||||
(define *interesting-primitive-vars* (make-hash-table))
|
||||
|
||||
(for-each add-interesting-primitive! *interesting-primitive-names*)
|
||||
|
||||
(define (resolve-primitives! x mod)
|
||||
(post-order!
|
||||
|
|
|
@ -1061,31 +1061,10 @@
|
|||
;; the idea is to compile the index into the procedure, for fastest
|
||||
;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes.
|
||||
|
||||
;; separate expression so that we affect the expansion of the subsequent
|
||||
;; expression
|
||||
(eval-when (compile)
|
||||
(use-modules ((language scheme compile-ghil) :select (define-scheme-translator))
|
||||
((language ghil) :select (make-ghil-inline make-ghil-call))
|
||||
(system base pmatch)))
|
||||
|
||||
(eval-when (compile)
|
||||
;; unfortunately, can't use define-inline because these are primitive
|
||||
;; syntaxen.
|
||||
(define-scheme-translator @slot-ref
|
||||
((,obj ,index) (guard (integer? index)
|
||||
(>= index 0) (< index max-fixnum))
|
||||
(make-ghil-inline #f #f 'slot-ref
|
||||
(list (retrans obj) (retrans index))))
|
||||
(else
|
||||
(make-ghil-call e l (retrans (car exp)) (map retrans (cdr exp)))))
|
||||
|
||||
(define-scheme-translator @slot-set!
|
||||
((,obj ,index ,val) (guard (integer? index)
|
||||
(>= index 0) (< index max-fixnum))
|
||||
(make-ghil-inline #f #f 'slot-set
|
||||
(list (retrans obj) (retrans index) (retrans val))))
|
||||
(else
|
||||
(make-ghil-call e l (retrans (car exp)) (map retrans (cdr exp))))))
|
||||
(use-modules ((language tree-il optimize) :select (add-interesting-primitive!)))
|
||||
(add-interesting-primitive! '@slot-ref)
|
||||
(add-interesting-primitive! '@slot-set!))
|
||||
|
||||
(eval-when (eval load compile)
|
||||
(define num-standard-pre-cache 20))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue