From 92999318bf600b354606207ced134d89aaa9802a Mon Sep 17 00:00:00 2001 From: Gerard Vermeulen Date: Fri, 22 Dec 2023 11:54:51 +0100 Subject: [PATCH] Focus on Emacs Lisp and Common Lisp programming; add appendices --- elisp-to-cl-lesson.org | 1754 ++++++++++++++++++++++------------------ 1 file changed, 946 insertions(+), 808 deletions(-) diff --git a/elisp-to-cl-lesson.org b/elisp-to-cl-lesson.org index 4fb0b6d..6453fb9 100644 --- a/elisp-to-cl-lesson.org +++ b/elisp-to-cl-lesson.org @@ -167,27 +167,24 @@ 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~. +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 [[./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 +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 [[./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]]. +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:1st-part-test-queue +#+name: lst:test-queue-1 #+begin_src emacs-lisp -n :tangle test-queue.el ;;; test-queue.el --- ERT for queue.el -*- lexical-binding: t; -*- @@ -221,7 +218,7 @@ or Common Lisp. The file [[./test-queue.el][test-queue.el]] has been tangled fr (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)))) @@ -242,7 +239,7 @@ or Common Lisp. The file [[./test-queue.el][test-queue.el]] has been tangled fr #+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 +#+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) @@ -292,7 +289,7 @@ or Common Lisp. The file [[./test-queue.el][test-queue.el]] has been tangled fr #+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 +#+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) @@ -308,57 +305,11 @@ or Common Lisp. The file [[./test-queue.el][test-queue.el]] has been tangled fr ;;; 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 +:header-args:lisp: :tangle queue.lisp :END: The [[./queue.lisp][queue.lisp]] file is a translation to Common Lisp of ~queue.el~. The @@ -402,7 +353,7 @@ define the short function aliases for export in listing [[lst:1st-part-queue.lis #+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 +#+begin_src lisp -n :eval never ;;; queue.lisp --- a translation of queue.el to Common Lisp ;;; Package header: @@ -455,7 +406,7 @@ Return nil if QUEUE is empty." #+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 +#+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." @@ -505,7 +456,7 @@ The items themselves are *not* copied." #+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 +#+begin_src lisp -n :eval never ;;; Package footer: ;;; Make short function names for export with prefix `queue:' in `defpackage'. (setf (fdefinition 'all) #'queue-all) @@ -527,40 +478,6 @@ The items themselves are *not* copied." ;;; 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" @@ -806,8 +723,6 @@ QUEUE:TAIL :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]], @@ -823,6 +738,9 @@ Listing [[lst:5am-test-queue-header]], [[lst:5am-test-queue-create]], (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"]: @@ -840,20 +758,20 @@ Listing [[lst:5am-test-queue-header]], [[lst:5am-test-queue-create]], #+caption[Run "TEST-QUEUE-CREATE"]: #+caption: Run ~TEST-QUEUE-CREATE~. -#+header: :wrap "src text -n :exports never" +#+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 :exports never +#+begin_"src text -n Running test TEST-QUEUE-CREATE .. Did 2 checks. Pass: 2 (100%) Skip: 0 ( 0%) Fail: 0 ( 0%) -#+end_src +#+end_"src #+caption[Define "TEST-QUEUE-ENQUEUE"]: #+caption: Define ~TEST-QUEUE-ENQUEUE~. @@ -862,27 +780,26 @@ Running test TEST-QUEUE-CREATE .. (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))) + (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))) (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)))")))) + (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 :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-ENQUEUE .................... Did 20 checks. @@ -898,27 +815,26 @@ Running test TEST-QUEUE-ENQUEUE .................... (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))) + (a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))) (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))")))) + (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 :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-PREPEND .................... Did 20 checks. @@ -934,27 +850,27 @@ Running test TEST-QUEUE-PREPEND .................... (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))") + (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) - (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))"))))) + (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 :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-DEQUEUE ............................... Did 31 checks. @@ -973,27 +889,24 @@ Running test TEST-QUEUE-DEQUEUE ............................... (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))") + (5am:is (not (queue:empty queue)) "Not: (not (queue:empty queue))") (queue:dequeue queue) - (5am:is (queue:empty queue) - "Not: (eq (car (queue:tail queue)) (car datum))"))))) + (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 :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-EMPTY .................... Did 20 checks. @@ -1012,7 +925,6 @@ Running test TEST-QUEUE-EMPTY .................... (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)) @@ -1023,13 +935,13 @@ Running test TEST-QUEUE-EMPTY .................... #+caption[Run "TEST-QUEUE-FIRST"]: #+caption: Run ~TEST-QUEUE-FIRST~. -#+header: :wrap "src text -n :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-FIRST .................... Did 20 checks. @@ -1048,7 +960,6 @@ Running test TEST-QUEUE-FIRST .................... (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))) @@ -1060,13 +971,13 @@ Running test TEST-QUEUE-FIRST .................... #+caption[Run "TEST-QUEUE-NTH"]: #+caption: Run ~TEST-QUEUE-NTH~. -#+header: :wrap "src text -n :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-NTH ........................................ Did 40 checks. @@ -1082,27 +993,27 @@ Running test TEST-QUEUE-NTH ........................................ (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)") + (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) - (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)))")))) + (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 :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-LAST ........... Did 11 checks. @@ -1118,27 +1029,26 @@ Running test TEST-QUEUE-LAST ........... (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)") + (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) - (queue:clear queue) - (dolist (item datum) - (queue:enqueue queue item)) - (5am:is (equal (queue:all queue) datum) - "Not: (equal (queue:all queue) datum)")))) + (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 :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-ALL ........... Did 11 checks. @@ -1193,13 +1103,13 @@ Running test TEST-QUEUE-ALL ........... #+caption[Run "TEST-QUEUE-COPY"]: #+caption: Run ~TEST-QUEUE-COPY~. -#+header: :wrap "src text -n :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-COPY .................................................................................................... Did 100 checks. @@ -1215,27 +1125,26 @@ Running test TEST-QUEUE-COPY ................................................... (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)))") + (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) - (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)")))) + (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 :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-LENGTH ........... Did 11 checks. @@ -1264,13 +1173,13 @@ Running test TEST-QUEUE-LENGTH ........... #+caption[Run "TEST-QUEUE-CLEAR"]: #+caption: Run ~TEST-QUEUE-CLEAR~. -#+header: :wrap "src text -n :exports never" +#+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 :exports never +#+begin_src text -n Running test TEST-QUEUE-CLEAR ..................... Did 21 checks. @@ -1279,22 +1188,22 @@ Running test TEST-QUEUE-CLEAR ..................... Fail: 0 ( 0%) #+end_src -#+caption[Run all tests]: -#+caption: Run all tests. -#+header: :wrap "src text -n :exports never" +#+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-tests) +(5am:run! 'all-queue-tests) ;;; test-queue.lisp ends here #+end_src -#+caption: Run all tests result. +#+caption: Run "ALL-QUEUE-TESTS" result. #+name: lst:5am-run-all-tests #+RESULTS: lst:5am-test-queue-footer -#+begin_src text -n :exports never +#+begin_src text -n -Running test suite NIL +Running test suite ALL-QUEUE-TESTS Running test TEST-QUEUE-CREATE .. Running test TEST-QUEUE-ENQUEUE .................... Running test TEST-QUEUE-PREPEND .................... @@ -1313,218 +1222,829 @@ Running test suite NIL Fail: 0 ( 0%) #+end_src -* Emacs Lisp +* Failing list based "QUEUE-LIST" Emacs Lisp implementation -#+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; -*- +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. -(defun keu-create () +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)) -(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))))))) +;; 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 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 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 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 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))) -(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)) +;;; queue-list.lisp ends here #+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))) +#+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 -(defun keu-last (keu) - "Return the last element of KEU, without removing it. -Returns nil if KEU is empty." - (cadr keu)) +(ql:quickload :fiveam) +(load "queue-list.lisp" :verbose t :print t) -(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))) +(5am:def-suite all-queue-list-tests) +(5am:in-suite all-queue-list-tests) #+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)) +#+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" -(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 +; loading #P"/Users/vermeulen/.emacs.d/queue-list.lisp" +; QUEUE-LIST-CREATE +; QUEUE-LIST-ENQUEUE +; QUEUE-LIST-PREPEND +; QUEUE-LIST-DEQUEUE #+end_src -** ~KEU~ Elisp Regression Testing +#+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: 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; -*- +#+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 -(require 'ert) -(require 'keu) +#+RESULTS: +#+begin_src text -n -(ert-deftest keu-create-test () - (should (equal (keu-create) (list nil nil)))) +Running test TEST-QUEUE-LIST-CREATE .. + Did 2 checks. + Pass: 2 (100%) + Skip: 0 ( 0%) + Fail: 0 ( 0%) +#+end_src -(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) +#+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) - (dolist (item datum) - (keu-enqueue keu item)) - (should (equal keu `(,datum ,(list (car (reverse datum))))))))) + (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 -(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) +#+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) - (dolist (item datum) - (keu-enqueue keu item)) - (let (mutad) + (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)) - (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)))))) + (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: 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 +#+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 -* [[https://common-lisp-libraries.readthedocs.io/fiveam/][Fiveam Common Lisp Regression Testing Framework]] +#+RESULTS: +#+begin_src text -n -Here, I explore how to use [[https://common-lisp-libraries.readthedocs.io/fiveam/][fiveam]]. +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 :results output +#+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. -#+RESULTS: +# 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: @@ -1535,6 +2055,7 @@ To load "fiveam": #+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." @@ -1543,16 +2064,20 @@ To load "fiveam": (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. +#+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" -#+begin_src lisp -n :package fiveam :results output +#+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 -#+RESULTS: +#+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%) @@ -1567,7 +2092,8 @@ Running test 5AM-TEST-DEMO ..f #+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 +#+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))) @@ -1577,14 +2103,18 @@ Running test 5AM-TEST-DEMO ..f #+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 :results output +#+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 -#+RESULTS: +#+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%) @@ -1597,444 +2127,52 @@ Running test CL-TEST-DEMO ..f -------------------------------- #+end_src -* Common Lisp +* Common Lisp "How do you DO?" do-loop example +:PROPERTIES: +:CUSTOM_ID: sec:how-do-you-do +:END: -#+caption: Common Lisp ~KEU~ implementation. -#+begin_src lisp -n :package cl-user :results silent -;;; keu.lisp --- handle FIFOs of items +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. -(defun keu-create () - "Create an empty keu." - (list nil nil)) +#+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)))) -;; 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))) +(let ((items '(how do you do \?))) + (how-do-you-do? items)) #+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 ; # -; 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 ; # -; A08: 6A10 PUSH 16 -; A0A: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP -; A11: 58 POP RAX -; A12: E904FDFFFF JMP #x5365671B ; # -; A17: 6A10 PUSH 16 -; A19: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP -; A20: 58 POP RAX -; A21: E926FDFFFF JMP #x5365674C ; # -; 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 ; # -; A37: 6A10 PUSH 16 -; A39: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP -; A40: 58 POP RAX -; A41: E980FEFFFF JMP #x536568C6 ; # -; A46: 6A10 PUSH 16 -; A48: FF142588050050 CALL [#x50000588] ; #x52A005B0: LIST-ALLOC-TRAMP -; A4F: 58 POP RAX -; A50: E9A2FEFFFF JMP #x536568F7 ; # -; 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) +#+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 * Local variables :noexport: