1
#| objects.jl -- very basic OO system
3
$Id: objects.jl,v 1.6 2001/08/01 03:14:46 jsh Exp $
5
Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
7
This file is part of librep.
9
librep is free software; you can redistribute it and/or modify it
10
under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2, or (at your option)
14
librep is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
GNU General Public License for more details.
19
You should have received a copy of the GNU General Public License
20
along with Jade; see the file COPYING. If not, write to
21
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
(define-structure rep.data.objects
33
;; This module provides an extremely simple message-passing object
34
;; implementation, with support for single inheritance. The `object'
35
;; form expands to a lambda expression, hence it captures local
36
;; bindings for the method implementations.
40
;; (object BASE-OBJECT METHOD...)
42
;; each METHOD is either ((METHOD-NAME . PARAM-LIST) BODY...), or
43
;; (METHOD-NAME FUNCTION).
45
;; PARAM-LIST currently isn't the full lambda spec, just a list of
46
;; symbols. The list can be dotted to a symbol to make a #!rest
47
;; parameter. All parameters are optional (i.e. default to nil)
49
;; Any unknown methods are passed off to BASE-OBJECT, or if that is
50
;; nil, an `unknown-method' error is signalled.
52
;; Each object has the variable `self' bound to the closure
53
;; representing itself. (In superclasses, `self' points to the
54
;; subclass originally called into)
58
;; (define obj (object nil
59
;; ((foo a b) (+ a b))
62
;; (obj 'foo 2 1) => 3
63
;; (obj 'bar 2 1) => 1
64
;; (obj 'baz 2 1) error--> unknown method: baz
66
(define (make-let-bindings spec args-var)
67
(let loop ((rest spec)
70
(cond ((null rest) (nreverse out))
72
(loop '() (1+ i) (cons `(,rest (nthcdr ,i ,args-var)) out)))
73
((memq (car rest) '(#!optional #!rest #!key &optional &rest))
74
(error "Lambda-list keywords aren't implemented for objects: %s" spec))
75
(t (loop (cdr rest) (1+ i)
76
(cons `(,(car rest) (nth ,i ,args-var)) out))))))
78
(defmacro object (base-object . methods)
83
`(let ((,base ,base-object))
85
(lambda (,op #!key (self ,self) . ,args)
89
(cond ((consp (car method))
90
;; ((METHOD-NAME . PARAM-LIST) BODY...)
92
(let ,(make-let-bindings
95
((symbolp (car method))
96
;; (METHOD-NAME FUNCTION)
98
(apply ,(cadr method) ,args)))))
101
(apply ,base ,op #:self self ,args)
102
(signal 'unknown-method (list ,op))))))))
105
(define objectp closurep)
107
(put 'unknown-method 'error-message "Unknown method call"))
added
removed
lisp/rep/data/objects.jl
