diff options
Diffstat (limited to 'oop/goops.scm')
-rw-r--r-- | oop/goops.scm | 41 |
1 files changed, 36 insertions, 5 deletions
diff --git a/oop/goops.scm b/oop/goops.scm index ac5c4ef3f..dd993ded2 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -1055,17 +1055,48 @@ (vector-set! methods index m) m))))) -;; eval tricks are apparently to make the accessors as fast as possible -;; for the evaluator. when goops gets vm-aware, this will be different. +;; the idea is to compile the index into the procedure, for fastest +;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes. +(eval-case + ((load-toplevel compile-toplevel) + (use-modules ((language scheme translate) :select (define-scheme-translator)) + ((system il ghil) :select (make-ghil-inline)) + (system base pmatch)) + + ;; 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))))) + + (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))))))) + +;; Irritatingly, we can't use `compile' here, as the module shadows +;; the binding. (define (make-bound-check-get index) - (eval `(lambda (o) (@assert-bound-ref o ,index)) *goops-module*)) + ((@ (system base compile) compile) + `(lambda (o) (let ((x (@slot-ref o ,index))) + (if (unbound? x) + (slot-unbound obj) + x))) + *goops-module*)) (define (make-get index) - (eval `(lambda (o) (@slot-ref o ,index)) *goops-module*)) + ((@ (system base compile) compile) + `(lambda (o) (@slot-ref o ,index)) + *goops-module*)) (define (make-set index) - (eval `(lambda (o v) (@slot-set! o ,index v)) *goops-module*)) + ((@ (system base compile) compile) + `(lambda (o v) (@slot-set! o ,index v)) + *goops-module*)) (define bound-check-get (standard-accessor-method make-bound-check-get bound-check-get-methods)) |