machine.lisp

(define-method-combination machine ()
  ((start (:start))
   (rest *))
  (let ((qualifiers (mapcar #'method-qualifiers rest))
        (tags (mapcar (lambda (m) (declare (ignore m)) (gensym)) rest)))
    `(prog (switch)
        (setf switch
              (lambda (state)
                (cond ((equal state nil) (go nil))
                      ,@(loop for qualifier in qualifiers
                              for tag in tags
                              collect `((equal state ',qualifier) (go ,tag)))
                      (t (return state)))))
      nil
        (funcall switch (call-method ,(first start)))
        ,@(loop for tag in tags for method in rest
                collect tag collect `(funcall switch (call-method ,method))))))

(defgeneric test (x) (:method-combination machine))

(defmethod test :start (x) (declare (ignore x)) '(:hello))
(defmethod test :hello ((x integer)) (print (list :hello x)) '(:goodbye))
(defmethod test :goodbye (x) :halt)

(test 4)
; (HELLO 4)
; :HALT

(test 'symbol)
; (:HELLO)