From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:29 -0800 Subject: Import Upstream version 3a1 --- object.scm | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) (limited to 'object.scm') diff --git a/object.scm b/object.scm index 2055224..298baad 100644 --- a/object.scm +++ b/object.scm @@ -23,11 +23,11 @@ (if (object? obj) ((vector-ref obj 4)) (slib:error "Cannot get methods on non-object: " obj))) - +;@ (define (object? obj) (and (vector? obj) (eq? object:tag (vector-ref obj 0)))) - +;@ (define (make-method! obj generic-method method) (if (object? obj) (if (procedure? method) @@ -36,22 +36,22 @@ method) (slib:error "Method must be a procedure: " method)) (slib:error "Cannot make method on non-object: " obj))) - +;@ (define (get-method obj generic-method) (if (object? obj) ((vector-ref obj 1) generic-method) (slib:error "Cannot get method on non-object: " obj))) - +;@ (define (unmake-method! obj generic-method) (if (object? obj) ((vector-ref obj 3) generic-method) (slib:error "Cannot unmake method on non-object: " obj))) - +;@ (define (make-predicate! obj generic-predicate) (if (object? obj) ((vector-ref obj 2) generic-predicate (lambda (self) #t)) (slib:error "Cannot make predicate on non-object: " obj))) - +;@ (define (make-generic-method . exception-procedure) (define generic-method (lambda (obj . operands) @@ -70,7 +70,7 @@ (lambda (obj . params) (slib:error "Operation not supported: " obj)))) generic-method) - +;@ (define (make-generic-predicate) (define generic-predicate (lambda (obj) @@ -80,7 +80,7 @@ #f) #f))) generic-predicate) - +;@ (define (make-object . ancestors) (define method-list (apply append (map (lambda (obj) (get-all-methods obj)) ancestors))) @@ -95,5 +95,3 @@ (let ((method-def (assq generic-method method-list))) (if method-def (cdr method-def) #f))) (vector object:tag get-method make-method! unmake-method! all-methods)) - - -- cgit v1.2.3