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

#+title: From Emacs Lisp to Common Lisp
#+author: Gerard Vermeulen
#+macro: kbd (eval (by-backend-kbd-org-macro $1))
#+property: header-args:emacs-lisp :exports code :results silent
#+property: header-args:lisp :eval never-export
#+property: tangle-dir ./site-lisp/
#+startup: showeverything
#+time-stamp-file: -*- LaTeX -*-
#+cite_export: biblatex phys,biblabel=brackets,doi=true
#+latex_class: article
#+latex_class_options: [10pt,english,svgnames]
#+begin_src latex :noweb yes :results raw
,#+latex_header: <<latex-header>>
#+end_src
#+name: latex-header
#+begin_src latex :exports none
% -*- LaTeX -*-
% LaTeX PREAMBLE:
% See: https://list.orgmode.org/87o807r7fr.fsf@posteo.net/
% From: "Juan Manuel Macías" <maciaschain@posteo.net>
% To: orgmode <emacs-orgmode@gnu.org>
% Subject: [tip] Insert arbitrary LaTeX code at the beginning of any float environment
% Date: Sun, 08 May 2022 22:22:16 +0000
% Message-ID: <87o807r7fr.fsf@posteo.net>
% LANGUAGE:
\usepackage{babel}
\usepackage{fvextra}
\usepackage{csquotes}
% LISTS:
\usepackage{enumitem}
\setlist{noitemsep}
% CAPTIONS, LISTINGS, and SUBCAPTIONS
% Section 2.6 of caption-eng.pdf (texdoc caption) explains that the sign
% of "skip" depends on the assumption "position=above" or "position=below".
% The assumption should match the real caption position in the LaTeX code.
% Use the "DejaVu Sans Mono" as typewriter font for engrave-faces listings.
\usepackage{caption}
\captionsetup[listing]{position=below,skip=0em}
\setmonofont{DejaVu Sans Mono}[Scale=MatchLowercase]
\usepackage{subcaption}
% TABLES:
% https://tex.stackexchange.com/a/341254 answers:
% "How differ the environments tabular, tabular*, and tabularx?"
% https://emacs.stackexchange.com/a/28903 answers:
% "How to tweak org-mode table colors for latex export only?"
% https://tex.stackexchange.com/a/468596 answers:
% "How to format LaTeX using siunitx?"
% https://tex.stackexchange.com/a/355396 answers:
% "How to load colortbl and xcolor for maximal interoperability?"
\usepackage{booktabs}
\usepackage[table]{xcolor}
\usepackage{tabularx}  % DANGER: beware of Org table :width and :align options!
% STANDALONE FIGURES AND TABLES:
% https://xuc.me/blog/reuse-tikz-figures-in-articles-and-slides/ explains that
% making fake beamer commands for standalone pictures is less error-prone than
% using beamerarticle.
\usepackage{standalone}
\usepackage{xparse}
\NewDocumentCommand{\onslide}{s t+ d<>}{}
\NewDocumentCommand{\only}{d<>}{}
\NewDocumentCommand{\uncover}{d<>}{}
\NewDocumentCommand{\visible}{d<>}{}
\NewDocumentCommand{\invisible}{d<>}{}
% PAGE LAYOUT:
\usepackage[headheight=20mm,top=40mm,bottom=20mm,left=0.1\paperwidth,right=0.1\paperwidth,heightrounded,verbose]{geometry}
% SI UNITS:
\usepackage[load-configurations=abbreviations]{siunitx}
\sisetup{
  range-phrase = \ensuremath{\text{\,\textendash\,}},
  range-units = brackets,
  separate-uncertainty,
}
\DeclareSIUnit\dollar{\$}
\DeclareSIUnit\euro{€}
\DeclareSIUnit\mK{\milli\kelvin}
\DeclareSIUnit\mbar{\milli\bar}
\DeclareSIUnit\micron{\micro\meter}
\DeclareSIUnit\nW{\nano\watt}
% TIKZ AND PGFPLOTS:
\usepackage{tikz}
\usetikzlibrary{3d,arrows,backgrounds,calc,plotmarks}
\usepackage{pgfplots}
\pgfplotsset{compat=newest}
\def\axisdefaultwidth{90mm}
\def\axisdefaultheight{75mm}
% SYMBOLS FOR FLUID MECHANICS
\newcommand{\Nusselt}{\mbox{\textit{Nu}}}
\newcommand{\Reynolds}{\mbox{\textit{Re}}}
% FLOAT BARRIERS:
% https://tex.stackexchange.com/a/118667 answers:
% "How to make float barriers for subsections as placeins does for sections?"
% 1. Make section an implicit float barrier:
\usepackage[section]{placeins}
% 2. Make subsection an implicit float barrier:
\makeatletter
\AtBeginDocument{%
  \expandafter\renewcommand\expandafter\subsection\expandafter{%
    \expandafter\@fb@secFB\subsection
  }%
}
\makeatother
% 3. Make subsubsection an implicit float barrier:
\makeatletter
\AtBeginDocument{%
  \expandafter\renewcommand\expandafter\subsubsection\expandafter{%
    \expandafter\@fb@secFB\subsubsection
  }%
}
\makeatother
% HEADERS AND FOOTERS
\usepackage{fancyhdr}
\usepackage{lastpage}

