can we do multiple inheritance in euslisp?

[knorth55]

can we do multiple inheritance in euslisp?
or can we dynamically change method name to avoid method name collision?
in euslisp doc, message forwarding is using pseudo multiple inheritance, but I could not find the code.

[Affonso-Gui]

No, EusLisp do not support multiple inheritance and it is not possible to implement it without changing the fundamentals of how methods are searched for in the language.

Message forwarding acts as pseudo multiple inheritance only for non-conflicting methods.
Sample code:

(defclass foo :super object :slots (a))
(defmethod foo
  (:test-foo (val) (1+ val)))

(defclass bar :super object :slots (b))
(defmethod bar
  (:test-bar (val) (* val 2)))

(defclass foobar :super foo :slots ((bar-inst :forward (:test-bar))))
(defmethod foobar
  (:init () (setq bar-inst (instance bar))))


irteusgl> (defvar c (instance foobar :init))
c
irteusgl> (send c :test-foo 1)
2
irteusgl> (send c :test-bar 2)
4

As for 'dynamically changing the method name', it seems that it may be sufficient to overwrite the metaclass methods variable, although this is of course not recommended.

irteusgl> (send foo :get-val 'methods)
((:test-foo (val) (1+ val)))

irteusgl> (send foo :set-val 'methods '((:test-foo-2 (val) (1+ val))))
((:test-foo-2 (val) (1+ val)))

irteusgl> (send c :test-foo-2 1)
2

[k-okada]

This is another example of how to change the method name.
https://github.com/euslisp/jskeus/blob/0f6abd3aeea52188b0173d39d5ddc985949f8ffc/irteus/irtgl.l#L137-L146

[knorth55]

Thank you for the answers.
I want to do multiple inheritance but also prevent method name collision, so I implemented in @k-okada 's idea.
knorth55/eus_vive#21

[knorth55]

I found out that method-name changing approach have problems with return-from.
an example code (but not multiple inheritance code) is like below.

#!/usr/bin/env roseus

(require :pr2-interface "package://pr2eus/pr2-interface.l")

(if (not (assoc :start-grasp-org (send pr2-interface :methods)))
  (rplaca (assoc :start-grasp (send pr2-interface :methods)) :start-grasp-org))


(defmethod pr2-interface
  (:start-grasp
    (&optional (arm :arms) &key ((:objects objs) nil) &rest args)
    (send* self :start-grasp-org arm args)))

when I try to do :start-grasp, I got the following error.

2.irteusgl$ (send *ri* :start-grasp)
Call Stack (max depth: 20):
  0: at (return-from :start-grasp (case arm (:larm (send robot :l_gripper_joint :joint-angle)) (:rarm (send robot :r_gripper_joint :joint-angle)) (t (list (send robot :l_gripper_joint :joint-angle) (send robot :r_gripper_joint :joint-angle)))))
  1: at (progn (dolist (a (if (eq arm :arms) '(:larm :rarm) (list arm))) (when objs (let ((grasp-convex (convex-hull-3d (flatten (mapcar #'(lambda (l) (send-all (send l :bodies) :worldcoords) (send-all (send l :bodies) :vertices)) (send robot a :gripper :links)))))) (dolist (obj objs) (when (or force-assoc (and (find-method obj :faces) (not (= (pqp-collision-check grasp-convex obj) 0)))) (if (send obj :parent) (send (send obj :parent) :dissoc obj)) (send robot a :end-coords :assoc obj)))))) (return-from :start-grasp (case arm (:larm (send robot :l_gripper_joint :joint-angle)) (:rarm (send robot :r_gripper_joint :joint-angle)) (t (list (send robot :l_gripper_joint :joint-angle) (send robot :r_gripper_joint :joint-angle))))))
  2: at (if (not joint-action-enable) (progn (dolist (a (if (eq arm :arms) '(:larm :rarm) (list arm))) (when objs (let ((grasp-convex (convex-hull-3d (flatten (mapcar #'(lambda (l) (send-all (send l :bodies) :worldcoords) (send-all (send l :bodies) :vertices)) (send robot a :gripper :links)))))) (dolist (obj objs) (when (or force-assoc (and (find-method obj :faces) (not (= (pqp-collision-check grasp-convex obj) 0)))) (if (send obj :parent) (send (send obj :parent) :dissoc obj)) (send robot a :end-coords :assoc obj)))))) (return-from :start-grasp (case arm (:larm (send robot :l_gripper_joint :joint-angle)) (:rarm (send robot :r_gripper_joint :joint-angle)) (t (list (send robot :l_gripper_joint :joint-angle) (send robot :r_gripper_joint :joint-angle)))))))
  3: at (when (not joint-action-enable) (dolist (a (if (eq arm :arms) '(:larm :rarm) (list arm))) (when objs (let ((grasp-convex (convex-hull-3d (flatten (mapcar #'(lambda (l) (send-all (send l :bodies) :worldcoords) (send-all (send l :bodies) :vertices)) (send robot a :gripper :links)))))) (dolist (obj objs) (when (or force-assoc (and (find-method obj :faces) (not (= (pqp-collision-check grasp-convex obj) 0)))) (if (send obj :parent) (send (send obj :parent) :dissoc obj)) (send robot a :end-coords :assoc obj)))))) (return-from :start-grasp (case arm (:larm (send robot :l_gripper_joint :joint-angle)) (:rarm (send robot :r_gripper_joint :joint-angle)) (t (list (send robot :l_gripper_joint :joint-angle) (send robot :r_gripper_joint :joint-angle))))))
  4: at (unless joint-action-enable (dolist (a (if (eq arm :arms) '(:larm :rarm) (list arm))) (when objs (let ((grasp-convex (convex-hull-3d (flatten (mapcar #'(lambda (l) (send-all (send l :bodies) :worldcoords) (send-all (send l :bodies) :vertices)) (send robot a :gripper :links)))))) (dolist (obj objs) (when (or force-assoc (and (find-method obj :faces) (not (= (pqp-collision-check grasp-convex obj) 0)))) (if (send obj :parent) (send (send obj :parent) :dissoc obj)) (send robot a :end-coords :assoc obj)))))) (return-from :start-grasp (case arm (:larm (send robot :l_gripper_joint :joint-angle)) (:rarm (send robot :r_gripper_joint :joint-angle)) (t (list (send robot :l_gripper_joint :joint-angle) (send robot :r_gripper_joint :joint-angle))))))
  5: at (apply #'send self :start-grasp-org arm args)
  6: at (apply #'send self :start-grasp-org arm args)
  7: at (send* self :start-grasp-org arm args)
  8: at (send *ri* :start-grasp)
  9: at #<compiled-code #X55bdbf4df5b0>
/home/knorth55/install/jskeus/eus/Linux64/bin/irteusgl 0 error: no such block in (return-from :start-grasp (case arm (:larm (send robot :l_gripper_joint :joint-angle)) (:rarm (send robot :r_gripper_joint :joint-angle)) (t (list (send robot :l_gripper_joint :joint-angle) (send robot :r_gripper_joint :joint-angle)))))

[Affonso-Gui]

Makes sense, and thanks for the heads up!

It is also interesting to notice that this seems to work for compiled code (?)

;; test.l
(defclass foo :super object)
(defmethod foo
  (:test-foo () (return-from :test-foo :none)))

(rplaca (assoc :test-foo (send foo :methods)) :test-bar)

(setq c (instance foo))

Then euscomp test.l and finally

(load "test.so")
(send c :test-bar)   ;; :none

If your objective is to ornament an existing method, though, why don't you use (standard single) inheritance?

(require :pr2-interface "package://pr2eus/pr2-interface.l")

(defclass awesome-pr2-interface :super pr2-interface)
(defmethod awesome-pr2-interface
  (:start-grasp
    (&optional (arm :arms) &key ((:objects objs) nil) &rest args)
    (send-super* :start-grasp arm args)))

[knorth55]

this is just a simple example and we can avoid this error when i use single inheritance.
but for multiple inheritance with method renaming approach, we have this return-from error.

[Affonso-Gui]

Oh, ok.

By the way is the below fairly close to what you would want to achieve with 'multiple-inheritance'? If you could give us more details it would be easier to find better work-arounds.

(defclass foo :super object :slots (a))
(defmethod foo
  (:test-foo (val) (1+ val)))

(defclass bar :super object :slots (b))
(defmethod bar
  (:test-foo (val) (* val 2))  ;; overlapping method
  (:test-bar (val) (* val 10)))

(eval `(defclass foobar :super foo
         :slots ((bar-inst :forward ,(mapcar #'car (send bar :all-methods))))))
(defmethod foobar
  (:init () (setq bar-inst (instance bar)))
  (:test-foo-bar (a) (send bar-inst :test-foo a)))

(defvar c (instance foobar :init))
(send c :test-foo 10)  ;; 11
(send c :test-bar 10)  ;; 100
(send c :test-foo-bar 10)  ;; 20

[knorth55]

@Affonso-Gui probably, your example is what I want to do. Thanks you.

[tkmtnt7000]

@Affonso-Gui
I found that this method does not run with slot variables.

(defclass foo :super object :slots (a))
(defmethod foo
  (:test-foo (val) (1+ val)))

(defclass bar :super object :slots (b))
(defmethod bar 
  (:init (setq b 10))
  (:test-foo (val) (* val (send self :test-bar val)))  ;; overlapping method
  (:test-bar (val) (* val b)))

(eval `(defclass foobar :super foo
         :slots ((bar-inst :forward ,(mapcar #'car (send bar :all-methods)))))
(defmethod foobar
  (:init () (setq bar-inst (instance bar)))
  (:test-foo-bar (a) (send bar-inst :test-foo a)))

(defvar c (instance foobar :init))
(print (send c :test-foo 10))  ;; 11
(print (send c :test-bar 10))  ;; 100
(print (send c :test-foo-bar 10))  ;; 20

[Affonso-Gui]

I am not sure why you are getting this result. When I try to run your code I get some errors regarding the parenthesis mismatch and faulty initialization, and when I correct them to what I think you were running then the code seems to execute normally.

(defclass foo :super object :slots (a))
(defmethod foo
  (:test-foo (val) (1+ val)))

(defclass bar :super object :slots (b))
(defmethod bar 
  (:init () (setq b 10))
  (:test-foo (val) (* val (send self :test-bar val)))  ;; overlapping method
  (:test-bar (val) (* val b)))

(eval `(defclass foobar :super foo
         :slots ((bar-inst :forward ,(mapcar #'car (send bar :all-methods))))))
(defmethod foobar
  (:init () (setq bar-inst (instance bar :init)))
  (:test-foo-bar (a) (send bar-inst :test-foo a)))

(defvar c (instance foobar :init))
(print (send c :test-foo 10))  ;; 11
(print (send c :test-bar 10))  ;; 100
(print (send c :test-foo-bar 10))  ;; 1000

Note:

• the parenthesis in eval
• the argument list in the bar :init
• passing :init when initializing the bar-inst instance

[Affonso-Gui]

Ok, I think I solved this.

You were probably running your code after executing the sample I posted.
However because we are using defvar the variable c is only assigned in the first time and not overwritten in the second time (try using setq or defparameter instead).

This method should work just fine with slot variables as well.

[knorth55]

@Affonso-Gui sorry, it was my typo. and there is also a typo in :init.

[knorth55]

@Affonso-Gui In that case, slot variable will not be shared, so we should take care of it.

(defclass foo :super object :slots (b))
(defmethod foo
  (:test-foo (val) (1+ val))
  (:test-b () (setq b 10)))

(defclass bar :super object :slots (b))
(defmethod bar 
  (:init ())
  (:test-foo (val) (* val (send self :test-bar val)))  ;; overlapping method
  (:test-b () (setq b 20))
  (:test-bar (val) (send self :test-b) (* val b)))

(eval `(defclass foobar :super foo
         :slots ((bar-inst :forward ,(mapcar #'car (send bar :all-methods))))))

(defmethod foobar
  (:init () (setq bar-inst (instance bar :init)))
  (:test-foo-bar (a) (send bar-inst :test-foo a)))

(defvar c (instance foobar :init))
(print (send c :test-foo 10))  ;; 11
(print (send c :test-bar 10))  ;; 200
(print (send c :test-foo-bar 10))  ;; 2000

[knorth55]

maybe this example is better.
method can be shared, but can we share the slot variables?

(defclass foo :super object :slots (b))
(defmethod foo
  (:test-foo (val) (1+ val))
  (:test-b () (setq b 10)))

(defclass bar :super object :slots (b))
(defmethod bar 
  (:init ())
  (:test-foo (val) (* val (send self :test-bar val)))  ;; overlapping method
  (:test-bar (val) (* val b))
  (:test-b () (setq b 20)))

(eval `(defclass foobar :super foo
         :slots ((bar-inst :forward ,(mapcar #'car (send bar :all-methods))))))

(defmethod foobar
  (:init () (setq bar-inst (instance bar :init)))
  (:test-foo-bar (val) (send bar-inst :test-foo val)))

(defvar c (instance foobar :init))
(print (send c :test-foo 10))  ;; 11
(send c :test-b)
(print (send c :test-bar 10))  ;; error 
(print (send c :test-foo-bar 10))  ;; error

[Affonso-Gui]

Sharing slot variables is much more challenging.
We could initialize them with the same variable or add some syntactic sugar for (let ((b (send bar-inst :get-val 'b)) ..., but this would not share the variable 'pointer'.

Actually in CLOS the symbol-macrolet had to be defined for this sole purpose, and although we might find some workarounds for specific cases I cannot think of any general and easy way of doing this.