emacs.d/elisp-to-cl-lesson.org

From Emacs Lisp to Common Lisp

• Introduction
• Elisp Regression Testing of "queue.el"
• Common Lisp "How do you DO?" do-loop example
• Translate "queue.el" to "queue.lisp"
• Common Lisp "CS325-USER" package setup to critique code
  • Code critiques of "queue.lisp"
• Validation of package "queue"
  • Validation of all "queue" package loading loading messages
  • Validation of all external "queue" package symbols
• Common Lisp "QUEUE" regression testing
• Emacs Lisp
  • KEU Elisp Regression Testing
• Fiveam Common Lisp Regression Testing Framework
• Common Lisp
  • queue-lisp code critique

,#+latex_header: <<latex-header>>

\clearpage

Introduction

The Emacs Lisp queue library (src_emacs-lisp{(describe-package 'queue)}) implements a QUEUE by means of a cl-defstruct holding the head and the rear of the QUEUE. Here, I re-implement a QUEUE in by translating the Emacs Lisp queue.el file to the Common Lisp queue.lisp file.

Note: I am trying to implement similar functionality starting from the forms (cons nil nil) or (list nil nil) instead of the queue structure. Those unsuccessful attempts are named FIFO or KEU.

Note: the words FIFO and QUEUE name identical objects in computer science and KEU is a Dutch translation of the French word QUEUE.

Elisp Regression Testing of "queue.el"

The file test-queue.el contains an implementation of Elisp Regression Testing for queue.el. Implementing test-queue.el clarifies the queue.el client contract which is useful for any re-implementation of queue.el in Emacs Lisp or Common Lisp. The file test-queue.el has been tangled from listings lst:1st-part-test-queue, lst:2nd-part-test-queue, and lst:3rd-part-test-queue.

;;; test-queue.el --- ERT for queue.el   -*- lexical-binding: t; -*-

(require 'ert)
(require 'queue)

(ert-deftest queue-create-test ()
  (let ((queue (queue-create)))
    (should (equal t (and (equal (queue-head queue) nil)
                          (equal (queue-tail queue) nil))))))

(ert-deftest queue-enqueue-test ()
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue-create)))
        (dolist (item datum)
          (queue-enqueue queue item))
        (should (equal t (and (equal datum (queue-head queue))
                              (equal (list (car (reverse datum)))
                                     (queue-tail queue)))))))))

(ert-deftest queue-dequeue-test ()
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue-create)))
        (dolist (item datum)
          (queue-enqueue queue item))
        (let (mutad)
          (dotimes (n (length datum))
            (push (queue-dequeue queue) mutad))
          (should (equal datum (reverse mutad))))))))
<
(ert-deftest queue-prepend-test ()
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue-create)) enqueue prepend)
        ;; Enqueue/prepend items at even/odd positions:
        (dotimes (n (length datum))
          (let ((item (nth n datum)))
            (if (= 0 (mod n 2))
                (progn
                  (push item enqueue)
                  (queue-enqueue queue item))
              (push item prepend)
              (queue-prepend queue item))))
        (should (equal (append prepend (reverse enqueue))
                       (queue-all queue)))))))

(ert-deftest queue-empty-test ()
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue-create)))
        (queue-clear queue)
        (dolist (item datum)
          (queue-enqueue queue item))
        (dotimes (count (1- (length datum)))
          (queue-dequeue queue))
        ;; Check that QUEUE is not empty:
        (should (equal nil (queue-empty queue)))
        (queue-dequeue queue)
        ;; Check that QUEUE is empty:
        (should (equal t (queue-empty queue)))))))

(ert-deftest queue-copy-test ()
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((one (queue-create)) two)
        (dolist (item datum)
          (queue-enqueue one item))
        ;; Check that the queues have identical contents.
        (setq two (queue-copy one))
        (should (equal t (and (equal (queue-head one) (queue-head two))
                              (equal (queue-tail one) (queue-tail two)))))
        ;; Check that changing queue ONE does not change queue TWO.
        (dotimes (count (length datum))
          (queue-dequeue one))
        (should (equal t (and (equal nil (queue-head one))
                              (equal nil (queue-tail one))
                              (equal datum (queue-head two))
                              (equal (list (car (reverse datum)))
                                     (queue-tail two)))))
        ;; Check that changing queue TWO does not change queue ONE.
        (setq one (queue-copy two))
        (setq two (queue-copy one))
        (queue-clear two)
        (should (equal t (and (equal nil (queue-head two))
                              (equal nil (queue-tail two))
                              (equal datum (queue-head one))
                              (equal (list (car (reverse datum)))
                                     (queue-tail one)))))))))

(ert-deftest queue-iterator-test ()
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue-create)))
        (dolist (item datum)
          (queue-enqueue queue item))
        (let ((queue-iterator (queue-iter queue)))
          (dotimes (n (length datum))
            (should (equal (nth n datum) (iter-next queue-iterator)))))))))

;;; test-queue.el ends here

Common Lisp "How do you DO?" do-loop example