\pagestyle{fancy}
\fancyhf{}
\renewcommand{\footrulewidth}{0.4pt}
\fancyfoot[C]{\emph{
    FIFO in Emacs Lisp and Common Lisp -- Gerard Vermeulen
  }
}
\renewcommand{\headrulewidth}{0.4pt}
\fancyhead[L]{\includegraphics[height=1.8cm]{Org-mode-unicorn.png}}
\fancyhead[C]{
  Page: \thepage/\pageref{LastPage} \\
  \text{ } \\
  \text{ } \\
  DRAFT
}
\fancyhead[R]{\includegraphics[height=1.8cm]{Emacs-logo.png}}
#+end_src

#+name: lst:emacs-lisp-setup
#+begin_src emacs-lisp :exports none :results silent :tangle no
(with-eval-after-load 'ox-latex
  (make-variable-buffer-local 'org-export-filter-src-block-functions)
  (add-to-list 'org-export-filter-src-block-functions
               'org-latex-engraved-source-block-filter)

  (when (fboundp 'smart-latex-engrave-org-source-blocks)
    (smart-latex-engrave-org-source-blocks))

  (make-variable-buffer-local 'org-latex-compiler-file-string)
  (setq org-latex-compiler-file-string
        "%% -*- LaTeX -*-\n%% Intended LaTeX compiler: %s\n")
  (make-variable-buffer-local 'org-latex-title-command)
  (setq org-latex-title-command "\\maketitle\\thispagestyle{fancy}")

  (make-variable-buffer-local 'org-latex-toc-command)
  (setq org-latex-toc-command "
\\tableofcontents\\label{toc}
% \\listoffigures
\\listoflistings
% \\listoftables
\\newpage
"))
#+end_src

\clearpage

* Introduction
:PROPERTIES:
:CUSTOM_ID: sec:introduction
:END:

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 form
~(list nil nil)~ instead of the ~queue~ structure.  This attempt is either
impossible or unsuccessful.

* Elisp Regression Testing of "queue.el"
:PROPERTIES:
:CUSTOM_ID: sec:test-queue-el
:END:

The file [[./site-lisp/test-queue.el][test-queue.el]] contains an implementation of Elisp Regression Testing
for ~queue.el~.  Implementing [[./site-lisp/test-queue.el][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 [[./site-lisp/test-queue.el][test-queue.el]] has been tangled from listings
[[lst:test-queue-1]], [[lst:test-queue-2]], and [[lst:test-queue-3]].

#+caption[Elisp Regression Testing queue: 1st part of test-queue.el]:
#+caption: Elisp Regression Testing ~queue~: 1st part of ~test-queue.el~.
#+name: lst:test-queue-1
#+begin_src emacs-lisp -n :tangle test-queue.el
;;; 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)))))))
#+end_src

#+caption[Elisp Regression Testing queue: 2nd part of test-queue.el]:
#+caption: Elisp Regression Testing ~queue~: 2nd part of ~test-queue.el~.
#+name: lst:test-queue-2
#+begin_src emacs-lisp -n :tangle test-queue.el
(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)))))))))
#+end_src

#+caption[Elisp Regression Testing queue: 3rd part of test-queue.el]:
#+caption: Elisp Regression Testing ~queue~: 3rd part of ~test-queue.el~.
#+name: lst:test-queue-3
#+begin_src emacs-lisp -n :tangle test-queue.el
(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
#+end_src


* Translate "queue.el" to "queue.lisp"
:PROPERTIES:
:CUSTOM_ID: sec:queue-el-to-queue-lisp
:header-args:lisp: :tangle queue.lisp
:END:

The [[./queue.lisp][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][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 [[https://lispcookbook.github.io/cl-cookbook/packages.html][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 [[https://courses.cs.northwestern.edu/325/exercises/critic.html][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][queue.lisp]] code is robust:
1. Validate all compiler message by loading [[./queue.lisp][queue.lisp]] as shown in section
   [[#sec:queue-loading-check]]
2. Validate all external symbols of [[./queue.lisp][queue.lisp]] as shown in section
   [[#sec:queue-externals-check]].
3. Write a test suite as client code of [[./queue.lisp][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]].

#+caption[Translate queue.el to Common Lisp: 1st part]:
#+caption: Translate ~queue.el~ to Common Lisp: 1st part.
#+name: lst:1st-part-queue.lisp
#+begin_src lisp -n :eval never
;;; 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)))
#+end_src

#+caption[Translate queue.el to Common Lisp: 2nd part]:
#+caption: Translate ~queue.el~ to Common Lisp: 2nd part.
#+name: lst:2nd-part-queue.lisp
#+begin_src lisp -n :eval never
(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))
#+end_src

#+caption[Translate queue.el to Common Lisp: 3rd part]:
#+caption: Translate ~queue.el~ to Common Lisp: 3rd part.
#+name: lst:3rd-part-queue.lisp
#+begin_src lisp -n :eval never
;;; 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
#+end_src

\clearpage

** Code critiques of "queue.lisp"
:PROPERTIES:
:CUSTOM_ID: sec:queue-code-critiques
:END:

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.

#+caption[1st part of "queue.lisp" code critiques]:
#+caption: 1st part of ~queue.lisp~ code critiques.
#+header: :wrap "src text -n :exports none"
#+name: lst:1st-part-queue-critiques
#+begin_src lisp -n :exports code :package cs325-user :results output :tangle no
(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))))
#+end_src

#+RESULTS: lst:1st-part-queue-critiques
#+begin_src text -n :exports none
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
#+end_src

#+caption[2nd part of "queue.lisp" code critiques]:
#+caption: 2nd part of ~queue.lisp~ code critiques.
#+header: :wrap "src text -n :exports none"
#+name: lst:2nd-part-queue-critiques
#+begin_src lisp -n :exports code :package cs325-user :results output :tangle no
(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)))
#+end_src

#+RESULTS: lst:2nd-part-queue-critiques
#+begin_src text -n :exports none
----------------------------------------------------------------------
----------------------------------------------------------------------
(NTH ...) is expensive. Lists are not arrays.
Hint: use FIRST, REST, and/or a pointer to access elements of a list
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
#+end_src

#+caption[3nd part of "queue.lisp" code critique]:
#+caption: 3nd part of ~queue.lisp~ code critique.
#+header: :wrap "src text -n :exports none"
#+name: lst:3rd-part-queue-critiques
#+begin_src lisp -n :exports code :package cs325-user :results output :tangle no
(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)))
#+end_src

#+RESULTS: lst:3rd-part-queue-critiques
#+begin_src text -n :exports none
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
#+end_src

* Validation of package "queue"
:PROPERTIES:
:CUSTOM_ID: sec:queue-validation
:END:

** Validation of all "queue" package loading loading messages
:PROPERTIES:
:CUSTOM_ID: sec:queue-loading-check
:END:

#+caption[Validate all queue package loading messages]:
#+caption: Validate all ~queue~ package loading messages.
#+header: :wrap "src lisp -n :eval never"
#+begin_src lisp -n :exports both :package cl-user :results output :tangle no
(load "queue.lisp" :verbose t :print t)
#+end_src

#+caption[Validation of all "queue" package loading messages]:
#+caption: Validation of all ~queue~ package loading messages.
#+RESULTS:
#+begin_src lisp -n :eval never
; 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>
#+end_src

\clearpage

** Validation of all external "queue" package symbols
:PROPERTIES:
:CUSTOM_ID: sec:queue-externals-check
:END:

#+caption[Validate all external "queue" package symbols]:
#+caption: Validate all external ~queue~ package symbols.
#+header: :wrap "src lisp -n :eval never"
#+begin_src lisp -n :exports both :package cl-user :results output :tangle no
;; BUG: Remove the first empty line of the output.  This is not easy!
(do-external-symbols (s (find-package :queue))
  (print s))
#+end_src

#+caption[Validation of all external "queue" package symbols]:
#+caption: Validation of all external ~queue~ package symbols.
#+RESULTS:
#+begin_src lisp -n :eval never

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
#+end_src

* Common Lisp "QUEUE" regression testing
:PROPERTIES:
:CUSTOM_ID: sec:queue-client-testing
:header-args:lisp: :tangle test-queue.lisp
:END:

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]].

#+caption[Setup Common Lisp "QUEUE" regression testing]:
#+caption: Setup Common Lisp ~QUEUE~ regression testing.
#+name: lst:5am-test-queue-header
#+begin_src lisp -n :package cl-user :results silent
;;; test-queue.lisp --- 5am regression testing of queue.lisp

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

(5am:def-suite all-queue-tests)
(5am:in-suite all-queue-tests)
#+end_src

#+caption[Define "TEST-QUEUE-CREATE"]:
#+caption: Define ~TEST-QUEUE-CREATE~.
#+name: lst:5am-test-queue-create
#+begin_src lisp -n :package cl-user :results silent
(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))")))
#+end_src

#+caption[Run "TEST-QUEUE-CREATE"]:
#+caption: Run ~TEST-QUEUE-CREATE~.
#+header: :wrap "src text -n
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-create)
#+end_src

#+RESULTS:
#+begin_"src text -n

Running test TEST-QUEUE-CREATE ..
 Did 2 checks.
    Pass: 2 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)
#+end_"src

#+caption[Define "TEST-QUEUE-ENQUEUE"]:
#+caption: Define ~TEST-QUEUE-ENQUEUE~.
#+name: lst:5am-test-queue-enqueue
#+begin_src lisp -n :package cl-user :results silent
(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))))
    (dolist (datum data)
      (let ((queue (queue:create)))
        (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)))")))))
#+end_src

