220 lines
9.7 KiB
EmacsLisp
220 lines
9.7 KiB
EmacsLisp
;;; simple-state-machines.el --- My simple state machine macro. -*- lexical-binding: t -*-
|
|
|
|
;; Author: iamtoaster
|
|
;; Version: 0.1
|
|
;; Package-Requires: (cl-lib)
|
|
;; Homepage:
|
|
;; Keywords: FSM, Macro
|
|
|
|
;; This file is not part of GNU Emacs
|
|
|
|
;; This program is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This is my implementation of simple finite state machines. This package
|
|
;; provides a defstate-machine macro and an update-state function. They can be
|
|
;; combined to create a simple FSM with three states like so:
|
|
;;
|
|
;; (ssm-defstate-machine test
|
|
;; :states (one two three)
|
|
;; :initial-state three
|
|
;; :transitions ((one . two)
|
|
;; (two . three)
|
|
;; (three . one))
|
|
;; :handlers ((two . (lambda (name) (ssm-update-state name 'three)))
|
|
;; (three . (lambda (name) (ssm-update-state name 'one)))
|
|
;; (one . (lambda (name) (ssm-update-state name 'two)))))
|
|
;;
|
|
;; The code above will create a state machine with three states, appropriately
|
|
;; named 'one', 'two' and 'three', by specifying them after the :states key. The
|
|
;; initial state will be set to state 'three'. If no initial state is provided,
|
|
;; the first state in the list will be used automatically.
|
|
;;
|
|
;; Then, we define valid transitions between states using the :transitions key.
|
|
;; If we try to change the state in a way that is not defined in this alist,
|
|
;; `update-state' will signal an error.
|
|
;;
|
|
;; Finally, we specify handlers for states using the :handlers key. See
|
|
;; `defstate-machine' for information.
|
|
;;
|
|
;; This macro call will provide us with the following variables:
|
|
;; 'test-state-table' -- Stores the state list, verbatim.
|
|
;; 'test-transition-table' -- Stores the valid transitions, verbatim.
|
|
;; 'test-current-state' -- Stores the current state.
|
|
;; 'test-state-data' -- Optional data for the current state, initialized to nil.
|
|
;; 'test-state-handlers' -- Stores the mapping from the states to their handlers,
|
|
;; verbatim.
|
|
;;
|
|
;; As well as the following functions:
|
|
;; 'test-step' -- Calls the handler for the current state.
|
|
;; 'test-set-state' -- Tries to set the current state to the provided one, and
|
|
;; 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:
|
|
|
|
(require 'cl-lib)
|
|
|
|
(defmacro ssm-defstate-machine (name &rest args)
|
|
"Defines a state machine with name NAME, STATES and TRANSITIONS between
|
|
them. If INITIAL-STATE is nil, the first state will be used.
|
|
|
|
Arguments are specified as keyword/argument pairs. The following
|
|
arguments are defined:
|
|
|
|
:states LIST -- LIST should be a list of symbols each representing a
|
|
state. LIST will not be evaluated.
|
|
|
|
:transitions ALIST -- ALIST should be an alist of the form (FROM . TO)
|
|
where both FROM and TO are names of states available in the :states LIST.
|
|
|
|
:handlers ALIST -- ALIST should be an alist of the form (STATE .
|
|
HANDLER) where STATE is one of the states in the :states LIST and
|
|
HANDLER is a function that can be called by funcall. It is advised to
|
|
provide a handler for all of the state, because an error will be
|
|
signalled if you try to step on a state with no handler.
|
|
|
|
The following optional arguments are defined:
|
|
|
|
:initial-state SYMBOL -- If SYMBOL is non-nil and present in the :states
|
|
LIST, it will be set as the initial state of this state machine.
|
|
Otherwise, the first state in the :states LIST will be used.
|
|
|
|
(fn NAME &key INITIAL-STATE STATES TRANSITIONS HANDLERS)"
|
|
(declare (indent defun))
|
|
(let ((machine-name (symbol-name name))
|
|
(states (plist-get args :states))
|
|
(transitions (plist-get args :transitions))
|
|
(handlers (plist-get args :handlers))
|
|
(initial-state (plist-get args :initial-state)))
|
|
(if (not initial-state)
|
|
(setq initial-state (car states)))
|
|
(cl-assert (cl-find initial-state states) t
|
|
"Cannot find the initial state in the state list.")
|
|
(dolist (entry handlers)
|
|
(cl-assert (cl-find (car entry) states)) t)
|
|
(dolist (entry transitions)
|
|
(cl-assert (and (cl-find (car entry) states)
|
|
(cl-find (cdr entry) states))
|
|
nil "Invalid transition: Either the source or the target state does not exist."))
|
|
(let ((state-table (intern (concat machine-name "-state-table")))
|
|
(transition-table (intern (concat machine-name "-transition-table")))
|
|
(current-state (intern (concat machine-name "-current-state")))
|
|
(state-data (intern (concat machine-name "-state-data")))
|
|
(step-fn (intern (concat machine-name "-step")))
|
|
(state-set-fn (intern (concat machine-name "-set-state")))
|
|
(handlers-table (intern (concat machine-name "-state-handlers"))))
|
|
`(progn
|
|
(defvar ,state-table ',states
|
|
,(concat "The state table of the " machine-name " state machine."))
|
|
(defvar ,transition-table ',transitions
|
|
,(concat "The transitions table of the " machine-name " state machine.\n
|
|
Each entry of this alist has the form (FROM . TO)."))
|
|
(defvar ,current-state ',initial-state
|
|
,(concat "The current state of the " machine-name " state machine."))
|
|
(defvar ,state-data nil
|
|
,(concat "The data of the current state of the " machine-name " state machine."))
|
|
(defvar ,handlers-table ',handlers
|
|
,(concat "An alist mapping states of the "
|
|
machine-name
|
|
" state machine to their respective handlers."))
|
|
,@(let ((handler (make-symbol "handler"))
|
|
(prev-state (make-symbol "prev-state")))
|
|
`((defun ,step-fn ()
|
|
,(concat "The stepping function of the "
|
|
machine-name
|
|
" state machine.\n\nIt tries to find a handler for the current state (see `"
|
|
(symbol-name current-state)
|
|
"' and\n`"
|
|
(symbol-name handlers-table)
|
|
"'),and then call it with the name of this state machine\nas its only argument.")
|
|
(let ((,handler (alist-get ,current-state ,handlers-table))
|
|
(,prev-state ,current-state))
|
|
(cl-assert ,handler nil "There is no handler for the current state")
|
|
(funcall ,handler ',name)
|
|
(cl-assert
|
|
(cl-find
|
|
(cons ,prev-state ,current-state)
|
|
,transition-table
|
|
:test 'equal)
|
|
"Invalid state transition. State machine is now in inconsistent state.")))
|
|
(defun ,state-set-fn (state &optional new-data)
|
|
,(concat
|
|
"Sets the state of "
|
|
machine-name
|
|
" state machine. Signals an error if the state transition\nis invalid, see `"
|
|
(symbol-name transition-table)
|
|
"' for a list of valid transitions.")
|
|
(cl-assert
|
|
(cl-find
|
|
(cons ,current-state state)
|
|
,transition-table
|
|
:test 'equal) t
|
|
"Invalid state transition.")
|
|
(setq ,current-state state
|
|
,state-data new-data))))))))
|
|
|
|
(defun ssm-update-state (machine new-state new-data)
|
|
"Updates the state of the state machine MACHINE. Signals an error if the
|
|
state transition is invalid."
|
|
(let ((state-fn
|
|
(intern-soft (concat (symbol-name machine) "-set-state"))))
|
|
(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)
|
|
;;; simple-state-machines.el ends here
|