Listing lst:how-do-you-do is an complete do-loop example with variable clauses, exit clauses, and a body. I have gleaned listing lst:how-do-you-do from:

• How do you DO? by Chris Riesbeck.
• Successful Lisp: How to understand and use Common Lisp by David B. Lamkins.

(defun how-do-you-do? (items)
  (let ((result))
    ;; do loop:
    (do (;; variable clauses:
         (i 1 (1+ i))
         (items items (cdr items)))
        (;; exit clauses:
         (null items) 'done)
      ;; body:
      (format t "~&Item ~D is ~S~%" i (car items))
      (push (car items) result))
    ;; rest of `how-do-you-do?':
    (format t "~&~A~%" (reverse result))))

(let ((items '(how do you do \?)))
  (how-do-you-do? items))

Item 1 is HOW
Item 2 is DO
Item 3 is YOU
Item 4 is DO
Item 5 is ?
(HOW DO YOU DO ?)

Translate "queue.el" to "queue.lisp"

The queue.lisp file is a translation to Common Lisp of queue.el. The translation is wrapped in a Common Lisp package definition named queue. The design of the queue package offers its client code to use the exported symbols queue:all, queue:clear, queue:copy, queue:create, queue:dequeue, queue:empty, queue:enqueue, queue:first, queue:head, queue:last, queue:length, queue:nth, queue:p, queue:prepend, and queue:tail. Limit access to the private queue::queue structure to reading documentation with for instance (describe-object 'queue::queue t).

The queue.lisp code has a package header section, a code section which contains the translation of queue.el to Common Lisp, and package footer section. The package footer section defines a kind of short function aliases that the package header section exports. See The Common Lisp Cookbook: Packages for additional information.

The translation takes into account the following points:

1. (setcar place content) must be replaced with (setf (car place content)).
2. (setcdr place content) must be replaced with (setf (cdr place content)).
3. The while loop in the Emacs Lisp version of queue-copy is no valid Common Lisp, where it has been replaced with a dotimes loop in listing lst:2nd-part-queue.lisp.
4. Chris Riesbeck's code critique recommends to replace recursively (cons item nil) with (list item).

Section #sec:queue-code-critiques shows that only the Common Lisp implementation of queue-nth fails to pass the code critique implying that client code should not use queue:nth. In order to ensure that the queue.lisp code is robust:

1. Validate all compiler message by loading queue.lisp as shown in section #sec:queue-loading-check
2. Validate all external symbols of queue.lisp as shown in section #sec:queue-externals-check.
3. Write a test suite as client code of queue.lisp as shown in section #sec:queue-client-testing.

Note: ensure that there is an operational sly-mrepl-mode buffer by means of executing for instance src_emacs-lisp{(call-interactively 'sly)} and execute src_emacs-lisp{(sly-hyperspec-lookup "fdefinition")} to read the fdefinition documentation; fdefinition is used in listing lst:3rd-part-queue.lisp to define the short function aliases for export in listing lst:1st-part-queue.lisp.

;;; queue.lisp --- a translation of queue.el to Common Lisp

;;; Package header:
(defpackage queue
  (:use :cl)
  ;; Beware of shadowing!
  (:shadow :first :last :length :nth)
  ;; Use the short function names defined near the end of this file!
  ;; Export all 15 functions!
  ;; No `queue' structure export because of package name symbol conflicts!
  (:export #:all #:clear #:copy #:create #:dequeue #:empty #:enqueue
           #:first #:head #:last #:length #:nth #:p #:prepend #:tail))

(in-package :queue)

;;; Code:
(defstruct queue
  "QUEUE structure holding the HEAD and the TAIL of QUEUE.
HEAD is a list of all items and TAIL is a list of the last item.
QUEUE is empty when HEAD and TAIL are nil."
  (head) (tail))

(defun queue-enqueue (queue item)
  "Add ITEM to the end of QUEUE."
  (if (queue-head queue)
      (setf (cdr (queue-tail queue))
            (setf (queue-tail queue) (list item)))
      (setf (queue-head queue)
            (setf (queue-tail queue) (list item)))))

(defun queue-prepend (queue item)
  "Add ITEM before the front of QUEUE."
  (if (queue-head queue)
      (push item (queue-head queue))
      (setf (queue-head queue)
            (setf (queue-tail queue) (list item)))))

(defun queue-dequeue (queue)
  "Remove the first item of QUEUE and return it.
Return nil if QUEUE is empty."
  (unless (cdr (queue-head queue))
    (setf (queue-tail queue) nil))
  (pop (queue-head queue)))

(defun queue-empty (queue)
  "Return t if QUEUE is empty, otherwise return nil."
  (null (queue-head queue)))

(defun queue-first (queue)
  "Return the first item in QUEUE, without removing it.
Return nil if QUEUE is empty."
  (car (queue-head queue)))

(defun queue-nth (queue n)
  "Return the item at index N in QUEUE, without removing it.
Return nil if the length of QUEUE is less than N.
The first item in QUEUE has index 0."
  (cl:nth n (queue-head queue)))

(defun queue-last (queue)
  "Return the last item in QUEUE, without removing it.
Return nil if QUEUE is empty."
  (car (queue-tail queue)))

(defun queue-all (queue)
  "Return a list of all items in QUEUE or nil if QUEUE is empty.
The oldest item in QUEUE is the first in the list."
  (queue-head queue))

(defun queue-copy (queue)
  "Return a copy of QUEUE.
The new queue contains all items of QUEUE in the same order.
The items themselves are *not* copied."
  (let ((q (make-queue))
        (items (queue-head queue)))
    (when (queue-head queue)
      (setf (queue-head q) (list (car (queue-head queue)))
            (queue-tail q) (queue-head q))
      (dotimes (count (1- (cl:length items)))
        (setq items (cdr items))
        (setf (queue-tail q)
              (setf (cdr (queue-tail q)) (list (car items))))))
    q))

(defun queue-length (queue)
  "Return the number of items in QUEUE."
  (cl:length (queue-head queue)))

(defun queue-clear (queue)
  "Remove all items from QUEUE."
  (setf (queue-head queue) nil
        (queue-tail queue) nil))

;;; Package footer:
;;; Make short function names for export with prefix `queue:' in `defpackage'.
(setf (fdefinition 'all) #'queue-all)
(setf (fdefinition 'clear) #'queue-clear)
(setf (fdefinition 'copy) #'queue-copy)
(setf (fdefinition 'create) #'make-queue)
(setf (fdefinition 'dequeue) #'queue-dequeue)
(setf (fdefinition 'empty) #'queue-empty)
(setf (fdefinition 'enqueue) #'queue-enqueue)
(setf (fdefinition 'first) #'queue-first)
(setf (fdefinition 'head) #'queue-head)
(setf (fdefinition 'last) #'queue-last)
(setf (fdefinition 'length) #'queue-length)
(setf (fdefinition 'nth) #'queue-nth)
(setf (fdefinition 'prepend) #'queue-prepend)
(setf (fdefinition 'p) #'queue-p)
(setf (fdefinition 'tail) #'queue-tail)

;;; queue.lisp ends here

Common Lisp "CS325-USER" package setup to critique code

I use the critique macro in Chris Riesbeck's Common Lisp CS325-USER package to improve my Common Lisp code. Therefore, I have installed the CS325 library according to the CS325 Common Lisp Setup instructions and I have to execute listing lst:load-cs325 (or its equivalence) to ql:quickload the :cs325 package. This is a prerequisite for executing listing lst:1st-part-queue-critiques, lst:2nd-part-queue-critiques, and lst:3rd-part-queue-critiques.

;; The call (ql:quickload :cs325) is equivalent.
(ql:quickload "cs325")

To load "cs325":
  Load 1 ASDF system:
    cs325
; Loading "cs325"

\clearpage

Code critiques of "queue.lisp"

Execution of listing lst:1st-part-queue-critiques, lst:2nd-part-queue-critiques, and lst:3rd-part-queue-critiques may require prior execution of listing lst:load-cs325 (or its equivalence) to ql:quickload the :cs325 package.

(critique
 (defstruct queue
   "QUEUE structure holding the HEAD and the TAIL of QUEUE.
HEAD is a list of all items and TAIL is a list of the last item.
QUEUE is empty when HEAD and TAIL are nil."
   (head) (tail)))

(critique
 (defun queue-enqueue (queue item)
   "Add ITEM to the end of QUEUE."
   (if (queue-head queue)
       (setf (cdr (queue-tail queue))
             (setf (queue-tail queue) (list item)))
       (setf (queue-head queue)
             (setf (queue-tail queue) (list item))))))

(critique
 (defun queue-prepend (queue item)
   "Add ITEM before the front of QUEUE."
   (if (queue-head queue)
       (push item (queue-head queue))
       (setf (queue-head queue)
             (setf (queue-tail queue) (list item))))))

(critique
 (defun queue-dequeue (queue)
   "Remove the first item of QUEUE and return it.
Return nil if QUEUE is empty."
   (unless (cdr (queue-head queue))
     (setf (queue-tail queue) nil))
   (pop (queue-head queue))))

(critique
 (defun queue-empty (queue)
   "Return t if QUEUE is empty, otherwise return nil."
   (null (queue-head queue))))

(critique
 (defun queue-first (queue)
   "Return the first item in QUEUE, without removing it.
Return nil if QUEUE is empty."
   (car (queue-head queue))))

;; CRITIQUE says of QUEUE-NTH:
;; (NTH ...) is expensive. Lists are not arrays.
;; Hint: use FIRST, REST, and/or a pointer to access elements of a list
(critique
 (defun queue-nth (queue n)
   "Return the item at index N in QUEUE, without removing it.
Return nil if the length of QUEUE is less than N.
The first item in QUEUE has index 0."
   (cl:nth n (queue-head queue))))

(critique
 (defun queue-last (queue)
   "Return the last item in QUEUE, without removing it.
Return nil if QUEUE is empty."
   (car (queue-tail queue))))

(critique
 (defun queue-all (queue)
   "Return a list of all items in QUEUE or nil if QUEUE is empty.
The oldest item in QUEUE is the first in the list."
   (queue-head queue)))

(critique
 (defun queue-copy (queue)
   "Return a copy of QUEUE.
The new queue contains all items of QUEUE in the same order.
The items themselves are *not* copied."
   (let ((q (make-queue))
         (items (queue-head queue)))
     (when (queue-head queue)
       (setf (queue-head q) (list (car (queue-head queue)))
             (queue-tail q) (queue-head q))
       (dotimes (count (1- (length items)))
         (setq items (cdr items))
         (setf (queue-tail q)
               (setf (cdr (queue-tail q)) (list (car items))))))
     q)))

(critique
 (defun queue-length (queue)
   "Return the number of items in QUEUE."
   (length (queue-head queue))))

(critique
 (defun queue-clear (queue)
   "Remove all items from QUEUE."
   (setf (queue-head queue) nil
         (queue-tail queue) nil)))

Validation of package "queue"

Validation of all "queue" package loading loading messages

(load "queue.lisp" :verbose t :print t)

; loading #P"/Users/vermeulen/.emacs.d/queue.lisp"
; #<PACKAGE "QUEUE">
; #<PACKAGE "QUEUE">
; QUEUE
; QUEUE-ENQUEUE
; QUEUE-PREPEND
; QUEUE-DEQUEUE
; QUEUE-EMPTY
; QUEUE-FIRST
; QUEUE-NTH
; QUEUE-LAST
; QUEUE-ALL
; QUEUE-COPY
; QUEUE-LENGTH
; QUEUE-CLEAR
; #<FUNCTION QUEUE-ALL>
; #<FUNCTION QUEUE-CLEAR>
; #<FUNCTION QUEUE-COPY>
; #<FUNCTION MAKE-QUEUE>
; #<FUNCTION QUEUE-DEQUEUE>
; #<FUNCTION QUEUE-EMPTY>
; #<FUNCTION QUEUE-ENQUEUE>
; #<FUNCTION QUEUE-FIRST>
; #<FUNCTION QUEUE-HEAD>
; #<FUNCTION QUEUE-LAST>
; #<FUNCTION QUEUE-LENGTH>
; #<FUNCTION QUEUE-NTH>
; #<FUNCTION QUEUE-PREPEND>
; #<FUNCTION QUEUE-P>
; #<FUNCTION QUEUE-TAIL>

Validation of all queue package loading messages.

\clearpage

Validation of all external "queue" package symbols

;; BUG: Remove the first empty line of the output.  This is not easy!
(do-external-symbols (s (find-package :queue))
  (print s))

QUEUE:HEAD
QUEUE:LAST
QUEUE:DEQUEUE
QUEUE:LENGTH
QUEUE:PREPEND
QUEUE:FIRST
QUEUE:NTH
QUEUE:ENQUEUE
QUEUE:COPY
QUEUE:CREATE
QUEUE:P
QUEUE:ALL
QUEUE:EMPTY
QUEUE:CLEAR
QUEUE:TAIL

Validation of all external queue package symbols.

Common Lisp "QUEUE" regression testing

Listing lst:5am-test-queue-header, lst:5am-test-queue-create, lst:5am-test-queue-enqueue, lst:5am-test-queue-prepend, lst:5am-test-queue-empty, lst:5am-test-queue-first, lst:5am-test-queue-nth, lst:5am-test-queue-last, lst:5am-test-queue-all, lst:5am-test-queue-copy, lst:5am-test-queue-length, lst:5am-test-queue-clear and lst:5am-test-queue-footer are tangled into test-queue.lisp.

;;; test-queue.lisp --- 5am regression testing of queue.lisp

(ql:quickload :fiveam)
(load "queue.lisp" :verbose t :print t)

(5am:test test-queue-create
  "Test queue:create."
  (let ((queue (queue:create)))
    (5am:is (eq nil (queue:head queue))
            "Not: (eq nil (queue:head queue))")
    (5am:is (eq nil (queue:tail queue))
            "Not: (eq nil (queue:tail queue))")))

(5am:run! 'test-queue-create)

Running test TEST-QUEUE-CREATE ..
 Did 2 checks.
    Pass: 2 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-enqueue
  "Test queue:enqueue."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
        (queue (queue:create)))
    (dolist (datum data)
      (queue:clear queue)
      (dolist (item datum)
        (queue:enqueue queue item))
      (5am:is (equal (queue:head queue) datum)
              "Not: (equal (queue:head queue) datum)")
      (5am:is (eq (car (queue:tail queue)) (car (reverse datum)))
              "Not: (eq (car (queue:tail queue)) (car (reverse datum)))"))))

(5am:run! 'test-queue-enqueue)

Running test TEST-QUEUE-ENQUEUE ....................
 Did 20 checks.
    Pass: 20 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-prepend
  "Test queue:prepend."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
        (queue (queue:create)))
    (dolist (datum data)
      (queue:clear queue)
      (dolist (item datum)
        (queue:prepend queue item))
      (5am:is (equal (queue:head queue) (reverse datum))
              "Not: (equal (queue:head queue) (reverse datum))")
      (5am:is (eq (car (queue:tail queue)) (car datum))
              "Not: (eq (car (queue:tail queue)) (car datum))"))))

(5am:run! 'test-queue-prepend)

Running test TEST-QUEUE-PREPEND ....................
 Did 20 checks.
    Pass: 20 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-dequeue
  "Test queue:dequeue."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
        (queue (queue:create)))
    (5am:is (not (car (queue:dequeue queue)))
            "Not: (car (queue:dequeue queue))")
    (dolist (datum data)
      (dolist (item datum)
        (queue:enqueue queue item))
      (dotimes (n (length datum))
        (5am:is (equal (queue:dequeue queue) (cl:nth n datum))
                "Not: (equal (queue:dequeue queue) (cl:nth n datum))")))))

(5am:run! 'test-queue-dequeue)

Running test TEST-QUEUE-DEQUEUE ...............................
 Did 31 checks.
    Pass: 31 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-empty
  "Test queue:empty."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue:create)))
        (queue:clear queue)
        (dolist (item datum)
          (queue:enqueue queue item))
        (dotimes (count (1- (length datum)))
          (queue:dequeue queue))
        (5am:is (not (queue:empty queue))
                "Not: (equal (queue:head queue) (reverse datum))")
        (queue:dequeue queue)
        (5am:is (queue:empty queue)
                "Not: (eq (car (queue:tail queue)) (car datum))")))))

(5am:run! 'test-queue-empty)

Running test TEST-QUEUE-EMPTY ....................
 Did 20 checks.
    Pass: 20 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-first
  "Test queue:first."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue:create)))
        (queue:clear queue)
        (dolist (item datum)
          (queue:enqueue queue item))
        (5am:is (eq  (queue:first queue) (car datum))
                "Not: (eq  (queue:first queue) (car datum))")
        (5am:is (equal (queue:head queue) datum)
                "Not: (equal (queue:head queue) datum)")))))

(5am:run! 'test-queue-first)

Running test TEST-QUEUE-FIRST ....................
 Did 20 checks.
    Pass: 20 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-nth
  "Test queue:nth."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (let ((queue (queue:create)))
        (queue:clear queue)
        (dolist (item datum)
          (queue:enqueue queue item))
        (dotimes (n (1- (length datum)))
          (5am:is (eq  (queue:nth queue n) (cl:nth n datum))
                  "Not: (eq  (queue:nth queue n) (cl:nth n datum))")
          (5am:is (not (queue:nth queue (length datum)))
                  "Not: (not (queue:nth queue (length datum)))"))))))