#+caption[Run "TEST-QUEUE-ENQUEUE"]:
#+caption: Run ~TEST-QUEUE-ENQUEUE~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-enqueue)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-PREPEND"]:
#+caption: Define ~TEST-QUEUE-PREPEND~.
#+name: lst:5am-test-queue-prepend
#+begin_src lisp -n :package cl-user :results silent
(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))))
    (dolist (datum data)
      (let ((queue (queue:create)))
        (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))")))))
#+end_src

#+caption[Run "TEST-QUEUE-PREPEND"]:
#+caption: Run ~TEST-QUEUE-PREPEND~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-prepend)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-DEQUEUE"]:
#+caption: Define ~TEST-QUEUE-DEQUEUE~.
#+name: lst:5am-test-queue-dequeue
#+begin_src lisp -n :package cl-user :results silent
(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))))
    (5am:is (not (car (queue:dequeue (queue:create))))
            "Not: (not (car (queue:dequeue (queue:create))))")
    (dolist (datum data)
      (let ((queue (queue:create)))
        (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))"))))))
#+end_src

#+caption[Run "TEST-QUEUE-DEQUEUE"]:
#+caption: Run ~TEST-QUEUE-DEQUEUE~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-dequeue)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-EMPTY"]:
#+caption: Define ~TEST-QUEUE-EMPTY~.
#+name: lst:5am-test-queue-empty
#+begin_src lisp -n :package cl-user :results silent
(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)))
        (dolist (item datum)
          (queue:enqueue queue item))
        (dotimes (count (1- (length datum)))
          (queue:dequeue queue))
        (5am:is (not (queue:empty queue)) "Not: (not (queue:empty queue))")
        (queue:dequeue queue)
        (5am:is (queue:empty queue) "Not: (queue:empty queue)")))))
#+end_src

#+caption[Run "TEST-QUEUE-EMPTY"]:
#+caption: Run ~TEST-QUEUE-EMPTY~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-empty)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-FIRST"]:
#+caption: Define ~TEST-QUEUE-FIRST~.
#+name: lst:5am-test-queue-first
#+begin_src lisp -n :package cl-user :results silent
(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)))
        (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)")))))
#+end_src

#+caption[Run "TEST-QUEUE-FIRST"]:
#+caption: Run ~TEST-QUEUE-FIRST~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-first)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-NTH"]:
#+caption: Define ~TEST-QUEUE-NTH~.
#+name: lst:5am-test-queue-nth
#+begin_src lisp -n :package cl-user :results silent
(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)))
        (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)))"))))))
#+end_src

#+caption[Run "TEST-QUEUE-NTH"]:
#+caption: Run ~TEST-QUEUE-NTH~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-nth)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-LAST"]:
#+caption: Define ~TEST-QUEUE-LAST~.
#+name: lst:5am-test-queue-last
#+begin_src lisp -n :package cl-user :results silent
(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))))
    (5am:is (eq (queue:last (queue:create)) nil)
            "Not: (eq (queue:last (queue:create)) nil)")
    (dolist (datum data)
      (let ((queue (queue:create)))
        (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)))")))))
#+end_src

#+caption[Run "TEST-QUEUE-LAST"]:
#+caption: Run ~TEST-QUEUE-LAST~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-last)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-ALL"]:
#+caption: Define ~TEST-QUEUE-ALL~.
#+name: lst:5am-test-queue-all
#+begin_src lisp -n :package cl-user :results silent
(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))))
    (5am:is (eq (queue:all (queue:create)) nil)
            "Not: (eq (queue:all (queue:create)) nil)")
    (dolist (datum data)
      (let ((queue (queue:create)))
        (dolist (item datum)
          (queue:enqueue queue item))
        (5am:is (equal (queue:all queue) datum)
                "Not: (equal (queue:all queue) datum)")))))
#+end_src

#+caption[Run "TEST-QUEUE-ALL"]:
#+caption: Run ~TEST-QUEUE-ALL~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-all)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-COPY"]:
#+caption: Define ~TEST-QUEUE-COPY~.
#+name: lst:5am-test-queue-copy
#+begin_src lisp -n :package cl-user :results silent
(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)))"))))
#+end_src

#+caption[Run "TEST-QUEUE-COPY"]:
#+caption: Run ~TEST-QUEUE-COPY~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-copy)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-LENGTH"]:
#+caption: Define ~TEST-QUEUE-LENGTH~.
#+name: lst:5am-test-queue-length
#+begin_src lisp -n :package cl-user :results silent
(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))))
    (5am:is (eq (queue:length (queue:create)) (cl:length nil))
            "Not: (eq (queue:length (queue:create)) (cl:length nil))")
    (dolist (datum data)
      (let ((queue (queue:create)))
        (dolist (item datum)
          (queue:enqueue queue item))
        (5am:is (equal (queue:length queue) (cl:length datum))
                "Not: (queue:length queue) (cl:length datum)")))))
#+end_src

#+caption[Run "TEST-QUEUE-LENGTH"]:
#+caption: Run ~TEST-QUEUE-LENGTH~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-length)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-CLEAR"]:
#+caption: Define ~TEST-QUEUE-CLEAR~.
#+name: lst:5am-test-queue-clear
#+begin_src lisp -n :package cl-user :results silent
(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))"))))
#+end_src

