diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
commit | 8466d8cfa486fb30d1755c4261b781135083787b (patch) | |
tree | c8c12c67246f543c3cc4f64d1c07e003cb1d45ae /object.scm | |
parent | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff) | |
download | slib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz slib-8466d8cfa486fb30d1755c4261b781135083787b.zip |
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'object.scm')
-rw-r--r-- | object.scm | 18 |
1 files changed, 8 insertions, 10 deletions
@@ -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)) - - |