Re: finite state machines in guile

[Wade Humeniuk <humeniuw@cadvision.com>]

Klaus Schilling wrote:
> 
> What is a good way to model finite state machines in guile?
> Does it make sense to wrap a R.Smith's libfsm , or can guile do it better
> on its own?
> 
> Klaus Schilling

Klaus, I have modified the previous code that I sent you.  I
have changed the sea table to be seperate from the fsm to
allow reuse of essentially global table.  Also the action
procedures now take the first argument as self.



;; Finite State Machine by lookup table, each state and event has a
;; numerical value.  The FSM is a tagged vector, with current-state,
;; and state/event/action SEA table.
;;
;; An entry in the SEA table is a pair with the first being the next
;; state to move to and then a procedure (with one argument) to
;; execute.
;;
;; A call to process-event! causes the machine to change state to the
;; next state for the current state and event.  This allows the
;; possibility of the FSM to be reentrant.  Then the action procedure
;; is called with a reference to itself and any event specific data
;; there may be.
;;
;; This implementation is derived from lookup tables I have used in
;; implementing communication protocols.  The original machines were
;; written in C, were very simple and very efficient.

(define *fsm-tag* "fsm")

(define (fsm? obj)
  (and (vector? obj) (eq? (vector-ref obj 0) *fsm-tag*)))

(define (assert-fsm obj)
  (if (fsm? obj)
      #t
      (error "Object is not a FSM: " obj)))

(define (current-state obj)
  (assert-fsm obj)
  (vector-ref obj 1))

(define (sea-table obj)
  (assert-fsm obj)
  (vector-ref obj 2))
  
(define (set-current-state! obj new-state)
  (assert-fsm obj)
  (vector-set! obj 1 new-state))

(define (make-fsm initial-state sea-table)
  (vector
   *fsm-tag*
   initial-state ;; Initial State set to 0
   sea-table))

(define (make-sea-table num-states num-events)
  (make-array #f num-states num-events))

(define (make-sea-entry next-state action-proc) ;; sea
  (cons next-state action-proc))

(define (attach-action! sea-table for-state for-event next-state
action-proc)
  (array-set! sea-table (make-sea-entry next-state action-proc)
for-state for-event))

(define (process-event! fsm event . data)
  (let ((sea-entry (array-ref (sea-table fsm) (current-state fsm)
event)))
    (if sea-entry ;; Do Nothing if #f, allow for sparsely populated
tables
	(begin
	  (set-current-state! fsm (car sea-entry))
	  ((cdr sea-entry) fsm (if (null? data) #f (car data)))))))
    

;; Example - Salutation FSM

;; Events
(define hello 0)
(define goodbye 1)
(define number-salutation-events 2)

;; States
(define alone 0)
(define together 1)
(define number-group-states 2)

(define salutor-table (make-sea-table number-group-states
number-salutation-events))
(attach-action! salutor-table alone hello together
		(lambda (self . foo) (display "Hello!") (newline)))
(attach-action! salutor-table alone goodbye alone
		(lambda (self . foo) (display "Who said that!") (newline)))
(attach-action! salutor-table together hello together
		(lambda (self . foo) (display "Hello AGAIN!") (newline)))
(attach-action! salutor-table together goodbye alone
		(lambda (self . foo) (display "Goodbye!") (newline)))

(define george (make-fsm alone salutor-table))

(process-event! george hello)
(process-event! george hello "How is it going?")
(process-event! george goodbye)
(process-event! george goodbye)