#+caption[Run "TEST-QUEUE-CLEAR"]:
#+caption: Run ~TEST-QUEUE-CLEAR~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-clear)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Run "ALL-QUEUE-TESTS" tests]:
#+caption: Run ~ALL-QUEUE-TESTS~ tests.
#+header: :wrap "src text -n"
#+name: lst:5am-test-queue-footer
#+begin_src lisp -n :package cl-user :results output
(5am:run! 'all-queue-tests)

;;; test-queue.lisp ends here
#+end_src

#+caption: Run "ALL-QUEUE-TESTS" result.
#+name: lst:5am-run-all-tests
#+RESULTS: lst:5am-test-queue-footer
#+begin_src text -n

Running test suite ALL-QUEUE-TESTS
 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%)
#+end_src

* Failing list based "QUEUE-LIST" Emacs Lisp implementation

Using ~(list nil nil)~ to keep track of the head and the tail of ~queue~ does
not work because emptying ~queue~ by calling ~(queue-list-dequeue queue)~ breaks
an invariant.  Now, ~queue~ equals the bad ~(list nil)~ instead of the good
~(list nil nil)~ which I cannot fix.

Listing [[lst:queue-list-el]] shows a minimal ~queue-list~ implementation and where
the implementation breaks down in the code of ~queue-list-dequeue~.

Listing [[lst:test-queue-list-el]] shows Emacs Lisp regression tests of the
functions defined in listing [[lst:queue-list-el]] and where in
~queue-list-dequeue-test~ the regression test of ~queue-list-dequeue~ fails.

#+caption[Failing Emacs Lisp "QUEUE-LIST" implentation]:
#+caption: Failing Emacs Lisp ~QUEUE-LIST~ implentation using ~(list nil nil)~.
#+name: lst:queue-list-el
#+begin_src emacs-lisp -n :lexical t :tangle queue-list.el
;;; queue-list.el --- handle queues of items   -*- lexical-binding: t; -*-
;;;
;;; Start from an empty queue equal to (list nil nil)

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

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

(defun queue-list-prepend (queue item)
  "Add ITEM in front of the QUEUE head."
  (if (car queue)
      (push item (car queue))
    (setcar queue (car (setcdr queue (list (list item)))))))

(defun queue-list-dequeue (queue)
  "Remove the first ITEM from QUEUE and return it.
Returns nil if QUEUE is empty."
  (unless (cdr (car queue))
    ;; BUG: but how to obtain (list nil nil)?
    (setf (cdr queue) nil))
  (pop (car queue)))

(provide 'queue-list)
;;; queue-list.el ends here
#+end_src

#+caption[Elisp Regression Testing "QUEUE-LIST"]:
#+caption: Elisp Regression Testing ~QUEUE-LIST~.
#+name: lst:test-queue-list-el
#+begin_src emacs-lisp -n :tangle test-queue-list.el
;;; test-queue-list.el --- ERT for queue-list.el   -*- lexical-binding: t; -*-

(require 'ert)
(require 'queue-list)

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

(ert-deftest queue-list-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-list-create)))
        (dolist (item datum)
          (queue-list-enqueue queue item))
        (should (equal queue (list datum (list (car (reverse datum))))))))))

(ert-deftest queue-list-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-list-create)))
        (dolist (item datum)
          (queue-list-prepend queue item))
        (should (equal queue (list (reverse datum) (list (car datum)))))))))

(ert-deftest queue-list-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-list-create)))
        (dolist (item datum)
          (queue-list-enqueue queue item))
        (let (mutad)
          (dotimes (n (1- (length datum)))
            (push (queue-list-dequeue queue) mutad))
          (should (equal (car (cadr queue)) (car (reverse datum))))
          (push (queue-list-dequeue queue) mutad)
          ;; BUG: queue equals wrong (list nil) instead of good (list nil nil).
          (should (equal datum (reverse mutad)))
          (should (equal (car queue) nil))
          (should (equal queue (list nil))) ;; should fail, but it does not.
          (should (equal (cdr queue) '(nil))) ;; should pass, but it does not.
          )))))

;;; test-queue-list.el ends here
#+end_src

* Failing list based "QUEUE-LIST" Common Lisp implementation
:PROPERTIES:
:CUSTOM_ID: sec:failing-cl-queue-list
:header-args:lisp: :tangle test-queue-list.lisp
:END:

Listing [[lst:queue-list]] is tangled into [[./site-lisp/queue-list.el][queue-list.el]] and listing
[[lst:5am-test-queue-list-header]], [[lst:5am-test-queue-list-create]],
[[lst:5am-test-queue-list-enqueue]], [[lst:5am-test-queue-list-prepend]],
[[lst:5am-test-queue-list-dequeue]], and [[lst:5am-test-queue-list-footer]] are tangled
into [[./site-lisp/test-queue-list.el][test-queue-list.el]]

#+caption[Common Lisp "QUEUE-LIST" implementation]:
#+caption: Common Lisp ~QUEUE-LIST~ implementation.
#+name: lst:queue-list
#+begin_src lisp -n :package cl-user :results silent :tangle queue-list.lisp
;;; queue-list.lisp --- handle queues of items
;;;
;;; Start from an empty queue equal to (list nil nil)

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

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

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

(defun queue-list-dequeue (queue)
  "Remove the first ITEM from QUEUE and return it.
Returns nil if the QUEUE is empty."
  (unless (cdr (car queue))
    ;; BUG: but how to obtain (list nil nil)?
    (setf (cdr queue) nil))
  (pop (car queue)))

;;; queue-list.lisp ends here
#+end_src

#+caption[Setup Common Lisp "QUEUE-LIST" regression testing]:
#+caption: Setup Common Lisp ~QUEUE-LIST~ regression testing.
#+name: lst:5am-test-queue-list-header
#+caption: Common Lisp ~QUEUE-LIST~ testing.
#+header: :wrap "src text -n"
#+begin_src lisp -n :exports code :package cl-user :results output
;;; test-queue-list.lisp --- 5am regression testing of queue-lisp.lisp

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

(5am:def-suite all-queue-list-tests)
(5am:in-suite all-queue-list-tests)
#+end_src

#+name: lst:5am-test-queue-list-header-result
#+RESULTS: lst:5am-test-queue-list-header
#+begin_src text -n
To load "fiveam":
  Load 1 ASDF system:
    fiveam
; Loading "fiveam"

; loading #P"/Users/vermeulen/.emacs.d/queue-list.lisp"
; QUEUE-LIST-CREATE
; QUEUE-LIST-ENQUEUE
; QUEUE-LIST-PREPEND
; QUEUE-LIST-DEQUEUE
#+end_src

#+caption[Define "TEST-QUEUE-LIST-CREATE"]:
#+caption: Define ~TEST-QUEUE-LIST-CREATE~.
#+name: lst:5am-test-queue-list-create
#+begin_src lisp -n :package cl-user :results silent
(5am:test test-queue-list-create
  "Test queue-list-create."
  (let ((queue (queue-list-create)))
    (5am:is (eq nil (car queue))
            "Not: (eq nil (car queue))")
    (5am:is (eq nil (cadr queue))
            "Not: (eq nil (cadr queue))")))
#+end_src

#+caption[Run "TEST-QUEUE-LISP-CREATE"]:
#+caption: Run ~TEST-QUEUE-LISP-CREATE~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :exports code :package cl-user :results output :tangle no
(5am:run! 'test-queue-list-create)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-LIST-ENQUEUE"]:
#+caption: Define ~TEST-QUEUE-LIST-ENQUEUE~.
#+name: lst:5am-test-queue-list-enqueue
#+begin_src lisp -n :package cl-user :results silent
(5am:test test-queue-list-enqueue
  "Test queue-list-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))))
    (dolist (datum data)
      (let ((queue (queue-list-create)))
        (dolist (item datum)
          (queue-list-enqueue queue item))
        (5am:is (equal (car queue) datum)
                "Not: (equal (car queue) datum)")
        (5am:is (eq (caadr queue) (car (reverse datum)))
                "Not: (eq (car (cdr queue)) (car (reverse datum)))")))))
#+end_src

#+caption[Run "TEST-QUEUE-LIST-ENQUEUE"]:
#+caption: Run ~TEST-QUEUE-LIST-ENQUEUE~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :exports code :package cl-user :results output :tangle no
(5am:run! 'test-queue-list-enqueue)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-LIST-PREPEND"]:
#+caption: Define ~TEST-QUEUE-LIST-PREPEND~.
#+name: lst:5am-test-queue-list-prepend
#+begin_src lisp -n :package cl-user :results silent :tangle test-queue-list.lisp
(5am:test test-queue-list-prepend
  "Test queue-list-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))))
    (dolist (datum data)
      (let ((queue (queue-list-create)))
        (dolist (item datum)
          (queue-list-prepend queue item))
        (5am:is (equal (car queue) (reverse datum))
                "Not: (equal (car queue) (reverse datum))")
        (5am:is (eq (caadr queue) (car datum))
                "Not: (eq (caadr queue) (car datum))")))))
#+end_src

#+caption[Run "TEST-QUEUE-LIST-PREPEND"]:
#+caption: Run ~TEST-QUEUE-LIST-PREPEND~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-list-prepend)
#+end_src

#+RESULTS:
#+begin_src text -n

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

