Finite State Machine code

Question

I have been making this FSM today. However, as this is probably the biggest practical program I have ever written in CL, I don't know if there are some things that could be improved, or if using a closure is the best thing here.

Any feedback is appreciated.

;;; States: -- EnterMineAndDigForNugget 
;;; -- QuenchThirst
;;; -- GoHomeAndSleepTillRested
;;; -- VisitBankAndDepositGold
(defmacro while (test &rest body)
 `(do ()
 ((not ,test))
 ,@body))
(defmacro enter (state)
 `(setf state ,state))
(defun make-miner ()
 (let ((wealth 0)
 (thirst 0)
 (rested 0)
 (state 'EnterMineAndDigForNugget))
 (list 
 (defun EnterMineAndDigForNugget ()
 ; (setf location 'mine)
 (format t "~&Diggin' up gold!")
 (incf wealth)
 (incf thirst)
 (cond ((>= thirst 7) (enter 'QuenchThirst))
 (t (enter 'VisitBankAndDepositGold))))
 (defun QuenchThirst () 
 (format t "~&Drinkin' old good whiskey")
 (setf thirst 0)
 (enter 'EnterMineAndDigForNugget))
 (defun VisitBankAndDepositGold ()
 (format t "~&All this gold ought to be stored somewhere!")
 (incf wealth)
 (cond ((>= wealth 5) (progn 
 (format t "~&Too much gold for today, let's sleep!")
 (enter 'GoHomeAndSleepTillRested)
 (setf wealth 0)))
 (t (EnterMineAndDigForNugget))))
 (defun GoHomeAndSleepTillRested ()
 (while (<= rested 3)
 (format t "~&Sleepin'")
 (incf rested))
 (enter 'EnterMineAndDigForNugget)
 (setf rested 0))
 (defun controller ()
 (dotimes (n 30)
 (cond ((equal state 'QuenchThirst) (QuenchThirst))
 ((equal state 'VisitBankAndDepositGold) (VisitBankAndDepositGold))
 ((equal state 'GoHomeAndSleepTillRested) (GoHomeAndSleepTillRested))
 ((equal state 'EnterMineAndDigForNugget) (EnterMineAndDigForNugget))))))))

EDIT

I have applied all the suggested changes but for the flet/labels one. Everything worked fine until I changed the one of "set the state to the next function". Now, the macro enter doesn't seem to be ever called.

This is the current state of the code, with the required code to make it work

;;; States: -- enter-mine-and-dig-for-nugget 
;;; -- quench-thirst
;;; -- go-home-and-sleep-till-rested
;;; -- visit-bank-and-deposit-gold
(defmacro enter (state)
 `(setf state ,state))
(defun make-miner ()
 (let ((wealth 0)
 (thirst 0)
 (rested 0)
 (state #'enter-mine-and-dig-for-nugget))
 (list 
 (defun enter-mine-and-dig-for-nugget ()
 (format t "~&Diggin' up gold!")
 (incf wealth)
 (incf thirst)
 (if (>= thirst 7)
 (enter #'quench-thirst)
 (enter #'visit-bank-and-deposit-gold)))
 (defun quench-thirst () 
 (format t "~&Drinkin' old good whiskey")
 (setf thirst 0)
 (enter #'enter-mine-and-dig-for-nugget))
 (defun visit-bank-and-deposit-gold ()
 (format t "~&All this gold ought to be stored somewhere!")
 (incf wealth)
 (if (>= wealth 5)
 (progn 
 (format t "~&Too much gold for today, let's sleep!")
 (enter #'go-home-and-sleep-till-rested)
 (setf wealth 0))
 (enter #'enter-mine-and-dig-for-nugget)))
 (defun go-home-and-sleep-till-rested ()
 (dotimes (i 4)
 (format t "~&Sleepin'"))
 (enter #'enter-mine-and-dig-for-nugget))
 (defun controller ()
 (dotimes (n 30)
 (funcall state))))))
(let ((a (make-miner)))
 (funcall (fifth a)))

• gumbo: The code tag doesn't keep all the formatting, but in my real code it is a good one
• Ed Swangren: Because there is no code tag. Just indent 4 spaces (the button or Ctrl+K) and text will be formatted as code.
• gumbo: well, by code tag I meant the 4-indentation. But it still shows 4 lines slightly out of place
• Rainer Joswig: THe nested DEFUN is definitely wrong. You need to get rid of that. The indenting also looks wrong. Let the editor indent the code, add four spaces in front of the each line and paste that into the text field.
• gumbo: I want to get rid of the DEFUN, but I need to make sure to change one thing at a time, to make sure everything still works. Also, the indentation is managed by EMACS+SLIME, but somehow I can't make it look right here

Answer 1

DEFUN

The most basic mistake in your code is that DEFUN is not correct for nested functions. DEFUN is a top-level macro, defining a top-level function and should be used in top-level forms.

Nested functions are defined in Common Lisp with FLET and LABELS. LABELS is used for recursive sub-functions.

Naming

Symbols like FooBarBaz are not use in Common Lisp. By default Common Lisp upcases all names internally, so the case information gets lost.

Usually we write foo-bar-baz.

Checking symbols

Use CASE (or ECASE) instead of (cond ((equal foo 'bar) ...)).

Architecture

Usually I would write that piece of code using CLOS, the Common Lisp Object System.

In a more functional style I would propose the following:

• use LABELS for the local procedures.

• set the state to the next function. A function is written as (function my-function) or #'my-function.

• the controller just calls the next function from the state variable. It is not necessary to list all cases.

• gumbo: Edited OP, need some help
• gumbo: Both answers are very good. I chose yours because it was the one I found more helpful
• James McMahon: What does 'DEFUN is not thought for nested functions' mean?
• Rainer Joswig: @James McMahon: DEFUN inside DEFUN is not a useful concept in Lisp. Local functions are defined by FLET or LABELS.

Answer 2

As of your second edit.

Ok, yeah now that you've shown how this is supposed to be called, CLOS is definitely the way to go here. Representing an object as a list of closures is less than optimal, if for no other reason that you then need to resort to (funcall (fifth a-miner)) in order to actually start it up (and consequently change that call every time you add a new "method" to your miner). There's also the problem that each "miner" you instantiate carries around its own independent functions (so good luck changing behavior at runtime or using any kind of inheritance for more complex modeling).

I suggest you take a look at this CLOS tutorial as well as chapters 16 and 17 of Practical Common Lisp

Here's a transliteration of your program using CLOS to act as a learning aid:

(defpackage :cl-miner (:use :cl))
(in-package :cl-miner)
(defclass miner ()
 ((wealth :accessor wealth :initarg :wealth :initform 0)
 (thirst :accessor thirst :initarg :thirst :initform 0)
 (rested :accessor rested :initarg :rested :initform 0)
 (state :accessor state :initarg :state :initform #'enter-mine-and-dig-for-nugget)))
;;;;;;;;;;;;;;; shortcuts
(defmethod enter ((m miner) a-state)
 (setf (state m) a-state))
(defun make-miner ()
 (make-instance 'miner))
;;;;;;;;;;;;;;; miner methods
(defmethod enter-mine-and-dig-for-nugget ((m miner))
 (format t "~&Diggin' up gold!")
 (incf (wealth m))
 (incf (thirst m))
 (if (>= (thirst m) 7)
 (enter m #'quench-thirst)
 (enter m #'visit-bank-and-deposit-gold)))
(defmethod quench-thirst ((m miner))
 (format t "~&Drinkin' old good whiskey")
 (setf (thirst m) 0)
 (enter m #'enter-mine-and-dig-for-nugget))
(defmethod visit-bank-and-deposit-gold ((m miner))
 (format t "~&All this gold ought to be stored somewhere!")
 (incf (wealth m))
 (if (>= (wealth m) 5)
 (progn 
 (format t "~&Too much gold for today, let's sleep!")
 (enter m #'go-home-and-sleep-till-rested)
 (setf (wealth m) 0))
 (enter m #'enter-mine-and-dig-for-nugget)))
(defmethod go-home-and-sleep-till-rested ((m miner))
 (dotimes (i 4)
 (format t "~&Sleepin'"))
 (enter m #'enter-mine-and-dig-for-nugget))
(defmethod work ((m miner))
 (dotimes (n 30)
 (funcall (state m) m)))
(let ((a (make-miner)))
 (work a))

I was going to compare them for performance, but I couldn't get your revised version to run (it gave me an "unhandled memory fault" error which is something I haven't seen before).

Answer 3

Can you comment on what the goal/output of this program is supposed to be? How you're supposed to use it? It looks like make-miner just returns a list of functions, which doesn't sound useful on its own.

Some preliminary comments:

---

You can cut the while macro. CL provides you with many iteration constructs (do, dotimes, dolist, mapcar and friends, and loop). That last one can do what you want here (and lots more if you feel like reading);

(loop while (<= rested 3)
 do (format t "~&Sleepin'")
 do (incf rested))

Since you reset rested to 0 later in the same block anyway, you could also just do

(loop repeat 4 do (format t "~&Sleepin'"))

or

(dotimes (i 4) do (format t "~&Sleepin'"))

---

Common Lisp convention is to use dashed-lower-case-names rather than CamelCaseNames.

---

cond clauses don't need an explicit progn, but read on first

---

Wherever you've got (cond ([test] [clause]) (t [clause])), you can instead write (if [test] [clause] [clause]). For example,

(if (>= wealth 5) 
 (progn 
 (format t "~&Too much gold for today, let's sleep!")
 (enter 'GoHomeAndSleepTillRested)
 (setf wealth 0))
 (EnterMineAndDigForNugget))

You do actually need the progn here. In general, you should use cond where you'd normally use if/elseif/else in other languages (case is actually the switch analogue), and use if/when/unless where you can to signal intent.

• gumbo: Thanks, I'll read the links you provided and correct the code. Also, I'm aware of the naming convention, and even use it myself, but I was following an AI book (Programming AI by example), so I kept it the way it appeared in the book

Answer 4

If your FSM hardly ever changes, and performance is your primary concern, you can't beat this.

Translate it into simple structured code, in a progn or whatever, which you can do with any FSM. Here's the "C-ish" equivalent:

w = th = 0;
while(T){
 w++; th++;
 // Diggin' up gold!
 if (th >= 7){
 // Drinkin' old good whiskey
 th = 0;
 } else {
 // all this gold ought to be stored somewhere
 if (w >= 5){
 // Too much gold for today, let's sleep!
 w = 0;
 for (r = 0; r <= 3; r++){
 // sleepin'
 }
 }
 }
}