[cl-backend]

when doing method dispatch the type of the invocant is taken into account

cl-backend/backend.lisp

@@ -121,31 +121,32 @@
 ) `(setf ,(main-xref i) 'placeholder))
 
 (defmacro define-nam-class (
- i
- name            ; The object's debug name
- exports         ; List of global names to which object is bound
- attributes      ; Attributes local to the class
- methods         ; Methods local to the class
- superclasses    ; Direct superclasses of the class
- linear_mro      ; All superclasses in C3 order
- ) 
-  `(progn
-    (defclass ,(main-xref i) (p6-Mu) ())
-    ,@(mapcar #'compile-method methods)
-    (setf ,(main-xref i) (make-instance ',(main-xref i)))
-    ))
+  i
+  name            ; The object's debug name
+  exports         ; List of global names to which object is bound
+  attributes      ; Attributes local to the class
+  methods         ; Methods local to the class
+  superclasses    ; Direct superclasses of the class
+  linear_mro      ; All superclasses in C3 order
+  ) 
+  (let ((class (main-xref i)))
+    `(progn
+      (defclass ,class (p6-Mu) ())
+      ,@(mapcar (lambda (m) (compile-method class m)) methods)
+      (setf ,(main-xref i) (make-instance ',(main-xref i)))
+    )))
 
 (defun method-name (name) (intern name))
 
-(defun compile-method (method)
+(defun compile-method (class method)
   (fare-matcher:match method 
     ((and (list 
       name ; Method name without ! decorator
       kind ; Allowable kinds are "normal", "private", and "sub"
       var  ; Variable for implementing sub in param role
       body ; Reference to implementing sub
     ) (when (equal kind "normal")))
-      `(defmethod ,(method-name name) (invocant &rest rest) (apply ',(xref-to-subsymbol body) invocant rest)))))
+      `(defmethod ,(method-name name) ((invocant ,class) &rest rest) (apply ',(xref-to-subsymbol body) invocant rest)))))
 
 ; converts one lexical to a variable declaration for a let
 (defun lexical-to-let (lexical)
@@ -210,7 +211,7 @@
                             (format t "Can't handle that sort of method call yet")
                             ))))
 (nam-op methodcall (method-name dunno invocant &rest args) 
-  `(,(method-name (to-string method-name)) ,@args)))
+  `(,(method-name (to-string method-name)) (FETCH ,(first args)) ,@(rest args))))
 
 
 (defun nam-obj_getbool (obj) (if (numberp obj) (not (equal obj 0)) t))

simple-tests/different-methods.t

@@ -0,0 +1,15 @@
+say "1..2";
+class Foo {
+    method ok {
+        say "ok 1";
+    }
+}
+class Bar {
+    method ok {
+        say "ok 2";
+    }
+}
+my $foo = Foo.new();
+my $bar = Bar.new();
+$foo.ok();
+$bar.ok();