cl-mm, Common Lisp

Language: Layout:

(defparameter *data* (vector 0 0 0 0))

(defun run-machine (&key (state 1) (count 0))
  (labels ((dump (state)
             (format t "Step: ~2d    Proc: ~2d  ~{ ~2d~}~%" count state (coerce *data* 'list))
             (incf count)))
    (tagbody
     (case state
       (1 (go :proc-1))
       (2 (go :proc-2))
       (3 (go :proc-3))
       (4 (go :proc-4))
       (t (go :stop)))
     :proc-1
     (dump 1)
     (process-1)
     (if (decision-1) (go :proc-4) (go :proc-3))
     :proc-2
     (dump 2)
     (process-2)
     (if (decision-2) (go :proc-3) (go :proc-4))
     :proc-3
     (dump 3)
     (process-3)
     (if (decision-3) (go :proc-2) (go :proc-1))
     :proc-4
     (dump 4)
     (process-4)
     (if (decision-4) (go :stop) (go :proc-2))
     :stop
     (dump 5))))

(defun process-1 ()
  (incf (cell 0)))

(defun process-2 ()
  (incf (cell 1) (+ (cell 3) 1)))

(defun process-3 ()
  (unless (divisible (sum-cells 0 1) :by 3)
    (incf (cell 2) 7)))

(defun process-4 ()
  (unless (= 4 (rem (sum-cells 0 2) 5))
    (incf (cell 3))))

(defun decision-1 ()
  (divisible (cells-sum) :by 2))

(defun decision-2 ()
  (plusp (rem (cells-sum) 7)))

(defun decision-3 ()
  (all-cells #'evenp))

(defun decision-4 ()
  (> (cells-sum) 24))

;------------------------------------------------

(defun cell (i)
  (aref *data* i))

(defun (setf cell) (v i)
  (setf (aref *data* i) v))

(defun divisible (v &key by)
  (zerop (rem v by)))

(defun sum-cells (&rest indexes)
  (loop for i in indexes summing (cell i)))

(defun cells-sum ()
  (loop for x across *data* summing x))

(defun all-cells (predicate)
  (loop for x across *data*
        unless (funcall predicate x)
          do (return-from all-cells nil))
  t)

;------------------------------------------------

(defun main ()
  (run-machine)
  (format t "----------------------------------------------------------------~%")
  (let ((*data* (vector 3 3 14 1)))
    (run-machine :count 9 :state 4))
  (format t "----------------------------------------------------------------~%"))

(main)

[ + ] Show input
Absolute running time: 0.16 sec, cpu time: 0.02 sec, memory peak: 9 Mb, absolute service time: 0,23 sec