define-class.lisp

;;;;****************************************************************************

;;;; SPECIALIZING SLOTS WITH THE DEFINE-CLASS MACRO

;;;;****************************************************************************

;;;;***** RATIONALE ************************************************************

;;; In this file, we introduce a DEFINE-CLASS macro that proposes a particular
;;; approach to defining CLOS classes such that type information is retained
;;; in slots and can be specialized on.

;;; Consider the following set-up

(defclass shape ()
  ((%shape :initarg :shape :accessor shape)))

(defclass circle (shape) ())
(defclass square (shape) ())
(defclass rectangle (shape) ())

(defclass color ()
  ((%color :initarg :color :accessor color)))

(defclass red-color (color) ())
(defclass green-color (color) ())
(defclass blue-color (color) ())
(defclass black-color (color) ())
(defclass brown-color (color) ())

;;; We can then create colored-shapes as follows, by inheriting from SHAPE
;;; and COLOR. We prepend this name with OLD because we will hopefully show
;;; a better way in our proposed approach

(defclass old-colored-shape (shape color) ())

;;; If we want to have a RED-CIRCLE class, we could do

(defclass red-circle (circle red-color) ())

;;; However, with 3 different types of shapes and 5 colors, we are left
;;; with 15 combinations, which is too many to manually create

;;; But why do we want to identify RED-CIRCLE objects?

;;; One situation would be if we want to specialise on RED-CIRCLES...
;;; ...something like this: (defmethod paint ((obj old-red-circle)) ...)

;;; Which brings us to our DEFINE-CLASS Proposal

;;;;****************************************************************************

;;;;***** PROPOSAL *************************************************************

;;; What if we did the following:

(defclass colored-shape (shape color)
  ((%shape :initarg :shape :accessor colored-shape-shape)
   (%color :initarg :color :accessor colored-shape-color)))

;;; And instead of putting the VALUE of a SHAPE / COLOR in the slot, we put
;;; an actual SHAPE / COLOR OBJECT into the slot, e.g.

;; (make-instance 'colored-shape :shape (make-instance 'circle) :color (make-instance 'red-color))

;;; We then add some methods to hide this indirection:

;; (defmethod shape ((obj colored-shape))
;;   (shape (colored-shape-area obj)))

;; (defmethod (setf shape) (val (obj colored-shape))
;;   (setf (colored-shape-area obj) val))

;;; This will then allow us to specialise on the components of a COLORED-SHAPE,
;;; by passing each slot as an argument:

;; (defmethod paint ((obj circle) (obj green-color)) ...)

;; which can be called by (paint (shape obj) (color obj))

;;; The benefit of this approach is that we do not need to define each of the
;;; combinations that we need to use, and the information of the type of object
;;; stored in the slots is retained

;;; The downside is the indirection and additional complexity

;;;;****************************************************************************

;;;;***** THE MACRO ************************************************************

;;; No point doing a proposal without code :-) See below for a draft version.

;;;;****************************************************************************

;;; Simple helper function to generate and intern symbols from component strings

(defun concatenate-and-intern (&rest objects)
  "Generate and intern a symbol based on the concatenation of the supplied objects."
  (intern (apply #'concatenate 'string (mapcar #'stringify objects))))

(defun concatenate-and-intern-keyword (&rest objects)
  "Generate and intern a keyword symbol based on the concatenation of the supplied objects."
  (intern (apply #'concatenate 'string (mapcar #'stringify objects)) "KEYWORD"))

(defgeneric stringify (obj)
  (:documentation "Generate a string equivalent of OBJ."))

(defmethod stringify ((obj string))
  obj)

(defmethod stringify ((obj symbol))
  (symbol-name obj))

;;;;****************************************************************************

;;; Generate Slot Forms for use in DEFINE-CLASS Macro
;;; Slots are either symbol or (symbol . initform)

(defun define-class-inherited-slot-forms (class-name slots)
  "Returns a list of slot forms for use within the DEFINE-CLASS macro expression."
  (loop for slot in slots
	collect
	(typecase slot
	  (atom (list (concatenate-and-intern "%" slot)
		      :initarg (concatenate-and-intern-keyword slot)
		      :accessor (concatenate-and-intern class-name "-" slot)))
	  (cons (list (concatenate-and-intern "%" (car slot))
		      :initarg (concatenate-and-intern (car slot))
		      :accessor (concatenate-and-intern class-name "-" (car slot))
		      :initform (concatenate-and-intern `',(cdr slot)))))))

;;;;****************************************************************************

(defun define-class-primary-slot-forms (class-name)
  "Returns a slot form for use within the DEFINE-CLASS macro expression for single-slot classes."
  (list (list (concatenate-and-intern "%" class-name)
	      :initarg (concatenate-and-intern-keyword class-name)
	      :accessor (concatenate-and-intern class-name))))

;;;;****************************************************************************

;;; Modify Accessor Functions

(defun define-class-reader-forms (class-name slots)
  "Generate a DEFMETHOD form to re-point the reader for SLOT in CLASS-NAME to (SLOT (CLASS-NAME OBJ))."
  (loop for slot in slots
	collect
	`(defmethod ,slot ((obj ,class-name))
	   (,slot (,(concatenate-and-intern class-name "-" slot) obj)))))

(defun define-class-writer-forms (class-name slots)
  "Generate a DEFMETHOD form to re-point the reader for SLOT in CLASS-NAME to (SLOT (CLASS-NAME OBJ))."
  (loop for slot in slots
	collect
	`(defmethod (setf ,slot) (val (obj ,class-name))
	   (setf (,(concatenate-and-intern class-name "-" slot) obj) val))))

;;;;****************************************************************************

;;; Primary Macro

(defmacro define-class (class-name slots non-inherited-slots &rest options)
  "Define a CLOS class for CLASS-NAME with SLOTS such that the SLOTS can be specialised in a generic function call.
Assumes SLOTS are defined as single-slot classes to begin with. [Better docstring to be written]."
  (let ((slot-forms (if (null slots)
			(define-class-primary-slot-forms class-name)
			(define-class-inherited-slot-forms class-name slots)))
	(reader-forms (define-class-reader-forms class-name slots))
	(writer-forms (define-class-writer-forms class-name slots)))
    `(progn
       (defclass ,class-name ,slots
	 (list ,@slot-forms ,non-inherited-slots)
	 ,@options)
       ,@reader-forms
       ,@writer-forms)))

Note for Future:

Hi all - I'm keen on any feedback on the following. I was thinking of a way to combine classes (multiple inheritance) in a way that allows for generic functions to specialise on slots
lisp123
https://gist.github.com/ashok-khanna/8ce9821e6f87fda49135ab0807d4375e
nij-
Btw yitzi there seems to be two different cl-org-mode: https://github.com/deepfire/cl-org-mode https://common-lisp.net/project/cl-org-mode/
lisp123
yitzi: What about a pure CL solution? I.e. create a mini documentation system
18:07 nij-
The second one is well-documented but I cannot find the code.
nij-
The first one has the code but doesn't seem easy to use.
yitzi
lisp123: I am sure it may be that eventually, but I have to hook into the existing stuff they are working on in CLIM (which is a spec browser of sorts).
lisp123
yitzi: Ah okay, understood
nij- has left IRC (Quit: Using Circe, the loveliest of all IRC clients)
pranavats has left (Error from remote client)
pranavats has joined (3fba1d1b34@jabberfr.org)
s-liao has left IRC (Quit: Client closed)
cage
local-nicknames are great! Thanks to all the people that implemented this feature!
rotateq
lisp123: i think about your line 172 if it would macro-expand correctly
rotateq
and maybe better when you do ATOM in a typecase branch then not LIST but CONS in the other
rotateq
yes it is cage
lisp123
rotateq: I hacked that in (I tested it without non-inherited-slots), but will fix that later if necessary (at least the general idea can be taken)
lisp123
let me rename list to cons :-)
rotateq
colored-shape-shape :D
rotateq
yes I just have this in mind "everything that's not a CONS is an ATOM" ^^
lisp123
rotateq: It's a better way for sure, thanks for pointing out. Since the definition of ATOM is (not cons)
rotateq
yes but with the macro in the end, did you do some expand?
lisp123
it seems to work
lisp123
I just haven't tested with non-inherited-slots yet
rotateq
hmm I just wasn't sure with the list thing in line 172
lisp123
there's a typo, non-inherited-slots should be ,non-inherited-slots
lisp123
but otherwise okay: https://plaster.tymoon.eu/view/2841#2841
pjb
lisp123: you cannot dispatch on slots, but you can dispatch on mixin classes.
lisp123
pjb: So the point here is to store an instance of the mixin class (even though in normal usage they are not meant to be instantiated) in the slot, so that then you can dispatch on the slot
pjb
lisp123: you seem to be saying something different now. You're talking now about the slot value. Before you only talked about the slots.
contrapunctus
In this program I'm working on, a.lisp contains a:my-class and generic function make-foo ; b.lisp contains b:my-class and method make-foo specializing on b:my-class . But when I call make-foo in a.lisp I get a 'no applicable method' error. The object it is called with is an instance of b:my-class ...so what gives? 🤔️
Xach
contrapunctus: does make-foo refer to the same symbol in each file?
lisp123
pjb: Sorry, so what I meant was to overcome the inability to specialise on slot, I am suggesting storing an instance of the mixin class in the slot so that when you pass the slot value to a generic function, you can specialise on it (since it is now a class object vs. a value)
pjb
lisp123: https://termbin.com/ewcv
pjb
lisp123: otherwise it's just a matter of calling th egeneric function on the slot value: (defclass point () ((x :initarg :x :reader x))) (defmethod move ((pt point)) (move (x pt))) (move (make-instance 'point :x (make-instance ' :body 'bod))) #| moving body --> nil |#
pjb
lisp123: an instance of a class, be it a mixin class, is an instance, not a class, unless that class was a meta class.
pjb
classes are first class objects in lisp, so class objects are values.
rotateq
ah okay lisp123, now i got it, was just unfamiliar use in a backquoted expression
lisp123
pjb: Thanks. So that code makes sense. Now what if you want to subclass into
lisp123
You would need to create or something similar, correct?
pjb
Then you just do that, and (defclass bipedal-animal (animal ) ())
pjb
Yes.
pjb
Again do you want to dispatch on the slots, or on the values bound to the slots?
lisp123
But if there's many combinations (e.g. 10 shapes x 15 colors = 150), it becomes a lot
pjb
there are method combinations.
pjb
what method combination do you want?
pjb
lisp123: what is the last name of a last name?
rotateq
lisp123: so you can learn writing macros that generate macros maybe
pjb
I've not given a first name to my first name. Perhaps I should. "Pascal" I name thee "Bob"!
pjb
Now (first-name #) -> "Bob"…
pjb
What use is that?
contrapunctus
Xach: I think so. It's always used without package prefixes...
lisp123
pjb: My terminology is bad, so rather than saying it the wrong way, let me give an example: (make-instance 'animal :leg (make-instance ' :leg "leg") ...)
pjb
lisp123: instead of talking about classes, slots, values, etc, you should be talking about your problem domain!
phoe
contrapunctus: that's a code smell
pjb
lisp123: what are those colors and those shapes?
phoe
DEFMETHOD is kinda infamous for silently implicitly creating generic functions
phoe
so DEFMETHOD FOO and DEFMETHOD FOO in two different packages can silently define methods on two different GFs
contrapunctus
phoe: so do I write (defmethod a:make-foo ...) ?
lisp123
If you do that, then you can do (defmethod new-move ((obj animal) (obj right-leg)) ...) and then called with (new-move animal (leg animal))
phoe
contrapunctus: either that or you IMPORT-FROM the symbol
phoe
or rather, IMPORT the symbol, or use :IMPORT-FROM in your package definition
contrapunctus
Ah, that seems to have changed the error, at least xD
contrapunctus
thanks phoe and Xach
pjb
lisp123: yes, this is my point example above. you don't need the mixins, just have your method call methods that dispatch on the slot values.
lisp123
pjb: Thanks, will think a bit and re-read the above
pjb
lisp123: again, it would be better if you explained first what you want to do.
pjb
Not how.
cage
rotateq: :)
tyson2 has left IRC (Remote host closed the connection)
lisp123
pjb: I am writing a parser with a large set of rules (well not that large, but lets assume it can get large) on how to parse. Initially, I had a large COND table that went through each parser rule and applied it. Now I'm rewriting in a CLOS way where each of those conditional paths becomes its own DEFMETHOD, specialising on parts of the object it receives
lisp123
For example, I read a word say "Thus," and I split it into components - the word "thus" and trailing-punctuation ",". For some types of words, trailing punctuation matters, for others it does not
frodef
I haven't really figured out pathnames.. if I have a directory foo (e.g. #p"/tmp/") how am I suppod to get the pathname for the file "bar.zap" in that directory? (so ending up with #p"/tmp/bar.zap")
Bike has joined (~Glossina@71.69.170.70)
ChanServ has changed mode: +o Bike
pjb
lisp123: Perhaps something similar to what I did to parse lambda-lists: https://github.com/informatimago/lisp/blob/master/common-lisp/lisp-sexp/source-form.lisp#L495 ?
foxfromabyss has left IRC (Quit: Client closed)
nature has left IRC (Ping timeout: 240 seconds)
lisp123
pjb: Thanks, will have a read
pjb
lisp123: but otherwise, the question when you perform an OO analyse, is to determine what concepts need to be reified, ie. made into objects/classes.
lisp123
pjb: It's a hard topic :(
domovod has joined (~domovod@176.196.122.197)
pjb
lisp123: when you have a cond, you have a mapping from conditions to expressions. If you consider that each mapping is a rule, and reify rules, this means that you preview that there may be a dynamic set of rules. If all the rules are fixed and known at code writing time, then writing the cond may be better.
bollu
I'm trying to move to emacs+slime. When I run slime-eval-buffer, I get an error at (EVAL (ASSERT-EQUAL (DEEPEQ (MK-INST-ADD :X :Y 1) (MK-INST-ADD :X :Y 1)) T)), where the (ASSERT-EQUAL ...) comes from my source code
bollu
How do I move to the appropriate source location
lisp123
pjb: "known at code writing time..." -> Yes, I was getting to the same conclusion as well as I did it more
bollu
or, am I supposed to run my LISP file with some other interface?
bollu
I'm using emacs+slime+sbcl for the record. I don't know if that affects things.
pjb
lisp123: so if you reify the rule; (defclass rule () ((condition :initarg condition-predicate :reader condition-predicate) (parser :initarg :parser-function :reader parser-function))) You can indeed replace the cond with something like: (loop for rule in (grammar-rules grammar) when (funcall (condition-predicate rule) scanner) do (funcall (parser-function rule)))
lisp123
pjb: Not sure if its clear, but basically I wanted to avoid having to create red-circle, but rather be able to write a method (defmethod paint ((obj circle) (obj red-color)) ...) -> (paint obj (color obj) and have it work
lisp123
pjb: Yes I thought that too
pjb
lisp123: (defclass colored-circle (circle) ((color :initarg :color :reader color)))
pjb
Then you just use (make-instance 'colored-circle :color 'red) as a normal circle.
bollu
[also, should I use slime? versus sly?]
notzmv has left IRC (Ping timeout: 240 seconds)
lisp123
pjb: In that example, how do you write a method that specialises on color = red (apart from EQL specialisation)?
rotateq
bollu: yes start with slime
pjb
lisp123: why would you want to do that?
bollu
rotateq okay
monaaraj has left IRC (Ping timeout: 256 seconds)
taiju has left IRC (Ping timeout: 240 seconds)
bollu
rotateq How do I go the location of an error in slime? Like I said, when I press v, it takes me to the definition of eval, NOT to the definition of assert-equal from my source which is frustrating
pjb
lisp123: (driver-behavior car (color semaphore))
bollu
Like, I don't care about the details of the REPL. I want to see my code
rotateq
bollu: for example i use spacemacs, then have left the source file buffer and right the REPL, then i can (re)evaluate forms with C-c C-c
rotateq
ehm don't know
pjb
lisp123: (defmethod driver-behavior (mobile (semaphore-color (eql 'red0))) …)
bollu
so, on the stack frame, I do see a call to DEEPEQ, but it seems to be tagged as [fast-method] and heavily processed by SBCL
bollu
There must be some way to run code in "debug mode"?
Xach
frodef: (merge-pathnames relative absolute) is one way
lisp123
pjb: Yes, that I get. But then you lose the inheritance structure of colors (perhaps there is pale-red, dark-red etc. and you want to specialise on red)
lisp123
(pale-red and dark-red roll up into red)
frodef
Xach: thanks.
myrrh has left IRC (Remote host closed the connection)
frodef
..what if I want to get at "foo/bar.zap" relative to some directory?
kevingal has left IRC (Ping timeout: 256 seconds)
Xach
frodef: merge-pathnames works there too
pjb
lisp123: colors are not structured, they're a continuum.
pjb
lisp123: you need to perform an OO analysis first.
pjb
lisp123: Of course, your analysis may lead you to things like green yellow red as symbols or semaphore states. But not colors.
lisp123
pjb: Indeed. But this was more about an approach to take where I don't "lose" information
pjb
(semaphore-state sem) -> #
pjb
Then you can have classes such as closed-semaphore-state open-semaphore-state etc.
lisp123
pjb: That's a good idea actually, I will google this "semaphore" thing
frodef
Xach: (merge-pathnames #p"/tmp/" #p"bar/foo.zap") -> #P"/tmp/foo.zap"
pjb
lisp123: again, you must do the analysis!
Xach
frodef: bar/foo.zap is relative. it should go first.
pjb
lisp123: https://en.wikipedia.org/wiki/Object-oriented_analysis_and_design
Xach
(merge-pathnames relative abvsolute)
lisp123
pjb: Thanks. By the way, do you have any recommended books?
frodef
Xach: indeed. Thanks!
monaaraj has joined (~MonAaraj@user/mon-aaraj/x-4416475)
pjb
lisp123: eg. Grady Booch. "Object-oriented Analysis and Design with Applications, 3rd edition":http://www.informit.com/store/product.aspx?isbn=020189551X Addison-Wesley 2007. or Meyer, Bertrand (1988). Object-Oriented Software Construction. Cambridge: Prentise Hall International Series in Computer Science. p. 23. ISBN 0-13-629049-3.
lisp123
pjb: Thanks <3!
rotateq
oh Bertrand Meyer :)

doesn't make sense
dispatch on values
can have a function that generates a value and dispatch on that
but otherwise, the question when you perform an OO analyse, is to determine what concepts need to be reified, ie. made into objects/classes.
perform OO analyse