From 96350d142146fd6784ba9f9ccf336a56af8da826 Mon Sep 17 00:00:00 2001
From: tamura shingo <tamura.shingo@gmail.com>
Date: Wed, 25 Mar 2026 08:00:14 +0900
Subject: [PATCH 1/2] Add defgeneric type definition support with method
 dispatch type safety

Support type extraction, type checking, transpilation, LSP integration,
and serialization for defgeneric/defmethod. Validates return types,
argument counts, and specializers. Handles defmethod without defgeneric
and implicit generic functions from defclass accessors.
---
 sample/sample-project.asd |   2 +
 sample/src/animals.tycl   |  59 +++++++++
 sample/src/main.tycl      |  15 +++
 sample/src/packages.lisp  |  14 +-
 src/lsp-integration.lisp  |  44 ++++++-
 src/packages.lisp         |   3 +
 src/transpiler.lisp       |  52 ++++++++
 src/type-checker.lisp     |  99 +++++++++++++-
 src/type-extractor.lisp   |  75 ++++++++++-
 src/type-info.lisp        |  26 ++++
 src/type-serializer.lisp  |  14 ++
 test/defgeneric-test.lisp | 265 ++++++++++++++++++++++++++++++++++++++
 tycl.asd                  |   3 +-
 13 files changed, 658 insertions(+), 13 deletions(-)
 create mode 100644 sample/src/animals.tycl
 create mode 100644 test/defgeneric-test.lisp

diff --git a/sample/sample-project.asd b/sample/sample-project.asd
index d5818d4..ffc868e 100644
--- a/sample/sample-project.asd
+++ b/sample/sample-project.asd
@@ -19,6 +19,7 @@
   :tycl-output-dir "build/"
   :tycl-extract-types t
   :tycl-save-types t
+  :depends-on ("cl-ppcre")
   :components ((:module "src"
                 :serial t
                 :components
@@ -28,6 +29,7 @@
                  (:tycl-file "collections")
                  (:tycl-file "models")
                  (:tycl-file "api")
+                 (:tycl-file "animals")
                  (:file "config")
                  (:tycl-file "main"))))
   :in-order-to ((test-op (test-op "sample-project/test-rove"))))
diff --git a/sample/src/animals.tycl b/sample/src/animals.tycl
new file mode 100644
index 0000000..3121042
--- /dev/null
+++ b/sample/src/animals.tycl
@@ -0,0 +1,59 @@
+;;; -*- mode: lisp -*-
+;;;; Sample Project - Animals (TyCL)
+;;;; Demonstrates defgeneric/defmethod with class hierarchy
+(in-package #:cl-user)
+(defpackage #:sample-project/animals
+  (:use #:cl)
+  (:export #:animal #:animal-name
+           #:dog #:dog-breed
+           #:cat #:cat-color
+           #:say
+           #:introduce
+           #:describe-animal
+           #:book #:product #:get-label
+           #:print-labels))
+(in-package #:sample-project/animals)
+
+;;; Class hierarchy
+(defclass animal ()
+  (([name :string] :initarg :name :accessor animal-name)))
+
+(defclass dog (animal)
+  (([breed :string] :initarg :breed :accessor dog-breed)))
+
+(defclass cat (animal)
+  (([color :string] :initarg :color :accessor cat-color)))
+
+;;; Generic function with type annotations
+(defgeneric [say :string] ([animal animal]))
+
+(defmethod [say :string] ([animal dog])
+  (format nil "~A (a ~A dog): Woof!" (animal-name animal) (dog-breed animal)))
+
+(defmethod [say :string] ([animal cat])
+  (format nil "~A (a ~A cat): Meow!" (animal-name animal) (cat-color animal)))
+
+;;; Function that uses the generic function
+(defun [introduce :void] ([animal animal])
+  (format t "  ~A~%" (say animal)))
+
+;;; defmethod without defgeneric (implicit generic function)
+(defmethod [describe-animal :string] ([animal dog])
+  (format nil "Dog: ~A, breed: ~A" (animal-name animal) (dog-breed animal)))
+
+(defmethod [describe-animal :string] ([animal cat])
+  (format nil "Cat: ~A, color: ~A" (animal-name animal) (cat-color animal)))
+
+;;; Unrelated classes sharing the same accessor name
+;;; CLOS implicitly creates a single defgeneric with methods for each class
+(defclass book ()
+  (([title :string] :initarg :title :accessor get-label)))
+
+(defclass product ()
+  (([name :string] :initarg :name :accessor get-label)))
+
+(defun [print-labels :void] ([b book] [p product])
+  (format t "  Book label: ~A~%" (get-label b))
+  (format t "  Product label: ~A~%" (get-label p)))
+
+;;; vim: set filetype=lisp :
diff --git a/sample/src/main.tycl b/sample/src/main.tycl
index dc99ac1..7889e6a 100644
--- a/sample/src/main.tycl
+++ b/sample/src/main.tycl
@@ -29,6 +29,10 @@
                 #:add-user
                 #:find-user
                 #:list-users)
+  (:import-from #:sample-project/animals
+                #:animal #:dog #:cat
+                #:say #:introduce #:describe-animal
+                #:book #:product #:print-labels)
   (:export #:format-result
            #:describe-app
            #:run))
@@ -77,6 +81,17 @@
   (format t "~A~%" (list-users))
   (format t "find Alice: ~A~%" (find-user "Alice"))
   (format t "find Charlie: ~A~%" (find-user "Charlie"))
+  (format t "~%--- Animals (defgeneric/defmethod) ---~%")
+  (let ((pochi (make-instance 'dog :name "Pochi" :breed "Shiba"))
+        (tama (make-instance 'cat :name "Tama" :color "calico")))
+    (introduce pochi)
+    (introduce tama)
+    (format t "  ~A~%" (describe-animal pochi))
+    (format t "  ~A~%" (describe-animal tama)))
+  (format t "~%--- Shared Accessor (implicit defgeneric) ---~%")
+  (let ((b (make-instance 'book :title "Common Lisp the Language"))
+        (p (make-instance 'product :name "TyCL Compiler")))
+    (print-labels b p))
   (format t "~%Done.~%"))
 
 ;;; vim: set filetype=lisp :
diff --git a/sample/src/packages.lisp b/sample/src/packages.lisp
index 67e51f0..6ee55ec 100644
--- a/sample/src/packages.lisp
+++ b/sample/src/packages.lisp
@@ -43,13 +43,25 @@
            #:find-user
            #:list-users))
 
+(defpackage #:sample-project/animals
+  (:use #:cl)
+  (:export #:animal #:animal-name
+           #:dog #:dog-breed
+           #:cat #:cat-color
+           #:say
+           #:introduce
+           #:describe-animal
+           #:book #:product #:get-label
+           #:print-labels))
+
 (defpackage #:sample-project/main
   (:use #:cl
         #:sample-project/math
         #:sample-project/string-utils
         #:sample-project/config
         #:sample-project/collections
-        #:sample-project/api)
+        #:sample-project/api
+        #:sample-project/animals)
   (:export #:format-result
            #:describe-app
            #:run))
diff --git a/src/lsp-integration.lisp b/src/lsp-integration.lisp
index 8267824..c51134b 100644
--- a/src/lsp-integration.lisp
+++ b/src/lsp-integration.lisp
@@ -46,7 +46,17 @@
       (:value
        (append base-info
                `((:type . ,(type-to-json (value-type-spec type-info))))))
-      
+
+      (:generic-function
+       (append base-info
+               `((:params . ,(mapcar (lambda (param)
+                                      `((:name . ,(getf param :name))
+                                        (:type . ,(type-to-json (getf param :type)))))
+                                    (function-params type-info)))
+                 (:return . ,(type-to-json (function-return-type type-info)))
+                 ,@(when (function-type-params type-info)
+                     `((:type-params . ,(function-type-params type-info)))))))
+
       (:function
        (append base-info
                `((:params . ,(mapcar (lambda (param)
@@ -289,6 +299,7 @@
   "Create LSP completion item from type-info"
   (let ((kind (ecase (type-info-kind type-info)
                 (:function "Function")
+                (:generic-function "Function")
                 (:method "Method")
                 (:class "Class")
                 (:value "Variable")
@@ -327,7 +338,18 @@
   (ecase (type-info-kind type-info)
     (:value
      (format nil "~a" (value-type-spec type-info)))
-    
+
+    (:generic-function
+     (format nil "generic ~A(~{~a~^ ~}) → ~a"
+             (if (function-type-params type-info)
+                 (format nil "{~{~A~^, ~}}" (function-type-params type-info))
+                 "")
+             (insert-optional-marker
+              (mapcar (lambda (p) (getf p :type))
+                      (function-params type-info))
+              (function-params type-info))
+             (function-return-type type-info)))
+
     (:function
      (format nil "~A(~{~a~^ ~}) → ~a"
              (if (function-type-params type-info)
@@ -375,6 +397,24 @@
       (:value
        (format s "Type: `~a`" (value-type-spec type-info)))
       
+      (:generic-function
+       (format s "```lisp~%")
+       (let ((param-names (insert-optional-marker
+                           (mapcar (lambda (p) (getf p :name))
+                                   (function-params type-info))
+                           (function-params type-info))))
+         (if (function-type-params type-info)
+             (format s "(defgeneric [~a {~{~A~^ ~}} ~a] (~{~a~^ ~}))~%"
+                     (type-info-symbol type-info)
+                     (function-type-params type-info)
+                     (function-return-type type-info)
+                     param-names)
+             (format s "(defgeneric [~a ~a] (~{~a~^ ~}))~%"
+                     (type-info-symbol type-info)
+                     (function-return-type type-info)
+                     param-names)))
+       (format s "```"))
+
       (:function
        (format s "```lisp~%")
        (let ((param-names (insert-optional-marker
diff --git a/src/packages.lisp b/src/packages.lisp
index bc2523f..0f15ae0 100644
--- a/src/packages.lisp
+++ b/src/packages.lisp
@@ -84,6 +84,9 @@
            #:function-type-params
            #:method-type-info
            #:method-specializers
+           #:generic-function-type-info
+           #:generic-function-methods
+           #:add-method-to-generic-function
            #:class-type-info
            #:class-slots
            #:class-superclasses
diff --git a/src/transpiler.lisp b/src/transpiler.lisp
index 653722c..53465ba 100644
--- a/src/transpiler.lisp
+++ b/src/transpiler.lisp
@@ -20,6 +20,11 @@
           (string= (symbol-name (car form)) "DEFTYPE-TYCL"))
      nil)
 
+    ;; defmethod - preserve specializers in parameter list
+    ((and (consp form) (symbolp (car form))
+          (string= (symbol-name (car form)) "DEFMETHOD"))
+     (transpile-defmethod form))
+
     ;; List - recursively process each element
     ((consp form)
      (cons (transpile-form (car form))
@@ -28,6 +33,53 @@
     ;; Atom - return as-is
     (t form)))
 
+(defun transpile-defmethod-param (param)
+  "Transpile a defmethod parameter, preserving the specializer as CLOS form.
+   [animal dog] -> (animal dog)  (specializer form for CLOS)
+   [x :integer] -> x            (keyword types are TyCL-only, not CLOS specializers)
+   x -> x                       (untyped parameter)"
+  (cond
+    ((type-annotation-p param)
+     (let ((sym (annotation-symbol param))
+           (type (annotation-type param)))
+       (if (and (symbolp type) (not (keywordp type)))
+           ;; User-defined class as specializer: (param class)
+           (list sym type)
+           ;; Keyword type annotation: strip to just the symbol
+           sym)))
+    ;; Default-value list: ([param type] default) -> ((param type) default) or (param default)
+    ((and (listp param) (not (type-annotation-p param)))
+     (cons (transpile-defmethod-param (first param))
+           (mapcar #'transpile-form (rest param))))
+    (t param)))
+
+(defun transpile-defmethod (form)
+  "Transpile a defmethod form, preserving specializers in the parameter list.
+   (defmethod [say :string] ([animal dog]) body...)
+   -> (defmethod say ((animal dog)) body...)"
+  (let* ((name (transpile-form (second form)))
+         (params-spec (third form))
+         (body (cdddr form))
+         (in-lambda-keyword nil)
+         (transpiled-params
+           (mapcar (lambda (param)
+                     (cond
+                       ;; Lambda list keywords: pass through
+                       ((and (symbolp param)
+                             (member (symbol-name param)
+                                     '("&OPTIONAL" "&KEY" "&REST")
+                                     :test #'string=))
+                        (setf in-lambda-keyword t)
+                        param)
+                       ;; After &optional/&key/&rest: no specializers
+                       (in-lambda-keyword
+                        (transpile-form param))
+                       ;; Required params: preserve specializers
+                       (t
+                        (transpile-defmethod-param param))))
+                   params-spec)))
+    `(defmethod ,name ,transpiled-params ,@(mapcar #'transpile-form body))))
+
 (defun process-reader-package-form (form)
   "Process in-package and defpackage forms to update *package* during reading.
    This mirrors the behavior of COMPILE-FILE and LOAD, where these forms
diff --git a/src/type-checker.lisp b/src/type-checker.lisp
index d15bc69..01bd4dc 100644
--- a/src/type-checker.lisp
+++ b/src/type-checker.lisp
@@ -378,6 +378,9 @@
                (not (valid-type-p return-type)))
       (record-type-error name-spec
                           (format nil "Invalid return type: ~S" return-type)))
+    ;; For defmethod: validate against defgeneric
+    (when (eq (first form) 'defmethod)
+      (check-defmethod-against-defgeneric form func-name return-type params-spec env))
     ;; Build parameter environment
     (let ((body-env (build-param-env params-spec env)))
       ;; Check body forms
@@ -392,8 +395,19 @@
                                 (format nil "Return type mismatch: declared ~S but body returns ~S"
                                         return-type inferred))))))
     ;; Register function in env for forward references within local scope
-    (let ((param-types (extract-param-types params-spec)))
-      (push (cons func-name `(:function ,return-type ,param-types)) env))
+    (if (eq (first form) 'defmethod)
+        ;; For defmethod: register with :t param types if not already in env
+        ;; (generic functions accept any specializer at call site)
+        (unless (assoc func-name env)
+          (let ((param-types (mapcar (lambda (p)
+                                       (list :name (getf p :name)
+                                             :type :t
+                                             :kind (getf p :kind)))
+                                     (extract-param-types params-spec))))
+            (push (cons func-name `(:function ,return-type ,param-types)) env)))
+        ;; For defun: register with declared param types
+        (let ((param-types (extract-param-types params-spec)))
+          (push (cons func-name `(:function ,return-type ,param-types)) env)))
     env))
 
 (defun check-let (form env)
@@ -511,6 +525,84 @@
     ;; Return original env
     env))
 
+(defun check-defgeneric (form env)
+  "Check types in a defgeneric form.
+   (defgeneric [name return-type] ([params...]) ...)
+   Validates type annotations and registers the generic function in env."
+  (let* ((name-spec (second form))
+         (params-spec (third form))
+         (func-name (if (tycl/annotation:type-annotation-p name-spec)
+                        (tycl/annotation:annotation-symbol name-spec)
+                        name-spec))
+         (return-type (if (tycl/annotation:type-annotation-p name-spec)
+                          (tycl/annotation:annotation-type name-spec)
+                          :t)))
+    ;; Validate return type
+    (when (and (tycl/annotation:type-annotation-p name-spec)
+               (not (valid-type-p return-type)))
+      (record-type-error name-spec
+                          (format nil "Invalid return type for generic function: ~S" return-type)))
+    ;; Validate parameter types
+    (dolist (param params-spec)
+      (when (tycl/annotation:type-annotation-p param)
+        (let ((type (tycl/annotation:annotation-type param)))
+          (unless (valid-type-p type)
+            (record-type-error param
+                                (format nil "Invalid parameter type in generic function: ~S" type))))))
+    ;; Register in env for forward references
+    (let ((param-types (extract-param-types params-spec)))
+      (push (cons func-name `(:function ,return-type ,param-types)) env))
+    env))
+
+(defun check-defmethod-against-defgeneric (form func-name return-type params-spec env)
+  "Validate that a defmethod is consistent with its defgeneric.
+   Checks return type compatibility, argument count, and specializer validity."
+  (let* ((sym-name (string-upcase (symbol-name func-name)))
+         (generic-info (or (tycl:get-type-info *current-package* sym-name)
+                           (resolve-type-info-for-symbol func-name))))
+    (when (and generic-info (typep generic-info 'tycl:generic-function-type-info))
+      (let ((generic-return (tycl:function-return-type generic-info))
+            (generic-params (tycl:function-params generic-info)))
+        ;; Check return type compatibility
+        (when (and (not (eq return-type :t))
+                   (not (eq generic-return :t))
+                   (not (type-compatible-p return-type generic-return)))
+          (record-type-error
+           form
+           (format nil "defmethod ~S: return type ~S is incompatible with defgeneric return type ~S"
+                   func-name return-type generic-return)))
+        ;; Check argument count (excluding &optional/&key/&rest markers)
+        (let* ((method-params (remove-if (lambda (p)
+                                            (and (symbolp p)
+                                                 (member (symbol-name p)
+                                                         '("&OPTIONAL" "&KEY" "&REST")
+                                                         :test #'string=)))
+                                          params-spec))
+               (generic-required (remove-if-not
+                                  (lambda (p) (member (getf p :kind) '(:required nil)))
+                                  generic-params))
+               ;; Count actual params (annotations and symbols, not default-value lists counted separately)
+               (method-param-count (length method-params))
+               (generic-required-count (length generic-required)))
+          (unless (= method-param-count generic-required-count)
+            (record-type-error
+             form
+             (format nil "defmethod ~S: expected ~D required parameters (matching defgeneric), got ~D"
+                     func-name generic-required-count method-param-count))))
+        ;; Check specializer validity (each specializer must be a subtype of defgeneric's param type)
+        (let ((method-params-extracted (extract-param-types params-spec)))
+          (loop for method-param in method-params-extracted
+                for generic-param in generic-params
+                for method-type = (getf method-param :type)
+                for generic-type = (getf generic-param :type)
+                when (and (not (eq method-type :t))
+                          (not (eq generic-type :t))
+                          (not (type-compatible-p method-type generic-type)))
+                do (record-type-error
+                    form
+                    (format nil "defmethod ~S: specializer ~S is not a subtype of defgeneric parameter type ~S"
+                            func-name method-type generic-type))))))))
+
 (defun check-lambda (form env)
   "Check types in a lambda form.
    (lambda ([params...]) body...)
@@ -720,6 +812,9 @@
          ;; defun / defmethod
          ((member op '(defun defmethod))
           (check-defun form env))
+         ;; defgeneric
+         ((eq op 'defgeneric)
+          (check-defgeneric form env))
          ;; let / let*
          ((member op '(let let*))
           (check-let form env))
diff --git a/src/type-extractor.lisp b/src/type-extractor.lisp
index 44d0e34..3216036 100644
--- a/src/type-extractor.lisp
+++ b/src/type-extractor.lisp
@@ -24,6 +24,7 @@
         ((eq operator 'defparameter) (extract-defparameter-type form))
         ((eq operator 'defconstant) (extract-defconstant-type form))
         ((eq operator 'defclass) (extract-defclass-type form))
+        ((eq operator 'defgeneric) (extract-defgeneric-type form))
         ((eq operator 'defmethod) (extract-defmethod-type form))
         ((eq operator 'in-package) (update-current-package form))
         ((string= (symbol-name operator) "DEFTYPE-TYCL") (extract-deftype-tycl form))
@@ -181,6 +182,38 @@
         collect (list :name (string-upcase (symbol-name slot-name))
                       :type slot-type)))
 
+;;; defgeneric Type Extraction
+
+(defun extract-defgeneric-type (form)
+  "Extract type information from defgeneric form
+   (defgeneric [name return-type] ([params...]) ...)
+   (defgeneric [name {T} return-type] ([params...]) ...)"
+  (when (< (length form) 3)
+    (return-from extract-defgeneric-type nil))
+  (let* ((name-spec (second form))
+         (params-spec (third form))
+         (name (if (tycl/annotation:type-annotation-p name-spec)
+                   (tycl/annotation:annotation-symbol name-spec)
+                   name-spec))
+         (return-type (if (tycl/annotation:type-annotation-p name-spec)
+                          (tycl/annotation:annotation-type name-spec)
+                          :t))
+         (type-params (when (and (tycl/annotation:type-annotation-p name-spec)
+                                 (tycl/annotation:annotation-type-params name-spec))
+                        (mapcar (lambda (sym)
+                                  (string-upcase (symbol-name sym)))
+                                (tycl/annotation:type-params-entries
+                                 (tycl/annotation:annotation-type-params name-spec)))))
+         (params (extract-params-types params-spec)))
+    (when (and name (symbolp name))
+      (make-generic-function-type-info
+       *current-package*
+       (string-upcase (symbol-name name))
+       params
+       return-type
+       :source-location *current-file*
+       :type-params type-params))))
+
 ;;; defmethod Type Extraction
 
 (defun extract-defmethod-type (form)
@@ -207,13 +240,41 @@
          (specializers (extract-method-specializers params-spec)))
     (declare (ignore type-params))
     (when (and name (symbolp name))
-      (make-method-type-info
-       *current-package*
-       (string-upcase (symbol-name name))
-       params
-       return-type
-       specializers
-       :source-location *current-file*))))
+      (let* ((sym-name (string-upcase (symbol-name name)))
+             (method-info (make-instance 'method-type-info
+                                         :package *current-package*
+                                         :symbol sym-name
+                                         :params params
+                                         :return-type return-type
+                                         :specializers specializers
+                                         :source-location *current-file*))
+             (existing (lookup-type-info *current-package* sym-name)))
+        (cond
+          ;; defgeneric already exists: add method to it
+          ((and existing (typep existing 'generic-function-type-info))
+           (add-method-to-generic-function existing method-info)
+           method-info)
+          ;; Another defmethod already exists (no defgeneric): auto-create
+          ;; a generic-function-type-info with :t param types to hold all methods
+          ((and existing (typep existing 'method-type-info))
+           (let* ((generic-params (mapcar (lambda (p)
+                                            (list :name (getf p :name)
+                                                  :type :t
+                                                  :kind (getf p :kind)))
+                                          (function-params existing)))
+                  (generic-info (make-instance 'generic-function-type-info
+                                               :package *current-package*
+                                               :symbol sym-name
+                                               :params generic-params
+                                               :return-type :t
+                                               :source-location (type-info-source-location existing))))
+             (register-type-info generic-info)
+             (add-method-to-generic-function generic-info existing)
+             (add-method-to-generic-function generic-info method-info)
+             method-info))
+          ;; First defmethod for this name (no defgeneric): register as method
+          (t
+           (register-type-info method-info)))))))
 
 (defun extract-method-specializers (params-spec)
   "Extract method specializers from parameter list"
diff --git a/src/type-info.lisp b/src/type-info.lisp
index 04fc433..9131ad3 100644
--- a/src/type-info.lisp
+++ b/src/type-info.lisp
@@ -80,6 +80,17 @@
   (:default-initargs :kind :class)
   (:documentation "Type information for classes and structures"))
 
+;;; Generic Function Type Info
+
+(defclass generic-function-type-info (function-type-info)
+  ((methods :initarg :methods
+            :accessor generic-function-methods
+            :initform nil
+            :type list
+            :documentation "List of method-type-info associated with this generic function"))
+  (:default-initargs :kind :generic-function)
+  (:documentation "Type information for generic functions defined by defgeneric"))
+
 ;;; Type Alias Info
 
 (defclass type-alias-info (type-info)
@@ -195,6 +206,21 @@
                   :specializers specializers
                   :source-location source-location)))
 
+(defun make-generic-function-type-info (package symbol params return-type &key source-location type-params)
+  "Create and register a generic function type info"
+  (register-type-info
+   (make-instance 'generic-function-type-info
+                  :package package
+                  :symbol symbol
+                  :params params
+                  :return-type return-type
+                  :type-params type-params
+                  :source-location source-location)))
+
+(defun add-method-to-generic-function (generic-info method-info)
+  "Associate a method-type-info with a generic-function-type-info"
+  (push method-info (generic-function-methods generic-info)))
+
 (defun make-class-type-info (package symbol slots superclasses &key source-location)
   "Create and register a class type info"
   (register-type-info
diff --git a/src/type-serializer.lisp b/src/type-serializer.lisp
index 54303a7..d530d05 100644
--- a/src/type-serializer.lisp
+++ b/src/type-serializer.lisp
@@ -12,6 +12,13 @@
      `(:value
        :symbol ,(type-info-symbol type-info)
        :type ,(value-type-spec type-info)))
+    (generic-function-type-info
+     `(:generic-function
+       :symbol ,(type-info-symbol type-info)
+       :params ,(function-params type-info)
+       :return ,(function-return-type type-info)
+       ,@(when (function-type-params type-info)
+           `(:type-params ,(function-type-params type-info)))))
     (function-type-info
      `(:function
        :symbol ,(type-info-symbol type-info)
@@ -138,6 +145,13 @@
         package
         (getf props :symbol)
         (getf props :type)))
+      (:generic-function
+       (make-generic-function-type-info
+        package
+        (getf props :symbol)
+        (getf props :params)
+        (getf props :return)
+        :type-params (getf props :type-params)))
       (:function
        (make-function-type-info
         package
diff --git a/test/defgeneric-test.lisp b/test/defgeneric-test.lisp
new file mode 100644
index 0000000..d55d5eb
--- /dev/null
+++ b/test/defgeneric-test.lisp
@@ -0,0 +1,265 @@
+;;;; TyCL defgeneric Type Support Tests
+
+(defpackage #:tycl/test/defgeneric
+  (:use #:cl #:rove))
+
+(in-package #:tycl/test/defgeneric)
+
+;;; Helper to run type checking on a string and return (values errors result)
+(defun check-and-get-errors (tycl-string)
+  "Run type checking on a TyCL string and return the list of errors."
+  (tycl:clear-type-database)
+  (let ((result (tycl/type-checker:check-string tycl-string)))
+    (values (reverse tycl/type-checker:*type-check-errors*) result)))
+
+;;; ============================================================
+;;; Type Extraction Tests
+;;; ============================================================
+
+(deftest test-defgeneric-type-extraction
+  (testing "defgeneric extracts type information correctly"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (tycl:extract-type-from-form
+       (let ((*readtable* tycl/reader:*tycl-readtable*))
+         (read-from-string "(defgeneric [area :float] ([shape shape]))"))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "AREA")))
+      (ok info "should register type info")
+      (ok (typep info 'tycl:generic-function-type-info)
+          "should be generic-function-type-info")
+      (ok (eq (tycl:function-return-type info) :float)
+          "return type should be :float")
+      (ok (= (length (tycl:function-params info)) 1)
+          "should have 1 parameter"))))
+
+(deftest test-defgeneric-without-annotation
+  (testing "defgeneric without type annotation uses default :t"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (tycl:extract-type-from-form
+       (let ((*readtable* tycl/reader:*tycl-readtable*))
+         (read-from-string "(defgeneric area (shape))"))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "AREA")))
+      (ok info "should register type info")
+      (ok (typep info 'tycl:generic-function-type-info))
+      (ok (eq (tycl:function-return-type info) :t)))))
+
+;;; ============================================================
+;;; Transpilation Tests
+;;; ============================================================
+
+(deftest test-defgeneric-transpile
+  (testing "defgeneric type annotations are stripped during transpilation"
+    (let ((result (tycl:transpile-string
+                   "(defgeneric [area :float] ([shape shape]))")))
+      (ok (search "defgeneric" result) "should contain defgeneric")
+      (ok (not (search "[" result)) "should not contain brackets")
+      (ok (search "area" result) "should contain function name")
+      (ok (search "shape" result) "should contain parameter name"))))
+
+(deftest test-defgeneric-with-defmethod-transpile
+  (testing "defgeneric and defmethod transpile correctly together"
+    (let ((result (tycl:transpile-string
+                   "(defgeneric [area :float] ([shape shape]))
+                    (defmethod [area :float] ([shape circle])
+                      (* 3.14 (slot-value shape 'radius)))")))
+      (ok (search "defgeneric" result))
+      (ok (search "defmethod" result))
+      (ok (not (search "[" result))))))
+
+;;; ============================================================
+;;; Type Checking Tests
+;;; ============================================================
+
+(deftest test-defgeneric-valid
+  (testing "Valid defgeneric passes type check"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defgeneric [area :float] ([shape shape]))")
+      (ok result "should pass")
+      (ok (null errors) "should have no errors"))))
+
+(deftest test-defgeneric-with-matching-defmethod
+  (testing "defmethod with matching return type passes"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass shape () ())
+          (defclass circle (shape) (([radius :float])))
+          (defgeneric [area :float] ([shape shape]))
+          (defmethod [area :float] ([shape circle])
+            (* 3.14 (slot-value shape 'radius)))")
+      (ok result "should pass")
+      (ok (null errors) "should have no errors"))))
+
+(deftest test-defmethod-return-type-mismatch
+  (testing "defmethod with incompatible return type produces error"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass shape () ())
+          (defclass circle (shape) ())
+          (defgeneric [area :float] ([shape shape]))
+          (defmethod [area :string] ([shape circle])
+            \"not a number\")")
+      (ng result "should fail")
+      (ok (not (null errors)) "should have errors")
+      (ok (search "incompatible" (tycl/type-checker:error-message (first errors)))
+          "error should mention incompatibility"))))
+
+(deftest test-defmethod-wrong-param-count
+  (testing "defmethod with wrong parameter count produces error"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defgeneric [move :void] ([shape shape] [dx :float] [dy :float]))
+          (defmethod [move :void] ([shape circle] [dx :float])
+            nil)")
+      (ng result "should fail")
+      (ok (not (null errors)) "should have errors")
+      (ok (search "parameter" (tycl/type-checker:error-message (first errors)))
+          "error should mention parameters"))))
+
+(deftest test-defmethod-invalid-specializer
+  (testing "defmethod with specializer not subtype of defgeneric param produces error"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass shape () ())
+          (defclass color () (([name :string])))
+          (defgeneric [area :float] ([shape shape]))
+          (defmethod [area :float] ([shape color])
+            0.0)")
+      (ng result "should fail")
+      (ok (not (null errors)) "should have errors")
+      (ok (search "subtype" (tycl/type-checker:error-message (first errors)))
+          "error should mention subtype"))))
+
+(deftest test-defgeneric-call-type-inference
+  (testing "Calling defgeneric function infers correct return type"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass shape () ())
+          (defgeneric [area :float] ([shape shape]))
+          (defun [total-area :float] ([s shape])
+            (area s))")
+      (ok result "should pass")
+      (ok (null errors) "should have no errors"))))
+
+(deftest test-defgeneric-call-type-mismatch
+  (testing "Using defgeneric return type in wrong context produces error"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass shape () ())
+          (defgeneric [area :float] ([shape shape]))
+          (defun [describe-area :string] ([s shape])
+            (area s))")
+      (ng result "should fail")
+      (ok (not (null errors)) "should have errors"))))
+
+(deftest test-defgeneric-multi-level-subtype
+  (testing "defmethod with multi-level subtype passes"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass a () ())
+          (defclass b (a) ())
+          (defclass c (b) ())
+          (defgeneric [process :t] ([obj a]))
+          (defmethod [process :t] ([obj c])
+            obj)")
+      (ok result "should pass")
+      (ok (null errors) "should have no errors"))))
+
+;;; ============================================================
+;;; Serialization Tests
+;;; ============================================================
+
+(deftest test-defgeneric-serialization
+  (testing "defgeneric type info serializes and deserializes correctly"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (tycl:extract-type-from-form
+       (let ((*readtable* tycl/reader:*tycl-readtable*))
+         (read-from-string "(defgeneric [area :float] ([shape shape]))"))))
+    (let* ((info (tycl:lookup-type-info "TEST-PKG" "AREA"))
+           (serialized (tycl::serialize-type-info info)))
+      (ok (eq (first serialized) :generic-function)
+          "serialized kind should be :generic-function")
+      ;; Deserialize and verify
+      (tycl:clear-type-database)
+      (tycl::deserialize-type-info "TEST-PKG" serialized)
+      (let ((restored (tycl:lookup-type-info "TEST-PKG" "AREA")))
+        (ok restored "should restore from serialized form")
+        (ok (typep restored 'tycl:generic-function-type-info)
+            "restored should be generic-function-type-info")
+        (ok (eq (tycl:function-return-type restored) :float)
+            "restored return type should be :float")))))
+
+;;; ============================================================
+;;; defmethod without defgeneric Tests
+;;; ============================================================
+
+(deftest test-defmethod-without-defgeneric-different-specializers
+  (testing "Multiple defmethods without defgeneric with different specializers pass"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass foo () ())
+          (defclass bar () ())
+          (defmethod [show :void] ([obj foo])
+            (format t \"foo~%\"))
+          (defmethod [show :void] ([obj bar])
+            (format t \"bar~%\"))")
+      (ok result "should pass")
+      (ok (null errors) "should have no errors"))))
+
+(deftest test-defmethod-without-defgeneric-call
+  (testing "Calling defmethod-only generic function works"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass foo () ())
+          (defclass bar () ())
+          (defmethod [show :void] ([obj foo])
+            (format t \"foo~%\"))
+          (defmethod [show :void] ([obj bar])
+            (format t \"bar~%\"))
+          (defun [demo :void] ([f foo] [b bar])
+            (show f)
+            (show b))")
+      (ok result "should pass")
+      (ok (null errors) "should have no errors"))))
+
+(deftest test-defmethod-without-defgeneric-param-count-mismatch
+  (testing "defmethod with different param count produces error"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defmethod [show :void] ([p1 :integer] [p2 :integer])
+            (format t \"result:~A~%\" (+ p1 p2)))
+          (defmethod [show :void] ([p1 :integer])
+            (format t \"result:~A~%\" p1))")
+      (ng result "should fail")
+      (ok (not (null errors)) "should have errors")
+      (ok (search "parameter" (tycl/type-checker:error-message (first errors)))
+          "error should mention parameters"))))
+
+(deftest test-defmethod-without-defgeneric-auto-creates-generic-info
+  (testing "Two defmethods auto-create a generic-function-type-info"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (dolist (form-str '("(defclass foo () ())"
+                          "(defclass bar () ())"
+                          "(defmethod [show :void] ([obj foo]) nil)"
+                          "(defmethod [show :void] ([obj bar]) nil)"))
+        (tycl:extract-type-from-form
+         (let ((*readtable* tycl/reader:*tycl-readtable*))
+           (read-from-string form-str)))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "SHOW")))
+      (ok info "should have type info")
+      (ok (typep info 'tycl:generic-function-type-info)
+          "should be auto-created generic-function-type-info")
+      (ok (= (length (tycl:generic-function-methods info)) 2)
+          "should have 2 methods"))))
+
+(deftest test-defmethod-without-defgeneric-transpile
+  (testing "defmethod without defgeneric transpiles with specializers"
+    (let ((result (tycl:transpile-string
+                   "(defclass foo () ())
+                    (defmethod [show :void] ([obj foo])
+                      (format t \"foo~%\"))")))
+      (ok (search "defmethod" result) "should contain defmethod")
+      (ok (search "(obj foo)" result) "should preserve specializer"))))
diff --git a/tycl.asd b/tycl.asd
index c9a37bb..c7ebc4f 100644
--- a/tycl.asd
+++ b/tycl.asd
@@ -63,7 +63,8 @@
                  (:file "type-checker-test")
                  (:file "deftype-tycl-test")
                  (:file "type-vars-test")
-                 (:file "declarations-test")))
+                 (:file "declarations-test")
+                 (:file "defgeneric-test")))
                (:module "test/lsp"
                 :components
                 ((:file "did-change-test")

From db25710514067083ffb80ba0bf5262d71b788a9a Mon Sep 17 00:00:00 2001
From: tamura shingo <tamura.shingo@gmail.com>
Date: Wed, 15 Apr 2026 12:27:50 +0900
Subject: [PATCH 2/2] Add accessor return type inference and common superclass
 computation

Extract type info from defclass :accessor/:reader slot options so that
accessor calls infer the correct return type. When auto-creating generic
functions from multiple defmethods, compute the common superclass of
specializers instead of defaulting to :t.
---
 src/type-checker.lisp     |   6 +-
 src/type-extractor.lisp   | 109 +++++++++++++++++++++++++++++----
 test/defgeneric-test.lisp | 125 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 226 insertions(+), 14 deletions(-)

diff --git a/src/type-checker.lisp b/src/type-checker.lisp
index 01bd4dc..bd3940e 100644
--- a/src/type-checker.lisp
+++ b/src/type-checker.lisp
@@ -168,8 +168,12 @@
       ((or (eq expected :t) (eq expected :any)) t)
       ((or (eq actual :t) (eq actual :any)) t)
 
-      ;; Exact match
+      ;; Exact match (including uninterned symbols by name)
       ((equal actual expected) t)
+      ((and (symbolp actual) (symbolp expected)
+            (not (keywordp actual)) (not (keywordp expected))
+            (string= (symbol-name actual) (symbol-name expected)))
+       t)
 
       ;; Union type: expected is a list whose first element is NOT a keyword.
       ;; e.g. (:integer :string) has :integer (keyword) as first → ambiguous
diff --git a/src/type-extractor.lisp b/src/type-extractor.lisp
index 3216036..be2ef45 100644
--- a/src/type-extractor.lisp
+++ b/src/type-extractor.lisp
@@ -161,12 +161,15 @@
          (slots-spec (fourth form))
          (slots (extract-slots-types slots-spec)))
     (when (and name (symbolp name))
-      (make-class-type-info
-       *current-package*
-       (string-upcase (symbol-name name))
-       slots
-       (mapcar (lambda (s) (string-upcase (symbol-name s))) supers)
-       :source-location *current-file*))))
+      (let ((class-name (string-upcase (symbol-name name))))
+        (make-class-type-info
+         *current-package*
+         class-name
+         slots
+         (mapcar (lambda (s) (string-upcase (symbol-name s))) supers)
+         :source-location *current-file*)
+        ;; Register accessor/reader functions with slot types
+        (extract-accessor-types slots-spec class-name)))))
 
 (defun extract-slots-types (slots-spec)
   "Extract slot types from defclass slots
@@ -182,6 +185,78 @@
         collect (list :name (string-upcase (symbol-name slot-name))
                       :type slot-type)))
 
+(defun extract-accessor-types (slots-spec class-name)
+  "Extract accessor/reader function type info from defclass slot options.
+   For each slot with :accessor or :reader, register a function that takes
+   an instance of the class and returns the slot's type.
+   If another class already registered the same accessor name, widen the
+   parameter type to :t (CLOS implicitly creates a shared generic function)."
+  (dolist (slot slots-spec)
+    (when (listp slot)
+      (let* ((slot-name-spec (first slot))
+             (slot-type (if (tycl/annotation:type-annotation-p slot-name-spec)
+                            (tycl/annotation:annotation-type slot-name-spec)
+                            :t))
+             (options (rest slot)))
+        ;; Scan slot options for :accessor and :reader
+        (loop for (key val) on options by #'cddr
+              when (and (member key '(:accessor :reader)) val (symbolp val))
+              do (let* ((accessor-name (string-upcase (symbol-name val)))
+                        (existing (lookup-type-info *current-package* accessor-name))
+                        (pkg (find-package *current-package*))
+                        (class-type-sym (if pkg
+                                            (intern class-name pkg)
+                                            (make-symbol class-name))))
+                   (if existing
+                       ;; Another class already registered this accessor;
+                       ;; widen param type to :t and return type to :t
+                       (when (typep existing 'function-type-info)
+                         (setf (function-params existing)
+                               (list (list :name "SELF" :type :t :kind :required)))
+                         (setf (function-return-type existing) :t))
+                       ;; First registration
+                       (make-function-type-info
+                        *current-package*
+                        accessor-name
+                        (list (list :name "SELF"
+                                    :type class-type-sym
+                                    :kind :required))
+                        slot-type
+                        :source-location *current-file*))))))))
+
+;;; Common Superclass Computation
+
+(defun get-class-ancestors (class-name package)
+  "Return a list of all ancestor class names (strings) for CLASS-NAME, including itself.
+   Walks the superclass chain using the type database."
+  (let ((result (list class-name))
+        (info (lookup-type-info package class-name)))
+    (when (and info (typep info 'class-type-info))
+      (dolist (super (class-superclasses info))
+        (setf result (append result (get-class-ancestors super package)))))
+    result))
+
+(defun find-common-superclass (type-a type-b package)
+  "Find the most specific common superclass of two types.
+   TYPE-A and TYPE-B are type specifiers (symbols or keywords).
+   Returns the common superclass symbol, or :t if none found."
+  (when (or (eq type-a :t) (eq type-b :t)
+            (keywordp type-a) (keywordp type-b))
+    (return-from find-common-superclass :t))
+  (let ((name-a (string-upcase (symbol-name type-a)))
+        (name-b (string-upcase (symbol-name type-b))))
+    (when (string= name-a name-b)
+      (return-from find-common-superclass type-a))
+    (let ((ancestors-a (get-class-ancestors name-a package))
+          (ancestors-b (get-class-ancestors name-b package)))
+      ;; Find first ancestor of A that is also an ancestor of B
+      (dolist (ancestor ancestors-a)
+        (when (member ancestor ancestors-b :test #'string=)
+          (let ((pkg (find-package package)))
+            (return-from find-common-superclass
+              (if pkg (intern ancestor pkg) (make-symbol ancestor))))))
+      :t)))
+
 ;;; defgeneric Type Extraction
 
 (defun extract-defgeneric-type (form)
@@ -255,18 +330,26 @@
            (add-method-to-generic-function existing method-info)
            method-info)
           ;; Another defmethod already exists (no defgeneric): auto-create
-          ;; a generic-function-type-info with :t param types to hold all methods
+          ;; a generic-function-type-info with computed param types
           ((and existing (typep existing 'method-type-info))
-           (let* ((generic-params (mapcar (lambda (p)
-                                            (list :name (getf p :name)
-                                                  :type :t
-                                                  :kind (getf p :kind)))
-                                          (function-params existing)))
+           (let* ((generic-params
+                    (mapcar (lambda (p1 p2)
+                              (list :name (getf p1 :name)
+                                    :type (find-common-superclass
+                                           (getf p1 :type) (getf p2 :type)
+                                           *current-package*)
+                                    :kind (getf p1 :kind)))
+                            (function-params existing)
+                            (function-params method-info)))
+                  (generic-return-type
+                    (let ((rt1 (function-return-type existing))
+                          (rt2 (function-return-type method-info)))
+                      (if (equal rt1 rt2) rt1 :t)))
                   (generic-info (make-instance 'generic-function-type-info
                                                :package *current-package*
                                                :symbol sym-name
                                                :params generic-params
-                                               :return-type :t
+                                               :return-type generic-return-type
                                                :source-location (type-info-source-location existing))))
              (register-type-info generic-info)
              (add-method-to-generic-function generic-info existing)
diff --git a/test/defgeneric-test.lisp b/test/defgeneric-test.lisp
index d55d5eb..edf827c 100644
--- a/test/defgeneric-test.lisp
+++ b/test/defgeneric-test.lisp
@@ -263,3 +263,128 @@
                       (format t \"foo~%\"))")))
       (ok (search "defmethod" result) "should contain defmethod")
       (ok (search "(obj foo)" result) "should preserve specializer"))))
+
+;;; ============================================================
+;;; Accessor Type Inference Tests
+;;; ============================================================
+
+(deftest test-accessor-type-inference
+  (testing "defclass accessor registers function with correct return type"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (tycl:extract-type-from-form
+       (let ((*readtable* tycl/reader:*tycl-readtable*))
+         (read-from-string "(defclass dog () (([breed :string] :initarg :breed :accessor dog-breed)))"))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "DOG-BREED")))
+      (ok info "should register accessor type info")
+      (ok (typep info 'tycl:function-type-info)
+          "should be function-type-info")
+      (ok (eq (tycl:function-return-type info) :string)
+          "return type should be :string")
+      (ok (= (length (tycl:function-params info)) 1)
+          "should have 1 parameter"))))
+
+(deftest test-accessor-reader-type-inference
+  (testing "defclass :reader registers function with correct return type"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (tycl:extract-type-from-form
+       (let ((*readtable* tycl/reader:*tycl-readtable*))
+         (read-from-string "(defclass person () (([name :string] :initarg :name :reader person-name)))"))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "PERSON-NAME")))
+      (ok info "should register reader type info")
+      (ok (eq (tycl:function-return-type info) :string)
+          "return type should be :string"))))
+
+(deftest test-accessor-shared-across-classes
+  (testing "Same accessor on different classes widens param type to :t"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (dolist (form-str '("(defclass book () (([title :string] :initarg :title :accessor get-label)))"
+                          "(defclass product () (([name :string] :initarg :name :accessor get-label)))"))
+        (tycl:extract-type-from-form
+         (let ((*readtable* tycl/reader:*tycl-readtable*))
+           (read-from-string form-str)))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "GET-LABEL")))
+      (ok info "should have accessor type info")
+      (ok (eq (getf (first (tycl:function-params info)) :type) :t)
+          "param type should be widened to :t"))))
+
+(deftest test-accessor-type-check-in-function
+  (testing "Accessor return type is used in type checking"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass dog ()
+            (([breed :string] :initarg :breed :accessor dog-breed)))
+          (defun [get-breed :string] ([d dog])
+            (dog-breed d))")
+      (ok result "should pass")
+      (ok (null errors) "should have no errors"))))
+
+(deftest test-accessor-type-mismatch
+  (testing "Accessor return type mismatch produces error"
+    (multiple-value-bind (errors result)
+        (check-and-get-errors
+         "(defclass dog ()
+            (([breed :string] :initarg :breed :accessor dog-breed)))
+          (defun [get-breed :integer] ([d dog])
+            (dog-breed d))")
+      (ng result "should fail")
+      (ok (not (null errors)) "should have errors"))))
+
+;;; ============================================================
+;;; Common Superclass Computation Tests
+;;; ============================================================
+
+(deftest test-defmethod-auto-generic-common-superclass
+  (testing "Auto-created generic computes common superclass for param type"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (dolist (form-str '("(defclass animal () ())"
+                          "(defclass dog (animal) ())"
+                          "(defclass cat (animal) ())"
+                          "(defmethod [describe :string] ([a dog]) \"dog\")"
+                          "(defmethod [describe :string] ([a cat]) \"cat\")"))
+        (tycl:extract-type-from-form
+         (let ((*readtable* tycl/reader:*tycl-readtable*))
+           (read-from-string form-str)))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "DESCRIBE")))
+      (ok info "should have type info")
+      (ok (typep info 'tycl:generic-function-type-info)
+          "should be generic-function-type-info")
+      (ok (string= "ANIMAL"
+                    (symbol-name (getf (first (tycl:function-params info)) :type)))
+          "param type should be common superclass ANIMAL")
+      (ok (eq (tycl:function-return-type info) :string)
+          "return type should be :string (both methods agree)"))))
+
+(deftest test-defmethod-auto-generic-no-common-superclass
+  (testing "Auto-created generic falls back to :t for unrelated classes"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (dolist (form-str '("(defclass foo () ())"
+                          "(defclass bar () ())"
+                          "(defmethod [show :void] ([obj foo]) nil)"
+                          "(defmethod [show :void] ([obj bar]) nil)"))
+        (tycl:extract-type-from-form
+         (let ((*readtable* tycl/reader:*tycl-readtable*))
+           (read-from-string form-str)))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "SHOW")))
+      (ok info "should have type info")
+      (ok (eq (getf (first (tycl:function-params info)) :type) :t)
+          "param type should be :t for unrelated classes"))))
+
+(deftest test-defmethod-auto-generic-return-type-mismatch
+  (testing "Auto-created generic uses :t when return types differ"
+    (tycl:clear-type-database)
+    (let ((tycl:*current-package* "TEST-PKG"))
+      (dolist (form-str '("(defclass foo () ())"
+                          "(defclass bar () ())"
+                          "(defmethod [convert :string] ([obj foo]) \"foo\")"
+                          "(defmethod [convert :integer] ([obj bar]) 42)"))
+        (tycl:extract-type-from-form
+         (let ((*readtable* tycl/reader:*tycl-readtable*))
+           (read-from-string form-str)))))
+    (let ((info (tycl:lookup-type-info "TEST-PKG" "CONVERT")))
+      (ok (eq (tycl:function-return-type info) :t)
+          "return type should be :t when methods disagree"))))