mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

fix @slot-ref / @slot-set! compilation

Browse source 
* 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:
Andy Wingo 2009-05-20 13:59:42 +02:00
parent c11f46afe1
commit ad9b8c451b
3 changed files with 14 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

27
module/oop/goops.scm
View file

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