(5am:run! 'test-queue-nth)

Running test TEST-QUEUE-NTH ........................................
 Did 40 checks.
    Pass: 40 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-last
  "Test queue:last."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
        (queue (queue:create)))
    (5am:is (eq (queue:last queue) nil)
            "Not: (eq (queue:last queue) nil)")
    (dolist (datum data)
      (queue:clear queue)
      (dolist (item datum)
        (queue:enqueue queue item))
      (5am:is (eq (queue:last queue) (car (reverse datum)))
              "Not: (eq (queue:last queue) (car (reverse datum)))"))))

(5am:run! 'test-queue-last)

Running test TEST-QUEUE-LAST ...........
 Did 11 checks.
    Pass: 11 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-all
  "Test queue:all."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
        (queue (queue:create)))
    (5am:is (eq (queue:all queue) nil)
            "Not: (eq (queue:all queue) nil)")
    (dolist (datum data)
      (queue:clear queue)
      (dolist (item datum)
        (queue:enqueue queue item))
      (5am:is (equal (queue:all queue) datum)
              "Not: (equal (queue:all queue) datum)"))))

(5am:run! 'test-queue-all)

Running test TEST-QUEUE-ALL ...........
 Did 11 checks.
    Pass: 11 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-copy
  "Test queue:copy."
  (let ((one (queue:create))
        (two nil)
        (data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (queue:clear one)
      (dolist (item datum)
        (queue:enqueue one item))
      ;; Check for equality of ORIGINAL and COPY:
      (setq two (queue:copy one)) ;;
      (5am:is (equal (queue:head one) (queue:head two))
              "Not: (equal (queue:head one) (queue:head two))")
      (5am:is (equal (queue:tail one) (queue:tail two))
              "Not: (equal (queue:tail one) (queue:tail two))")
      ;; Check that the COPY does not share structure with the ORIGINAL:
      (queue:clear one)
      (5am:is (eq nil (queue:head one))
              "Not: (eq nil (queue:head one))")
      (5am:is (eq nil (queue:tail one))
              "Not: (eq nil (queue:tail one))")
      (5am:is (equal (queue:head two) datum)
              "Not: (equal (queue:head two) datum)")
      (5am:is (eq (car (queue:tail two)) (car (reverse datum)))
              "Not: (eq (car (queue:tail two)) (car (reverse datum)))")
      ;; Check that the ORIGINAL does not share structure with the COPY:
      (setq one (queue:copy two))
      (setq two (queue:copy one))
      (queue:clear two)
      (5am:is (eq nil (queue:head two))
              "Not: (eq nil (queue:head two))")
      (5am:is (eq nil (queue:tail two))
              "Not: (eq nil (queue:tail two))")
      (5am:is (equal (queue:head one) datum)
              "Not: (equal (queue:head one) datum)")
      (5am:is (eq (car (queue:tail one)) (car (reverse datum)))
              "Not: (eq (car (queue:tail one)) (car (reverse datum)))"))))

(5am:run! 'test-queue-copy)

Running test TEST-QUEUE-COPY ....................................................................................................
 Did 100 checks.
    Pass: 100 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-length
  "Test queue:all."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
        (queue (queue:create)))
    (5am:is (eq (queue:length queue) (cl:length nil))
            "Not: (eq (eq (queue:length queue) (cl:length nil)))")
    (dolist (datum data)
      (queue:clear queue)
      (dolist (item datum)
        (queue:enqueue queue item))
      (5am:is (equal (queue:length queue) (cl:length datum))
              "Not: (queue:length queue) (cl:length datum)"))))

