Add defgeneric/defmethod type safety and accessor type inference

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"))))

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 :

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 :

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))

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

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

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