(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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment