Instantly share code, notes, and snippets.

Embed
What would you like to do?
(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