callable objects

[Stefan Monnier]

Common-Lisp has the notion of an object that can be called, functions
being one example, generic functions another (and IIUC symbols also are
callable).

AFAICT the Common-Lisp standard does not provide a standard way to build
such objects in general: you can't define your own kind of
callable object.

Do some Common-Lisp implementations offer a way to define your own
callable objects? If so, which ones, and what kind of primitive do they
provide to do that?


Stefan

[Pascal J. Bourguignon]

Yes, it's done with the MOP and CLOS.

I don't know the details, but basically you can define your own
subclasses of closer-mop:FUNCALLABLE-STANDARD-OBJECT.

--
__Pascal Bourguignon__ http://www.informatimago.com/
“The factory of the future will have only two employees, a man and a
dog. The man will be there to feed the dog. The dog will be there to
keep the man from touching the equipment.” -- Carl Bass CEO Autodesk

[Pascal Costanza]

The ones listed at
https://common-lisp.net/project/closer/closer-mop.html should all be
fine. Other implementations may have this as well.

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/
The views expressed are my own, and not those of my employer.

[Stefan Monnier]

> I don't know the details, but basically you can define your own
> subclasses of closer-mop:FUNCALLABLE-STANDARD-OBJECT.

But how do I specify the code executed when they're called?


Stefan

[Didier Verna]

Cf. SET-FUNCALLABLE-INSTANCE-FUNCTION (MOP, not standard lisp).

--
My new Jazz CD entitled "Roots and Leaves" is out!
Check it out: http://didierverna.com/records/roots-and-leaves.php

Lisp, Jazz, Aïkido: http://www.didierverna.info

[Stefan Monnier]

>>> I don't know the details, but basically you can define your own
>>> subclasses of closer-mop:FUNCALLABLE-STANDARD-OBJECT.
>> But how do I specify the code executed when they're called?
> Cf. SET-FUNCALLABLE-INSTANCE-FUNCTION (MOP, not standard lisp).

Thanks. That lead me to
http://metamodular.com/CLOS-MOP/funcallable-instances.html which even
gives me an example.

Does someone know of alternative APIs for that kind of functionality
(e.g. one that would allow to use a single underlying "vector" to
hold both the slots of the object and the free variables of the closure)?


Stefan

[Lars Brinkhoff]

Stefan Monnier <mon...@iro.umontreal.ca> writes:
> Does someone know of alternative APIs for that kind of functionality
> (e.g. one that would allow to use a single underlying "vector" to
> hold both the slots of the object and the free variables of the closure)?

I have implemented funcallable objects as part of my CL written in Emacs
Lisp. That was before closures were added to Emacs, though.

I don't remeber the details of how or why, but looking at the code now,
it seems I chose to store funcallable objects in Emacs compiled-
functions. To access the slots, the function is used to index into a
hash table which holds vectors containing the slots.

[Stefan Monnier]

> I don't remeber the details of how or why, but looking at the code now,
> it seems I chose to store funcallable objects in Emacs compiled-
> functions. To access the slots, the function is used to index into a
> hash table which holds vectors containing the slots.

Interesting, thanks,


Stefan

[smh]

Well, you don't the entire machinery of the MOP, or even CLOS, to build funcallable instances with data slots. Closures are quite enough. Here is a quick hack that implements funcallable instances with a Pythony associative map for slots. Was fun to write. Enjoy!

(progn ; smh 2015-08-14
;; These unintered symbols are walled off from the world.
(defun f-fin (fin) (funcall fin '#1=#:||))
(defun f-set-fin (fin new) (funcall fin '#2=#:|| new))
(defun f-slot-value (fin slot-name) (funcall fin '#3=#:|| slot-name))
(defun f-set-slot-value (fin slot-name new)
(funcall fin '#4=#:|| slot-name new))
(defsetf f-slot-value f-set-slot-value)

(defun funcallable-object (fin &rest slotnames-and-values)
(let ((slots (make-hash-table :test #'eql)))
;; perhaps #'equal ht would be more powerful
(loop for (slot value) on slotnames-and-values by #'cddr
do (setf (gethash slot slots) value))
(lambda (&rest args) ; This is the new instance.
(case (car args) ; empty arglist is nil
(#1# fin)
(#2# (setf fin (cadr args)))
(#3# (gethash (cadr args) slots))
(#4# (setf (gethash (cadr args) slots) (caddr args)))
(t (apply fin args))))))

)

Here's a sample of its use. The implementation could be more bulletproof, of course, but this is only a proof of concept. Should be portable to any conforming CL implementation.

cl-user(36): (setq q (funcallable-object #'+
'name "Ishmael" 'ship 'Lollypop))
#<Closure (:internal funcallable-object 0) @ #x1012205d2>
cl-user(37): (f-fin q)
#<Function +>
cl-user(38): (funcall q 1 2 3 4)
10
cl-user(39): (f-set-fin q #'*)
#<Function *>
cl-user(40): (funcall q 1 2 3 4)
24
cl-user(41): (f-slot-value q 'name)
"Ishmael"
t
cl-user(42): (setf (f-slot-value q 'name) "Ahab")
"Ahab"
cl-user(43): (f-slot-value q 'name)
"Ahab"
t
cl-user(44): (f-slot-value q 22/7)
nil
nil
cl-user(45): (setf (f-slot-value q 22/7) "Starbucks")
"Starbucks"
cl-user(46): (f-slot-value q 22/7)
"Starbucks"
t

[Pascal Costanza]

On 15/08/2015 07:13, smh wrote:
> Well, you don't the entire machinery of the MOP, or even CLOS, to build funcallable instances with data slots. Closures are quite enough. Here is a quick hack that implements funcallable instances with a Pythony associative map for slots. Was fun to write. Enjoy!

Good point. While we're at it, you can actually also use symbols as
funcallable objects: make-symbol creates (uninterned) symbols,
symbol-function allows you to set the function, and symbol-plist gives
you a property list for storing your slots. Alternatively, symbol-value
could refer to a slot vector. You can also pass a symbol as the first
parameter to funcall / apply.

This is actually how Closette from AMOP simulates funcallable objects to
implement a subset of CLOS.

[smh]

Good point. Implementations using closures and symbols have the same capabilities.

There is a slight advantage to closures in that a closure satisfied functionp and typep 'function while a symbol does not. My closure hack goes through some effort to prevent the implementation from being violated or even visible (to portable code) whereas the function, value, and plist bindings of a symbol are all public. Closures are "closed"! :-)

[Stefan Monnier]

> (lambda (&rest args) ; This is the new instance.
> (case (car args) ; empty arglist is nil
> (#1# fin)
> (#2# (setf fin (cadr args)))
> (#3# (gethash (cadr args) slots))
> (#4# (setf (gethash (cadr args) slots) (caddr args)))
> (t (apply fin args))))))

Indeed, I considered doing it that way, but the problem with it is that
it's not self-describing: additionally to slot access functions, I also
need a predicate function, and I can't see how to implement that.


Stefan

[Pascal J. Bourguignon]

Well, for the predicate you have two choices:

- keep the objects of a given type in a given list and identify them by
this presence. (not tasty, would be better with a weak list).

- go meta, by wrapping the native functions:


(defun box-typed-function (type function)
(lambda (message &rest args)
(ecase message
(type type)
(call (apply function args))
(…))))

(fbind 'sin (box-typed-function 'function (function sin)))
(fbind 'cos (box-typed-function 'function (function cos)))
(fbind 'thingy (box-typed-function 'funcallable-object (make-funcallable-object)))

[Jim Newton]

I found a something curious about funcallable-standard-object.

(defpackage "FUNCALLABLE-OBJECT"
(:use :cl :closer-mop)
(:shadowing-import-from :closer-mop standard-generic-function defmethod defgeneric))


(in-package "FUNCALLABLE-OBJECT")

(defclass X ()
())

(defmethod initialize-instance :after ((c X) &key)
(set-funcallable-instance-function
c
#'(lambda (&rest arguments)
(call c arguments))))

(defmethod call ((self X) &rest arguments)
(cerror "Return nil" "class ~A does not define a CALL method" (class-name (class-of self)))
nil)

(setf (find-class 'Z) nil)

(defclass Z (X)
()
(:metaclass funcallable-standard-class))


(defmethod call ((self Z) &rest arguments)
(cons self arguments))

(funcall (make-instance 'Z) 1 2 3) ==> triggers an error

Protocol violation: the FUNCALLABLE-STANDARD-CLASS class
#1=#<FUNCALLABLE-STANDARD-CLASS Z> does not have the class
#<SB-PCL:SYSTEM-CLASS FUNCTION> in its class precedence list:
(#1# #<STANDARD-CLASS X> #<STANDARD-CLASS STANDARD-OBJECT>
#<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT>
#<SB-PCL:SYSTEM-CLASS T>).
[Condition of type SB-PCL::CPL-PROTOCOL-VIOLATION]
See also:
SBCL Manual, Metaobject Protocol [:node]

However, If I change the definition of Z to the following, it works fine.

(defclass Z (X function)
()
(:metaclass funcallable-standard-class))

[Pascal Costanza]

This is specific to SBCL, not a general property of the CLOS MOP. See
Section 7.5.1 of the SBCL manual.

[Jim Newton]

Pascal, is this something Closer should/could solve? My understanding was that closer should iron over the different MOP interpretations of all the CL implementations.

According to the SBCL manual FUNCTION is a superclass of FUNCALLABLE-STANDARD-OBJECT, but the error message from SBCL says FUNCTION must be a superclass of Z (the class whose metaclass is F-S-O). (BTW my mac wants to spell correct metaclassto meatballs

Here is the paragraph from the SBCL manual 7.5.1:
The direct superclasses of funcallable-standard-object are (function standard-object), not (standard-object function).
This is to ensure that the standard-object class is the last of the standardized classes before t appearing in the class precedence list of generic-function and standard-generic-function, as required by section 1.4.4.5 of the ANSI specification.

[Jim Newton]

Here is another example which leads to more questions.
This defines a class called HAS-CALL. If a class inherits from HAS-CALL, then funcall-ing an object of that class causes the CALL generic function to be called with the object as first argument, and any remaining arguments following. Thus such a class can define a method CALL and that will implement be funcall-able behaviour.

This works great, except that the class of the object must be defined with
(:metaclass funcallable-standard-class)
in its defclass form.

There must be a way to make this automatic. I.e., to somehow create a subclass of FUNCALLABLE-STANDARD-CLASS, and use that derived class as the metaclass of HAS-CALL, with the result being that classes which inherit from HAS-CALL will also inherit the metaclass.

Does someone have a recipe for that?

---------------------------------
(defpackage "MY-APP"

(:use :cl :closer-mop)
(:shadowing-import-from :closer-mop standard-generic-function defmethod defgeneric))

(in-package "MY-APP")

(setf (find-class 'has-call) nil)
(setf (find-class 'X) nil)
(setf (find-class 'W) nil)
(setf (find-class 'U) nil)

(defgeneric call (obj &rest arguments))

(defclass has-call (standard-object function) ;; must list standard-object before function, else there is no applicable method for initialize-instance
()
(:metaclass funcallable-standard-class))

(defmethod initialize-instance :after ((self has-call) &key)
(set-funcallable-instance-function
self
#'(lambda (&rest arguments)
(apply #'call self arguments))))

(defmethod call ((self has-call) &rest arguments)
(declare (ignore arguments))

(cerror "Return nil" "class ~A does not define a CALL method" (class-name (class-of self)))
nil)

(defclass X (has-call)
()
(:metaclass funcallable-standard-class))


(defmethod call ((self X) &rest arguments)
(cons 1 (list self arguments)))

(funcall (make-instance 'X) 1 2 3)

(defclass W (X)
()
(:metaclass funcallable-standard-class))

(defmethod call ((self W) &rest arguments)
(cons 2 (list self arguments)))

(funcall (make-instance 'W) 1 2 3)

(defclass U (W)
()
(:metaclass funcallable-standard-class))

(funcall (make-instance 'U) 1 2 3)

[Jim Newton]

On the subject of how to make the metaclass force subclasses to use the same metaclass, I tried to add a method on ensure-class-using-class. The problem with this is that SBCL calls ensure-class-using-class with nil as the first argument.


(defmethod ensure-class-using-class ((class app-metaclass) name &rest args &key metaclass &allow-other-keys)
(case metaclass
((nil standard-class)
(apply #'call-next-method class name :metaclass metaclass args))
(t
(call-next-method))))

[WJ]

Pascal J. Bourguignon wrote:

> Stefan Monnier <mon...@iro.umontreal.ca> writes:
>
> > Common-Lisp has the notion of an object that can be called, functions
> > being one example, generic functions another (and IIUC symbols also are
> > callable).
> >
> > AFAICT the Common-Lisp standard does not provide a standard way to build
> > such objects in general: you can't define your own kind of
> > callable object.
> >
> > Do some Common-Lisp implementations offer a way to define your own
> > callable objects? If so, which ones, and what kind of primitive do they
> > provide to do that?
>
> Yes, it's done with the MOP and CLOS.
>
> I don't know the details, but basically you can define your own
> subclasses of closer-mop:FUNCALLABLE-STANDARD-OBJECT.

Gauche Scheme:

(define-method object-apply ((v <vector>) (i <integer>))
(vector-ref v i))

(#(a b c d e) 4)
===>
e

--
He has nothing but kind sentiments for those who would destroy his home and
family.... He is universally tolerant.... If he has any principles, he keeps
them well concealed.... He is, to the extent of his abilities, exactly like
the next citizen, who, he trusts, is trying to be exactly like him: a faceless,
characterless putty-man. --- Father Feeney; "Should Hate Be Outlawed?"

[Pascal Costanza]

On 21/08/2015 14:23, Jim Newton wrote:
> Pascal, is this something Closer should/could solve? My understanding was that closer should iron over the different MOP interpretations of all the CL implementations.

Yes, ideally Closer to MOP would solve this. I wasn't aware of the
documentation for this particular case, so maybe there is something
possible. Alas, Closer to MOP cannot always do a good job, especially
when it comes to generic functions, and sometimes it's better to leave
in the incompatibilities.

[Pascal Costanza]

You can define a method :around make-instance to replace the class being
asked for, for example to replace my-metaclass with a subclass of
my-metaclass.