Make SSM library actually usable.

This commit is contained in:
2026-01-30 22:10:55 +09:00
parent 5fd2116943
commit e4ad515ee6
2 changed files with 47 additions and 4 deletions

View File

@@ -61,7 +61,31 @@
;; 'test-step' -- Calls the handler for the current state. ;; 'test-step' -- Calls the handler for the current state.
;; 'test-set-state' -- Tries to set the current state to the provided one, and ;; 'test-set-state' -- Tries to set the current state to the provided one, and
;; signals an error if the transition is invalid. ;; signals an error if the transition is invalid.
;;
;; Here is the recreation of the counter example from
;; https://www.emacswiki.org/emacs/StateMachine
;;
;; (ssm-defstate-machine counter
;; :states (start count end)
;; :transitions ((start . count)
;; (count . end)
;; (count . count))
;; :handlers ((start . (lambda (name)
;; (princ "Starting...")
;; (terpri)
;; (ssm-update-state name 'count 0)))
;; (count . (lambda (name)
;; (cond ((<= (ssm-get-state-data name) 10)
;; (princ (ssm-get-state-data name))
;; (ssm-update-state
;; name
;; 'count
;; (1+ (ssm-get-state-data name))))
;; (t (terpri) (ssm-update-state name 'end nil)))))))
;;
;; (ssm-run-until-state 'counter 'end)
;;
;; As you can see, ssm-update-state definitely needs some love. It is unwieldy.
;;; Code: ;;; Code:
(require 'cl-lib) (require 'cl-lib)
@@ -142,7 +166,7 @@ Each entry of this alist has the form (FROM . TO)."))
(let ((,handler (alist-get ,current-state ,handlers-table)) (let ((,handler (alist-get ,current-state ,handlers-table))
(,prev-state ,current-state)) (,prev-state ,current-state))
(cl-assert ,handler nil "There is no handler for the current state") (cl-assert ,handler nil "There is no handler for the current state")
(funcall ,handler ,machine-name) (funcall ,handler ',name)
(cl-assert (cl-assert
(cl-find (cl-find
(cons ,prev-state ,current-state) (cons ,prev-state ,current-state)
@@ -165,12 +189,31 @@ Each entry of this alist has the form (FROM . TO)."))
(setq ,current-state state (setq ,current-state state
,state-data new-data)))))))) ,state-data new-data))))))))
(defun ssm-update-state (machine new-state &optional new-data) (defun ssm-update-state (machine new-state new-data)
"Updates the state of the state machine MACHINE. Signals an error if the "Updates the state of the state machine MACHINE. Signals an error if the
state transition is invalid." state transition is invalid."
(let ((state-fn (let ((state-fn
(intern-soft (concat machine "-set-state")))) (intern-soft (concat (symbol-name machine) "-set-state"))))
(funcall state-fn new-state new-data))) (funcall state-fn new-state new-data)))
(defun ssm-get-state (machine)
"Returns the state of the specified machine."
(let ((state
(intern-soft (concat (symbol-name machine) "-current-state"))))
(symbol-value state)))
(defun ssm-get-state-data (machine)
"Returns the state data of the specified machine."
(let ((state-data
(intern-soft (concat (symbol-name machine) "-state-data"))))
(symbol-value state-data)))
(defun ssm-run-until-state (machine state)
"Steps the specified MACHINE until it enters state STATE."
(let ((step-fn
(intern-soft (concat (symbol-name machine) "-step"))))
(while (not (equal (ssm-get-state machine) state))
(funcall step-fn))))
(provide 'simple-state-machines) (provide 'simple-state-machines)
;;; simple-state-machines.el ends here ;;; simple-state-machines.el ends here

Binary file not shown.