Hello,
Readers of SICP (http://mitpress.mit.edu/sicp/sicp.html) are being
taught a simplified object oriented programming style using closures.
Here's a simple example (Scheme code):
(define (make-account balance)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (dispatch m)
(cond ((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else (error "Unknown request -- MAKE-ACCOUNT"
m))))
dispatch)
Usage:
(define acc (make-account 100))
((acc 'withdraw) 50)
50
((acc 'withdraw) 60)
"Insufficient funds"
((acc 'deposit) 40)
90
((acc 'withdraw) 60)
30
This style can be mimicked in Common Lisp, but looks much less elegant
because it has to be peppered with a fair amount of #' symbols and
funcall-s.
Here's a sample snipped - a queue object in Common Lisp:
(defun make-queue ()
(let ((front '())
(rear '()))
(labels (
(front-ptr ()
front)
(rear-ptr ()
rear)
(empty-queue? ()
(null front))
(set-front-ptr! (item)
(setf front item))
(set-rear-ptr! (item)
(setf rear item))
(front-queue ()
(if (empty-queue?)
(error "FRONT on empty queue")
(car front-ptr)))
(insert-queue! (item)
(let ((new-pair (cons item '())))
(cond ((empty-queue?)
(set-front-ptr! new-pair)
(set-rear-ptr! new-pair))
(t
(setf (cdr (rear-ptr)) new-pair)
(set-rear-ptr! new-pair)))))
(delete-queue! ()
(cond ((empty-queue?)
(error "DELETE! on empty queue"))
(t
(set-front-ptr!
(cdr (front-ptr))))))
(print-queue ()
(format t "~a~%" (front-ptr)))
(dispatch (m)
(case m
('front-ptr #'front-ptr)
('rear-ptr #'rear-ptr)
('empty-queue? #'empty-queue?)
('set-front-ptr! #'set-front-ptr!)
('set-rear-ptr! #'set-rear-ptr!)
('front-queue #'front-queue)
('insert-queue! #'insert-queue!)
('delete-queue! #'delete-queue!)
('print-queue #'print-queue)
(otherwise (error "Bad dispatch ~A" m)))))
#'dispatch)))
(defvar q (make-queue))
(funcall (funcall q 'insert-queue!) 't)
(funcall (funcall q 'insert-queue!) 'a)
(funcall (funcall q 'print-queue))
-----------
Rather than asking if there's a prettier way to accomplish the same in
CL, I think I should ask what is the accepted technique to writing
these objects in CL. I suspect "dispatch"ing isn't it, and most
probably CLOS is used.
I'd love to hear about the idiomatic approaches to write such code in
CL.
Thanks in advance
Eli
On Thu, 04 Oct 2007 06:44:21 +0000, Eli Bendersky wrote:
> Hello,
>
> Readers of SICP (http://mitpress.mit.edu/sicp/sicp.html) are being
> taught a simplified object oriented programming style using closures.
>
> Here's a simple example (Scheme code):
>
> (define (make-account balance)
> (define (withdraw amount)
> (if (>= balance amount)
> (begin (set! balance (- balance amount))
> balance)
> "Insufficient funds"))
> (define (deposit amount)
> (set! balance (+ balance amount))
> balance)
> (define (dispatch m)
> (cond ((eq? m 'withdraw) withdraw)
> ((eq? m 'deposit) deposit)
> (else (error "Unknown request -- MAKE-ACCOUNT"
> m))))
> dispatch)
>
> Usage:
>
> (define acc (make-account 100))
> ((acc 'withdraw) 50)
> 50
> ((acc 'withdraw) 60)
> "Insufficient funds"
> ((acc 'deposit) 40)
> 90
> ((acc 'withdraw) 60)
> 30
>
> This style can be mimicked in Common Lisp, but looks much less elegant
> because it has to be peppered with a fair amount of #' symbols and
> funcall-s.
It's funny you should choose these two examples (accounts and queues), as
they are so very similar to the ones i went looking for in PAIP to use as
examples.
In CL one uses CLOS when one needs its features, as it's a superset of any
toy object system you can cook up using closures. Norvig has code that
implements something similar to what you've done above, but he then
evolves the idea towards a CLOS like system very quickly. Have a look :
http://norvig.com/paip/clos.lisp
Rather than greenspun up a CLOS, it's a better idea to use the well
thought out system that comes standard. Saves time debugging too.
> Here's a sample snipped - a queue object in Common Lisp:
>
> (defun make-queue ()
> (let ((front '())
> (rear '()))
> (labels (
> (front-ptr ()
> front)
> (rear-ptr ()
> rear)
> (empty-queue? ()
> (null front))
> (set-front-ptr! (item)
> (setf front item))
> (set-rear-ptr! (item)
> (setf rear item))
> (front-queue ()
> (if (empty-queue?)
> (error "FRONT on empty queue")
> (car front-ptr)))
Missing some ()'s around front-ptr.
> (insert-queue! (item)
> (let ((new-pair (cons item '())))
> (cond ((empty-queue?)
> (set-front-ptr! new-pair)
> (set-rear-ptr! new-pair))
> (t
> (setf (cdr (rear-ptr)) new-pair)
> (set-rear-ptr! new-pair)))))
> (delete-queue! ()
> (cond ((empty-queue?)
> (error "DELETE! on empty queue"))
> (t
> (set-front-ptr!
> (cdr (front-ptr))))))
> (print-queue ()
> (format t "~a~%" (front-ptr)))
> (dispatch (m)
> (case m
> ('front-ptr #'front-ptr)
> ('rear-ptr #'rear-ptr)
> ('empty-queue? #'empty-queue?)
> ('set-front-ptr! #'set-front-ptr!)
> ('set-rear-ptr! #'set-rear-ptr!)
> ('front-queue #'front-queue)
> ('insert-queue! #'insert-queue!)
> ('delete-queue! #'delete-queue!)
> ('print-queue #'print-queue)
> (otherwise (error "Bad dispatch ~A" m)))))
CASE does not evaluate its arguments, so no need
for QUOTE.
>
> #'dispatch)))
>
> (defvar q (make-queue))
Now that's not quite fair. Scheme only has one namespace, so if you make
this (setf (symbol-function 'q) (make-queue)) you can eliminate one of the
funcalls below... and you forgot the *earmuffs* on q. Poor thing'll get
cold.
>
> (funcall (funcall q 'insert-queue!) 't)
becomes (funcall (q 'insert-queue) 't)).
Which is not so bad. And if you rename FUNCALL to SEND, you get an idea
what some of the early message passing OO systems for lisp were like,
before the ideas behind generic functions caught on.
> (funcall (funcall q 'insert-queue!) 'a)
>
> (funcall (funcall q 'print-queue))
>
> -----------
>
> Rather than asking if there's a prettier way to accomplish the same in
> CL, I think I should ask what is the accepted technique to writing these
> objects in CL. I suspect "dispatch"ing isn't it, and most probably CLOS
> is used.
>
> I'd love to hear about the idiomatic approaches to write such code in
> CL.
In the case of something like your queue, one would simply use a CONS or a
struct. You don't really need CLOS there, you've got no classes,
inheritance or method specializing going on. See Norvig's Queue just over
halfway down : http://norvig.com/paip/auxfns.lisp
If what you're trying to achieve is the encapsulation of the
messages/methods/functions that you ultimately dispatch, so as not to
clutter your namespace, that's what the package system is for. No need to
worry about clobbering everything, like in some other LISP likes languages
i know ;).
One simply makes a queue package, and defines your functions in it. I
think this more closely mimics what the scheme-like code actually
achieves, only it uses a package and regular functions rather than a
closure and a dispatching function.
(defvar *q* (q:make))
(queue:insert *q* 't)
(queue:insert *q* 'a)
(queue:print *q*)
No #'s or FUNCALLs to be found, and one less set of parens than in scheme!
If you really wanted to make extensible queues, then you want
CLOS. Subclassing queue and specializing on its methods is something CLOS
makes easy, and that something isn't really handled at all in your
dispatch-with-closures examples.
With your simple examples, one needs nothing more than structs and defuns.
But if it's objects and methods you seek, CLOS is the way to go.
hth,
drewc
>
> Thanks in advance
> Eli
--
Posted via a free Usenet account from http://www.teranews.com
On Oct 4, 10:03 am, Drew Crampsie <·············@gmail.com> wrote:
> On Thu, 04 Oct 2007 06:44:21 +0000, Eli Bendersky wrote:
> > Hello,
>
> > Readers of SICP (http://mitpress.mit.edu/sicp/sicp.html) are being
> > taught a simplified object oriented programming style using closures.
>
> > Here's a simple example (Scheme code):
>
> > (define (make-account balance)
> > (define (withdraw amount)
> > (if (>= balance amount)
> > (begin (set! balance (- balance amount))
> > balance)
> > "Insufficient funds"))
> > (define (deposit amount)
> > (set! balance (+ balance amount))
> > balance)
> > (define (dispatch m)
> > (cond ((eq? m 'withdraw) withdraw)
> > ((eq? m 'deposit) deposit)
> > (else (error "Unknown request -- MAKE-ACCOUNT"
> > m))))
> > dispatch)
>
> > Usage:
>
> > (define acc (make-account 100))
> > ((acc 'withdraw) 50)
> > 50
> > ((acc 'withdraw) 60)
> > "Insufficient funds"
> > ((acc 'deposit) 40)
> > 90
> > ((acc 'withdraw) 60)
> > 30
>
> > This style can be mimicked in Common Lisp, but looks much less elegant
> > because it has to be peppered with a fair amount of #' symbols and
> > funcall-s.
>
> It's funny you should choose these two examples (accounts and queues), as
> they are so very similar to the ones i went looking for in PAIP to use as
> examples.
>
> In CL one uses CLOS when one needs its features, as it's a superset of any
> toy object system you can cook up using closures. Norvig has code that
> implements something similar to what you've done above, but he then
> evolves the idea towards a CLOS like system very quickly. Have a look :http://norvig.com/paip/clos.lisp
>
> Rather than greenspun up a CLOS, it's a better idea to use the well
> thought out system that comes standard. Saves time debugging too.
> <snip>
Thanks for the interesting explanation.
I have a followup question. In SICP, another example involves a
simplified digital simulation program (full code in
http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-22.html#%_sec_3.3.4).
There, the authors employ closures to pass "callbacks" with state
between objects (where objects are the "dispatch"-ing lambdas in my
original question). It looks roughly like this (full code in the link
above):
(define (inverter input output)
(define (invert-input)
(let ((new-value (logical-not (get-signal input))))
(after-delay inverter-delay
(lambda ()
(set-signal! output new-value)))))
(add-action! input invert-input)
'ok)
Note the call to add-action, providing the "invert-input" closure that
caught lexical state of "inverter".
add-action! is defined by:
(define (make-wire)
(let ((signal-value 0) (action-procedures '()))
(define (set-my-signal! new-value)
(if (not (= signal-value new-value))
(begin (set! signal-value new-value)
(call-each action-procedures))
'done))
(define (accept-action-procedure! proc)
(set! action-procedures (cons proc action-procedures))
(proc))
(define (dispatch m)
(cond ((eq? m 'get-signal) signal-value)
((eq? m 'set-signal!) set-my-signal!)
((eq? m 'add-action!) accept-action-procedure!)
(else (error "Unknown operation -- WIRE" m))))
dispatch))
(define (add-action! wire action-procedure)
((wire 'add-action!) action-procedure))
My question is: is it possible to pass an object's method (CLOSsy
"defmethod" definition) similarly ?
>From experience with OOP in C++, I know that these occasions on which
you want to pass objects to other objects cause most leaky
abstractions. Sometimes all that's needed is a callback that has some
internal state. But in languages like C++ that's hardly possible, so
whole objects are passed. Some bright engineers create delightful
hacks like Qt's signal/slot mechanism to work around these limitations
in highly non-standard ways. I imagine that the easy closures of Lisp
make this leaky abstraction go away, as is beautifully shown in the
example above.
However, how would I do it with CLOS ?
Thanks
Eli
Eli Bendersky wrote:
> My question is: is it possible to pass an object's method (CLOSsy
> "defmethod" definition) similarly ?
There is no such thing as "an object's method" in CLOS. Methods belong
to generic functions, and generic functions exist independently of
classes or objects.
[It is possible to define methods _on_ objects using eql specializers,
but that's not what you mean here, I suppose.]
It is also not straightforward to pass methods around - or better, it is
not that useful, because it is not straightforward to funcall or apply
methods. For callbacks, you typically rather pass functions around
(which may be plain functions, generic functions or closures).
Furthermore, it's rare that methods close over some lexical variables.
Typically, defmethods are used as top-level definitions. (They can be
used locally, and correctly close over lexical variables then - it's
just rare, as far as I can tell.)
>>From experience with OOP in C++, I know that these occasions on which
> you want to pass objects to other objects cause most leaky
> abstractions. Sometimes all that's needed is a callback that has some
> internal state. But in languages like C++ that's hardly possible, so
> whole objects are passed. Some bright engineers create delightful
> hacks like Qt's signal/slot mechanism to work around these limitations
> in highly non-standard ways. I imagine that the easy closures of Lisp
> make this leaky abstraction go away, as is beautifully shown in the
> example above.
>
> However, how would I do it with CLOS ?
'Pure' CLOS programs are rare. In almost all cases, CLOS and other
Common Lisp concepts are mixed and used together in the same programs.
It seems to me that you would do exactly the same in Common Lisp as in
the SICP example, simply pass a closure around.
Pascal
P.S.: In Dylan, object-oriented concepts and functional concepts are
even closer integrated than in CLOS. There, functions and methods are
actually the same concepts (and functions can be grouped to generic
functions). Dylan is derived from CLOS, but closer to Scheme in other
respects, so you may want to take a look at that, depending on your
interests.
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
In article <·······················@n39g2000hsh.googlegroups.com>,
Eli Bendersky <······@gmail.com> wrote:
> I have a followup question. In SICP, another example involves a
> simplified digital simulation program (full code in
> http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-22.html#%_sec_3.3.4).
> There, the authors employ closures to pass "callbacks" with state
> between objects (where objects are the "dispatch"-ing lambdas in my
> original question). It looks roughly like this (full code in the link
> above):
>
> (define (inverter input output)
...
> (define (make-wire)
...
Note that you write about the same code in Common Lisp using ordinary functions.
>
> My question is: is it possible to pass an object's method (CLOSsy
> "defmethod" definition) similarly ?
Methods don't belong to classes. Methods are also not called by ordinary
user code.
Methods belong to 'generic functions'.
Say you have a class ship and a class crane.
(defclass ship () ())
(defclass crane () ())
Now you want to unload a ship with a crane.
This is the definition of the generic function, which does not much - well
it defines something.
(defgeneric unload (ship crane))
(defmethod unload ((a-ship ship) (a-crane crane))
...)
Now, where does the method belong to? To a class? No.
It belongs to the generic function UNLOAD.
Now there is a restriction: METHODS are usually defined at top-level without
capturing bindings. There is no form to define methods locally.
(though you can work around that with the MOP).
There were attempts to provide those (GENERIC-FUNCTION,
GENERIC-FLET and GENERIC-LABELS in CLtL2), but they have been not
defined for ANSI Common Lisp.
So you don't use lexical references in METHODS to outside variables.
What you do is:
1) always pass things you need in your functions as arguments (as objects)
2) set up some dynamic binding
3) write a method combination
4) define specialized generic functions
1) is very common and you get clear code
2) is also used for example
(defmethod unload :around (a-ship a-crane)
(ensure-ship-is-safe)
(ensure-crane-is-safe)
(let ((*safe-working-environment* t))
(declare (special *safe-working-environment*))
(call-next-method)))
(defmethod unload ((a-ship ship) (a-crane crane))
(when (not *safe-working-environment*)
(error "No safe working environment"))
...)
In this case the around method sets up some dynamic binding which is
still accessible when the primary method runs.
3) is advanced
4) is even more advanced
>
> >From experience with OOP in C++, I know that these occasions on which
> you want to pass objects to other objects cause most leaky
> abstractions. Sometimes all that's needed is a callback that has some
> internal state. But in languages like C++ that's hardly possible, so
> whole objects are passed. Some bright engineers create delightful
> hacks like Qt's signal/slot mechanism to work around these limitations
> in highly non-standard ways. I imagine that the easy closures of Lisp
> make this leaky abstraction go away, as is beautifully shown in the
> example above.
>
> However, how would I do it with CLOS ?
You write the methods with CLOS, but the closures are ordinary anonymous
functions and their bindings.
Example style:
(let ((button (find-button-named some-view 'quit-button)))
(n-clicked 0))
(set-dialog-item-action button (lambda (button)
(speak (format nil "the number of button clicks is ~a" n-clicked))
(incf n-clicked)))))
So, a typical DIALOG-ITEM has following definition:
(defclass DIALOG-ITEM (view-item)
(...
(action ...) ; it has an action slot
...))
Then the framework has also a method
(defmethod dialog-item-action ((item dialog-item))
(when (and (slot-bound-p item 'action)
(or (symbolp (slot-value item 'action))
(functionp (slot-value item 'action))))
(funcall (slot-value item 'action) item))
(call-next-method))
So in this example you can store a callback function in the object and
the framework will call that callback function when it
thinks it is a good time (for example somebody clicked
on this button). It is just that the callbacks are the usual
functions - and not generic functions - if you need a closure.
>
> Thanks
> Eli
--
http://lispm.dyndns.org
<snip>
> So you don't use lexical references in METHODS to outside variables.
>
> What you do is:
>
> 1) always pass things you need in your functions as arguments (as objects)
> 2) set up some dynamic binding
> 3) write a method combination
> 4) define specialized generic functions
>
> 1) is very common and you get clear code
> 2) is also used for example
>
> (defmethod unload :around (a-ship a-crane)
> (ensure-ship-is-safe)
> (ensure-crane-is-safe)
> (let ((*safe-working-environment* t))
> (declare (special *safe-working-environment*))
> (call-next-method)))
>
> (defmethod unload ((a-ship ship) (a-crane crane))
> (when (not *safe-working-environment*)
> (error "No safe working environment"))
> ...)
>
> In this case the around method sets up some dynamic binding which is
> still accessible when the primary method runs.
Interesting. I didn't imagine such a thing is possible in CL. Is it
really being used ? How long does *safe-working-environment* last, is
it until the end of the /let/ ?
>
> 3) is advanced
> 4) is even more advanced
>
>
>
> > >From experience with OOP in C++, I know that these occasions on which
> > you want to pass objects to other objects cause most leaky
> > abstractions. Sometimes all that's needed is a callback that has some
> > internal state. But in languages like C++ that's hardly possible, so
> > whole objects are passed. Some bright engineers create delightful
> > hacks like Qt's signal/slot mechanism to work around these limitations
> > in highly non-standard ways. I imagine that the easy closures of Lisp
> > make this leaky abstraction go away, as is beautifully shown in the
> > example above.
>
> > However, how would I do it with CLOS ?
>
> You write the methods with CLOS, but the closures are ordinary anonymous
> functions and their bindings.
>
> Example style:
>
> (let ((button (find-button-named some-view 'quit-button)))
> (n-clicked 0))
> (set-dialog-item-action button (lambda (button)
> (speak (format nil "the number of button clicks is ~a" n-clicked))
> (incf n-clicked)))))
>
> So, a typical DIALOG-ITEM has following definition:
>
> (defclass DIALOG-ITEM (view-item)
> (...
> (action ...) ; it has an action slot
> ...))
>
> Then the framework has also a method
>
> (defmethod dialog-item-action ((item dialog-item))
> (when (and (slot-bound-p item 'action)
> (or (symbolp (slot-value item 'action))
> (functionp (slot-value item 'action))))
> (funcall (slot-value item 'action) item))
> (call-next-method))
>
> So in this example you can store a callback function in the object and
> the framework will call that callback function when it
> thinks it is a good time (for example somebody clicked
> on this button). It is just that the callbacks are the usual
> functions - and not generic functions - if you need a closure.
>
This is a good example, thanks. I guess I'll just try to re-code the
program in the book with CL using CLOS for the classes and see if it
works.
Eli
On 2007-10-04 10:00:25 -0400, Eli Bendersky <······@gmail.com> said:
> How long does *safe-working-environment* last, is
> it until the end of the /let/ ?
<http://www.flownet.com/ron/specials.pdf>
In article <························@g4g2000hsf.googlegroups.com>,
Eli Bendersky <······@gmail.com> wrote:
> > 2) set up some dynamic binding
...
> > 2) is also used for example
> >
> > (defmethod unload :around (a-ship a-crane)
> > (ensure-ship-is-safe)
> > (ensure-crane-is-safe)
> > (let ((*safe-working-environment* t))
> > (declare (special *safe-working-environment*))
> > (call-next-method)))
> >
> > (defmethod unload ((a-ship ship) (a-crane crane))
> > (when (not *safe-working-environment*)
> > (error "No safe working environment"))
> > ...)
> >
> > In this case the around method sets up some dynamic binding which is
> > still accessible when the primary method runs.
>
> Interesting. I didn't imagine such a thing is possible in CL. Is it
> really being used ? How long does *safe-working-environment* last, is
> it until the end of the /let/ ?
The binding is available as long as the code inside (and everything that is called from there)
the LET runs. So the availability depends on the runtime. There are several things
which setup and use such runtime 'environments'.
Special variables are often used when you want to set up some variable only
for some time and then have the possibly shadowed value back.
Some code uses special variables. For example *standard-output* holds the
current default stream for output. Another example is the the printer, which
uses a few variables for default values.
Imagine some complicated print (output some values) functionality in a function.
You have several methods like this
(defmethod hairy-output-fn (data stream)
...)
(defmethod hairy-output-fn :before (data stream)
...)
Now you want that inside all these methods numbers are printed in hex by default.
You set up the special variable *print-base*. Usually *print-base*
is 10.
(defmethod hairy-output-fn :around (data stream)
(let ((*print-base* 16))
(call-next-method)))
Now the other methods of HAIRY-OUTPUT-FN will run with the variable
*PRINT-BASE* bound to 16.
Sometimes these effects are hidden behind a macro, so you see in
the source code something else:
(defmethod hairy-output-fn :around (data stream)
(with-default-hex-print-environment
(call-next-method)))
--
http://lispm.dyndns.org
<snip>
> So, a typical DIALOG-ITEM has following definition:
>
> (defclass DIALOG-ITEM (view-item)
> (...
> (action ...) ; it has an action slot
> ...))
>
> Then the framework has also a method
>
> (defmethod dialog-item-action ((item dialog-item))
> (when (and (slot-bound-p item 'action)
> (or (symbolp (slot-value item 'action))
> (functionp (slot-value item 'action))))
> (funcall (slot-value item 'action) item))
> (call-next-method))
>
<snip>
OK, heeding the advice I received in this thread, I implemented "wire"
as a CLOS class and defined the appropriate generics and methods for
it. I chose a class eventually (and not a struct with closures) to
allow extension, because it appears to me that such a "wire" class
might be extended with special wire types. Moreover, the CLOS
":before" method feature can be useful for installing monitors on
methods.
Here's the implementation:
;;;;;;;;;;;;;;;;;;;;;; Wire ;;;;;;;;;;;;;;;;;;;;;;
;;
(defclass wire ()
( (signal-value
:initform 0
:documentation
"The signal associated with the wire")
(action-procedures
:initform '()
:documentation
"Procedures that are executed when there's
an event on the wire")))
(defun make-wire ()
(make-instance 'wire))
(defgeneric get-signal (w)
(:documentation "Get the value of wire's signal"))
(defmethod get-signal ((w wire))
(slot-value w 'signal-value))
(defgeneric set-signal! (w new-value)
(:documentation "Sets a signal value on the wire"))
(defmethod set-signal! ((w wire) new-value)
(with-slots (signal-value action-procedures) w
(cond
((= signal-value new-value) 'done)
(t
(setf signal-value new-value)
(call-each action-procedures)))))
(defgeneric add-action! (w proc)
(:documentation "Add a new action procedure"))
(defmethod add-action! ((w wire) proc)
(with-slots (action-procedures) w
(push proc action-procedures)))
(defmethod print-object ((w wire) stream)
(print-unreadable-object (w stream :type t)
(with-slots ( (sv signal-value)
(ap action-procedures)) w
(format stream "Sig: ~a, N procs: ~a"
sv (length ap)))))
(defun call-each (procs)
(dolist (proc procs)
(funcall proc)))
And now I can also define the "inverter" function as follows:
(defun inverter (input output)
(flet ((invert-input ()
(let ((new-value
(logical-not (get-signal input))))
(after-delay
*inverter-delay*
(lambda ()
(set-signal! output new-value))))))
(add-action! input #'invert-input)
'ok))
Indeed, there appears to be no "conflict of interests" between input
and output being objects and passing closures that access them around.
I'm pretty satisfied with the result and hope I didn't do any obvious
goof-ups with the CLOS code.
Thanks for all the help
Eli
Eli Bendersky <······@gmail.com> wrote:
+---------------
| OK, heeding the advice I received in this thread, I implemented "wire"
| as a CLOS class and defined the appropriate generics and methods for
| it. I chose a class eventually (and not a struct with closures) to
| allow extension, because it appears to me that such a "wire" class
| might be extended with special wire types. ...
+---------------
Great! Here's a hopefully-simple exercise for you: Redfine your WIRE
type so that the SIGNAL-VALUE is constrained to exactly four values:
0, 1, Z, & X (or in CL, maybe 0, 1, nil, & T would be better choices,
you decide), where the SIGNAL-VALUE of a WIRE is:
0 if the wire is connected to one or more drivers which are
actively driving a "0", and is connected to no drivers which
are actively driving a "1". Any number of connected drivers
may also be driving with "Z"; they have no effect as long as
at least one driver is driving a "0".
1 if the wire is connected to one or more drivers which are
actively driving a "1", and is connected to no drivers which
are actively driving a "0". Any number of connected drivers
may also be driving with "Z"; they have no effect as long as
at least one driver is driving a "1".
Z if all of the drivers connected to the wire are driving with "Z".
X in any other case. That is, if the wire is being driven to
"1" by some driver(s) and "0" by other(s), or if *any* driver
is driving an "X". [I.e., a "bus collision" or otherwise
indeterminate state.]
Now also redefine all of your gates to implement their logic in
a similar fashion, e.g., the tables for NOT, TRI, OR, & AND become
as follows [note that any "Z" as an input must be treated as an
"X" value, since it's level is arbitrary & unknown]:
NOT (inverter) TRI (non-inverting driver with output enable)
Input | Output Input | Enable | Output
------+------- ------+--------+-------
0 | 1 0 | 1 | 0
1 | 0 1 | 1 | 1
Z | X Z | 1 | X
X | X X | 1 | X
(any)| 0 | Z
OR Input1 AND Input1
\ 0 1 Z X \ 0 1 Z X
I +----------- I +-----------
n 0 | 0 1 X X n 0 | 0 0 X X
p 1 | 1 1 X X p 1 | 0 1 X X
u Z | X X X X u Z | X X X X
t X | X X X X t X | X X X X
2 2
When the outputs of several gates are connected to the same wire,
the result is adjusted according to the SIGNAL-VALUE definitions
given above.
This is not a pointless exercise, since this is actually how hardware
simulation languages such as Verilog represent values [well, at least
for the "behavioral" parts of a design, as well as in the C FFI].
Advanced exercise: Now that you've got all *that* working, add
a subclass of WIRE called, say, WIRE/LIGHT-PULLUP, which never
resolves to the value of "Z". Instead, if the resulting SIGNAL-VALUE
would be "Z", let it be "1" instead. Verify that this doesn't
break anything else.
*Really* advanced exercise: Add floating-point "strengths" to all
wires and gate outputs, something like:
(declare-strength (TRI (0 3.4) (1 0.75) (Z .005))
(NOT (0 3) (1 3))
(AND (0 3) (1 3))
(AND (0 3) (1 3))
(WIRE)
(WIRE/LIGHT-PULLUP (1 .05)))
plus some way [not shown here, 'cuz I'm not sure what syntax I'd use]
for declaring how/when to map a collection of drive strengths into
an "X" or a "Z". That is, you should be able to say something like,
"When the sum of all drive strengths is less than .1, the result
is a Z" or "When the sum of drive-to-1 strengths is greater than 1.0
*and* the sum of drive-to-{0,Z} strengths is less than 0.2, then it's
a 1", or "When at least any two of the sums of drive-to-{0,1,X} is
greater than 0.3, then the result is an X". That sort of thing.
These rules should be properties of the respective circuit element
classes, and overrideable in subclasses [hmmm... or maybe using mixins,
that might be better], so you don't have to individually declare the
strengths of each WIRE or TRI instance.
Now you're starting to get close to how a *real* hardware simulation
language works... ;-}
-Rob
p.s. Oops! I forgot to mention: Semi-orthogonally to drive strengths,
add the concept of gate and/or wire "delays", which delay the effect
of changes in inputs on outputs. Advanced version: Make each delay come
in two parts: the delay from an input change until the output *can*
change, and the delay from an input change until the output *must*
change. Between those two times, the output must drive "X".
[Delays are only semi-orthogonal to drive strengths, since if you
want to get *really* advanced you put delay parameters *on* drive
strengths! That is, during the first "t0" ns the output doesn't
change; then until "t1" it drives an "X" with strength "s1", and
then at "t2" it drives the correct output (computed from the inputs),
but only at strength "s2". And finally, at "t3" it drives the same
value as at "t2", but now with strength "s3". And of course, each
of those strengths is actually a vector of drive-{0,1,Z,X} strengths,
depending upon what the computed output of the component is.]
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
SCNR. (Will the modeling approach I outline be sufficient ?)
* (Rob Warnock) <································@speakeasy.net> :
| Eli Bendersky <······@gmail.com> wrote:
| +---------------
| | OK, heeding the advice I received in this thread, I implemented "wire"
| | as a CLOS class and defined the appropriate generics and methods for
| | it. I chose a class eventually (and not a struct with closures) to
| | allow extension, because it appears to me that such a "wire" class
| | might be extended with special wire types. ...
| +---------------
|
| Great! Here's a hopefully-simple exercise for you: Redfine your WIRE
| type so that the SIGNAL-VALUE is constrained to exactly four values:
| 0, 1, Z, & X (or in CL, maybe 0, 1, nil, & T would be better choices,
| you decide), where the SIGNAL-VALUE of a WIRE is:
;; Use a GATE class that wraps up the the bare thunk abstraction
;; presented in SICP: a GATE has upto two input wires going in an and an
;; output wire coming out. The values are driven by a generic function
;; DRIVER.
(deftype signal-value () '(member 1 0 Z X))
(defclass wire ()
((signal-value :initform 0 :type signal-value :reader get-signal
:writer set-signal)
(gates :initform nil :accessor gates)))
(defclass gate ()
((output :type wire :initarg :output :reader output)))
(defclass gate1 (gate)
((input1 :type wire :initarg :input1 :reader input1)))
(defclass gate2 (gate1)
((input2 :type wire :initarg :input2 :reader input2)))
(defgeneric inputs (gate)
(:method ((gate gate1)) (list (input1 gate)))
(:method ((gate gate2)) (list (input1 gate) (input2 gate))))
(defgeneric driver (gate))
(defmethod set-signal :around (new-value (wire wire))
(let ((old-value (get-signal wire)))
(prog1 (call-next-method)
(unless (eql old-value new-value)
(map nil #'driver (gates wire))))))
(defun %findgate (gate-type gates output &rest inputs)
(find-if (lambda (gate)
(and (typep gate gate-type)
(eql output (output gate))
(endp (set-difference (inputs gate) inputs))))
gates))
;;;
;;;
(defclass and-gate (gate2) ())
(defvar *and-gate-delay* 3)
(defmethod driver ((and-gate and-gate))
(with-slots (input1 input2 output) and-gate
(let ((new-value (logical-and (get-signal input1) (get-signal input2)))
(output output))
(after-delay *and-gate-delay*
(lambda () (set-signal new-value output))))))
(defun and-gate (a1 a2 output)
(or (%findgate 'and-gate (gates a1) output a1 a2)
(let ((gate (make-instance 'and-gate :input1 a1 :input2 a2
:output output)))
(push gate (gates a1))
(push gate (gates a2))
(driver gate)
gate)))
;;;
;;;
(defclass inverter (gate1) ())
(defvar *inverter-delay* 2)
(defmethod driver ((not-gate inverter))
(let ((new-value (logical-not (get-signal (input1 not-gate))))
(output (output not-gate)))
(after-delay *inverter-delay* (lambda () (set-signal new-value
output)))))
(defun inverter (input output)
(or (%findgate 'inverter (gates input) output input)
(let ((gate (make-instance 'inverter :input1 input :output output)))
(push gate (gates input))
(driver gate)
gate)))
;;;
;;;
(defclass or-gate (gate2) ())
(defvar *or-gate-delay* 5)
(defmethod driver ((or-gate or-gate))
(let ((new-value (logical-or (get-signal (input1 or-gate))
(get-signal (input2 or-gate))))
(output (output or-gate)))
(after-delay *or-gate-delay* (lambda () (set-signal new-value
output)))))
(defun or-gate (a1 a2 output)
(or (%findgate 'or-gate (gates a1) output a1 a2)
(let ((gate (make-instance 'or-gate :input1 a1 :input2 a2
:output output)))
(push gate (gates a1))
(push gate (gates a2))
(driver gate)
gate)))
;;; Now Model the situation where ``output of several-gates are
;;; connected to the same wire'' using a CONNECTOR object. This has One
;;; output wire and several iinput wires. (defclass connector (gate)
;;; ((inputs :initform nil :initarg :inputs)))
(defmethod inputs ((connector connector))
(with-slots (inputs) connector
inputs))
(defun connect-outputs-of-gates-with-wire (gates wire)
(make-instance 'connector :inputs (mapcar #'output gates) :output wire))
#||
| 0 if the wire is connected to one or more drivers which are
| actively driving a "0", and is connected to no drivers which
| are actively driving a "1". Any number of connected drivers
| may also be driving with "Z"; they have no effect as long as
| at least one driver is driving a "0".
|
| 1 if the wire is connected to one or more drivers which are
| actively driving a "1", and is connected to no drivers which
| are actively driving a "0". Any number of connected drivers
| may also be driving with "Z"; they have no effect as long as
| at least one driver is driving a "1".
|
| Z if all of the drivers connected to the wire are driving with "Z".
|
| X in any other case. That is, if the wire is being driven to
| "1" by some driver(s) and "0" by other(s), or if *any* driver
| is driving an "X". [I.e., a "bus collision" or otherwise
| indeterminate state.]
||#
;; These rules would go into a driver method:
(defmethod driver ((gate connector))
(let* ((inputs (inputs gate))
(output (output gate))
(new-value
(cond ((and (some (lambda (s) (eql s 0)) inputs)
(notany (lambda (s) (eql s 1)) inputs)
(notany (lambda (s) (eql s 'X)) inputs)) 0)
((and (some (lambda (s) (eql s 1)) inputs)
(notany (lambda (s) (eql s 0)) inputs)
(notany (lambda (s) (eql s 'X)) inputs)) 1)
((every (lambda (s) (eql s 'Z)) inputs) 'Z)
(t 'X))))
(after-delay *and-gate-delay* (lambda () (set-signal new-value output)))))
#||
| Now also redefine all of your gates to implement their logic in
| a similar fashion, e.g., the tables for NOT, TRI, OR, & AND become
| as follows [note that any "Z" as an input must be treated as an
| "X" value, since it's level is arbitrary & unknown]:
|
| NOT (inverter) TRI (non-inverting driver with output enable)
| Input | Output Input | Enable | Output
| ------+------- ------+--------+-------
| 0 | 1 0 | 1 | 0
| 1 | 0 1 | 1 | 1
| Z | X Z | 1 | X
| X | X X | 1 | X
| (any)| 0 | Z
|
| OR Input1 AND Input1
| \ 0 1 Z X \ 0 1 Z X
| I +----------- I +-----------
| n 0 | 0 1 X X n 0 | 0 0 X X
| p 1 | 1 1 X X p 1 | 0 1 X X
| u Z | X X X X u Z | X X X X
| t X | X X X X t X | X X X X
| 2 2
| When the outputs of several gates are connected to the same wire,
| the result is adjusted according to the SIGNAL-VALUE definitions
| given above.
||#
;; XXX How would TRI be used in this framework? For the other functions
;; we used above:
(defun logical-not (a)
(ecase a (0 1) (1 0) (Z 'X) (X 'Z)))
(defun logical-or (a b)
(ecase a
(0 (ecase b (0 0) (1 1) (Z 'X) (X 'X)))
(1 (ecase b (0 1) (1 1) (Z 'X) (Z 'X)))
(Z (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))
(X (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))))
(defun logical-and (a b)
(ecase a
(0 (ecase b (0 0) (1 0) (Z 'X) (X 'X)))
(1 (ecase b (0 0) (1 1) (Z 'X) (Z 'X)))
(Z (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))
(X (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))))
;; IRL we would use a priority queue but for testing this we can add
;; simple framework bits:
(defstruct queue front tail-cons)
(defun dequeue (queue)
"Remove and return the first item of QUEUE's list"
(let ((tail-cons (queue-tail-cons queue))
(old-queue (queue-front queue)))
(cond ((endp old-queue) (cerror "Return NIL" "Queue Empty"))
(T (prog1 (car old-queue)
(setf (queue-front queue) (cdr old-queue))
(when (eq old-queue tail-cons)
(setf (queue-tail-cons queue) nil)))))))
(defstruct event (timeout 0) thunk)
(defvar *event-queue* (make-queue))
(defvar *global-clock* 0)
(defun after-delay (delay thunk &key (event-queue *event-queue*)
(global-clock *global-clock*))
(let* ((event-timeout (+ global-clock delay))
(item (make-event :timeout event-timeout :thunk thunk))
(tail-cons (queue-tail-cons event-queue))
(list (queue-front event-queue)))
(if (or (endp list) (<= event-timeout (event-timeout (car list))))
(let ((new-cons (cons item list))) ; add at front of event queue
(setf (queue-front event-queue) new-cons)
(unless tail-cons (setf (queue-tail-cons event-queue) new-cons)))
(loop for prev-cons = list then head ; insert sorted
for head on (cdr list)
if (<= event-timeout (event-timeout (car head)))
do (loop-finish) finally
(let ((new-cons (cons item head)))
(setf (cdr prev-cons) new-cons)
(unless head (setf (queue-tail-cons event-queue) new-cons)))))))
(defun propagate (&key (event-queue *event-queue*))
(loop for x = (queue-front event-queue) while x do
(let* ((event (dequeue event-queue))
(thunk (event-thunk event)))
(assert (>= (event-timeout event) *global-clock*))
(setq *global-clock* (event-timeout event))
(when thunk (funcall thunk))))
*global-clock*)
;; and test the half adder like this:
(defun half-adder (a b s c)
(let ((d (make-instance 'wire :name 'd))
(e (make-instance 'wire :name 'e)))
(or-gate a b d)
(and-gate a b c)
(inverter c e)
(and-gate d e s)
(values d e)))
#||
(setq *global-clock* 0 *event-queue* (make-queue))
(defvar $input-1 (make-instance 'wire))
(defvar $input-2 (make-instance 'wire))
(defvar $sum (make-instance 'wire))
(defvar $carry (make-instance 'wire))
(half-adder $input-1 $input-2 $sum $carry)
(set-signal 1 $input-2)
(propagate)
(get-signal $sum)
||#
#:END
| Advanced exercise: Now that you've got all *that* working, add
| a subclass of WIRE called, say, WIRE/LIGHT-PULLUP, which never
| resolves to the value of "Z". Instead, if the resulting SIGNAL-VALUE
| would be "Z", let it be "1" instead. Verify that this doesn't
| break anything else.
I'm not sure what this means. Do you think the stuff above models your
requirements correctly so far?
I havent risked hurting my head reading below this :)
<snip>
--
Madhu
SCNR. (Will the modeling approach I outline be sufficient ?) [superseded]
* (Rob Warnock) <································@speakeasy.net> :
| Eli Bendersky <······@gmail.com> wrote:
| +---------------
| | OK, heeding the advice I received in this thread, I implemented "wire"
| | as a CLOS class and defined the appropriate generics and methods for
| | it. I chose a class eventually (and not a struct with closures) to
| | allow extension, because it appears to me that such a "wire" class
| | might be extended with special wire types. ...
| +---------------
|
| Great! Here's a hopefully-simple exercise for you: Redfine your WIRE
| type so that the SIGNAL-VALUE is constrained to exactly four values:
| 0, 1, Z, & X (or in CL, maybe 0, 1, nil, & T would be better choices,
| you decide), where the SIGNAL-VALUE of a WIRE is:
;; Use a GATE class that wraps up the the bare thunk abstraction
;; presented in SICP: a GATE has upto two input wires going in an and an
;; output wire coming out. The values are driven by a generic function
;; DRIVER.
(deftype signal-value () '(member 1 0 Z X))
(defclass wire ()
((signal-value :initform 0 :type signal-value :reader get-signal
:writer set-signal)
(gates :initform nil :accessor gates)))
(defclass gate ()
((output :type wire :initarg :output :reader output)))
(defclass gate1 (gate)
((input1 :type wire :initarg :input1 :reader input1)))
(defclass gate2 (gate1)
((input2 :type wire :initarg :input2 :reader input2)))
(defgeneric inputs (gate)
(:method ((gate gate1)) (list (input1 gate)))
(:method ((gate gate2)) (list (input1 gate) (input2 gate))))
(defgeneric driver (gate))
(defmethod set-signal :around (new-value (wire wire))
(let ((old-value (get-signal wire)))
(prog1 (call-next-method)
(unless (eql old-value new-value)
(map nil #'driver (gates wire))))))
(defun %findgate (gate-type gates output &rest inputs)
(find-if (lambda (gate)
(and (typep gate gate-type)
(eql output (output gate))
(endp (set-difference (inputs gate) inputs))))
gates))
;;;
;;;
(defclass and-gate (gate2) ())
(defvar *and-gate-delay* 3)
(defmethod driver ((and-gate and-gate))
(let ((new-value (logical-and (get-signal (input1 and-gate))
(get-signal (input2 and-gate))))
(output (output and-gate)))
(after-delay *and-gate-delay* (lambda () (set-signal new-value output)))))
(defun and-gate (a1 a2 output)
(or (%findgate 'and-gate (gates a1) output a1 a2)
(let ((gate (make-instance 'and-gate :input1 a1 :input2 a2
:output output)))
(push gate (gates a1))
(push gate (gates a2))
(driver gate)
gate)))
;;;
;;;
(defclass inverter (gate1) ())
(defvar *inverter-delay* 2)
(defmethod driver ((not-gate inverter))
(let ((new-value (logical-not (get-signal (input1 not-gate))))
(output (output not-gate)))
(after-delay *inverter-delay* (lambda () (set-signal new-value output)))))
(defun inverter (input output)
(or (%findgate 'inverter (gates input) output input)
(let ((gate (make-instance 'inverter :input1 input :output output)))
(push gate (gates input))
(driver gate)
gate)))
;;;
;;;
(defclass or-gate (gate2) ())
(defvar *or-gate-delay* 5)
(defmethod driver ((or-gate or-gate))
(let ((new-value (logical-or (get-signal (input1 or-gate))
(get-signal (input2 or-gate))))
(output (output or-gate)))
(after-delay *or-gate-delay* (lambda () (set-signal new-value
output)))))
(defun or-gate (a1 a2 output)
(or (%findgate 'or-gate (gates a1) output a1 a2)
(let ((gate (make-instance 'or-gate :input1 a1 :input2 a2
:output output)))
(push gate (gates a1))
(push gate (gates a2))
(driver gate)
gate)))
;;; Now Model the situation where ``output of several-gates are
;;; connected to the same wire'' using a CONNECTOR object. This has One
;;; output wire and several iinput wires.
(defclass connector (gate)
((inputs :initform nil :initarg :inputs)))
(defmethod inputs ((connector connector))
(with-slots (inputs) connector
inputs))
(defun connect-outputs-of-gates-with-wire (gates wire)
(let* ((inputs (mapcar #'output gates))
(gate (make-instance 'connector :inputs inputs :output wire)))
(map nil (lambda (wire) (push gate (gates wire))) inputs)
gate))
(defvar *connector-delay* 1)
#||
| 0 if the wire is connected to one or more drivers which are
| actively driving a "0", and is connected to no drivers which
| are actively driving a "1". Any number of connected drivers
| may also be driving with "Z"; they have no effect as long as
| at least one driver is driving a "0".
|
| 1 if the wire is connected to one or more drivers which are
| actively driving a "1", and is connected to no drivers which
| are actively driving a "0". Any number of connected drivers
| may also be driving with "Z"; they have no effect as long as
| at least one driver is driving a "1".
|
| Z if all of the drivers connected to the wire are driving with "Z".
|
| X in any other case. That is, if the wire is being driven to
| "1" by some driver(s) and "0" by other(s), or if *any* driver
| is driving an "X". [I.e., a "bus collision" or otherwise
| indeterminate state.]
||#
;; These rules would go into a driver method:
(defmethod driver ((gate connector))
(let* ((inputs (inputs gate))
(output (output gate))
(new-value
(cond ((and (some (lambda (s) (eql s 0)) inputs)
(notany (lambda (s) (eql s 1)) inputs)
(notany (lambda (s) (eql s 'X)) inputs)) 0)
((and (some (lambda (s) (eql s 1)) inputs)
(notany (lambda (s) (eql s 0)) inputs)
(notany (lambda (s) (eql s 'X)) inputs)) 1)
((every (lambda (s) (eql s 'Z)) inputs) 'Z)
(t 'X))))
(after-delay *connector-delay*
(lambda () (set-signal new-value output)))))
#||
| Now also redefine all of your gates to implement their logic in
| a similar fashion, e.g., the tables for NOT, TRI, OR, & AND become
| as follows [note that any "Z" as an input must be treated as an
| "X" value, since it's level is arbitrary & unknown]:
|
| NOT (inverter) TRI (non-inverting driver with output enable)
| Input | Output Input | Enable | Output
| ------+------- ------+--------+-------
| 0 | 1 0 | 1 | 0
| 1 | 0 1 | 1 | 1
| Z | X Z | 1 | X
| X | X X | 1 | X
| (any)| 0 | Z
|
| OR Input1 AND Input1
| \ 0 1 Z X \ 0 1 Z X
| I +----------- I +-----------
| n 0 | 0 1 X X n 0 | 0 0 X X
| p 1 | 1 1 X X p 1 | 0 1 X X
| u Z | X X X X u Z | X X X X
| t X | X X X X t X | X X X X
| 2 2
| When the outputs of several gates are connected to the same wire,
| the result is adjusted according to the SIGNAL-VALUE definitions
| given above.
||#
;; XXX How would TRI be used in this framework? For the other functions
;; we used above:
(defun logical-not (a)
(ecase a (0 1) (1 0) (Z 'X) (X 'Z)))
(defun logical-or (a b)
(ecase a
(0 (ecase b (0 0) (1 1) (Z 'X) (X 'X)))
(1 (ecase b (0 1) (1 1) (Z 'X) (Z 'X)))
(Z (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))
(X (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))))
(defun logical-and (a b)
(ecase a
(0 (ecase b (0 0) (1 0) (Z 'X) (X 'X)))
(1 (ecase b (0 0) (1 1) (Z 'X) (Z 'X)))
(Z (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))
(X (ecase b (0 'X) (1 'X) (Z 'X) (X 'X)))))
;; IRL we would use a priority queue but for testing this we can add
;; simple framework bits:
(defstruct queue front tail-cons)
(defun dequeue (queue)
"Remove and return the first item of QUEUE's list"
(let ((tail-cons (queue-tail-cons queue))
(old-queue (queue-front queue)))
(cond ((endp old-queue) (cerror "Return NIL" "Queue Empty"))
(T (prog1 (car old-queue)
(setf (queue-front queue) (cdr old-queue))
(when (eq old-queue tail-cons)
(setf (queue-tail-cons queue) nil)))))))
(defstruct event (timeout 0) thunk)
(defvar *event-queue* (make-queue))
(defvar *global-clock* 0)
(defun after-delay (delay thunk &key (event-queue *event-queue*)
(global-clock *global-clock*))
(let* ((event-timeout (+ global-clock delay))
(item (make-event :timeout event-timeout :thunk thunk))
(tail-cons (queue-tail-cons event-queue))
(list (queue-front event-queue)))
(if (or (endp list) (<= event-timeout (event-timeout (car list))))
(let ((new-cons (cons item list))) ; add at front of event queue
(setf (queue-front event-queue) new-cons)
(unless tail-cons (setf (queue-tail-cons event-queue) new-cons)))
(loop for prev-cons = list then head ; insert sorted
for head on (cdr list)
if (<= event-timeout (event-timeout (car head)))
do (loop-finish) finally
(let ((new-cons (cons item head)))
(setf (cdr prev-cons) new-cons)
(unless head (setf (queue-tail-cons event-queue) new-cons)))))))
(defun propagate (&key (event-queue *event-queue*))
(loop for x = (queue-front event-queue) while x do
(let* ((event (dequeue event-queue))
(thunk (event-thunk event)))
(assert (>= (event-timeout event) *global-clock*))
(setq *global-clock* (event-timeout event))
(when thunk (funcall thunk))))
*global-clock*)
;; and test the half adder like this:
(defun half-adder (a b s c)
(let ((d (make-instance 'wire :name 'd))
(e (make-instance 'wire :name 'e)))
(or-gate a b d)
(and-gate a b c)
(inverter c e)
(and-gate d e s)
(values d e)))
#||
(setq *global-clock* 0 *event-queue* (make-queue))
(defvar $input-1 (make-instance 'wire))
(defvar $input-2 (make-instance 'wire))
(defvar $sum (make-instance 'wire))
(defvar $carry (make-instance 'wire))
(half-adder $input-1 $input-2 $sum $carry)
(set-signal 1 $input-2)
(propagate)
(get-signal $sum)
||#
#:END
| Advanced exercise: Now that you've got all *that* working, add
| a subclass of WIRE called, say, WIRE/LIGHT-PULLUP, which never
| resolves to the value of "Z". Instead, if the resulting SIGNAL-VALUE
| would be "Z", let it be "1" instead. Verify that this doesn't
| break anything else.
I'm not sure what this means. Do you think the stuff above models your
requirements correctly so far?
I havent risked hurting my head reading below this :)
<snip>
--
Madhu
Eli Bendersky wrote:
> Here's the implementation:
>
> ;;;;;;;;;;;;;;;;;;;;;; Wire ;;;;;;;;;;;;;;;;;;;;;;
> ;;
> (defclass wire ()
> ( (signal-value
> :initform 0
> :documentation
> "The signal associated with the wire")
> (action-procedures
> :initform '()
> :documentation
> "Procedures that are executed when there's
> an event on the wire")))
>
> (defun make-wire ()
> (make-instance 'wire))
It's unusual to define such simple creator functions. Simply call
(make-instance 'wire) when you need it.
> (defgeneric get-signal (w)
> (:documentation "Get the value of wire's signal"))
>
> (defmethod get-signal ((w wire))
> (slot-value w 'signal-value))
>
> (defgeneric set-signal! (w new-value)
> (:documentation "Sets a signal value on the wire"))
Such "getters" and "setters" are more easily define directly in a class
definition:
(defclass wire ()
((signal-value :initform 0 :accessor signal)
(action-procedures :initform '() :accessor actions)))
You can say things like:
(signal wire-instance)
(setf (signal wire-instance) 1)
(incf (signal wire-instance))
etc.
Using ! to indicate side effects is Scheme, and rather unusual in Common
Lisp.
It's better to make sure to hook into the setf framework, because that's
what Common Lispers typically expect. CLOS accessors do this
automatically for you.
> (defmethod set-signal! ((w wire) new-value)
> (with-slots (signal-value action-procedures) w
> (cond
> ((= signal-value new-value) 'done)
> (t
> (setf signal-value new-value)
> (call-each action-procedures)))))
Once you have accessor methods, you can define :after and :around
methods on such accessors:
(defmethod (setf signal) :around (new-value (w wire))
(let ((old-value (signal w)))
(prog1 (call-next-method)
(unless (= old-value new-value)
(mapc #'funcall (actions w))))))
The use of PROG1 is important here because SETF is expected to return
the value that was set. Better make sure that you always do this. (In
the general case, you actually need MULTIPLE-VALUE-PROG1, but here,
PROG1 is sufficient.)
You seem to use direct slot access via SLOT-VALUE by default, but never
CLOS-generated accessors. Accessing slots via SLOT-VALUE is considered
low-level and should be used judiciously. The main reason here is that
you skip :before/:after/:around methods on accessors when access slots
directly. So you have to be aware of this.
> (defgeneric add-action! (w proc)
> (:documentation "Add a new action procedure"))
>
> (defmethod add-action! ((w wire) proc)
> (with-slots (action-procedures) w
> (push proc action-procedures)))
Once you have CLOS-generated accessors, you don't necessarily need to
define add-action. Just say:
(push proc (actions w))
> (defun call-each (procs)
> (dolist (proc procs)
> (funcall proc)))
These little utility functions are typically not necessary, because
Common Lisp already provides most of them. Better use the ones provided
by Common Lisp, it's more idiomatic, and there is a better chance that a
CL implementation actually optimizes them.
> And now I can also define the "inverter" function as follows:
>
> (defun inverter (input output)
> (flet ((invert-input ()
> (let ((new-value
> (logical-not (get-signal input))))
> (after-delay
> *inverter-delay*
> (lambda ()
> (set-signal! output new-value))))))
> (add-action! input #'invert-input)
> 'ok))
Returning 'ok is a bit weird. Why not return the inverter function here?
If you don't want to return anything, (values) is more idiomatic. Unlike
Scheme, changing the number of values returned by a function doesn't
require the call sites to change as well, so there is no harm in doing that.
> Indeed, there appears to be no "conflict of interests" between input
> and output being objects and passing closures that access them around.
>
> I'm pretty satisfied with the result and hope I didn't do any obvious
> goof-ups with the CLOS code.
Looks pretty good. ;)
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
On Oct 4, 10:03 pm, Pascal Costanza <····@p-cos.net> wrote:
> Eli Bendersky wrote:
> > Here's the implementation:
>
> > ;;;;;;;;;;;;;;;;;;;;;; Wire ;;;;;;;;;;;;;;;;;;;;;;
> > ;;
> > (defclass wire ()
> > ( (signal-value
> > :initform 0
> > :documentation
> > "The signal associated with the wire")
> > (action-procedures
> > :initform '()
> > :documentation
> > "Procedures that are executed when there's
> > an event on the wire")))
>
> > (defun make-wire ()
> > (make-instance 'wire))
>
> It's unusual to define such simple creator functions. Simply call
> (make-instance 'wire) when you need it.
My reasons for doing this were:
1) Staying closer to the original Scheme implementation in the book
2) Abstracting away the implementation of wire as a CLOS class. (make-
wire) allows me to later change the representation to whatever I want
(say a CONS with closures, for whatever contrived reason).
>
> > (defgeneric get-signal (w)
> > (:documentation "Get the value of wire's signal"))
>
> > (defmethod get-signal ((w wire))
> > (slot-value w 'signal-value))
>
> > (defgeneric set-signal! (w new-value)
> > (:documentation "Sets a signal value on the wire"))
>
> Such "getters" and "setters" are more easily define directly in a class
> definition:
>
> (defclass wire ()
> ((signal-value :initform 0 :accessor signal)
> (action-procedures :initform '() :accessor actions)))
>
> You can say things like:
>
> (signal wire-instance)
> (setf (signal wire-instance) 1)
> (incf (signal wire-instance))
>
I defined these accessors separately as a means of encapsulation, but
I suppose that in the case of "signal" it's indeed unnecessary because
accessing it is simple set/get.
<snip>
>
> > (defgeneric add-action! (w proc)
> > (:documentation "Add a new action procedure"))
>
> > (defmethod add-action! ((w wire) proc)
> > (with-slots (action-procedures) w
> > (push proc action-procedures)))
>
> Once you have CLOS-generated accessors, you don't necessarily need to
> define add-action. Just say:
>
> (push proc (actions w))
>
But this completely exposes the internal representation of action-
procedures to caller code, which doesn't sound reasonable. Suppose
that I'll want to change action-procedures to something more
complicated like an ordered list which has its own enqueue method.
I'll want this to stay transparent to caller code.
> > (defun call-each (procs)
> > (dolist (proc procs)
> > (funcall proc)))
>
> These little utility functions are typically not necessary, because
> Common Lisp already provides most of them. Better use the ones provided
> by Common Lisp, it's more idiomatic, and there is a better chance that a
> CL implementation actually optimizes them.
>
Do you mean "mapc #'funcall procs" ? This again exposes the internal
representation. Perhaps I can replace the "dolist" with "mapcar...",
but keeping the "call-each" function sounds logical to abstract away
the actual representation of the procedures list.
> > And now I can also define the "inverter" function as follows:
>
> > (defun inverter (input output)
> > (flet ((invert-input ()
> > (let ((new-value
> > (logical-not (get-signal input))))
> > (after-delay
> > *inverter-delay*
> > (lambda ()
> > (set-signal! output new-value))))))
> > (add-action! input #'invert-input)
> > 'ok))
>
> Returning 'ok is a bit weird. Why not return the inverter function here?
>
> If you don't want to return anything, (values) is more idiomatic. Unlike
> Scheme, changing the number of values returned by a function doesn't
> require the call sites to change as well, so there is no harm in doing that.
>
True, thanks.
Eli
Eli Bendersky <······@gmail.com> writes:
> On Oct 4, 10:03 pm, Pascal Costanza <····@p-cos.net> wrote:
>> Eli Bendersky wrote:
>> > Here's the implementation:
>>
>> > ;;;;;;;;;;;;;;;;;;;;;; Wire ;;;;;;;;;;;;;;;;;;;;;;
>> > ;;
>> > (defclass wire ()
>> > ( (signal-value
>> > :initform 0
>> > :documentation
>> > "The signal associated with the wire")
>> > (action-procedures
>> > :initform '()
>> > :documentation
>> > "Procedures that are executed when there's
>> > an event on the wire")))
>>
>> > (defun make-wire ()
>> > (make-instance 'wire))
>>
>> It's unusual to define such simple creator functions. Simply call
>> (make-instance 'wire) when you need it.
>
> My reasons for doing this were:
> 1) Staying closer to the original Scheme implementation in the book
> 2) Abstracting away the implementation of wire as a CLOS class. (make-
> wire) allows me to later change the representation to whatever I want
> (say a CONS with closures, for whatever contrived reason).
I've sometimes done this, for a little more flexibility:
(defvar *default-wire-class* 'wire)
(defun make-wire (&rest initargs)
(apply #'make-instance *default-wire-class* initargs))
Rob St. Amant wrote:
> Eli Bendersky <······@gmail.com> writes:
>
>> On Oct 4, 10:03 pm, Pascal Costanza <····@p-cos.net> wrote:
>>> Eli Bendersky wrote:
>>>> Here's the implementation:
>>>> ;;;;;;;;;;;;;;;;;;;;;; Wire ;;;;;;;;;;;;;;;;;;;;;;
>>>> ;;
>>>> (defclass wire ()
>>>> ( (signal-value
>>>> :initform 0
>>>> :documentation
>>>> "The signal associated with the wire")
>>>> (action-procedures
>>>> :initform '()
>>>> :documentation
>>>> "Procedures that are executed when there's
>>>> an event on the wire")))
>>>> (defun make-wire ()
>>>> (make-instance 'wire))
>>> It's unusual to define such simple creator functions. Simply call
>>> (make-instance 'wire) when you need it.
>> My reasons for doing this were:
>> 1) Staying closer to the original Scheme implementation in the book
>> 2) Abstracting away the implementation of wire as a CLOS class. (make-
>> wire) allows me to later change the representation to whatever I want
>> (say a CONS with closures, for whatever contrived reason).
>
> I've sometimes done this, for a little more flexibility:
>
> (defvar *default-wire-class* 'wire)
>
> (defun make-wire (&rest initargs)
> (apply #'make-instance *default-wire-class* initargs))
This is overkill.
Make-instance is a generic function. If all else fails, you can define
methods on make-instance that ensure that you get something else than a
class instance:
(defmethod make-instance ((class (eql 'wire)) &rest initargs)
(cons 'wire (copy-list initargs)))
Strictly speaking this is undefined territory, but I would consider this
a border case anyway. This whole notion of "what if I change my mind in
some distant future" just leads to unnecessary overhead that is rarely
justified. The XP approach is better here ("do the most simple thing
that could possibly work").
Note that especially in your case, the organization of the
initialization arguments make it relatively obvious that you are
actually dealing with something like a CLOS class behind the scenes,
there is not a lot of information hiding you achieve here anyway.
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
Eli Bendersky wrote:
> On Oct 4, 10:03 pm, Pascal Costanza <····@p-cos.net> wrote:
>> Eli Bendersky wrote:
>>> (defun make-wire ()
>>> (make-instance 'wire))
>> It's unusual to define such simple creator functions. Simply call
>> (make-instance 'wire) when you need it.
>
> My reasons for doing this were:
> 1) Staying closer to the original Scheme implementation in the book
> 2) Abstracting away the implementation of wire as a CLOS class. (make-
> wire) allows me to later change the representation to whatever I want
> (say a CONS with closures, for whatever contrived reason).
1) is a good reason. I don't believe 2) - see my other post on this.
>>> (defgeneric add-action! (w proc)
>>> (:documentation "Add a new action procedure"))
>>> (defmethod add-action! ((w wire) proc)
>>> (with-slots (action-procedures) w
>>> (push proc action-procedures)))
>> Once you have CLOS-generated accessors, you don't necessarily need to
>> define add-action. Just say:
>>
>> (push proc (actions w))
>
> But this completely exposes the internal representation of action-
> procedures to caller code, which doesn't sound reasonable. Suppose
> that I'll want to change action-procedures to something more
> complicated like an ordered list which has its own enqueue method.
Then you can change (setf actions) accordingly. (Maybe I am missing
something here, but shouldn't that work?)
> I'll want this to stay transparent to caller code.
>
>>> (defun call-each (procs)
>>> (dolist (proc procs)
>>> (funcall proc)))
>> These little utility functions are typically not necessary, because
>> Common Lisp already provides most of them. Better use the ones provided
>> by Common Lisp, it's more idiomatic, and there is a better chance that a
>> CL implementation actually optimizes them.
>
> Do you mean "mapc #'funcall procs" ? This again exposes the internal
> representation. Perhaps I can replace the "dolist" with "mapcar...",
> but keeping the "call-each" function sounds logical to abstract away
> the actual representation of the procedures list.
Yes, you could argue that position. Again, I don't believe in such
"preparations for possible future changes", but that's a question of
style, I suppose.
Don't use mapcar here, though, but rather mapc. mapcar builds up a
result list (like Scheme's map), while mapc doesn't - mapc is actually
exactly the same as Scheme's for-each.
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
* Pascal Costanza <··············@mid.individual.net> :
| Eli Bendersky wrote:
|>>> (defgeneric add-action! (w proc)
|>>> (:documentation "Add a new action procedure"))
|>>> (defmethod add-action! ((w wire) proc)
|>>> (with-slots (action-procedures) w
|>>> (push proc action-procedures)))
|>> Once you have CLOS-generated accessors, you don't necessarily need to
|>> define add-action. Just say:
|>>
|>> (push proc (actions w))
|>
|> But this completely exposes the internal representation of action-
|> procedures to caller code, which doesn't sound reasonable. Suppose
|> that I'll want to change action-procedures to something more
|> complicated like an ordered list which has its own enqueue method.
|
| Then you can change (setf actions) accordingly. (Maybe I am missing
| something here, but shouldn't that work?)
ADD-ACTION has a side-effect, (which is not shown here) that of
funcalling PROC.
This is essential for ths sussman code to work --- otherwise the
inverter values would not be propagated.
--
Madhu
In article <························@k79g2000hse.googlegroups.com>,
Eli Bendersky <······@gmail.com> wrote:
> On Oct 4, 10:03 pm, Pascal Costanza <····@p-cos.net> wrote:
> > Eli Bendersky wrote:
> > Once you have CLOS-generated accessors, you don't necessarily need to
> > define add-action. Just say:
> >
> > (push proc (actions w))
> >
>
> But this completely exposes the internal representation of action-
> procedures to caller code, which doesn't sound reasonable. Suppose
> that I'll want to change action-procedures to something more
> complicated like an ordered list which has its own enqueue method.
> I'll want this to stay transparent to caller code.
That's not unreasonable. However, lists are ubiquitous in Lisp, and it
provides lots of built-in mechanisms to handle them. So for simple
collections that can easily be implemented with them, it's very common
to expose this. There are no generic equivalents to PUSH, MAPxxx,
DOLIST, LOOP, etc., so if you decide to implement your own abstraction
you lose all of these higher-level operations.
--
Barry Margolin, ······@alum.mit.edu
Arlington, MA
*** PLEASE post questions in newsgroups, not directly to me ***
*** PLEASE don't copy me on replies, I'll read them in the group ***
In article <························@22g2000hsm.googlegroups.com>,
Eli Bendersky <······@gmail.com> wrote:
> <snip>
> > So, a typical DIALOG-ITEM has following definition:
> >
> > (defclass DIALOG-ITEM (view-item)
> > (...
> > (action ...) ; it has an action slot
> > ...))
> >
> > Then the framework has also a method
> >
> > (defmethod dialog-item-action ((item dialog-item))
> > (when (and (slot-bound-p item 'action)
> > (or (symbolp (slot-value item 'action))
> > (functionp (slot-value item 'action))))
> > (funcall (slot-value item 'action) item))
> > (call-next-method))
> >
> <snip>
>
> OK, heeding the advice I received in this thread, I implemented "wire"
> as a CLOS class and defined the appropriate generics and methods for
> it. I chose a class eventually (and not a struct with closures) to
> allow extension, because it appears to me that such a "wire" class
> might be extended with special wire types. Moreover, the CLOS
> ":before" method feature can be useful for installing monitors on
> methods.
Just a few comments...
You don't need to write the setter and getter functions.
You can tell DEFCLASS to do it.
(defclass wire ()
( (signal-value
:initform 0
:documentation
:accessor get-signal
"The signal associated with the wire")
(action-procedures
:initform '()
:accessor get-action-procedures
:documentation
"Procedures that are executed when there's
an event on the wire")))
(defun make-wire ()
(make-instance 'wire))
Common Lisp has the idea of setters and places.
Usually there is only a GET function that retrieves a value.
(signal-value a-wire)
Above is also a 'place'.
Every macro that takes a place can also use it.
There is no need to learn the name of the setter.
It is always like this:
(setf (signal-value a-wire) new-signal-value)
(incf (signal-value a-wire) 20)
With CLOS you get setter generic functions:
#'(setf signal-value) is a function.
CL-USER 2 > #'(setf signal-value)
#<STANDARD-GENERIC-FUNCTION (SETF SIGNAL-VALUE) 216B39CA>
It is an unusual function, since the name of the generic function is a list.
You can write/extend SETF methods with CLOS like
this (untested):
(defmethod (setf get-signal) :before (new-value (w wire))
(format t "about to change the signal vaue of wire ~a to value ~a!" w new-value))
(defmethod (setf get-signal) :around (new-value (w wire))
(with-slots (signal-value action-procedures) w
(cond
((= signal-value new-value) 'done)
(t
(call-next-method)
(call-each action-procedures)))))
(defgeneric add-action! (w proc)
(:documentation "Add a new action procedure"))
(defmethod add-action! ((w wire) proc)
(push proc (get-action-procedures w)))
...
(defun inverter (input output)
(flet ((invert-input ()
(let ((new-value
(logical-not (get-signal input))))
(after-delay
*inverter-delay*
(lambda ()
(setf (get-signal output) new-value))))))
(add-action! input #'invert-input)
'ok))
--
http://lispm.dyndns.org
In article <·························@free.teranews.com>,
Drew Crampsie <·············@gmail.com> wrote:
> If you really wanted to make extensible queues, then you want
> CLOS. Subclassing queue and specializing on its methods is something CLOS
> makes easy, and that something isn't really handled at all in your
> dispatch-with-closures examples.
>
> With your simple examples, one needs nothing more than structs and defuns.
> But if it's objects and methods you seek, CLOS is the way to go.
Right.
Some more remarks:
Hiding is usually not done in Lisp. Not for methods and not
for slots. Usually the symbols for the functions and classes
are organized in some package and the 'external' functionality
is exported as symbols being exported from the package.
Another basic issue is that you don't want to use closures
for data types, since they all look the same in Lisp and you
cannot look inside.
CLOS classes and Structures will give you instances/structures
which have a type. So you can ask a queue instance and
get a type back. Structures and classes are also easier
to inspect in most implementations.
Then in Common Lisp one usually does not organize functions
in classes. Functions/methods are a separate concept.
This makes it easy to extend your code later. You
can write additional methods, overwrite old ones or
even remove methods without touching some class.
Sometimes queues get more complicated, then it makes sense
to use more of Common Lisp.
An example are the TASK-QUEUEs from CL-HTTP (a web server written
in Common Lisp). TASK-QUEUEs allow you to put tasks
into a queue and some process (thread) will work to execute thoses tasks.
First you set up the package. Name the package, say which
Common Lisp package you want to use, import some
stuff and export some stuff.
(defpackage task-queue
(:nicknames tq)
(:use future-common-lisp)
(:import-from "WWW-UTILS"
"CURRENT-PROCESS"
"MAKE-LOCK"
"MAKE-PROCESS"
"PROCESS-ACTIVE-P"
...
"PROCESS-WAIT"
"PROCESS-WHOSTATE"
"WITH-LOCK-HELD")
(:export
"BACKGROUND-TASK"
"CLEAR-TASK-QUEUE"
"ENSURE-ACTIVE-TASK"
"ENSURE-ACTIVE-TASK-QUEUE"
"MULTI-THREADED-TASK-QUEUE"
"POP-TASK-QUEUE"
"PUSH-TASK-QUEUE"
"START-TASK"
"START-TASK-QUEUE"
"STOP-TASK"
"STOP-TASK-QUEUE"
"TASK-EXECUTE"
"TASK-MAIN-LOOP"
"TASK-PROCESS-KILL"
"TASK-PROCESS-PRIORITY"
"TASK-QUEUE"
"TASK-QUEUE-EXECUTE-PENDING-TASKS"
"TASK-QUEUE-EXECUTE-TASK"
"TASK-QUEUE-EXHAUSTED-P"
"TASK-QUEUE-MAP-ENTRIES"
"TASK-QUEUE-NEXT"
"TASK-QUEUE-PENDING-TASKS"
"TASK-QUEUE-PENDING-TASKS-P"
"TASK-QUEUE-PROCESS-KILL"
"TASK-QUEUE-PROCESS-NAME"
"TASK-QUEUE-PUSH-FRONT"
"TASK-QUEUE-PUSH-ORDERED"
"TASK-QUEUE-RUN-P"
"TASK-QUEUE-THREAD-NUMBER"
"TASK-QUEUE-WAIT-WHOSTATE"
"TASK-THREAD"
"TASK-WORK-P"))
...
Then you have a class for the task queue. You see that it
already inherits from two classes. The QUEUE-MIXIN provides
the basic QUEUE functionality and the BACKGROUND-TASK
provides functionality, so that the TASK-QUEUE itself
runs in a process.
(defclass task-queue
(queue-mixin background-task)
((process-name :initform "Task Queue" :initarg :process-name :accessor task-queue-process-name)
(wait-whostate :initform "Task Wait" :initarg :wait-whostate :accessor task-queue-wait-whostate))
(:documentation "A mixin that executes task entries with a separate process."))
Then you implement the functionality. One example is to push a task
to the front of the queue.
(defgeneric task-queue-push-front (task-queue task)
(:documentation "Push an entry onto TASK-QUEUE with inter-process locking."))
(defmethod task-queue-push-front ((task-queue queue-mixin) task)
(with-slots (lock queue pointer n-pending-tasks) task-queue
(with-lock-held (lock :write "Task Queue Push")
(cond (queue
(push task queue))
(t (let ((entry (list task)))
(setf queue entry
pointer entry))))
(incf (the fixnum n-pending-tasks)))))
The implementation defines a few queue types. But then
a user might write her own classes.
For example the CL-HTTP web walker W4 defines certain
queue types for different ways to walk the web.
The W4 queues are using a primary queue and a retry queue (an
architecture decision).
(defclass w4-multi-threaded-task-queue (tq:multi-threaded-task-queue) ())
(defclass primary-queue (w4-multi-threaded-task-queue)
...)
(defclass retry-queue (w4-multi-threaded-task-queue)
...)
and some more hair.
If you go to that level, then CLOS is the way to organize your code.
But be prepared that it fast mutates into extremely sophisticated
code assembled from tiny pieces from all over the place and you
need some way to cope with this complexity. CLOS code is like
LEGO. You have all kinds of tiny pieces which you can assemble
in various ways. If you don't organize your LEGO pieces, well,
many of us know what happens then. ;-)
The complexity of the implementation should not be of higher-order than the
complexity of the problem you want to solve. If your domain
really needs multiple queue types, interfaces of the queues
to, say, processes, the window system (to display progress)
and to a user interface to expose commands - then you definitely
need CLOS. If not, you may use a simpler implementation technique.
So you get a bunch of approaches that you have to choose from
based on the architectural needs of your appliation:
* basic Lisp CONSes with some functions working on them (avoid)
* closures with some simple functional dispatching (avoid)
* defstructs for the data and some functions (basic)
* CLOS classes for the data and generic functions (basic - advanced)
for the operations. Packages to group functionality
>
> hth,
>
> drewc
>
> >
> > Thanks in advance
> > Eli
--
http://lispm.dyndns.org
<snip>
> So you get a bunch of approaches that you have to choose from
> based on the architectural needs of your appliation:
>
> * basic Lisp CONSes with some functions working on them (avoid)
> * closures with some simple functional dispatching (avoid)
> * defstructs for the data and some functions (basic)
> * CLOS classes for the data and generic functions (basic - advanced)
> for the operations. Packages to group functionality
>
I understand that CLOS should only be used for the advanced stuff. But
why is using defstructs superior to CONSes ?
Eli
Eli Bendersky wrote:
> <snip>
>
>> So you get a bunch of approaches that you have to choose from
>> based on the architectural needs of your appliation:
>>
>> * basic Lisp CONSes with some functions working on them (avoid)
>> * closures with some simple functional dispatching (avoid)
>> * defstructs for the data and some functions (basic)
>> * CLOS classes for the data and generic functions (basic - advanced)
>> for the operations. Packages to group functionality
>>
>
> I understand that CLOS should only be used for the advanced stuff. But
> why is using defstructs superior to CONSes ?
Structs give you better distinctions between types:
(defstruct a x y)
(defstruct b x y)
(defun make-c (x y) (list 'c x y))
(defun make-d (x y) (list 'd x y))
(type-of (make-a :x 5 :y 7)) => A
(type-of (make-b :x 5 :y 7)) => B
(type-of (make-c 5 6)) => CONS
(type-of (make-d 5 6)) => CONS
(make-a :x 5 :y 7) => #S(A :X 5 :Y 7)
(make-b :x 5 :y 7) => #S(B :X 5 :Y 7)
(make-c 5 7) => (C 5 7)
(make-d 5 7) => (D 5 7)
You can also more easily move to generic functions later on:
(defmethod foo ((x a)) 42)
(defmethod foo ((x b)) 4711)
(defmethod foo ((x cons))
"not nice"
(ecase (car x)
(c 666)
(d 0815)))
In general, it's a good idea to use defclass by default. defstruct is
more for low-level stuff, and/or where you are sure that you need the
better overall performance of defstruct. defclass is better for several
reasons - among other things, when you're not sure yet what your types
will end up looking like. defclass supports redefinition at runtime,
including seamless updates of all instances, which makes developing code
more convenient. There are also other advantages to defclass.
But different Common Lispers prefer different styles here. There is no
general rule what to prefer that everybody would subscribe to.
Some for generic functions: I tend to use generic functions more often,
even when their extensibility is not necessarily required. In some
cases, I find a defgeneric form with several :method declarations much
easier to read than the equivalent typecase/case/cond forms.
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
In article <························@n39g2000hsh.googlegroups.com>,
Eli Bendersky <······@gmail.com> wrote:
> <snip>
>
> > So you get a bunch of approaches that you have to choose from
> > based on the architectural needs of your appliation:
> >
> > * basic Lisp CONSes with some functions working on them (avoid)
> > * closures with some simple functional dispatching (avoid)
> > * defstructs for the data and some functions (basic)
> > * CLOS classes for the data and generic functions (basic - advanced)
> > for the operations. Packages to group functionality
> >
>
> I understand that CLOS should only be used for the advanced stuff.
For everything that needs OO-features like
inheritance, dynamic dispatch, etc.
> But
> why is using defstructs superior to CONSes ?
Example:
You need to display a bunch of moving objects. The moving objects
have several features: position, speed, heading, image, name, type.
How would you represent this?
* CONS, LIST
(defun make-moving-object (posx posy speed heading image name type)
(list posx posy speed heading image name type))
Now a reader:
(defun moving-object-speed (object)
(third speed))
Now a setter:
(defun (setf moving-object-speed) (speed object)
(setf (third object) speed))
That gets painful the more you have to define.
Now the first version with DEFSTRUCT:
(defstruct (moving-object (:type list))
posx posy speed heading image name type)
Above gives you:
* a MAKE-MOVING-OBJECT function
* all the reader and writer functions
? (apropos "MOVING-OBJECT")
COPY-MOVING-OBJECT, Def: FUNCTION
MAKE-MOVING-OBJECT, Def: FUNCTION
MOVING-OBJECT
MOVING-OBJECT-HEADING, Def: FUNCTION
MOVING-OBJECT-IMAGE, Def: FUNCTION
MOVING-OBJECT-NAME, Def: FUNCTION
MOVING-OBJECT-POSX, Def: FUNCTION
MOVING-OBJECT-POSY, Def: FUNCTION
MOVING-OBJECT-SPEED, Def: FUNCTION
MOVING-OBJECT-TYPE, Def: FUNCTION
? (make-moving-object :speed 10)
(NIL NIL 10 NIL NIL NIL NIL)
? (setf (moving-object-heading *) :north)
:NORTH
? **
(NIL NIL 10 :NORTH NIL NIL NIL)
But the thing is still a list. I want a record, a structure.
(defstruct moving-object
posx posy speed heading image name type)
Now we get a real data type.
? (make-moving-object :speed 10)
#S(MOVING-OBJECT :POSX NIL :POSY NIL :SPEED 10 :HEADING NIL :IMAGE NIL :NAME NIL :TYPE NIL)
? (type-of *)
MOVING-OBJECT
? (apropos "MOVING-OBJECT")
COPY-MOVING-OBJECT, Def: FUNCTION
MAKE-MOVING-OBJECT, Def: FUNCTION
MOVING-OBJECT
MOVING-OBJECT-HEADING, Def: FUNCTION
MOVING-OBJECT-IMAGE, Def: FUNCTION
MOVING-OBJECT-NAME, Def: FUNCTION
MOVING-OBJECT-P, Def: FUNCTION
MOVING-OBJECT-POSX, Def: FUNCTION
MOVING-OBJECT-POSY, Def: FUNCTION
MOVING-OBJECT-SPEED, Def: FUNCTION
MOVING-OBJECT-TYPE, Def: FUNCTION
We got a new MOVING-OBJECT-P, which returns T if the data
is a MOVING-OBJECT-STRUCTURE.
Now you can also do:
(typecase object
(moving-object .... ....))
Okay, let's do a table comparing the approaches:
| LIST | DEFSTRUCT/LIST | DEFSTRUCT | DEFCLASS
------------------------+-----------------------+----------------+--------------+--------------
Automatic accessors | NO | YES | YES | NO
Data Type | NO | NO | YES | YES
Inheritance | NO | SINGLE | SINGLE | MULTIPLE
Redefinition of objects | NO | NO | NO | YES
Method dispatching | NO | NO | YES | YES
Copy Function | NO | YES | YES | NO
Creation Function | custom | generated | generated | MAKE-INSTANCE
Efficient slot access | small number of slots | EXCELLENT | GOOD | GOOD
Printing | custom | custom | PRINT-OBJECT | PRINT-OBJECT
Get slots | NO | NO | NO | MOP
NIL
Here an example where you define the data in simple lists, very generic:
(defun print-list-as-text-table (header lines stream)
"Takes a list of headers and a list of lines
Each line is a list of objects. Calculates
max column widths."
(let* ((items (loop for line in lines
collect (loop for cell in line
collect (princ-to-string cell))))
(header (loop for cell in header
collect (princ-to-string cell)))
(lengths (max-cell-lengths (cons header items)))
(column-number (length header)))
(print-table-line header column-number lengths stream)
(print-table-border-line lengths stream)
(loop for line in items
do (print-table-line line column-number lengths stream))))
(defun print-table-border-line (lengths stream)
(print-table-line (mapcar #'(lambda (length)
(make-string length :initial-element #\-))
lengths)
(length lengths)
lengths stream :space nil))
(defun print-table-line (line line-length lengths stream &key (space t))
(loop for i from 1
for cell in line
for max-length in lengths
for nil = nil then (if space
(write-string " | " stream)
(write-string "-+-" stream))
do (princ cell stream)
unless (= i line-length)
do (print-repeated-char #\space
(- max-length (length cell))
stream))
(terpri stream))
(defun print-repeated-char (character count stream)
"Writes character count times to stream."
(loop repeat count do (write-char character stream)))
(defun max-cell-lengths (lines)
"Returns a list of maximum column widths."
(reduce #'(lambda (l1 l2)
(mapcar #'max l1 l2))
(mapcar #'(lambda (line)
(mapcar #'length line))
lines)))
Now the data:
(defparameter *h*
'("" LIST DEFSTRUCT/LIST DEFSTRUCT DEFCLASS))
(defparameter *b*
'(("Automatic accessors" no yes yes no)
("Data Type" no no yes yes)
("Inheritance" no single single multiple)
("Redefinition of objects" no no no yes)
("Method dispatching" no no yes yes)
("Copy Function" no yes yes no)
("Creation Function" "custom" "generated" "generated" MAKE-INSTANCE)
("Efficient slot access" "small number of slots" excellent good good)
("Printing" "custom" "custom" PRINT-OBJECT PRINT-OBJECT)
("Get slots" no no no MOP)))
Applied:
CL-USER> (print-list-as-text-table *h* *b* t)
| LIST | DEFSTRUCT/LIST | DEFSTRUCT | DEFCLASS
------------------------+-----------------------+----------------+--------------+--------------
Automatic accessors | NO | YES | YES | NO
Data Type | NO | NO | YES | YES
Inheritance | NO | SINGLE | SINGLE | MULTIPLE
Redefinition of objects | NO | NO | NO | YES
Method dispatching | NO | NO | YES | YES
Copy Function | NO | YES | YES | NO
Creation Function | custom | generated | generated | MAKE-INSTANCE
Efficient slot access | small number of slots | EXCELLENT | GOOD | GOOD
Printing | custom | custom | PRINT-OBJECT | PRINT-OBJECT
Get slots | NO | NO | NO | MOP
Now the task: rewrite it to use CLOS objects for the ROWs...
Bonus points for rows as structures...
>
> Eli
--
http://lispm.dyndns.org
On Oct 4, 9:06 pm, Rainer Joswig <······@lisp.de> wrote:
> In article <························@n39g2000hsh.googlegroups.com>,
> Eli Bendersky <······@gmail.com> wrote:
>
> > <snip>
>
> > > So you get a bunch of approaches that you have to choose from
> > > based on the architectural needs of your appliation:
>
> > > * basic Lisp CONSes with some functions working on them (avoid)
> > > * closures with some simple functional dispatching (avoid)
> > > * defstructs for the data and some functions (basic)
> > > * CLOS classes for the data and generic functions (basic - advanced)
> > > for the operations. Packages to group functionality
>
> > I understand that CLOS should only be used for the advanced stuff.
>
> For everything that needs OO-features like
> inheritance, dynamic dispatch, etc.
>
> > But
> > why is using defstructs superior to CONSes ?
>
> Example:
>
> You need to display a bunch of moving objects. The moving objects
> have several features: position, speed, heading, image, name, type.
>
> How would you represent this?
>
> * CONS, LIST
>
> (defun make-moving-object (posx posy speed heading image name type)
> (list posx posy speed heading image name type))
>
> Now a reader:
>
> (defun moving-object-speed (object)
> (third speed))
>
> Now a setter:
>
> (defun (setf moving-object-speed) (speed object)
> (setf (third object) speed))
>
> That gets painful the more you have to define.
>
> Now the first version with DEFSTRUCT:
>
> (defstruct (moving-object (:type list))
> posx posy speed heading image name type)
>
> Above gives you:
>
> * a MAKE-MOVING-OBJECT function
> * all the reader and writer functions
>
> ? (apropos "MOVING-OBJECT")
>
> COPY-MOVING-OBJECT, Def: FUNCTION
> MAKE-MOVING-OBJECT, Def: FUNCTION
> MOVING-OBJECT
> MOVING-OBJECT-HEADING, Def: FUNCTION
> MOVING-OBJECT-IMAGE, Def: FUNCTION
> MOVING-OBJECT-NAME, Def: FUNCTION
> MOVING-OBJECT-POSX, Def: FUNCTION
> MOVING-OBJECT-POSY, Def: FUNCTION
> MOVING-OBJECT-SPEED, Def: FUNCTION
> MOVING-OBJECT-TYPE, Def: FUNCTION
>
> ? (make-moving-object :speed 10)
> (NIL NIL 10 NIL NIL NIL NIL)
> ? (setf (moving-object-heading *) :north)
> :NORTH
> ? **
> (NIL NIL 10 :NORTH NIL NIL NIL)
>
> But the thing is still a list. I want a record, a structure.
>
> (defstruct moving-object
> posx posy speed heading image name type)
>
> Now we get a real data type.
>
> ? (make-moving-object :speed 10)
> #S(MOVING-OBJECT :POSX NIL :POSY NIL :SPEED 10 :HEADING NIL :IMAGE NIL :NAME NIL :TYPE NIL)
>
> ? (type-of *)
> MOVING-OBJECT
>
> ? (apropos "MOVING-OBJECT")
> COPY-MOVING-OBJECT, Def: FUNCTION
> MAKE-MOVING-OBJECT, Def: FUNCTION
> MOVING-OBJECT
> MOVING-OBJECT-HEADING, Def: FUNCTION
> MOVING-OBJECT-IMAGE, Def: FUNCTION
> MOVING-OBJECT-NAME, Def: FUNCTION
> MOVING-OBJECT-P, Def: FUNCTION
> MOVING-OBJECT-POSX, Def: FUNCTION
> MOVING-OBJECT-POSY, Def: FUNCTION
> MOVING-OBJECT-SPEED, Def: FUNCTION
> MOVING-OBJECT-TYPE, Def: FUNCTION
>
> We got a new MOVING-OBJECT-P, which returns T if the data
> is a MOVING-OBJECT-STRUCTURE.
>
> Now you can also do:
>
> (typecase object
> (moving-object .... ....))
>
> Okay, let's do a table comparing the approaches:
>
> | LIST | DEFSTRUCT/LIST | DEFSTRUCT | DEFCLASS
> ------------------------+-----------------------+----------------+--------------+--------------
> Automatic accessors | NO | YES | YES | NO
> Data Type | NO | NO | YES | YES
> Inheritance | NO | SINGLE | SINGLE | MULTIPLE
> Redefinition of objects | NO | NO | NO | YES
> Method dispatching | NO | NO | YES | YES
> Copy Function | NO | YES | YES | NO
> Creation Function | custom | generated | generated | MAKE-INSTANCE
> Efficient slot access | small number of slots | EXCELLENT | GOOD | GOOD
> Printing | custom | custom | PRINT-OBJECT | PRINT-OBJECT
> Get slots | NO | NO | NO | MOP
> NIL
>
> Here an example where you define the data in simple lists, very generic:
>
> (defun print-list-as-text-table (header lines stream)
> "Takes a list of headers and a list of lines
> Each line is a list of objects. Calculates
> max column widths."
> (let* ((items (loop for line in lines
> collect (loop for cell in line
> collect (princ-to-string cell))))
> (header (loop for cell in header
> collect (princ-to-string cell)))
> (lengths (max-cell-lengths (cons header items)))
> (column-number (length header)))
> (print-table-line header column-number lengths stream)
> (print-table-border-line lengths stream)
> (loop for line in items
> do (print-table-line line column-number lengths stream))))
>
> (defun print-table-border-line (lengths stream)
> (print-table-line (mapcar #'(lambda (length)
> (make-string length :initial-element #\-))
> lengths)
> (length lengths)
> lengths stream :space nil))
>
> (defun print-table-line (line line-length lengths stream &key (space t))
> (loop for i from 1
> for cell in line
> for max-length in lengths
> for nil = nil then (if space
> (write-string " | " stream)
> (write-string "-+-" stream))
> do (princ cell stream)
> unless (= i line-length)
> do (print-repeated-char #\space
> (- max-length (length cell))
> stream))
> (terpri stream))
>
> (defun print-repeated-char (character count stream)
> "Writes character count times to stream."
> (loop repeat count do (write-char character stream)))
>
> (defun max-cell-lengths (lines)
> "Returns a list of maximum column widths."
> (reduce #'(lambda (l1 l2)
> (mapcar #'max l1 l2))
> (mapcar #'(lambda (line)
> (mapcar #'length line))
> lines)))
>
> Now the data:
>
> (defparameter *h*
> '("" LIST DEFSTRUCT/LIST DEFSTRUCT DEFCLASS))
>
> (defparameter *b*
> '(("Automatic accessors" no yes yes no)
> ("Data Type" no no yes yes)
> ("Inheritance" no single single multiple)
> ("Redefinition of objects" no no no yes)
> ("Method dispatching" no no yes yes)
> ("Copy Function" no yes yes no)
> ("Creation Function" "custom" "generated" "generated" MAKE-INSTANCE)
> ("Efficient slot access" "small number of slots" excellent good good)
> ("Printing" "custom" "custom" PRINT-OBJECT PRINT-OBJECT)
> ("Get slots" no no no MOP)))
>
> Applied:
>
> CL-USER> (print-list-as-text-table *h* *b* t)
> | LIST | DEFSTRUCT/LIST | DEFSTRUCT | DEFCLASS
> ------------------------+-----------------------+----------------+--------------+--------------
> Automatic accessors | NO | YES | YES | NO
> Data Type | NO | NO | YES | YES
> Inheritance | NO | SINGLE | SINGLE | MULTIPLE
> Redefinition of objects | NO | NO | NO | YES
> Method dispatching | NO | NO | YES | YES
> Copy Function | NO | YES | YES | NO
> Creation Function | custom | generated | generated | MAKE-INSTANCE
> Efficient slot access | small number of slots | EXCELLENT | GOOD | GOOD
> Printing | custom | custom | PRINT-OBJECT | PRINT-OBJECT
> Get slots | NO | NO | NO | MOP
>
> Now the task: rewrite it to use CLOS objects for the ROWs...
> Bonus points for rows as structures...
>
Thanks for the time you're taking to write these wonderful, detailed
replies. Very helpful - I now have a complete answer to my question.
Eli
In article <························@y42g2000hsy.googlegroups.com>,
Eli Bendersky <······@gmail.com> wrote:
> Thanks for the time you're taking to write these wonderful, detailed
> replies. Very helpful - I now have a complete answer to my question.
Was it really necessary to quote 6 screenfulls just to thank him?
--
Barry Margolin, ······@alum.mit.edu
Arlington, MA
*** PLEASE post questions in newsgroups, not directly to me ***
*** PLEASE don't copy me on replies, I'll read them in the group ***
Eli Bendersky <······@gmail.com> writes:
> Here's a sample snipped - a queue object in Common Lisp:
Here's my CLOS'y queue implementation:
http://groups.google.com/group/comp.lang.lisp/msg/cc30fc502cd7912d
-russ