(5am:run! 'test-queue-length)

Running test TEST-QUEUE-LENGTH ...........
 Did 11 checks.
    Pass: 11 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:test test-queue-clear
  "Test queue:clear."
  (let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
        (queue (queue:create)))
    (5am:is (queue:empty queue) "Not: (queue:empty queue)")
    (dolist (datum data)
      (queue:clear queue)
      (5am:is (queue:empty queue) "Not: (queue:empty queue)")
      (dolist (item datum)
        (queue:enqueue queue item))
      (5am:is (not (queue:empty queue)) "Not: (not (queue:empty queue))"))))

(5am:run! 'test-queue-clear)

Running test TEST-QUEUE-CLEAR .....................
 Did 21 checks.
    Pass: 21 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

(5am:run-all-tests)

;;; test-queue.lisp ends here

Running test suite NIL
 Running test TEST-QUEUE-CREATE ..
 Running test TEST-QUEUE-ENQUEUE ....................
 Running test TEST-QUEUE-PREPEND ....................
 Running test TEST-QUEUE-DEQUEUE ...............................
 Running test TEST-QUEUE-EMPTY ....................
 Running test TEST-QUEUE-FIRST ....................
 Running test TEST-QUEUE-NTH ........................................
 Running test TEST-QUEUE-LAST ...........
 Running test TEST-QUEUE-ALL ...........
 Running test TEST-QUEUE-COPY ....................................................................................................
 Running test TEST-QUEUE-LENGTH ...........
 Running test TEST-QUEUE-CLEAR .....................
 Did 307 checks.
    Pass: 307 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

Emacs Lisp

;;; keu.el --- handle FIFOs of items    -*- lexical-binding: t; -*-

(defun keu-create ()
  "Create an empty keu."
  (list nil nil))

(defun keu-enqueue (keu item)
  "Add ITEM to the rear of KEU."
  (if (car keu)
      (setcdr (cadr keu) (setf (cadr keu) (list item)))
    (setcar keu (car (setcdr keu (list (list item)))))))

(defun keu-prepend (keu item)
  "Add ITEM in front of the KEU head."
  (if (car keu)
      (push item (car keu))
    (setcar keu (car (setcdr keu `((,item)))))))

(defun keu-dequeue (keu)
  "Remove the first ITEM from KEU and return it.
Returns nil if KEU is empty."
  (unless (car keu)
    (setf (cdr keu) '(nil)))
  (pop (car keu)))

(defun keu-empty (keu)
  "Return t if KEU is empty, otherwise return nil."
  (null (car keu)))

(defun keu-first (keu)
  "Return the first ITEM from KEU or nil if it is empty,
without removing it from KEU."
  (caar keu))

Emacs Lisp KEU implentation: 1st part of keu.el.

(defun keu-nth (keu n)
  "Return the Nth ITEM from KEU, without removing it.
If the length of the KEU is less than N, return nil. The first
element in KEU has index 0."
  (nth n (car keu)))

(defun keu-last (keu)
  "Return the last element of KEU, without removing it.
Returns nil if KEU is empty."
  (cadr keu))

(defun keu-all (keu)
  "Return a list of all ITEMS in KEU or nil if it is empty.
The oldest ITEM in KEU is the first in the list."
  (car keu))

(defun keu-copy (keu)
  "Return a copy of KEU.
The new queue contains all ITEMS in KEU in the same order.
The ITEMS themselves are *not* copied."
  (let ((q (keu-create))
	(items (car keu)))
    (when (car keu)
      (setcar q (list (caar keu)))
      (setcdr q (list (car q)))
      (while (setq items (cdr items))
        (setcdr q (list (setcdr (cadr q) (list (car items)))))))
    q))

(defun keu-length (keu)
  "Return the number of ITEMS in KEU."
  (length (car keu)))

;; BUG: does not return (nil nil), but ((nil) (nil)) when not empty
(defun keu-clear (keu)
  "Remove all elements from KEU."
  (setf (car keu) (list nil nil)))

Emacs Lisp KEU implentation: 2nd part of key.el.

(defmacro keu--when-generators (then)
  "Evaluate THEN if `generator' library is available."
  (declare (debug t))
  (if (require 'generator nil 'noerror) then))

(keu--when-generators
 (iter-defun keu-iterator-create (keu)
   "Return a KEU iterator object.

Calling `iter-next' on this object will retrieve the next element
from KEU, which itself is not modified."
   (let ((list (car keu)))
     (while list (iter-yield (pop list))))))

;; New functionality:

(defun items-enqueue (keu items)
  "Add ITEMS to the KEU rear."
  (dolist (item items)
    (keu-enqueue keu item)))

(defun items-dequeue (keu)
  "Remove all ITEMS from the from the KEU head and return them.
The order of the removed ITEMS equals the order of the ITEMS in KEU."
  (let (result)
    (while (not (keu-empty keu))
      (push (keu-dequeue keu) result))
    (reverse result)))

(provide 'keu)
;;; keu.el ends here

Emacs Lisp KEU implentation: 3rd part of key.el.

KEU Elisp Regression Testing

;;; test-keu.el --- ERT for keu.el   -*- lexical-binding: t; -*-

(require 'ert)
(require 'keu)

(ert-deftest keu-create-test ()
  (should (equal (keu-create) (list nil nil))))

(ert-deftest keu-enqueue-test ()
  (let ((keu (keu-create))
        (data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (dolist (item datum)
        (keu-enqueue keu item))
      (should (equal keu `(,datum ,(list (car (reverse datum)))))))))

(ert-deftest keu-dequeue-test ()
  (let ((keu (keu-create))
        (data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (dolist (item datum)
        (keu-enqueue keu item))
      (let (mutad)
        (dotimes (n (length datum))
          (push (keu-dequeue keu) mutad))
        (should (equal datum (reverse mutad)))))))

(ert-deftest keu-prepend-test ()
  (let ((keu (keu-create))
        (data '(a b c)))
    (keu-prepend keu (nth 1 data))
    (keu-prepend keu (nth 0 data))
    (keu-enqueue keu (nth 2 data))
    (should (equal data (list (keu-nth keu 0) (keu-nth keu 1) (keu-nth keu 2))))))

Elisp Regression Testing KEU: 1st part of test-keu.el.

(ert-deftest keu-empty-test ()
  (let ((ok (keu-create))
        (no (keu-create))
        (data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (dolist (item datum) (keu-enqueue no item))
      (dotimes (count (length datum)) (keu-dequeue no))
      (should (equal t (keu-empty ok)))
      (dolist (item datum) (keu-enqueue no item))
      (dotimes (count (1- (length datum))) (keu-dequeue no))
      (should (equal nil (keu-empty no))))))

(ert-deftest keu-copy-test ()
  (let ((old (keu-create))
        (data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (keu-clear old)
      (items-enqueue old datum)
      (let ((new (keu-copy keu)))
        (message "datum: `%S'" datum)
        (message "old: `%S'" old)
        (message "new: `%S'" new)
        (should (equal old new))))))

(ert-deftest keu-iterator-test ()
  (let ((keu (keu-create))
        (data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
                (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
    (dolist (datum data)
      (items-enqueue keu datum)
      (let ((keu-iterator (keu-iterator-create keu)))
        (dotimes (n (length datum))
          (should (equal (nth n datum) (iter-next keu-iterator))))))))

;;; test-keu.el ends here

Elisp Regression Testing KEU: 2nd part of test-keu.el.

Fiveam Common Lisp Regression Testing Framework

Here, I explore how to use fiveam.

(ql:quickload :fiveam)

To load "fiveam":
  Load 1 ASDF system:
    fiveam
; Loading "fiveam"

Result of loading the FIVEAM package.

(test 5am-test-demo
  "This demonstrates the basic use of test and check."
  (is (listp (list 1 2)))
  (is (= 5 (+ 2 3)) "This should pass.")
  (is (= 4 4.1) "~D and ~D are not = to each other." 4 4.1))

Define a test from within in the FIVEAM package.

(run! '5am-test-demo)

Running test 5AM-TEST-DEMO ..f
 Did 3 checks.
    Pass: 2 (66%)
    Skip: 0 ( 0%)
    Fail: 1 (33%)
 Failure Details:
 --------------------------------
 5AM-TEST-DEMO [This demonstrates the basic use of test and check.]:
      4 and 4.1 are not = to each other.
 --------------------------------

(5am:test cl-test-demo
  "This demonstrates the basic use of test and check."
  (5am:is (listp (list 1 2)))
  (5am:is (= 5 (+ 2 3)) "This should pass.")
  (5am:is (= 4 4.1) "~D and ~D are not = to each other." 4 4.1))

Define a test from within the CL-USER package.

(5am:run! 'cl-test-demo)

Running test CL-TEST-DEMO ..f
 Did 3 checks.
    Pass: 2 (66%)
    Skip: 0 ( 0%)
    Fail: 1 (33%)
 Failure Details:
 --------------------------------
 CL-TEST-DEMO [This demonstrates the basic use of test and check.]:
      4 and 4.1 are not = to each other.
 --------------------------------

Common Lisp

;;; keu.lisp --- handle FIFOs of items

(defun keu-create ()
  "Create an empty keu."
  (list nil nil))

;; BUG: in case of `(null item)'
(defun keu-enqueue (keu item)
  "Add ITEM to the rear of KEU."
  (if (car keu)
      (setf (cdr (cadr keu)) (setf (cadr keu) (list item)))
      (setf (car keu) (car (setf (cdr keu) (list (list item)))))))

(defun keu-prepend (keu item)
  "Add ITEM in front of the KEU head."
  (if (car keu)
      (push item (car keu))
      (setf (car keu) (car (setf (cdr keu) (list (list item)))))))

(defun keu-dequeue (keu)
  "Remove the first ITEM from KEU and return it.
Returns nil if the KEU is empty."
  (unless (car keu)
    (setf (cdr keu) '(nil)))
  (prog1
      (caar keu)
    (setf (car keu) (cdar keu))))

(defun keu-empty (keu)
  "Return t if KEU is empty, otherwise return nil."
  (null (car keu)))

Common Lisp KEU implementation.

(defun keu-first (keu)
  "Return the first ITEM from KEU or nil if it is empty,
without removing it from KEU."
  (caar keu))

(defun keu-nth (keu n)
  "Return the Nth ITEM from KEU, without removing it.
If the length of the KEU is less than N, return nil. The first
element in KEU has index 0."
  (nth n (car keu)))

(defun keu-last (keu)
  "Return the last element of KEU, without removing it.
Returns nil if the QUEUE is empty."
  (cadr keu))

(defun keu-all (keu)
  "Return a list of all ITEMS in QUEUE or nil if it is empty.
The oldest ITEM in KEU is the first in the list."
  (car keu))

(defun items-enqueue (keu items)
  "Add ITEMS to the KEU rear."
  (dolist (item items)
    (keu-enqueue keu item)))

(defun items-dequeue (keu)
  "Remove all ITEMS from the KEU head and return them.
The order of the removed ITEMS equals the order of the ITEMS in KEU."
  (loop while (not (keu-empty keu))
        collect (keu-dequeue keu)))

(defun keu-copy (keu)
  "CHEAT"
  (let ((queue (keu-create)))
    (items-enqueue queue (car keu))
    queue))

Common Lisp KEU scaffolding.

;; Testing:

(let ((keu (keu-create))
      (data '(0 1 2)))
  (items-enqueue keu data)
  (equal (items-dequeue keu) data))

(let ((keu (keu-create))
      (data '(0 (nil) 2)))
  (items-enqueue keu data)
  `(,(items-dequeue keu) must equal ,data))

(let ((keu (keu-create))
      (data '(0 1 2)))
  (keu-prepend keu (nth 1 data))
  (keu-prepend keu (nth 0 data))
  (keu-enqueue keu (nth 2 data))
  (equal data (items-dequeue keu)))

(let ((keu (keu-create))
      (data '(a b c)))
  (items-enqueue keu data)
  (equal (keu-copy keu) keu))

Common Lisp QUEUE testing.

queue-lisp code critique

(critique
 (defun keu-create ()
   "Create an empty keu."
   (list nil nil)))

(critique
 (defun keu-enqueue (keu item)
   "Add ITEM to the rear of KEU."
   (if (car keu)
       (setf (cdr (cadr keu)) (setf (cadr keu) (list item)))
       (setf (car keu) (car (setf (cdr keu) (list (list item))))))))

(critique
 (defun keu-prepend (keu item)
   "Add ITEM in front of the KEU head."
   (if (car keu)
       (push item (car keu))
       (setf (car keu) (car (setf (cdr keu) (list (list item))))))))

(critique
 (defun keu-dequeue (keu)
   "Remove the first ITEM from KEU and return it.
Returns nil if the KEU is empty."
   (unless (car keu)
     (setf (cdr keu) '(nil)))
   (prog1
       (caar keu)
     (setf (car keu) (cdar keu)))) )

(critique
 (defun keu-empty (keu)
   "Return t if KEU is empty, otherwise return nil."
   (null (car keu))))

(critique
 (defun items-enqueue (keu items)
   "Add ITEMS to the KEU rear."
   (dolist (item items)
     (keu-enqueue keu item))))

(critique
 (defun items-dequeue (keu)
   "Remove all ITEMS from the KEU head and return them.
The order of the removed ITEMS equals the order of the ITEMS in KEU."
  (loop while (not (fifo-empty keu))
        collect (fifo-dequeue keu))))