3 ms·

Think of all the confusion and hot air that could be saved if we all just switched to Lisp.

kmstout 3y ago
The game that I'm working on in my spare time has a lot of state machines in it compiled to CLOS, letting me use method calls as a means of directly sending sending events. Rather than write all those methods myself, with `case` forms on the state, I spent an afternoon writing this [0] (defmacro defdelta (class &body body) (let* ((body `(,@body (- enter - - -) (- leave - - -))) (acc (group-by 1 (let ((-q0) (-e) (-w) (-q) (-a)) (loop for (q0 e w q a) in (cdr body) do (setf -q0 (tc q0 -q0) -e (tc e -e) -w (tc w -w) -q (tc q -q) -a (tc a -a)) collect (list -q0 -e -w -q -a)))))) (push (cons class acc) *delta*) `(progn ,@(loop for (e . clauses) in acc collecting `(progn (defevent ,e) (defmethod ,e ((me ,class) &rest args) (when (member *@* args) (apply #'emit ',e (state me) me args)) (case (state me) ,@ (loop for (q0 . deltas) in (group-by 0 clauses) collecting `(,q0 (random-case ,@ (loop for (- -- w q a) in deltas collecting `((,@(or w 1)) ,@(when (and q (not (eq q0 q))) `((change-state me ',q args))) ,@(when a `((apply ',a me args))))))))))))))) which allows me to write, for example, this (defdelta door ( q0 event - q action ) ;;-------------------------------------------------- ( locked challenge - - test-lock ) ( ^ unlock - unlocked - ) ( ^ enter - - to-locked ) ;;-------------------------------------------------- ( unlocked enter - - to-unlocked ) ( ^ challenge - open - ) ( ^ lock - locked - ) ;;-------------------------------------------------- ( open enter - - to-open ) ( ^ arrival - blocked - ) ( ^ shut - unlocked - ) ;;-------------------------------------------------- ( blocked departure - open - ) ( ^ enter - - to-blocked )) along with some support code (e.g., the action functions) to define the auto-closing, auto-locking behavior of doors. --- [0] Some helpers have been omitted. `defevent` defines a generic function with the given name and a particular set of arguments, and a default method that does nothing. `change-state` handles the mechanics of updating the state variable, sending a `leave` event just before the transition and `enter` just after.

The game that I'm working on in my spare time has a lot of state machines in it compiled to CLOS, letting me use method calls as a means of directly sending sending events. Rather than write all those methods myself, with `case` forms on the state, I spent an afternoon writing this [0] (defmacro defdelta (class &body body) (let* ((body `(,@body (- enter - - -) (- leave - - -))) (acc (group-by 1 (let ((-q0) (-e) (-w) (-q) (-a)) (loop for (q0 e w q a) in (cdr body) do (setf -q0 (tc q0 -q0) -e (tc e -e) -w (tc w -w) -q (tc q -q) -a (tc a -a)) collect (list -q0 -e -w -q -a)))))) (push (cons class acc) *delta*) `(progn ,@(loop for (e . clauses) in acc collecting `(progn (defevent ,e) (defmethod ,e ((me ,class) &rest args) (when (member *@* args) (apply #'emit ',e (state me) me args)) (case (state me) ,@ (loop for (q0 . deltas) in (group-by 0 clauses) collecting `(,q0 (random-case ,@ (loop for (- -- w q a) in deltas collecting `((,@(or w 1)) ,@(when (and q (not (eq q0 q))) `((change-state me ',q args))) ,@(when a `((apply ',a me args))))))))))))))) which allows me to write, for example, this (defdelta door ( q0 event - q action ) ;;-------------------------------------------------- ( locked challenge - - test-lock ) ( ^ unlock - unlocked - ) ( ^ enter - - to-locked ) ;;-------------------------------------------------- ( unlocked enter - - to-unlocked ) ( ^ challenge - open - ) ( ^ lock - locked - ) ;;-------------------------------------------------- ( open enter - - to-open ) ( ^ arrival - blocked - ) ( ^ shut - unlocked - ) ;;-------------------------------------------------- ( blocked departure - open - ) ( ^ enter - - to-blocked )) along with some support code (e.g., the action functions) to define the auto-closing, auto-locking behavior of doors. --- [0] Some helpers have been omitted. `defevent` defines a generic function with the given name and a particular set of arguments, and a default method that does nothing. `change-state` handles the mechanics of updating the state variable, sending a `leave` event just before the transition and `enter` just after.