From 184332138129b45cf3985e70324e423b69544fd7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 15 Mar 2001 04:20:35 +0000 Subject: [PATCH] . original commit: db81df56ddf981a637eff54bdd6432b07019f05a --- collects/mred/private/kernel.ss | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss index 5a56ee89..4a6a8b53 100644 --- a/collects/mred/private/kernel.ss +++ b/collects/mred/private/kernel.ss @@ -11,21 +11,11 @@ (dynamic-require '#%mred-kernel 'initialize-primitive-object)) (define kernel:find-in-primitive-class (dynamic-require '#%mred-kernel 'find-in-primitive-class)) - (define kernel:primitive-class->method-name-list - (dynamic-require '#%mred-kernel 'primitive-class->method-name-list)) - (define kernel:primitive-class->method-vector - (dynamic-require '#%mred-kernel 'primitive-class->method-vector)) + (define kernel:primitive-class-find-method + (dynamic-require '#%mred-kernel 'primitive-class-find-method)) (define kernel:primitive-class-prepare-struct-type! (dynamic-require '#%mred-kernel 'primitive-class-prepare-struct-type!)) - ;; (require (prefix kernel: #%mred-kernel)) - - (define (find-method class name) - (let loop ([l (kernel:primitive-class->method-name-list class)][p 0]) - (if (eq? name (car l)) - (vector-ref (kernel:primitive-class->method-vector class) p) - (loop (cdr l) (add1 p))))) - (define-syntax define-constant (lambda (stx) (syntax-case stx () @@ -90,16 +80,17 @@ (define name (let ([c (dynamic-require '#%mred-kernel 'name)]) (make-primitive-class (lambda (class prop:object dispatcher) - (kernel:primitive-class-prepare-struct-type! c prop:object class dispatcher)) + (kernel:primitive-class-prepare-struct-type! + c prop:object class dispatcher)) kernel:initialize-primitive-object 'name super '(old ...) '(new ...) (list - (find-method c 'old) + (kernel:primitive-class-find-method c 'old) ...) (list - (find-method c 'new) + (kernel:primitive-class-find-method c 'new) ...)))))))))])))) (define-syntax define-class