gav451/emacs.d
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
emacs.d/elisp-to-cl-lesson.org

2049 lines
73 KiB
Org Mode
Raw Normal View History

Add elisp-to-cl-lesson.org
2023-12-19 18:41:17 +01:00
#+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 :tangle keu.el
#+property: header-args:lisp :eval never-export :tangle keu.lisp
#+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 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"
:PROPERTIES:
:CUSTOM_ID: sec:test-queue-el
:END:
The file [[./test-queue.el][test-queue.el]] contains an implementation of Elisp Regression Testing
for ~queue.el~. Implementing [[./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 [[./test-queue.el][test-queue.el]] has been tangled from listings
[[lst:1st-part-test-queue]], [[lst:2nd-part-test-queue]], and [[lst:3rd-part-test-queue]].
#+caption[Elisp Regression Testing queue: 1st part of test-queue.el]:
#+caption: Elisp Regression Testing ~queue~: 1st part of ~test-queue.el~.
#+name: lst:1st-part-test-queue
#+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:2nd-part-test-queue
#+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:3rd-part-test-queue
#+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
* 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
* Translate "queue.el" to "queue.lisp"
:PROPERTIES:
:CUSTOM_ID: sec:queue-el-to-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 :tangle 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)))
#+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 :tangle queue.lisp
(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 :tangle queue.lisp
;;; 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
* Common Lisp "CS325-USER" package setup to critique code
:PROPERTIES:
:CUSTOM_ID: sec:load-cs325
: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
\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:
# FIXME: test-queue-dequeue
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)
#+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 :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-create)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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)))"))))
#+end_src
#+caption[Run "TEST-QUEUE-ENQUEUE"]:
#+caption: Run ~TEST-QUEUE-ENQUEUE~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-enqueue)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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))"))))
#+end_src
#+caption[Run "TEST-QUEUE-PREPEND"]:
#+caption: Run ~TEST-QUEUE-PREPEND~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-prepend)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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))")))))
#+end_src
#+caption[Run "TEST-QUEUE-DEQUEUE"]:
#+caption: Run ~TEST-QUEUE-DEQUEUE~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-dequeue)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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))")))))
#+end_src
#+caption[Run "TEST-QUEUE-EMPTY"]:
#+caption: Run ~TEST-QUEUE-EMPTY~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-empty)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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)")))))
#+end_src
#+caption[Run "TEST-QUEUE-FIRST"]:
#+caption: Run ~TEST-QUEUE-FIRST~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-first)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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)))"))))))
#+end_src
#+caption[Run "TEST-QUEUE-NTH"]:
#+caption: Run ~TEST-QUEUE-NTH~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-nth)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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)))"))))
#+end_src
#+caption[Run "TEST-QUEUE-LAST"]:
#+caption: Run ~TEST-QUEUE-LAST~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-last)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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)"))))
#+end_src
#+caption[Run "TEST-QUEUE-ALL"]:
#+caption: Run ~TEST-QUEUE-ALL~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-all)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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 :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-copy)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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)))
(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)"))))
#+end_src
#+caption[Run "TEST-QUEUE-LENGTH"]:
#+caption: Run ~TEST-QUEUE-LENGTH~.
#+header: :wrap "src text -n :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-length)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
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 :exports never"
#+begin_src lisp -n :package cl-user :results output :tangle no
(5am:run! 'test-queue-clear)
#+end_src
#+RESULTS:
#+begin_src text -n :exports never
Running test TEST-QUEUE-CLEAR .....................
Did 21 checks.
Pass: 21 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)
#+end_src
#+caption[Run all tests]:
#+caption: Run all tests.
#+header: :wrap "src text -n :exports never"
#+name: lst:5am-test-queue-footer
#+begin_src lisp -n :package cl-user :results output
(5am:run-all-tests)
;;; test-queue.lisp ends here
#+end_src
#+caption: Run all tests result.
#+name: lst:5am-run-all-tests
#+RESULTS: lst:5am-test-queue-footer
#+begin_src text -n :exports never
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%)
#+end_src
* Emacs Lisp
#+caption: Emacs Lisp ~KEU~ implentation: 1st part of ~keu.el~.
#+begin_src emacs-lisp -n :lexical t
;;; 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))
#+end_src
#+caption: Emacs Lisp ~KEU~ implentation: 2nd part of ~key.el~.
#+begin_src emacs-lisp -n :lexical t
(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)))
#+end_src
#+caption: Emacs Lisp ~KEU~ implentation: 3rd part of ~key.el~.
#+begin_src emacs-lisp -n :eval never :lexical t
(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
#+end_src
** ~KEU~ Elisp Regression Testing
#+caption: Elisp Regression Testing ~KEU~: 1st part of ~test-keu.el~.
#+begin_src emacs-lisp -n :tangle test-keu.el
;;; 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))))))
#+end_src
#+caption: Elisp Regression Testing ~KEU~: 2nd part of ~test-keu.el~.
#+begin_src emacs-lisp -n :tangle 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
#+end_src
* [[https://common-lisp-libraries.readthedocs.io/fiveam/][Fiveam Common Lisp Regression Testing Framework]]
Here, I explore how to use [[https://common-lisp-libraries.readthedocs.io/fiveam/][fiveam]].
#+caption[Load the "FIVEAM" package]:
#+caption: Load the ~FIVEAM~ package.
#+header: :wrap "src text -n"
#+begin_src lisp -n :results output
(ql:quickload :fiveam)
#+end_src
#+caption[Result of loading the "FIVEAM" package]:
#+caption: Result of loading the ~FIVEAM~ package.
#+RESULTS:
#+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.
#+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 with the "FIVEAM" package]:
#+caption: Run the ~5AM-TEST-DEMO~ test from with the ~FIVEAM~ package.
#+header: :wrap "src text -n"
#+begin_src lisp -n :package fiveam :results output
(run! '5am-test-demo)
#+end_src
#+RESULTS:
#+begin_src text -n
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.
#+begin_src lisp -n :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.
#+header: :wrap "src text -n"
#+begin_src lisp -n :results output
(5am:run! 'cl-test-demo)
#+end_src
#+RESULTS:
#+begin_src text -n
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
#+caption: Common Lisp ~KEU~ implementation.
#+begin_src lisp -n :package cl-user :results silent
;;; 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)))
#+end_src
#+caption: Common Lisp KEU scaffolding.
#+begin_src lisp -n :package cl-user :results silent
(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))
#+end_src
#+caption: Common Lisp ~QUEUE~ testing.
#+begin_src lisp -n :package cl-user :results silent
;; 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))
#+end_src
** ~queue-lisp~ code critique
#+caption[Common Lisp code critique]:
#+caption: Common Lisp code critique.
#+header: :wrap "src text -n :exports none"
#+begin_src lisp -n :exports code :package cs325-user :results output :tangle no
(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))))
#+end_src
#+RESULTS:
#+begin_src text -n :exports none
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------
#+end_src
** Common Lisp Code disassembly :noexport:
*** ~Cl keu-create~ disassembly
#+caption: Common Lisp ~keu-create~ disassembly.
#+header: :wrap "src lisp -n :eval never :tangle no"
#+begin_src lisp -n :exports both :package cl-user :results output :tangle no
(disassemble 'keu-create)
#+end_src
#+RESULTS:
#+begin_src lisp -n :eval never :tangle no
; disassembly for KEU-CREATE
; Size: 215 bytes. Origin: #x5365698F ; KEU-CREATE
; 98F: 498B4510 MOV RAX, [R13+16] ; thread.binding-stack-pointer
; 993: 488945C0 MOV [RBP-64], RAX
; 997: 4D896D28 MOV [R13+40], R13 ; thread.pseudo-atomic-bits
; 99B: 498B5558 MOV RDX, [R13+88] ; thread.cons-tlab
; 99F: 488D4220 LEA RAX, [RDX+32]
; 9A3: 493B4560 CMP RAX, [R13+96]
; 9A7: 0F87AA000000 JA L2
; 9AD: 49894558 MOV [R13+88], RAX ; thread.cons-tlab
; 9B1: L0: 48C70217010050 MOV QWORD PTR [RDX], #x50000117 ; NIL
; 9B8: 48C7421017010050 MOV QWORD PTR [RDX+16], #x50000117 ; NIL
; 9C0: 48C7421817010050 MOV QWORD PTR [RDX+24], #x50000117 ; NIL
; 9C8: 488D4217 LEA RAX, [RDX+23]
; 9CC: 48894208 MOV [RDX+8], RAX
; 9D0: 80CA07 OR DL, 7
; 9D3: 4D316D28 XOR [R13+40], R13 ; thread.pseudo-atomic-bits
; 9D7: 7402 JEQ L1
; 9D9: CC09 INT3 9 ; pending interrupt trap
; 9DB: L1: C9 LEAVE
; 9DC: F8 CLC
; 9DD: C3 RET
; 9DE: CC10 INT3 16 ; Invalid argument count trap
; 9E0: CC10 INT3 16 ; Invalid argument count trap
; 9E2: 6A10 PUSH 16
; 9E4: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; 9EB: 58 POP RAX
; 9EC: E933FAFFFF JMP #x53656424 ; #<FUNCTION ITEMS-DEQUEUE {5365639B}>
; 9F1: CC10 INT3 16 ; Invalid argument count trap
; 9F3: CC10 INT3 16 ; Invalid argument count trap
; 9F5: CC10 INT3 16 ; Invalid argument count trap
; 9F7: CC10 INT3 16 ; Invalid argument count trap
; 9F9: 6A10 PUSH 16
; 9FB: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; A02: 58 POP RAX
; A03: E9BAFCFFFF JMP #x536566C2 ; #<FUNCTION KEU-PREPEND {5365666B}>
; A08: 6A10 PUSH 16
; A0A: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; A11: 58 POP RAX
; A12: E904FDFFFF JMP #x5365671B ; #<FUNCTION KEU-PREPEND {5365666B}>
; A17: 6A10 PUSH 16
; A19: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; A20: 58 POP RAX
; A21: E926FDFFFF JMP #x5365674C ; #<FUNCTION KEU-PREPEND {5365666B}>
; A26: CC10 INT3 16 ; Invalid argument count trap
; A28: 6A10 PUSH 16
; A2A: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; A31: 58 POP RAX
; A32: E903FEFFFF JMP #x5365683A ; #<FUNCTION KEU-ENQUEUE {536567CB}>
; A37: 6A10 PUSH 16
; A39: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; A40: 58 POP RAX
; A41: E980FEFFFF JMP #x536568C6 ; #<FUNCTION KEU-ENQUEUE {536567CB}>
; A46: 6A10 PUSH 16
; A48: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; A4F: 58 POP RAX
; A50: E9A2FEFFFF JMP #x536568F7 ; #<FUNCTION KEU-ENQUEUE {536567CB}>
; A55: CC10 INT3 16 ; Invalid argument count trap
; A57: L2: 6A20 PUSH 32
; A59: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; A60: 5A POP RDX
; A61: E94BFFFFFF JMP L0
#+end_src
*** ~CL keu-enqueue~ disassembly
#+caption: Common Lisp ~keu-enqueue~ disassembly.
#+header: :wrap "src lisp -n :eval never :tangle no"
#+begin_src lisp -n :exports both :package cl-user :results output :tangle no
(disassemble 'keu-enqueue)
#+end_src
#+RESULTS:
#+begin_src lisp -n :eval never :tangle no
; disassembly for KEU-ENQUEUE
; Size: 435 bytes. Origin: #x53653073 (segment 1 of 2) ; KEU-ENQUEUE
; 073: 498B4510 MOV RAX, [R13+16] ; thread.binding-stack-pointer
; 077: 488945D8 MOV [RBP-40], RAX
; 07B: 418D41F9 LEA EAX, [R9-7]
; 07F: A80F TEST AL, 15
; 081: 0F856F010000 JNE L13
; 087: 4D8B41F9 MOV R8, [R9-7]
; 08B: 4981F817010050 CMP R8, #x50000117 ; NIL
; 092: 0F84A4000000 JEQ L6
; 098: 4D8B4101 MOV R8, [R9+1]
; 09C: 418D40F9 LEA EAX, [R8-7]
; 0A0: A80F TEST AL, 15
; 0A2: 0F8591000000 JNE L5
; 0A8: 4D8B50F9 MOV R10, [R8-7]
; 0AC: 4D8B5901 MOV R11, [R9+1]
; 0B0: 4D896D28 MOV [R13+40], R13 ; thread.pseudo-atomic-bits
; 0B4: 498B4558 MOV RAX, [R13+88] ; thread.cons-tlab
; 0B8: 4C8D4010 LEA R8, [RAX+16]
; 0BC: 4D3B4560 CMP R8, [R13+96]
; 0C0: 0F87DF010000 JA L14
; 0C6: 4D894558 MOV [R13+88], R8 ; thread.cons-tlab
; 0CA: L0: 488938 MOV [RAX], RDI
; 0CD: 48C7400817010050 MOV QWORD PTR [RAX+8], #x50000117 ; NIL
; 0D5: 4C8D4007 LEA R8, [RAX+7]
; 0D9: 4D316D28 XOR [R13+40], R13 ; thread.pseudo-atomic-bits
; 0DD: 7402 JEQ L1
; 0DF: CC09 INT3 9 ; pending interrupt trap
; 0E1: L1: 4981FB17010050 CMP R11, #x50000117 ; NIL
; 0E8: 744C JEQ L4
; 0EA: 418D43F9 LEA EAX, [R11-7]
; 0EE: A80F TEST AL, 15
; 0F0: 7544 JNE L4
; 0F2: 498BC3 MOV RAX, R11
; 0F5: 48C1E80A SHR RAX, 10
; 0F9: 25FFFF0F00 AND EAX, 1048575
; 0FE: 41C6040400 MOV BYTE PTR [R12+RAX], 0
; 103: 4D8943F9 MOV [R11-7], R8
; 107: 4981FA17010050 CMP R10, #x50000117 ; NIL
; 10E: 7423 JEQ L3
; 110: 418D42F9 LEA EAX, [R10-7]
; 114: A80F TEST AL, 15
; 116: 751B JNE L3
; 118: 498BC2 MOV RAX, R10
; 11B: 48C1E80A SHR RAX, 10
; 11F: 25FFFF0F00 AND EAX, 1048575
; 124: 41C6040400 MOV BYTE PTR [R12+RAX], 0
; 129: 4D894201 MOV [R10+1], R8
; 12D: 498BD0 MOV RDX, R8
; 130: L2: C9 LEAVE
; 131: F8 CLC
; 132: C3 RET
; 133: L3: CC65 INT3 101 ; OBJECT-NOT-CONS-ERROR
; 135: 28 BYTE #X28 ; R10(d)
; 136: L4: CC65 INT3 101 ; OBJECT-NOT-CONS-ERROR
; 138: 2C BYTE #X2C ; R11(d)
; 139: L5: CC52 INT3 82 ; OBJECT-NOT-LIST-ERROR
; 13B: 20 BYTE #X20 ; R8(d)
; 13C: L6: 4D896D28 MOV [R13+40], R13 ; thread.pseudo-atomic-bits
; 140: 498B4558 MOV RAX, [R13+88] ; thread.cons-tlab
; 144: 4C8D4010 LEA R8, [RAX+16]
; 148: 4D3B4560 CMP R8, [R13+96]
; 14C: 0F8762010000 JA L15
; 152: 4D894558 MOV [R13+88], R8 ; thread.cons-tlab
; 156: L7: 488938 MOV [RAX], RDI
; 159: 48C7400817010050 MOV QWORD PTR [RAX+8], #x50000117 ; NIL
; 161: 4C8D5007 LEA R10, [RAX+7]
; 165: 4D316D28 XOR [R13+40], R13 ; thread.pseudo-atomic-bits
; 169: 7402 JEQ L8
; 16B: CC09 INT3 9 ; pending interrupt trap
; 16D: L8: 4D896D28 MOV [R13+40], R13 ; thread.pseudo-atomic-bits
; 171: 498B4558 MOV RAX, [R13+88] ; thread.cons-tlab
; 175: 4C8D4010 LEA R8, [RAX+16]
; 179: 4D3B4560 CMP R8, [R13+96]
; 17D: 0F8740010000 JA L16
; 183: 4D894558 MOV [R13+88], R8 ; thread.cons-tlab
; 187: L9: 4C8910 MOV [RAX], R10
; 18A: 48C7400817010050 MOV QWORD PTR [RAX+8], #x50000117 ; NIL
; 192: 4C8D4007 LEA R8, [RAX+7]
; 196: 4D316D28 XOR [R13+40], R13 ; thread.pseudo-atomic-bits
; 19A: 7402 JEQ L10
; 19C: CC09 INT3 9 ; pending interrupt trap
; 19E: L10: 4981F917010050 CMP R9, #x50000117 ; NIL
; 1A5: 7447 JEQ L12
; 1A7: 498BC1 MOV RAX, R9
; 1AA: 48C1E80A SHR RAX, 10
; 1AE: 25FFFF0F00 AND EAX, 1048575
; 1B3: 41C6040400 MOV BYTE PTR [R12+RAX], 0
; 1B8: 4D894101 MOV [R9+1], R8
; 1BC: 4D8B40F9 MOV R8, [R8-7]
; 1C0: 4981F917010050 CMP R9, #x50000117 ; NIL
; 1C7: 741D JEQ L11
; 1C9: 498BC1 MOV RAX, R9
; 1CC: 48C1E80A SHR RAX, 10
; 1D0: 25FFFF0F00 AND EAX, 1048575
; 1D5: 41C6040400 MOV BYTE PTR [R12+RAX], 0
; 1DA: 4D8941F9 MOV [R9-7], R8
; 1DE: 498BD0 MOV RDX, R8
; 1E1: E94AFFFFFF JMP L2
; 1E6: L11: B817010050 MOV EAX, #x50000117 ; NIL
; 1EB: CC65 INT3 101 ; OBJECT-NOT-CONS-ERROR
; 1ED: 00 BYTE #X00 ; RAX(d)
; 1EE: L12: B817010050 MOV EAX, #x50000117 ; NIL
; 1F3: CC65 INT3 101 ; OBJECT-NOT-CONS-ERROR
; 1F5: 00 BYTE #X00 ; RAX(d)
; 1F6: L13: CC52 INT3 82 ; OBJECT-NOT-LIST-ERROR
; 1F8: 24 BYTE #X24 ; R9(d)
; Origin #x536532A5 (segment 2 of 2) ; KEU-ENQUEUE
; 2A5: L14: 6A10 PUSH 16
; 2A7: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; 2AE: 58 POP RAX
; 2AF: E916FEFFFF JMP L0
; 2B4: L15: 6A10 PUSH 16
; 2B6: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; 2BD: 58 POP RAX
; 2BE: E993FEFFFF JMP L7
; 2C3: L16: 6A10 PUSH 16
; 2C5: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP
; 2CC: 58 POP RAX
; 2CD: E9B5FEFFFF JMP L9
#+end_src
*** ~CL keu-dequeue~ disassembly
#+caption: Common Lisp ~fifo-dequeue~ disassembly.
#+header: :wrap "src lisp -n :eval never :tangle no"
#+begin_src lisp -n :exports both :package cl-user :results output :tangle no
(disassemble 'keu-dequeue)
#+end_src
#+RESULTS:
#+begin_src lisp -n :eval never :tangle no
; disassembly for KEU-DEQUEUE
; Size: 160 bytes. Origin: #x53652E43 ; KEU-DEQUEUE
; 43: 498B4510 MOV RAX, [R13+16] ; thread.binding-stack-pointer
; 47: 488945E8 MOV [RBP-24], RAX
; 4B: 418D40F9 LEA EAX, [R8-7]
; 4F: A80F TEST AL, 15
; 51: 0F8589000000 JNE L5
; 57: 4D8B48F9 MOV R9, [R8-7]
; 5B: 4981F917010050 CMP R9, #x50000117 ; NIL
; 62: 7525 JNE L0
; 64: 4981F817010050 CMP R8, #x50000117 ; NIL
; 6B: 746B JEQ L4
; 6D: 488B0D8CFDFFFF MOV RCX, [RIP-628] ; '(NIL)
; 74: 498BC0 MOV RAX, R8
; 77: 48C1E80A SHR RAX, 10
; 7B: 25FFFF0F00 AND EAX, 1048575
; 80: 41C6040400 MOV BYTE PTR [R12+RAX], 0
; 85: 49894801 MOV [R8+1], RCX
; 89: L0: 4D8B48F9 MOV R9, [R8-7]
; 8D: 418D41F9 LEA EAX, [R9-7]
; 91: A80F TEST AL, 15
; 93: 7540 JNE L3
; 95: 498B51F9 MOV RDX, [R9-7]
; 99: 4D8B48F9 MOV R9, [R8-7]
; 9D: 418D41F9 LEA EAX, [R9-7]
; A1: A80F TEST AL, 15
; A3: 752D JNE L2
; A5: 4D8B4901 MOV R9, [R9+1]
; A9: 4981F817010050 CMP R8, #x50000117 ; NIL
; B0: 7418 JEQ L1
; B2: 498BC0 MOV RAX, R8
; B5: 48C1E80A SHR RAX, 10
; B9: 25FFFF0F00 AND EAX, 1048575
; BE: 41C6040400 MOV BYTE PTR [R12+RAX], 0
; C3: 4D8948F9 MOV [R8-7], R9
; C7: C9 LEAVE
; C8: F8 CLC
; C9: C3 RET
; CA: L1: B817010050 MOV EAX, #x50000117 ; NIL
; CF: CC65 INT3 101 ; OBJECT-NOT-CONS-ERROR
; D1: 00 BYTE #X00 ; RAX(d)
; D2: L2: CC52 INT3 82 ; OBJECT-NOT-LIST-ERROR
; D4: 24 BYTE #X24 ; R9(d)
; D5: L3: CC52 INT3 82 ; OBJECT-NOT-LIST-ERROR
; D7: 24 BYTE #X24 ; R9(d)
; D8: L4: B817010050 MOV EAX, #x50000117 ; NIL
; DD: CC65 INT3 101 ; OBJECT-NOT-CONS-ERROR
; DF: 00 BYTE #X00 ; RAX(d)
; E0: L5: CC52 INT3 82 ; OBJECT-NOT-LIST-ERROR
; E2: 20 BYTE #X20 ; R8(d)
#+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:
Reference in New Issue Copy Permalink