#+caption[Define "TEST-QUEUE-LIST-DEQUEUE"]:
#+caption: Define ~TEST-QUEUE-LIST-DEQUEUE~.
#+name: lst:5am-test-queue-list-dequeue
#+begin_src lisp -n :package cl-user :results silent :tangle test-queue-list.lisp
(5am:test test-queue-list-dequeue
  "Test queue-list-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-list-create)))
    (5am:is (eq nil (queue-list-dequeue queue))
            "Not: (eq nil (queue-list-dequeue queue))")
    (5am:is (not (equal queue '(nil)))
            "Not: (equal queue '(nil))") ;; should fail, but it does not.
    (5am:is (not (equal queue '(nil nil))) ;; should pass, but it does not
            "Not: (equal queue '(nil nil))")
    (dolist (datum data)
      (let ((queue (queue-list-create)))
        (dolist (item datum)
          (queue-list-enqueue queue item))
        (dotimes (n (length datum))
          (5am:is (equal (queue-list-dequeue queue) (cl:nth n datum))
                  "Not: (equal (queue-list-dequeue queue) (cl:nth n datum))"))
        (5am:is (equal queue '(nil))) ;; should fail, but it does not.
        (5am:is (equal queue '(nil nil))) ;; should pass, but it does not
        ))))
#+end_src

#+caption[Run "TEST-QUEUE-LIST-DEQUEUE"]:
#+caption: Run ~TEST-QUEUE-LIST-DEQUEUE~.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-list-dequeue)
#+end_src

#+RESULTS:
#+begin_src text -n

Running test TEST-QUEUE-LIST-DEQUEUE .f...f...f....f.....f......f..f...f....f.....f......f
 Did 53 checks.
    Pass: 42 (79%)
    Skip: 0 ( 0%)
    Fail: 11 (20%)
 Failure Details:
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
      Not: (equal queue '(nil))
 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
#+end_src


#+caption[Run "ALL-QUEUE-LIST-TESTS" tests]:
#+caption: Run ~ALL-QUEUE-LIST-TESTS~ tests.
#+header: :wrap "src text -n"
#+name: lst:5am-test-queue-list-footer
#+begin_src lisp -n :package cl-user :results output
(5am:run! 'all-queue-list-tests)

;;; test-queue-list.lisp ends here
#+end_src

#+name: lst:5am-test-queue-list-footer-result
#+RESULTS: lst:5am-test-queue-list-footer
#+begin_src text -n

Running test suite ALL-QUEUE-LIST-TESTS
 Running test TEST-QUEUE-LIST-CREATE ..
 Running test TEST-QUEUE-LIST-ENQUEUE ....................
 Running test TEST-QUEUE-LIST-PREPEND ....................
 Running test TEST-QUEUE-LIST-DEQUEUE .f...f...f....f.....f......f..f...f....f.....f......f
 Did 95 checks.
    Pass: 84 (88%)
    Skip: 0 ( 0%)
    Fail: 11 (11%)
 Failure Details:
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
      Not: (equal queue '(nil))
 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
 --------------------------------
 TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:

'(NIL NIL)

 evaluated to

(NIL NIL)

 which is not

EQUAL

 to

(NIL)


 --------------------------------
#+end_src

\appendix

* Common Lisp Code Critique
:PROPERTIES:
:CUSTOM_ID: sec:code-critique
:END:

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 [[https://courses.cs.northwestern.edu/325/admin/lisp-setup.html][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]].

#+caption[Load the "CS325-USER" package]:
#+caption: Load the ~CS325-USER~ package.
#+name: lst:load-cs325
#+header: :wrap "src text -n"
#+begin_src lisp -n :exports both :results output :package cl-user :tangle no
;; The call (ql:quickload :cs325) is equivalent.
(ql:quickload "cs325")
#+end_src

#+caption[Result of loading the "CS325-USER" package]:
#+caption: Result of loading the ~CS325-USER~ package.
#+name: lst:load-cs325-result
#+RESULTS: lst:load-cs325
#+begin_src text -n
To load "cs325":
  Load 1 ASDF system:
    cs325
; Loading "cs325"

#+end_src

#+caption[Code critique setup test example]:
#+caption: Code critique setup test example.
#+header: :wrap "src text -n"
#+name: lst:critique-test-example
#+begin_src lisp -n :exports both :package cs325-user :results output
(critique
 (defun foo (x)
   (setq x (+ x 1))))
#+end_src

#+caption: Code critique setup test example result.
#+name: lst:critique-test-example-result
#+RESULTS: lst:critique-test-example
#+begin_src text -n
----------------------------------------------------------------------
INCF would be simpler to add 1 to X than SETQ
----------------------------------------------------------------------
It's bad style to reassign input parameters like X -- and often
useless.
----------------------------------------------------------------------
Don't use (+ X 1), use (1+ X) for its value or (INCF X) to change X,
whichever is appropriate here.
----------------------------------------------------------------------
#+end_src

* [[https://common-lisp-libraries.readthedocs.io/fiveam/][Fiveam Common Lisp Regression Testing Framework]]

After executing listing [[lst:load-fiveam]] to ~ql:quickload~ [[https://common-lisp-libraries.readthedocs.io/fiveam/][fiveam]], one can
explore this package:
1. from within the ~:fiveam~ package in listing [[lst:define-5am-test-demo]] and
   [[lst:run-5am-test-demo]].
2. from within the ~:cl-user~ package in listing [[lst:define-cl-test-demo]] and
   [[lst:run-cl-test-demo]].  This point indicates how to use [[https://common-lisp-libraries.readthedocs.io/fiveam/][fiveam]] to test other
   packages.

#+caption[Load the "FIVEAM" package]:
#+caption: Load the ~FIVEAM~ package.
#+name: lst:load-fiveam
#+header: :wrap "src text -n"
#+begin_src lisp -n :exports both :results output
(ql:quickload :fiveam)
#+end_src

# caption[Result of loading the "FIVEAM" package]:
#+caption: Result of loading the "FIVEAM" package.
#+name: lst:load-fiveam-result
#+RESULTS: lst:load-fiveam
#+begin_src text -n
To load "fiveam":
  Load 1 ASDF system:
    fiveam
; Loading "fiveam"

#+end_src

#+caption[Define a test from within in the "FIVEAM" package]:
#+caption: Define a test from within in the ~FIVEAM~ package.
#+name: lst:define-5am-test-demo
#+begin_src lisp -n :package fiveam :results silent
(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))
#+end_src

#+caption[Run the "5AM-TEST-DEMO" test from within the "FIVEAM" package]:
#+caption: Run the ~5AM-TEST-DEMO~ test from within the ~FIVEAM~ package.
#+header: :wrap "src text -n"
#+name: lst:run-5am-test-demo
#+begin_src lisp -n :exports both :package fiveam :results output
(format t "~&In package ~A:" (package-name *package*))
(run! '5am-test-demo)
#+end_src

#+caption: "5AM-TEST-DEMO" test result.
#+name: lst:run-5am-test-demo-result
#+RESULTS: lst:run-5am-test-demo
#+begin_src text -n
In package IT.BESE.FIVEAM:
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.
 --------------------------------
#+end_src

#+caption[Define a test from within the "CL-USER" package]:
#+caption: Define a test from within the ~CL-USER~ package.
#+name: lst:define-cl-test-demo
#+begin_src lisp -n :package cl-user :results silent
(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))
#+end_src

#+caption[Run the "CL-TEST-DEMO" test from within the "CL-USER" package]:
#+caption: Run the ~CL-TEST-DEMO~ test from within the ~CL-USER~ package.
#+name: lst:run-cl-test-demo
#+header: :wrap "src text -n"
#+begin_src lisp -n :exports both :package cl-user :results output
(format t "~&In package ~A:" (package-name *package*))
(5am:run! 'cl-test-demo)
#+end_src

#+caption: "5AM-TEST-DEMO" test result.
#+name: lst:run-cl-test-demo-result
#+RESULTS: lst:run-cl-test-demo
#+begin_src text -n
In package COMMON-LISP-USER:
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.
 --------------------------------
#+end_src

* Common Lisp "How do you DO?" do-loop example
:PROPERTIES:
:CUSTOM_ID: sec:how-do-you-do
:END:

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:
- [[https://courses.cs.northwestern.edu/325/readings/do.html][How do you DO?]] by Chris Riesbeck.
- [[https://ebixio.com/online_docs/SuccessfulLisp.pdf][Successful Lisp: How to understand and use Common Lisp]] by David B. Lamkins.

#+caption["How do you DO?" do-loop example code]:
#+caption: "How do you DO?" ~do~-loop example code
#+caption: with variable clauses, exit clauses, and a body.
#+header: :wrap "src text -n"
#+name: lst:how-do-you-do
#+begin_src lisp -n :exports both :results output :package cl-user :tangle no
(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))
#+end_src

#+caption["How do you DO?" do-loop example result]:
#+caption: "How do you DO?" ~do~-loop example result.
#+name: lst:how-do-you-do-result
#+RESULTS: lst:how-do-you-do
#+begin_src text -n
Item 1 is HOW
Item 2 is DO
Item 3 is YOU
Item 4 is DO
Item 5 is ?
(HOW DO YOU DO ?)
#+end_src

* [[http://random-state.net/log/3390120648.html][Why I like CALL-WITH-* style in macros]]
:PROPERTIES:
:CUSTOM_ID: sec:call-with-macros
:END:

Listing [[lst]] The post [[https://lists.gnu.org/archive/html/emacs-devel/2023-12/msg00683.html][João Távora: permanently fix org breakage during builds]]
links to the origin of the code in listing [[lst:call-with-macros]].

BUG: make a concrete ~CALL-WITH-*~ macro example.

#+caption[Abstract "CALL-WITH-*" macro example]:
#+caption: Abstract ~CALL-WITH-*~ macro example.
#+caption: with variable clauses, exit clauses, and a body.
#+name: lst:call-with-macros
#+begin_src emacs-lisp -n :eval never
(defmacro with-foo ((foo) &body body)
  `(call-with-foo (lambda (,foo) ,@body)))

(defun call-with-foo (function)
  (let (foo)
    (unwind-protect
        (funcall function (setf foo (get-foo)))
      (when foo (release-foo foo)))))
#+end_src

* Local variables                                                  :noexport:

# Emacs looks for "Local variables:" after the last "newline-formfeed".

# Local Variables:
# compile-command: "latexmk -interaction=nonstopmode -lualatex -pvc elisp-to-cl-lesson.tex"
# eval: (org-eval-emacs-lisp-setup-blocks)
# fill-column: 80
# End: