CLOS: Method combination with arbitrary function - oop

While reading about CLOS (in ANSI Common Lisp by Paul Graham), I noticed that there are nine functions that can be given to defmethod as its second argument:
+, and, append, list, max, min, nconc, or and progn. According to this answer, they are called simple method combinations.
Question
Why only these nine? What is the reason I cannot pass an arbitrary function as the second argument?
Example of what I would like
Suppose I defined xor as
(defun xor (&rest args)
(loop for a in args counting (not (null a)) into truths
finally (return (= truths 1))))
(this could certainly be improved). I would like to define several classes describing clothes and their combinations using xor:
(defgeneric looks-cool (x)
(:method-combination xor))
(defclass black-trousers () ())
(defclass quilt () ())
(defclass white-shirt () ())
(defclass hawaii-shirt () ())
(defmethod looks-cool xor ((tr black-trousers)) nil)
(defmethod looks-cool xor ((qu quilt)) t)
(defmethod looks-cool xor ((ws white-shirt)) nil)
(defmethod looks-cool xor ((hs hawaii-shirt)) t)
(defclass too-stiff (black-trousers white-shirt) ())
(defclass scottish (quilt white-shirt) ())
(defclass also-good (black-trousers hawaii-shirt) ())
(defclass too-crazy (quilt hawaii-shirt) ())
Now if this compiled (which it doesn't), I would be able to use Lisp to guide me as to what to wear:
> (looks-cool (make-instance 'too-stiff))
NIL
> (looks-cool (make-instance 'scottish))
T
> (looks-cool (make-instance 'also-good))
T
> (looks-cool (make-instance 'too-crazy))
NIL
I am well aware that this is a rather artificial example of no practical importance. Still, I would like to know whether there is some deeper reason behind or whether the restriction to the nine functions is just to make implementation easier.

Use the standard Common Lisp macro DEFINE-METHOD-COMBINATION to define your own simple method combinations:
Example:
(define-method-combination xor :identity-with-one-argument t)
Then:
CL-USER 5 > (mapcar #'looks-cool
(list (make-instance 'too-stiff)
(make-instance 'scottish)
(make-instance 'also-good)
(make-instance 'too-crazy)))
(NIL T T NIL)
If we look at (define-method-combination xor :identity-with-one-argument t), it has several meanings for the name xor:
it uses an operator xor - a function, macro or special form - not only functions are allowed. If the operator name should be different from the method combination name -> use the :operator keyword to specify that.
it defines a method combination named xor. This name can be used in defgeneric.
it defines a method qualifier xor. This can be used in defmethod.
Note that one can also define more complex method combinations with that DEFINE-METHOD-COMBINATION.

Related

Common Lisp structures with dynamically scoped slots

Common Lisp is lexically scoped, but there is a possibility to create dynamic bindings with (declare (special *var*)). What I need, is a way to create a dynamically scoped structure slot, whose value is visible to all other slots. Here is an example:
(defun start-thread ()
*delay*) ;; We defer the binding of *delay*
This works for a usual lexical environment:
(let ((*delay* 1))
(declare (special *delay*))
(start-thread)) ;; returns 1
This does not work:
(defstruct table
(*delay* 0)
(thread (start-thread)))
(make-table) ;; => Error: *delay* is unbound.
My questions are
How to refer to the slot delay from other slots?
How to make the slot delay dynamically scoped, so that its value becomes visible
for the function (start-thread) ?
The first thing to realise that there's no good way to have a dynamically-scoped slot in an object (unless the implementation has some deep magic to support this): the only approach that will work is to use, essentially, explicit shallow-binding. Something like this macro, for instance (this has no error checking at all: I just typed it in):
(defmacro with-horrible-shallow-bound-slots ((&rest slotds) object &body forms)
(let ((ovar (make-symbol "OBJECT"))
(slot-vars (mapcar (lambda (slotd)
(make-symbol (symbol-name (first slotd))))
slotds)))
`(let ((,ovar ,object))
(let ,(mapcar (lambda (v slotd)
`(,v (,(first slotd) ,ovar)))
slot-vars slotds)
(unwind-protect
(progn
(setf ,#(mapcan (lambda (slotd)
`((,(first slotd) ,ovar) ,(second slotd)))
slotds))
,#forms)
(setf ,#(mapcan (lambda (slotd slot-var)
`((,(first slotd) ,ovar) ,slot-var))
slotds slot-vars)))))))
And now if we have some structure:
(defstruct foo
(x 0))
Then
(with-horrible-shallow-bound-slots ((foo-x 1)) foo
(print (foo-x foo)))
expands to
(let ((#:object foo))
(let ((#:foo-x (foo-x #:object)))
(unwind-protect
(progn (setf (foo-x #:object) 1) (print (foo-x foo)))
(setf (foo-x #:object) #:foo-x))))
where all the gensyms with the same name are in fact the same. And so:
> (let ((foo (make-foo)))
(with-horrible-shallow-bound-slots ((foo-x 1)) foo
(print (foo-x foo)))
(print (foo-x foo))
(values))
1
0
But this is a terrible approach because shallow binding is terrible in the presence of multiple threads: any other thread that wants to look at foo's slots will also see the temporary value. So this is just horrid.
A good approach is then to realise that while you can't safely dynamically-bind a slot in an object, you can dynamically bind a value which that slot indexes by using a secret special variable to hold a stack of bindings. In this approach the values of slots do not change, but the values they index do, and can do so safely in the presence of multiple threads.
A way of doing this this is Tim Bradshaw's fluids toy. The way this works is that you define the value of a slot to be a fluid, and then you can bind that fluid's value, which binding has dynamic scope.
(defstruct foo
(slot (make-fluid)))
(defun outer (v)
(let ((it (make-foo)))
(setf (fluid-value (foo-slot it) t) v) ;set global value
(values (fluid-let (((foo-slot it) (1+ (fluid-value (foo-slot it)))))
(inner it))
(fluid-value (foo-slot it)))))
(defun inner (thing)
(fluid-value (foo-slot thing)))
This often works better with CLOS objects because of the additional flexibility in things like naming and what you expose (you almost never want to be able to assign to a slot whose value is a fluid, for instance: you want to assign the value of the fluid).
The system uses a special variable behind the scenes to implement deep binding for fluids, so will work properly with threads (ie distinct threads can have different bindings for a fluid) assuming the implementation treats special variables sensibly (which I'm sure all multithreaded implementations do).
I don't think that this makes sense. Variables have scope and extent, but values just are, and slots are just parts of values. Additionally, threads do not inherit dynamic bindings.
If you want to have some kind of object that is dynamically changed (so to speak), you need to put it into a dynamic variable as a whole value, and do re-bindings with modified versions (preferably on the basis of some immutability, i. e. persistent datastructures, e. g. with FSet).
I'm doing a bit of guessing about what you need here, but I think using a class and initialize-instance will give you what you want. In the code below, I rewrote your struct as a class, and the object itself is passed to initialize-instance in a call to (make-instance 'table).
(defclass table ()
((delay :initform 5)
(thread)))
(defun start-my-thread (obj)
(print (slot-value obj 'delay)))
(defmethod initialize-instance :after ((obj table) &key)
(start-my-thread obj))
(make-instance 'table)
; above call will print 5

Separating initialization arguments and class slots in Common Lisp Object System for making objects

This asks about initializing slots from other slots. What I want to achieve instead is to take some arguments as input - perhaps but not necessarily to make-instance - and convert these arguments into the class slots for storage. In effect, I want to separate the implementation of the class from its (initialization) interface.
Is there a recommended way to achieve this?
The simplest way I can imagine is simply create a (defun make-my-object ...) as the interface. This may then call make-instance with appropriate arguments.
For example, imagine
(defclass my-object () (slot-1 slot-2))
(defun make-my-object (arg-1 arg-2)
(make-instance 'my-object
:slot-1 (+ arg-1 arg-2)
:slot-2 (- arg-1 arg-2)))
Other ways I can imagine include implementing an initialize-instance :after that takes arg-1 and arg-2 as keyword arguments and initializes slot-1 and slot-2 appropriately. However, since after methods are called in the least-specific-first-order, that means that superclass slots will be initialized before current-class slot. On the other hand, what looks more common is that one will take arguments for constructing current-class, and on the basis of these arguments, one will initialize the super-class slots.
The alternative is initialize-instance :before - or also :around - but if multiple classes in the hierarchy have such "interface-implementation" differences, I don't see this working, unless I can pass arguments to call-next-method.
Are there other ways?
EDIT: Thanks to #ignis volens for bringing to my notice that (one of) my main concern(s) is about superclass slots being initialized from subclass slots. Is there a recommended way to do this?
I am not sure I understand your question. The answer is almost certainly after methods on initialize-instance I think. You say that this will cause slots defined in superclasses to be initialized first: yes, it will, and that almost certainly what you want to happen. Slots defined in superclasses don't generally depend for their values on subclass slots (its always possible to think of exceptions to everything) and so initialising in least-specific first order is almost always what you want.
The two common ways of initializing slots that I use are either to simply declare what their initargs are in the definition:
(defclass minibeast ()
((legs :initform 'uncountable
:initarg :legs
:initarg :leg-count
:accessor legs)
(tentacles :initform 'many
:initarg :tentacles
:initarg :number-of-tentacles
:accessor tentacles)))
And now (make-instance 'minibeast :legs 87) does what you expect. And this works (because, obviously it has to if the two slots were defined in different classes):
(defclass awful-monster ()
((legs :initform 'uncountable
:initarg :legs
:initarg :leg-count
:accessor legs)
(appendages :initform 'many
:initarg :legs
:initarg :appendages)))
Now (make-instance 'awful-monster :legs 93) will result in an awful monster with 93 legs and 93 appendages.
However that method perhaps doesn't qualify as separating interface from implementation. You may also want to perform some computation when initialising slots. In both these cases after methods on initialize-instance are generally the right approach:
(defclass horrible-monster ()
((legs :initform 983
:accessor legs)
(eyes :initform 63
:accessor eyes)
(appendages
:reader appendages)))
(defmethod initialize-instance :after
((m horrible-monster) &key eyes legs (stalky-eyes t))
(with-slots ((e eyes) (l legs) appendages) m
(when eyes (setf e eyes))
(when legs (setf l legs))
(setf appendages (if stalky-eyes (+ e l) l))))
And now horrible monsters will get the appropriate number of appendages (I am not sure why horrible monsters don't know whether their eyes are on stalks or not: perhaps they don't have mirrors).
There are any number of other combinations of course. You might well not want to have user code call make-instance explicitly but wrap things up in some function:
(defun make-awful-thing (&rest args &key (sort-of-horrible-thing 'horrible-monster)
&allow-other-keys)
(let ((the-remaining-args (copy-list args)))
;; No doubt alexandria or something has a way of doing this
(remf the-remaining-args ':sort-of-horrible0thing)
(apply #'make-instance sort-of-horrible-thing the-remaining-args)))
And now, of course you can have some bespoke initialzation protocol easily:
(defgeneric enliven-horrible-thing (horrible-thing &key)
(:method :around ((horrible-thing t) &key)
(call-next-method)
t))
(defun make-awful-thing (&rest args &key (sort-of-horrible-thing 'horrible-monster)
&allow-other-keys)
(let ((the-remaining-args (copy-list args)))
;; No doubt alexandria or something has a way of doing this
(remf the-remaining-args ':sort-of-horrible0thing)
(apply #'enliven-horrible-thing
(apply #'make-instance sort-of-horrible-thing
the-remaining-args)
the-remaining-args)))
(defmethod enliven-horrible-thing ((horrible-thing horrible-monster)
&key (ichor t) (smell 'unspeakable))
...)

Why does `class-name` does not work in the REPL for this case?

I am reading the book Object Oriented Programming in Common Lisp from Sonja Keene.
In chapter 7, the author presents:
(class-name class-object)
This would make possible to query a class object for its name.
Using SBCL and the SLIME's REPL, I tried:
; SLIME 2.26.1
CL-USER> (defclass stack-overflow ()
((slot-1 :initform 1 )
(slot-2 :initform 2)))
#<STANDARD-CLASS COMMON-LISP-USER::STACK-OVERFLOW>
CL-USER> (make-instance 'stack-overflow)
#<STACK-OVERFLOW {1002D188E3}>
CL-USER> (defvar test-one (make-instance 'stack-overflow))
TEST-ONE
CL-USER> (slot-value test-one 'slot-1)
1
CL-USER> (class-name test-one)
; Evaluation aborted on #<SB-PCL::NO-APPLICABLE-METHOD-ERROR {10032322E3}>.
The code above returns the error message below:
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP:CLASS-NAME (1)>
when called with arguments
(#<STACK-OVERFLOW {1003037173}>).
[Condition of type SB-PCL::NO-APPLICABLE-METHOD-ERROR]
How would be the proper use of class-name?
Thanks.
The argument to class-name must be a class object, not an instance of the class.
Use class-of to get the class of the instance, then you can call class-name
(class-name (class-of test-one))
Using #Barmar's hint on a comment, this would the correct approach with class-name:
CL-USER> (class-name (defclass stack-overflow ()
((slot-1 :initform 1 )
(slot-2 :initform 2))))
STACK-OVERFLOW
class-name receives as an argument a class. In order to work with instances, the correct approach is using class-of:
CL-USER> (class-of 'test-one)
#<BUILT-IN-CLASS COMMON-LISP:SYMBOL>
I am not sure why class-name would be helpful, though.

Common Lisp: How do I set a variable in my parent's lexical scope?

I want to define a function (not a macro) that can set a variable in the scope its called.
I have tried:
(defun var-set (var-str val)
(let ((var-interned
(intern (string-upcase var-str))))
(set var-interned val)
))
(let ((year "1400"))
(var-set "year" 1388)
(labeled identity year))
Which doesn't work because of the scoping rules. Any "hacks" to accomplish this?
In python, I can use
previous_frame = sys._getframe(1)
previous_frame_locals = previous_frame.f_locals
previous_frame_locals['my-var'] = some_value
Any equivalent API for lisp?
You cannot do that because after compilation the variable might not even exist in any meaningful sense.
E.g., try to figure out by looking at the output of (disassemble (lambda (x) (+ x 4))) where you
would write the new values of x.
You have to tell both the caller and the callee (at compile time!) that the variable is special:
(defun set-x (v)
(declare (special x))
(setq x v))
(defun test-set (a)
(let ((x a))
(declare (special x))
(set-x 10)
x))
(test-set 3)
==> 10
See Dynamic and Lexical variables in Common Lisp for further details on lexical vs dynamic bindings.
You can't. This is why it is called lexical scope: you have access to variable bindings if and only if you can see them. The only way to get at such a binding is to create some object for which it is visible and use that. For instance:
(defun foo (x)
(bar (lambda (&optional (v nil vp)
(if vp (setf x vp) x))))
(defun bar (a)
...
(funcall a ...))
Some languages, such as Python have both rather rudimentary implementations of variable bindings and a single implementation (or a mandated implementation) which allow you to essentially poke around inside the system to subvert lexical scoping. Some CL implementations may have rudimentary implementation of variable bindings (probably none do) but Common Lisp the language does not mandate such implementations and nor should it.
As an example of the terrible consequences of mandating that some kind of access to lexical variables must be allowed consider this:
(defun outer (n f)
(if (> n 0)
(outer (g n) f)
(funcall f)))
If f could somehow poke at the lexical bindings of outer this would mean that all those bindings would need to exist at the point f was called: tail-call elimination would thus be impossible. If the language mandated that such bindings should be accessible then the language is mandating that tail-call elimination is not possible. That would be bad.
(It is quite possible that implementations, possibly with some debugging declarations, allow such access in some circumstances. That's very different than the language mandating such a thing.)
What are you trying to achieve?
What about a closure? Write the defun inside the let, and create an accessor and a setter function if needed.
(let ((year "1400"))
(defun current-year ()
year)
(defun set-year (val)
(setf year val)))
and
CL-USER> (current-year)
"1400"
CL-USER> (set-year 1200)
1200
CL-USER> (current-year)
1200
That Python mechanism violates the encapsulation which motivates the existence of lexical scope.
Because a lexical scope is inaccessible by any external means other than invocations of function bodies which are in that scope, a compiler is free to translate a lexical scope into any representation which performs the same semantics. Variables named in the source code of the lexical scope can disappear entirely. For instance, in your example, all references to year can be replaced by copies of the pointer to the "1400" string literal object.
Separately from the encapsulation issue there is also the consideration that a function does not have any access at all to a parent lexical scope, regardless of that scope's representation. It does not exist. Functions do not implicitly pass their lexical scope to children. Your caller may not have a lexical environment at all, and there is no way to know. The essence of the lexical environment is that no aspect of it is passed down to children, other than via the explicit passage of lexical closures.
Python's feature is poorly considered because it makes programs dependent on the representation of scopes. If a compiler like PyPy is to make that code work, it has to constrain its treatment of lexical scopes to mimic the byte code interpreted version of Python.
Firstly, each function has to know who called it, so it has to receive some parameter(s) about that, including a link to the caller's environment. That's going to be a source of inefficiency even in code that doesn't take advantage of it.
The concept of a well-defined "previous frame" means that the compiler cannot merge together frames. Code which expects some variable to be in the third frame up from here will break if those frames are all inlined together due to a nested lexical scope being flattened, or due to function inlining.
As soon as you provide an interface to the parent lexical environment, and applications start using it, you no longer have lexical scoping. You have a form of dynamic scoping with lexical-like visibility rules.
The application logic can implement de facto dynamic scope on top of this API, because you can write a loop which searches for a variable across the chain of lexical scopes. Does my parent have an x variable? If not, does the grandparent, if there is one? You can search the dynamic chain of invocations for the most recent one which binds x, and that is dynamic scope.
There is nothing wrong with dynamic scope, if it is a separate discipline that is not entangled in the implementation of lexical scope.
That said, an API for tracing frames and getting at local variables is is the sort of introspection that is very useful in developing a debugger. Another angle on this is that if you work that API into an application, you're using debugging features in production.
(defvar *lexical-variables* '())
(defun get-var (name)
(let ((var (cdr (assoc name *lexical-variables*))))
(unless var (error "No lexical variable named ~S" name))
var))
(defun deref (var)
(funcall (if (symbolp var)
(or (cdr (assoc var *lexical-variables*))
(error "No lexical variable named ~S" var))
var)))
(defun (setf deref) (new-value var)
(funcall (if (symbolp var)
(or (cdr (assoc var *lexical-variables*))
(error "No lexical variable named ~S" var))
var)
new-value))
(defmacro with-named-lexical-variable ((&rest vars) &body body)
(let ((vvar (gensym))
(vnew-value (gensym))
(vsetp (gensym)))
`(let ((*lexical-variables* (list* ,#(mapcar (lambda (var)
`(cons ',var
(lambda (&optional (,vnew-value nil ,vsetp))
(if ,vsetp
(setf ,var ,vnew-value)
,var))))
vars)
*lexical-variables*)))
,#body)))
(defun var-set (var-str val)
(let ((var-interned (intern (string-upcase var-str))))
(setf (deref var-interned) val)))
(let ((x 1)
(y 2))
(with-named-lexical-variable (x y)
(var-set "x" 3)
(setf (deref 'y) 4)
(mapcar (function deref) '(x y))))
;; -> (3 4)
(let ((year "1400"))
(with-named-lexical-variable (year)
(var-set "year" 1388))
year)
;; --> 1388

Using a Local Special Variable Passed as a Final Argument

I hope this isn't beating a dead horse, but I'd like an opinion about another possible strategy for writing referentially transparent code. (The previous discussion about referential transparency is at Using a Closure instead of a Global Variable). Again, the objective is to eliminate most global variables, but retain their convenience, without injecting bug-prone references or potentially non-functional behavior (ie, referential opaqueness, side-effects, and non-repeatable evaluations) into the code.
The proposal is to use local special variables to establish initial bindings, which can then be passed dynamically to the subsequent nested functions that eventually use them. The intended advantage, like globals, is that the local special variables do not need to be passed as arguments through all the intermediate functions (whose functionality has nothing to do with the local special variables). However to maintain referential transparency, they would be passed as arguments to the final consumer functions.
What I'm wondering about is whether floating a lot of dynamic variables around is prone to programming bugs. It doesn't seem particularly error prone to me, since any local rebinding of a previously bound variable should not affect the original binding, once it is released:
(defun main ()
(let ((x 0))
(declare (special x))
(fum)))
(defun fum ()
(let ((x 1)) ;inadvertant? use of x
(setf x 2))
(foo))
(defun foo ()
(declare (special x))
(bar x))
(defun bar (arg) ;final consumer of x
arg)
(main) => 0
Are there problems with this stragegy?
Now your functions are referencing a variable that is not guaranteed to be defined. Trying to execute (foo) at the repl will throw an unbound variable error. Not only is there referential opacity, but now referential context error throwing!
What you have here are globally bound routines, which can only be executed in the local context where (declare (special x)) has been hinted. You may as well put those functions in a labels so they don't get accidentally used, though at that point you are choosing between closing the variables in functions, or closing the functions in a function:
(defun main ()
(labels ((fum ()
(let ((x 1));Inadvertent use of x?
(setf x 2))
(foo))
(foo ()
(declare (special x))
(bar x))
(bar (arg) arg)) ;Final consumer of x.
(let ((x 0))
(declare (special x))
(fum))))
Wow, that is some ugly code!
After a convolution we can make x lexical! Now we can achieve the holy grail, referential transparency!
Convolute
(defun main ()
(let ((x 0))
(labels ((fum ()
(let ((x 1))
(setf x 2))
(foo))
(foo () (bar x))
(bar (arg) arg));Final consumer of x.
(fum))))
This code is much nicer, and lispy. It is essentially your code to the other question, but the functions bindings are localized. This is at least better than using explosive global naming. The inner let does nothing, same as before. Though now it is less convoluted.
CL-USER> (main) ;=> 0
Your test case is the same (main) ;=> 0 in both. The principle is to just encapsulate your variables lexially instead of with dynamic special declarations. Now we can reduce the code even more by just passing things functionally in a single environment variable, as suggested.
(defun convoluted-zero ()
(labels ((fum (x)
(let ((x 1))
(setf x 2))
(foo x))
(foo (x) (bar x))
(bar (arg) arg)).
(fum 0)))
CL-USER> (let ((x (convoluted-zero)))
(list x (convoluted-zero)))
;=> 0
□ QED your code with the special variables violates abstraction.
If you really want to go down the rabbit hole, you can read the section of chapter 6 of Doug Hoyte's Let Over Lambda on pandoric macros, where you can do something like this:
(use-package :let-over-lambda)
(let ((c 0))
(setf (symbol-function 'ludicrous+)
(plambda () (c) (incf c)))
(setf (symbol-function 'ludicrous-)
(plambda () (c)(decf c))))
You can then use pandoric-get to get c without incrementing it or defining any accessor function in that context, which is absolute bonkers. With lisp packages you can get away with a package-local "global" variable. I could see an application for this in elisp, for example, which has no packages built in.