diff options
author | Andy Wingo <wingo@pobox.com> | 2009-05-20 13:59:42 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-05-20 13:59:42 +0200 |
commit | ad9b8c451b82f74cf88c5a6207ed3ea72c86f93e (patch) | |
tree | 092ae4f3646be48bb2da8282a0a336cb3dd6ef3e /module/oop | |
parent | c11f46afe113f50e34af33ad3055b3da66e4b71f (diff) | |
download | guile-ad9b8c451b82f74cf88c5a6207ed3ea72c86f93e.tar.gz |
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.
Diffstat (limited to 'module/oop')
-rw-r--r-- | module/oop/goops.scm | 27 |
1 files changed, 3 insertions, 24 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm index f84af33fc..d7220d470 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -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)) |