Evaluate compatibility of Medley Common Lisp (formerly XCL) with popular books about Common Lisp

[masinter]

As a Lisp learning environment, divergence from the spec in obscure edge cases may not matter as much. This might be a good goal on the way:

Evaluate and document divergence from exercises and examples for PCL and PAIP.

• paip is short for paradigms of artificial intelligence programming by peter norvig https://github.com/norvig/paip-lisp/
• pcl is practical common lisp by peter seibel https://gigamonkeys.com/book/
• http://cs.cmu.edu/~dst/lispbook/book.pdf "Gentle Introduction"
• Common Lisp: An Interactive Approach is recommended
  • The notes from an on-line course, CSE 202, using this book, and given in Fall, 2000, is available.z

This is a step toward ANSII Common Lisp compatibility which would be useful.

[reflektoin]

As a beginner using the environment it took me a while to load the CLOS in the online version. Hopefully these steps are helpful for someone in the future. So to load the CLOS I did the following steps:

1. Open Interlisp Exec. Steps for opening the Exec are explained for example here.
2. Navigate to clos folder with command "cd medley>medley>clos"
3. type "(LOAD 'DEFSYS.DFASL)" into Interlisp Exec
4. Type "(CLOS::LOAD-CLOS)" into Interlisp Exec.

Now you should be able to do class definitions using "(CLOS:DEFCLASS ...)"

[masinter]

@reflektoin I've been meaning to take this and put it in the wiki as a How To in the "Experiments" section.
Should we load CLOS by default when you ask for "Common Lisp"?
@fghalasz #742

[masinter]

@fghalasz do you think it would be useful for now to link to this issue?

[reflektoin]

@masinter: Was the question "Should we load CLOS by default when you ask for "Common Lisp"?" directed to fghalasz?

By the way, in your first post the link http://cs.cmu.edu/~dst/lispbook/book.pdf gives me "Document not found". I could access the file from link https://www.cs.cmu.edu/~dst/LispBook/book.pdf. It seems that character casing plays a role here.

[masinter]

@reflektoin you, thanks. Anyone responding to this issue.

[reflektoin]

No problem.

About loading CLOS by default. Yes I would prefer that it would be loaded by default. And that might lower the barrier for people to experiment with Common Lisp when they don't have to do extra steps on order to run CLOS code.

[pamoroso]

I'm going through Peter Seibel's book Practical Common Lisp and testing the code of each chapter on Medley to see how far I can go.

Here's my process. I evaluate the code at a XCL Exec, usually via copy-paste. If I need to load a source file I adapt and load it as explained here.

So far I completed the first three chapters. Chapter 1. Introduction: Why Lisp? has no code.

Chapter 2. Lather, Rinse, Repeat: A Tour of the REPL

Chapter 2 contains these expressions, all of which are evaluated and work as expected:

2/6> 10
10
2/7> 
(+ 2 3)
5
2/8> 

2/8> "hello, world"
"hello, world"
2/9> 
(format t "hello, world")
hello, world
NIL
2/10> 

2/10> (defun hello-world () (format t "hello, world"))
HELLO-WORLD
2/11> 

2/11> (hello-world)
hello, world
NIL
2/12> 

2/12> (defun hello-world ()
  (format t "Hello, world!"))

New FUNCTIONS definition for HELLO-WORLD.
HELLO-WORLD
2/13> 

2/13> (hello-world)
Hello, world!
NIL
2/14> 

2/14> (load "hello.lisp")

; Loading {DSK}<home>medley>il>demo>hello.lisp;1
; Finished loading {DSK}<home>medley>il>demo>hello.lisp;1, 68 bytes read
IL:|{DSK}<home>medley>il>demo>hello.lisp;1|
2/15> 

2/15> (hello-world)
Hello, world!
NIL
2/16> 

2/16> (load (compile-file "hello.lisp"))
Compiling DEFUN HELLO-WORLD ... Done

; Loading {DSK}<home>medley>il>demo>hello.DFASL;1
XCL Compiler output for source file {DSK}<home>medley>il>demo>hello.lisp;1
Source file created Friday, 8 March 2024, 7:36:06
FASL file created Friday, 8 March 2024, 7:39:58

IL:|{DSK}<home>medley>il>demo>hello.DFASL;1|

The chapter also contains an intentional call to an undefined function which enters a break loop in the example output of the book. Medley prints an error instead:

2/6> (hello-world)
Undefined car of form
HELLO-WORLD

Chapter 3. Practical: A Simple Database

I loaded the code of chapter 3 from a source file. The function make-comparisons-list calls loop with options Medley doesn't support, so I rewrote it using do like this:

(defun make-comparisons-list (fields)
  (do (result)
      ((null fields) (nreverse result))
    (push (make-comparison-expr (pop fields) (pop fields)) result)))

With this change the code works as expected and lets me call select and where, which in Seibel's code rely on the loop version of make-comparisons-list:

NIL
2/6> (load "packages.lisp" :package (find-package "XCL-USER"))

; Loading {DSK}<home>medley>il>demo>packages.lisp;4
; Finished loading {DSK}<home>medley>il>demo>packages.lisp;4, 95 bytes read
IL:|{DSK}<home>medley>il>demo>packages.lisp;4|
2/7> (load "simple-database.lisp" :package (find-package "XCL-USER"))

; Loading {DSK}<home>medley>il>demo>simple-database.lisp;4
; Finished loading {DSK}<home>medley>il>demo>simple-database.lisp;4, 2150 bytes read
IL:|{DSK}<home>medley>il>demo>simple-database.lisp;4|
2/8> (setf *package* (find-package "COM.GIGAMONKEYS.SIMPLE-DB"))
#<Package COM.GIGAMONKEYS.SIMPLE-DB>
2/9> (add-cds)
Title: The Little Interlisper
Artist: W.R. Iter
Rating: 9
Ripped [y/n]: y
Another? [y/n]: n
NIL
2/10> (select (where :title "The Little Interlisper"))
((:TITLE "The Little Interlisper" :ARTIST "W.R. Iter" :RATING 9 :RIPPED T))
2/11> (select (where :rating 9))
((:TITLE "The Little Interlisper" :ARTIST "W.R. Iter" :RATING 9 :RIPPED T))
2/12> (dribble)

[pamoroso]

Concerning the earlier comments on CLOS, I believe it comes preloaded with recent builds and it's no longer necessary to load it manually.

[masinter]

CLOS is loaded in 'apps.sysout' which is used for online, but not the full.sysout which is the default in the run-medley & medley startup scripts.

[pamoroso]

Chapter 4. Syntax and Semantics

I tested the code of chapter 4 of Peter Seibel's book by evaluating the expressions at a XCL Exec. The code works as expected:

2/93> 123
123
2/94> 
3/7
3/7
2/95> 
1.0
1.0
2/96> 
1.0e0
1.0
2/97> 
1.0d0
1.0
2/98> 
1.0e-4
1.0E-4
2/99> 
+42
42
2/100> 
-42
-42
2/101> 
-1/4
-1/4
2/102> 
-2/8
-1/4
2/103> 
246/2
123
2/104> 
"foo"
"foo"
2/105> 
"fo\o"
"foo"
2/106> 
"fo\\o"
"fo\\o"
2/107> 
"fo\"o"
"fo\"o"
2/108> 
(+ 1 2)
3
2/109> 

2/109> (* (+ 1 2) (- 3 4))
-3
2/110> 

2/110> (setf x t)
T
2/111> 

2/111> (if x (format t "yes") (format t "no"))
yes
NIL
2/112> 

2/112> (quote (+ 1 2))
(+ 1 2)
2/113> 

2/113> '(+ 1 2)
(+ 1 2)
2/114> 

2/114> (defun print-list (list)
  (dolist (i list)
    (format t "item: ~a~%" i)))
PRINT-LIST
2/115> 

2/115> (print-list '(a b c 3 d "4"))
item: A
item: B
item: C
item: 3
item: D
item: 4
NIL
2/116> 

2/116> (defun foo ()
  (dotimes (i 10)
    (format t "~d. hello~%" i)))
FOO
2/117> 

2/117> (foo)
0. hello
1. hello
2. hello
3. hello
4. hello
5. hello
6. hello
7. hello
8. hello
9. hello

However, I noticed an unexpected and potentially confusing behavior when evaluating expressions that end with a comment preceeded by a semicolon.

I tested the code on Medley Online by pasting into a XCL Exec the expressions previously copied into the noVNC clipboard. I initially copied the first dozen lines of code, each of which is a Lisp expression followed by a comment like this:

123       ; the integer one hundred twenty-three

If you paste such a line at the Exec, or type it and press ENTER, the caret moves down one line and the expression isn't evaluated. At this point the Exec looks like this:

Pressing ENTER more times just moves the caret down as many lines. To make the prompt reappear I have to press an interruption keychord such as Ctrl+E. The issue occurs also when directly typing the line at the Exec, not just via copy-paste.

[masinter]

move discussion of typein prompt to new issue, keep this issue about books open?

[pamoroso]

Yes, it's useful to move the EOL behavior discussionto to a new issue and keep this one open for Common Lisp compatibility.

[pamoroso]

Chapter 5. Functions

I tested the code of chapter 5 of Peter Seibel's book. Since the code consists of expressions intended to be evaluated at a REPL I copied and pasted them into a XCL Exec.

The code required some minor changes. First, function plot contains two nested loop forms which I rewrote replacing them with equivalent do loops:

(defun plot (fn min max step)
  (do ((i min (+ i step)))
      ((> i max) (return))
    (let ((jmax (funcall fn i)))
      (do ((j 0 (+ j 1)))
          ((>= j jmax))
        (format t "*")))
    (format t "~%")))

Also, since a few expressions reference variables not defined elsewhere, I wrapped the expressions in let bindings or added a defvar form that assigned test values. This is not an ANSI Common Lisp compatibility issue, just a convenience.

With these changes all the expressions work as expected:

2/66> (defun hello-world () (format t "hello, world"))
HELLO-WORLD
2/67> 

2/67> (format t "hello, world")
hello, world
NIL
2/68> 

2/68> (defun verbose-sum (x y)
  "Sum any two numbers after printing a message."
  (format t "Summing ~d and ~d.~%" x y)
  (+ x y))
VERBOSE-SUM
2/69> 

2/69> (verbose-sum 1 2)
Summing 1 and 2.
3
2/70> 

2/70> (defun foo (a b &optional c d) (list a b c d))

New FUNCTIONS definition for FOO.
FOO
2/71> 

2/71> (foo 1 2)
(1 2 NIL NIL)
2/72> 

2/72> (foo 1 2 3)
(1 2 3 NIL)
2/73> 

2/73> (foo 1 2 3 4)
(1 2 3 4)
2/74> 

2/74> (defun foo (a &optional (b 10)) (list a b))

New FUNCTIONS definition for FOO.
FOO
2/75> 

2/75> (foo 1 2)
(1 2)
2/76> 

2/76> (foo 1)
(1 10)
2/77> 

2/77> (defun foo (a b &optional (c 3 c-supplied-p))
  (list a b c c-supplied-p))

New FUNCTIONS definition for FOO.
FOO
2/78> 

2/78> (foo 1 2)
(1 2 3 NIL)
2/79> 

2/79> (foo 1 2 3)
(1 2 3 T)
2/80> 

2/80> (foo 1 2 4)
(1 2 4 T)
2/81> 

2/81> (format t "hello, world")
hello, world
NIL
2/82> 

2/82> (let ((name "Paolo")) (format t "hello, ~a" name))
hello, Paolo
NIL
2/83> 

2/83> (let ((x 1) (y 2)) (format t "x: ~d y: ~d" x y))
x: 1 y: 2
NIL
2/84> 

2/84> (+)
0
2/85> 

2/85> (+ 1)
1
2/86> 

2/86> (+ 1 2)
3
2/87> 

2/87> (+ 1 2 3)
6
2/88> 

2/88> (defun foo (&key a b c) (list a b c))

New FUNCTIONS definition for FOO.
FOO
2/89> 

2/89> (foo)
(NIL NIL NIL)
2/90> 

2/90> (foo :a 1)
(1 NIL NIL)
2/91> 

2/91> (foo :b 1)
(NIL 1 NIL)
2/92> 

2/92> (foo :c 1)
(NIL NIL 1)
2/93> 

2/93> (foo :a 1 :c 3)
(1 NIL 3)
2/94> 

2/94> (foo :a 1 :b 2 :c 3)
(1 2 3)
2/95> 

2/95> (foo :a 1 :c 3 :b 2)
(1 2 3)
2/96> 

2/96> (defun foo (&key (a 0) (b 0 b-supplied-p) (c (+ a b)))
  (list a b c b-supplied-p))

New FUNCTIONS definition for FOO.
FOO
2/97> 

2/97> (foo :a 1)
(1 0 1 NIL)
2/98> 

2/98> (foo :b 1)
(0 1 1 T)
2/99> 

2/99> (foo :b 1 :c 4)
(0 1 4 T)
2/100>   
2/100> 
2/100> (foo :a 2 :b 1 :c 4)
(2 1 4 T)
2/101> 

2/101> (defun foo (&key ((:apple a)) ((:box b) 0) ((:charlie c) 0 c-supplied-p))
  (list a b c c-supplied-p))

New FUNCTIONS definition for FOO.
FOO
2/102> 

2/102> (foo :apple 10 :box 20 :charlie 30)
(10 20 30 T)
2/103> 

2/103> (defun foo (x &optional y &key z) (list x y z))

New FUNCTIONS definition for FOO.
FOO
2/104> 

2/104> (foo 1 2 :z 3)
(1 2 3)
2/105> 

2/105> (foo 1)
(1 NIL NIL)
2/106> 

2/106> (foo 1 :z 3)
Not an even number of arguments for &KEY

2/107> 

2/107> (defun foo (&rest rest &key a b c) (list rest a b c))

New FUNCTIONS definition for FOO.
FOO
2/108> 

2/108> (foo :a 1 :b 2 :c 3)
((:A 1 :B 2 :C 3) 1 2 3)
2/109> 

2/109> (defun foo (n)
  (dotimes (i 10)
    (dotimes (j 10)
      (when (> (* i j) n)
        (return-from foo (list i j))))))

New FUNCTIONS definition for FOO.
FOO
2/110> 

2/110> (foo 15)
(2 8)
2/111> 

2/111> (defun foo (x) (* 2 x))

New FUNCTIONS definition for FOO.
FOO
2/112> 

2/112> (function foo)
(LAMBDA (X) (BLOCK FOO (* 2 X)))
2/113> 

2/113> (defun plot (fn min max step)
  (do ((i min (+ i step)))
      ((> i max) (return))
    (let ((jmax (funcall fn i)))
      (do ((j 0 (+ j 1)))
          ((>= j jmax))
        (format t "*")))
    (format t "~%")))
PLOT
2/114> 

2/114> (plot #'exp 0 4 1/2)
*
**
***
*****
********
*************
*********************
**********************************
*******************************************************
NIL
2/115> 

2/115> (defvar plot-data (list #'exp 0 4 1/2))
PLOT-DATA
2/116> 

2/116> (plot (first plot-data) (second plot-data) (third plot-data) (fourth plot-data))
NIL
2/117> 

2/117> (apply #'plot plot-data)
Too few arguments to (LAMBDA (FN MIN MAX STEP) (BLOCK PLOT (DO ((I MIN (+ I STEP))) ((> I MAX) (RETURN)) (LET ((JMAX (FUNCALL FN I))) (DO ((J 0 (+ J 1))) ((>= J JMAX)) (FORMAT T *))) (FORMAT T ~%)))):
   3 were given but at least 4 are necessary

2/118> 

2/118> (setf plot-data (list 0 4 1/2))
(0 4 1/2)
2/119> 

2/119> (apply #'plot #'exp plot-data)
*
**
***
*****
********
*************
*********************
**********************************
*******************************************************
NIL
2/120> 

2/120> (funcall #'(lambda (x y) (+ x y)) 2 3)
5
2/121> 

2/121> ((lambda (x y) (+ x y)) 2 3)
5
2/122> 

2/122> (defun double (x) (* 2 x))
DOUBLE
2/123> 

2/123> (plot #'double 0 10 1)

**
****
******
********
**********
************
**************
****************
******************
********************
NIL
2/124> 

2/124> (plot #'(lambda (x) (* 2 x)) 0 10 1)

**
****
******
********
**********
************
**************
****************
******************
********************
NIL
2/125> 

[pamoroso]

Chapter 6. Variables

I tested the code in chapter 6 of Seibel's book. Again, since the code consists of expressions intended to be evaluated at a REPL I copied and pasted them into a XCL Exec.

The code required no changes for Common Lisp compatibility. I just added bindings and definitions for variables and functions the chapter leaves unspecified.

All the code works as expected:

2/6> (defun foo (x y z) (+ x y z))
FOO
2/7> 

2/7> (foo 1 2 3)
6
2/8> 

2/8> (defun foo (x)
  (format t "Parameter: ~a~%" x)
  (let ((x 2))
    (format t "Outer LET: ~a~%" x)
    (let ((x 3))
      (format t "Inner LET: ~a~%" x))
    (format t "Outer LET: ~a~%" x))
  (format t "Parameter: ~a~%" x))

New FUNCTIONS definition for FOO.
FOO
2/9> 

2/9> (foo 1)
Parameter: 1
Outer LET: 2
Inner LET: 3
Outer LET: 2
Parameter: 1
NIL
2/10> 

2/10> (dotimes (x 10) (format t "~d " x))
0 1 2 3 4 5 6 7 8 9 
NIL
2/11> 

2/11> (let* ((x 10)
       (y (+ x 10)))
  (list x y))
(10 20)
2/12> 

2/12> (let ((x 10))
  (let ((y (+ x 10)))
    (list x y)))
(10 20)
2/13> 

2/13> (let ((count 0)) #'(lambda () (setf count (1+ count))))
#<Interpreted closure @ 166,114750>
2/14> 

2/14> (defparameter *fn* (let ((count 0)) #'(lambda () (setf count (1+ count)))))
*FN*
2/15> 

2/15> (funcall *fn*)
1
2/16> 

2/16> (funcall *fn*)
2
2/17> 

2/17> (funcall *fn*)
3
2/18> 

2/18> (let ((count 0))
  (list
   #'(lambda () (incf count))
   #'(lambda () (decf count))
   #'(lambda () count)))
(#<Interpreted closure @ 166,114760> #<Interpreted closure @ 166,114764> #<Interpreted closure @ 166,114770>)
2/19> 

2/19> (defvar *count* 0
  "Count of widgets made so far.")
*COUNT*
2/20> 

2/20> (defparameter *gap-tolerance* 0.001
  "Tolerance to be allowed in widget gaps.")
*GAP-TOLERANCE*
2/21> 

2/21> (defun increment-widget-count () (incf *count*))
INCREMENT-WIDGET-COUNT
2/22> 

2/22> (defun stuff ()
  (format t "Doing stuff"))
STUFF
2/23> 

2/23> (defvar *some-other-stream* *debug-io*)
*SOME-OTHER-STREAM*
2/24> 

2/24> (let ((*standard-output* *some-other-stream*))
  (stuff))
Doing stuff
NIL
2/25> 

2/25> (defvar *x* 10)
*X*
2/26> 

2/26> (defun foo () (format t "X: ~d~%" *x*))

New FUNCTIONS definition for FOO.
FOO
2/27> 

2/27> (foo)
X: 10
NIL
2/28> 

2/28> (let ((*x* 20)) (foo))
X: 20
NIL
2/29> 

2/29> (foo)
X: 10
NIL
2/30> 

2/30> (defun bar ()
  (foo)
  (let ((*x* 20)) (foo))
  (foo))
BAR
2/31> 

2/31> (bar)
X: 10
X: 20
X: 10
NIL
2/32> 

2/32> (defun foo ()
  (format t "Before assignment~18tX: ~d~%" *x*)
  (setf *x* (+ 1 *x*))
  (format t "After assignment~18tX: ~d~%" *x*))

New FUNCTIONS definition for FOO.
FOO
2/33> 

2/33> (foo)
Before assignment X: 10
After assignment  X: 11
NIL
2/34> 

2/34> (bar)
Before assignment X: 11
After assignment  X: 12
Before assignment X: 20
After assignment  X: 21
Before assignment X: 12
After assignment  X: 13
NIL
2/35> 

2/35> (defvar x)
X
2/36> 

2/36> (setf x 10)
10
2/37> 

2/37> (defun foo (x) (setf x 10))

New FUNCTIONS definition for FOO.
FOO
2/38> 

2/38> (let ((y 20))
  (foo y)
  (print y))

20 
20
2/39> 

2/39> (defvar y)
Y
2/40> 

2/40> (setf x 1)
1
2/41> 

2/41> (setf y 2)
2
2/42> 

2/42> (setf x 1 y 2)
2
2/43> 

2/43> (setf x (setf y (random 10)))
4
2/44> 

2/44> (setf x (+ x 1))
5
2/45> 

2/45> (setf x (- x 1))
4
2/46> 

2/46> (incf x)
5
2/47> 

2/47> (decf x)
4
2/48> 

2/48> (incf x 10)
14
2/49> 

2/49> (defvar *array* (make-array 20 :initial-element 0))
*ARRAY*
2/50> 

2/50> (incf (aref *array* (random (length *array*))))
1
2/51> 

2/51> (defvar a 1)
A
2/52> 

2/52> (defvar b 2)
B
2/53> 

2/53> (rotatef a b)
NIL
2/54> 

2/54> (shiftf a b 10)
2
2/55> 

[pamoroso]

Chapter 7. Macros: Standard Control Constructs

I tested the code in chapter 7 of Seibel's book by copying the expressions and pasting them into a XCL Exec.

The only changes to che code mostly involved adding missing definitions and bindings. Also, I didn't evaluate a few expressions the chapter presents as pseudocode. And, since it redefines when and unless, I renamed the new definitions mywhen and myunless. Finally, one of the expressions intentionally runs an infinite loop I interrupted manually with Ctrl+E.

The code includes some loop forms. Unlike other chapters, for which I rewrote the loops because they are incidental to the features the text covers, here I didn't as the point is to introduce loop. But we already know loop is missing from Medley.

Aside from this all the code works as expected:

2/34> (if (> 2 3) "Yup" "Nope")
"Nope"
2/35> 

2/35> (if (> 2 3) "Yup")
NIL
2/36> 

2/36> (if (> 3 2) "Yup" "Nope")
"Yup"
2/37> 

2/37> (defun spam-p (message)
  t)
SPAM-P
2/38> 

2/38> (defun file-in-spam-folder (message)
  (format t "Filing in spam folder."))
FILE-IN-SPAM-FOLDER
2/39> 

2/39> (defun update-spam-database (message)
  (format t "Updating spam database."))
UPDATE-SPAM-DATABASE
2/40> 

2/40> 
2/40> (let ((current-message "I'm so spammy."))
  (if (spam-p current-message)
      (file-in-spam-folder current-message)
      (update-spam-database current-message)))
Filing in spam folder.
NIL
2/41> 

2/41> (let ((current-message "I'm so spammy."))
  (if (spam-p current-message)
      (progn
        (file-in-spam-folder current-message))))
Filing in spam folder.
NIL
2/42> 

2/42> (let ((current-message "I'm so spammy."))
  (when (spam-p current-message)
    (file-in-spam-folder current-message)
    (update-spam-database current-message)))
Filing in spam folder.Updating spam database.
NIL
2/43> 

2/43> (defmacro mywhen (condition &rest body)
  `(if ,condition (progn ,@body)))
MYWHEN
2/44> 

2/44> (mywhen t (format t "Mywhen"))
Mywhen
NIL
2/45> 

2/45> (defmacro myunless (condition &rest body)
  `(if (not ,condition) (progn ,@body)))
MYUNLESS
2/46> 

2/46> (myunless nil (format t "Myunless"))
Myunless
NIL
2/47> 

2/47> (not nil)
T
2/48> 

2/48> (not (= 1 1))
NIL
2/49> 

2/49> (and (= 1 2) (= 3 3))
NIL
2/50> 

2/50> (or (= 1 2) (= 3 3))
T
2/51> 

2/51> (dolist (x '(1 2 3)) (print x))

1 
2 
3 
NIL
2/52> 

2/52> (dolist (x '(1 2 3)) (print x) (if (evenp x) (return)))

1 
2 
NIL
2/53> 

2/53> (dotimes (i 4) (print i))

0 
1 
2 
3 
NIL
2/54> 

2/54> (dotimes (x 20)
  (dotimes (y 20)
    (format t "~3d " (* (1+ x) (1+ y))))
  (format t "~%"))
  1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
  2   4   6   8  10  12  14  16  18  20  22  24  26  28  30  32  34  36  38  40 
  3   6   9  12  15  18  21  24  27  30  33  36  39  42  45  48  51  54  57  60 
  4   8  12  16  20  24  28  32  36  40  44  48  52  56  60  64  68  72  76  80 
  5  10  15  20  25  30  35  40  45  50  55  60  65  70  75  80  85  90  95 100 
  6  12  18  24  30  36  42  48  54  60  66  72  78  84  90  96 102 108 114 120 
  7  14  21  28  35  42  49  56  63  70  77  84  91  98 105 112 119 126 133 140 
  8  16  24  32  40  48  56  64  72  80  88  96 104 112 120 128 136 144 152 160 
  9  18  27  36  45  54  63  72  81  90  99 108 117 126 135 144 153 162 171 180 
 10  20  30  40  50  60  70  80  90 100 110 120 130 140 150 160 170 180 190 200 
 11  22  33  44  55  66  77  88  99 110 121 132 143 154 165 176 187 198 209 220 
 12  24  36  48  60  72  84  96 108 120 132 144 156 168 180 192 204 216 228 240 
 13  26  39  52  65  78  91 104 117 130 143 156 169 182 195 208 221 234 247 260 
 14  28  42  56  70  84  98 112 126 140 154 168 182 196 210 224 238 252 266 280 
 15  30  45  60  75  90 105 120 135 150 165 180 195 210 225 240 255 270 285 300 
 16  32  48  64  80  96 112 128 144 160 176 192 208 224 240 256 272 288 304 320 
 17  34  51  68  85 102 119 136 153 170 187 204 221 238 255 272 289 306 323 340 
 18  36  54  72  90 108 126 144 162 180 198 216 234 252 270 288 306 324 342 360 
 19  38  57  76  95 114 133 152 171 190 209 228 247 266 285 304 323 342 361 380 
 20  40  60  80 100 120 140 160 180 200 220 240 260 280 300 320 340 360 380 400 
NIL
2/55> 

2/55> (do ((n 0 (1+ n))
     (cur 0 next)
     (next 1 (+ cur next)))
    ((= 10 n) cur))
55
2/56> 

2/56> (do ((i 0 (1+ i)))
    ((>= i 4))
  (print i))

0 
1 
2 
3 
NIL
2/57> 

2/57> (do ((nums nil) (i 1 (1+ i)))
    ((> i 10) (nreverse nums))
  (push i nums))
(1 2 3 4 5 6 7 8 9 10)
2/58>   ==> (1 2 3 4 5 6 7 8 9 10)
==> is an undefined function.

2/59> (defvar *some-future-date* (+ (get-universal-time) 1000))
*SOME-FUTURE-DATE*
2/60> 

2/60> (do ()
    ((> (get-universal-time) *some-future-date*))
  (format t "Waiting~%")
  (sleep 60))
Waiting

2/61>

[pamoroso]

Chapter 11. Collections

I tested the code of chapter 11 of Seibel's book by evaluating the expressions at a XCL Exec. As usual, I added only some missing definitions and assignments. Since the code includes a loop call I also loaded the experimental loop port of PR #1579.

All the code works as expected except for the loop call:

(loop for k being the hash-keys in *h* using (hash-value v)
  do (format t "~a => ~a~%" k v))

In my test run I got the error Undefined car of form XLP::WITH-HASH-TABLE-ITERATOR, most likely because of the incomplete implementation of loop:

2/112> (loop for k being the hash-keys in *h* using (hash-value v)
  do (format t "~a => ~a~%" k v))
Undefined car of form
XLP::WITH-HASH-TABLE-ITERATOR

Here's the complete transcript of the session:

2/7> (vector)
#<ARRAY T (0) @ 124,260>
2/8> 

2/8> (vector 1)
#<ARRAY T (1) @ 141,103120>
2/9> 

2/9> (vector 1 2)
#<ARRAY T (2) @ 123,176700>
2/10> 

2/10> (make-array 5 :initial-element nil)
#<ARRAY T (5) @ 124,240>
2/11> 

2/11> (make-array 5 :fill-pointer 0)
#<ARRAY T (5) @ 124,470>
2/12> 

2/12> (defparameter *x* (make-array 5 :fill-pointer 0))
*X*
2/13> 

2/13> (vector-push 'a *x*)
0
2/14> 

2/14> *x*
#<ARRAY T (5) @ 124,15360>
2/15> 
(vector-push 'b *x*)
1
2/16> 

2/16> *x*
#<ARRAY T (5) @ 124,15360>
2/17> 
(vector-push 'c *x*)
2
2/18> 

2/18> *x*
#<ARRAY T (5) @ 124,15360>
2/19> 
(vector-pop *x*)
C
2/20> 

2/20> *x*
#<ARRAY T (5) @ 124,15360>
2/21> 
(vector-pop *x*)
B
2/22> 

2/22> *x*
#<ARRAY T (5) @ 124,15360>
2/23> 
(vector-pop *x*)
A
2/24> 

2/24> *x*
#<ARRAY T (5) @ 124,15360>
2/25> 
(make-array 5 :fill-pointer 0 :adjustable t)
#<ARRAY T (5) @ 171,143726>
2/26> 

2/26> (make-array 5 :fill-pointer 0 :adjustable t :element-type 'character)
""
2/27> 

2/27> (defparameter *x* (vector 1 2 3))

New VARIABLES definition for *X*.
*X*
2/28> 

2/28> (length *x*)
3
2/29> 

2/29> (elt *x* 0)
1
2/30> 

2/30> (elt *x* 1)
2
2/31> 

2/31> (elt *x* 2)
3
2/32> 

2/32> (elt *x* 3)
Index out of bounds: 3.

2/33> 

2/33> (setf (elt *x* 0) 10)
10
2/34> 

2/34> *x*
#<ARRAY T (3) @ 141,71200>
2/35> 
(count 1 #(1 2 1 2 3 1 2 3 4))
#<ARRAY T (9) @ 124,26610> is an invalid expression for EVAL.

2/36> 

2/36> (remove 1 #(1 2 1 2 3 1 2 3 4))
#<ARRAY T (9) @ 124,36120> is an invalid expression for EVAL.

2/37> 

2/37> (remove 1 '(1 2 1 2 3 1 2 3 4))
(2 2 3 2 3 4)
2/38> 

2/38> (remove #\a "foobarbaz")
"foobrbz"
2/39> 

2/39> (substitute 10 1 #(1 2 1 2 3 1 2 3 4))
#<ARRAY T (9) @ 124,36450> is an invalid expression for EVAL.

2/40> 

2/40> (substitute 10 1 '(1 2 1 2 3 1 2 3 4))
(10 2 10 2 3 10 2 3 4)
2/41> 

2/41> (substitute #\x #\b "foobarbaz")
"fooxarxaz"
2/42> 

2/42> (find 1 #(1 2 1 2 3 1 2 3 4))
#<ARRAY T (9) @ 124,37070> is an invalid expression for EVAL.

2/43> 

2/43> (find 10 #(1 2 1 2 3 1 2 3 4))
#<ARRAY T (9) @ 124,37550> is an invalid expression for EVAL.

2/44> 

2/44> (position 1 #(1 2 1 2 3 1 2 3 4))
#<ARRAY T (9) @ 124,37670> is an invalid expression for EVAL.

2/45> 

2/45> (count "foo" #("foo" "bar" "baz") :test #'string=)
#<ARRAY T (3) @ 124,40440> is an invalid expression for EVAL.

2/46> 

2/46> (find 'c #((a 10) (b 20) (c 30) (d 40)) :key #'first)
#<ARRAY T (4) @ 124,150> is an invalid expression for EVAL.

2/47> 

2/47> (find 'a #((a 10) (b 20) (a 30) (b 40)) :key #'first)
#<ARRAY T (4) @ 124,320> is an invalid expression for EVAL.

2/48> 

2/48> (find 'a #((a 10) (b 20) (a 30) (b 40)) :key #'first :from-end t)
#<ARRAY T (4) @ 137,11240> is an invalid expression for EVAL.

2/49> 

2/49> (remove #\a "foobarbaz" :count 1)
"foobrbaz"
2/50> 

2/50> (remove #\a "foobarbaz" :count 1 :from-end t)
"foobarbz"
2/51> 

2/51> (defparameter *v* #((a 10) (b 20) (a 30) (b 40)))
#<ARRAY T (4) @ 124,15420> is an invalid expression for EVAL.

2/52> 

2/52> (defun verbose-first (x) (format t "Looking at ~s~%" x) (first x))
VERBOSE-FIRST
2/53> 

2/53> (count 'a *v* :key #'verbose-first)
*V* is an unbound variable.

2/54> 

2/54> (count 'a *v* :key #'verbose-first :from-end t)
*V* is an unbound variable.

2/55> 

2/55> (count-if #'evenp #(1 2 3 4 5))
#<ARRAY T (5) @ 125,16320> is an invalid expression for EVAL.

2/56> 

2/56> (count-if-not #'evenp #(1 2 3 4 5))
#<ARRAY T (5) @ 124,22020> is an invalid expression for EVAL.

2/57> 

2/57> (position-if #'digit-char-p "abcd0001")
4
2/58> 

2/58> (remove-if-not #'(lambda (x) (char= (elt x 0) #\f))
  #("foo" "bar" "baz" "foom"))
#<ARRAY T (4) @ 124,22540> is an invalid expression for EVAL.

2/59> 

2/59> (count-if #'evenp #((1 a) (2 b) (3 c) (4 d) (5 e)) :key #'first)
#<ARRAY T (5) @ 174,24760> is an invalid expression for EVAL.

2/60> 

2/60> (count-if-not #'evenp #((1 a) (2 b) (3 c) (4 d) (5 e)) :key #'first)
#<ARRAY T (5) @ 144,30240> is an invalid expression for EVAL.

2/61> 

2/61> (remove-if-not #'alpha-char-p
  #("foo" "bar" "1baz") :key #'(lambda (x) (elt x 0)))
#<ARRAY T (3) @ 124,36310> is an invalid expression for EVAL.

2/62> 

2/62> (remove-duplicates #(1 2 1 2 3 1 2 3 4))
#<ARRAY T (9) @ 124,36540> is an invalid expression for EVAL.

2/63> 

2/63> (concatenate 'vector #(1 2 3) '(4 5 6))
#<ARRAY T (3) @ 124,37140> is an invalid expression for EVAL.

2/64> 

2/64> (concatenate 'list #(1 2 3) '(4 5 6))
#<ARRAY T (3) @ 124,37610> is an invalid expression for EVAL.

2/65> 

2/65> (concatenate 'string "abc" '(#\d #\e #\f))
"abcdef"
2/66> 

2/66> (sort (vector "foo" "bar" "baz") #'string<)
#<ARRAY T (3) @ 124,40620>
2/67> 

2/67> (defvar my-sequence "My Sequence")
MY-SEQUENCE
2/68> 

2/68> (setf my-sequence (sort my-sequence #'string<))
" MSceeenquy"
2/69> 

2/69> (merge 'vector #(1 3 5) #(2 4 6) #'<)
#<ARRAY T (3) @ 141,61050> is an invalid expression for EVAL.

2/70> 

2/70> (merge 'list #(1 3 5) #(2 4 6) #'<)
#<ARRAY T (3) @ 141,61270> is an invalid expression for EVAL.

2/71> 

2/71> (subseq "foobarbaz" 3)
"barbaz"
2/72> 

2/72> (subseq "foobarbaz" 3 6)
"bar"
2/73> 

2/73> (defparameter *x* (copy-seq "foobarbaz"))

New VARIABLES definition for *X*.
*X*
2/74> 

2/74> (setf (subseq *x* 3 6) "xxx")
"xxx"
2/75> 

2/75> *x*
"fooxxxbaz"
2/76> 
(setf (subseq *x* 3 6) "abcd")
"abcd"
2/77> 

2/77> *x*
"fooabcbaz"
2/78> 
(setf (subseq *x* 3 6) "xx")
"xx"
2/79> 

2/79> *x*
"fooxxcbaz"
2/80> 
(position #\b "foobarbaz")
3
2/81> 

2/81> (search "bar" "foobarbaz")
3
2/82> 

2/82> (mismatch "foobarbaz" "foom")
3
2/83> 

2/83> (mismatch "foobar" "bar" :from-end t)
3
2/84> 

2/84> (every #'evenp #(1 2 3 4 5))
#<ARRAY T (5) @ 124,15410> is an invalid expression for EVAL.

2/85> 

2/85> (some #'evenp #(1 2 3 4 5))
#<ARRAY T (5) @ 124,15540> is an invalid expression for EVAL.

2/86> 

2/86> (notany #'evenp #(1 2 3 4 5))
#<ARRAY T (5) @ 125,16410> is an invalid expression for EVAL.

2/87> 

2/87> (notevery #'evenp #(1 2 3 4 5))
#<ARRAY T (5) @ 124,22150> is an invalid expression for EVAL.

2/88> 

2/88> (every #'> #(1 2 3 4) #(5 4 3 2))
#<ARRAY T (4) @ 124,22620> is an invalid expression for EVAL.

2/89> 

2/89> (some #'> #(1 2 3 4) #(5 4 3 2))
#<ARRAY T (4) @ 124,26600> is an invalid expression for EVAL.

2/90> 

2/90> (notany #'> #(1 2 3 4) #(5 4 3 2))
#<ARRAY T (4) @ 124,36200> is an invalid expression for EVAL.

2/91> 

2/91> (notevery #'> #(1 2 3 4) #(5 4 3 2))
#<ARRAY T (4) @ 124,36560> is an invalid expression for EVAL.

2/92> 

2/92> (map 'vector #'* #(1 2 3 4 5) #(10 9 8 7 6))
#<ARRAY T (5) @ 124,37520> is an invalid expression for EVAL.

2/93> 

2/93> (reduce #'+ #(1 2 3 4 5 6 7 8 9 10))
#<ARRAY T (10) @ 124,40030> is an invalid expression for EVAL.

2/94> 

2/94> (defparameter *h* (make-hash-table))
*H*
2/95> 

2/95> (gethash 'foo *h*)
NIL
NIL
2/96> 

2/96> (setf (gethash 'foo *h*) 'quux)
QUUX
2/97> 

2/97> (gethash 'foo *h*)
QUUX
T
2/98> 

2/98> (defun show-value (key hash-table)
  (multiple-value-bind (value present) (gethash key hash-table)
    (if present
      (format nil "Value ~a actually present." value)
      (format nil "Value ~a because key not found." value))))
SHOW-VALUE
2/99> 

2/99> (setf (gethash 'bar *h*) nil)
NIL
2/100> 

2/100> (show-value 'foo *h*)
"Value QUUX actually present."
2/101> 

2/101> (show-value 'bar *h*)
"Value NIL actually present."
2/102> 

2/102> (show-value 'baz *h*)
"Value NIL because key not found."
2/103> 

2/103> (maphash #'(lambda (k v) (format t "~a => ~a~%" k v)) *h*)
FOO => QUUX
BAR => NIL
NIL
2/104> 

2/104> (defparameter *h* (make-hash-table))
*H*
2/105> 

2/105> (setf (gethash 'a *h*) 2)
2
2/106> 

2/106> (setf (gethash 'a *h*) 3)
3
2/107> 

2/107> (setf (gethash 'a *h*) 11)
11
2/108> 

2/108> (setf (gethash 'a *h*) 12)
12
2/109> 

2/109> (setf (gethash 'a *h*) 13)
13
2/110> 

2/110> (setf (gethash 'a *h*) 15)
15
2/111> 

2/111> (maphash #'(lambda (k v) (when (< v 10) (remhash k *h*))) *h*)
NIL
2/112> 

2/112> (loop for k being the hash-keys in *h* using (hash-value v)
  do (format t "~a => ~a~%" k v))
Undefined car of form
XLP::WITH-HASH-TABLE-ITERATOR

2/113>

[pamoroso]

Chapter 12. They Called It LISP for a Reason: List Processing

I tested the code of chapter 12 of Seibel's book by evaluating the expressions at a XCL Exec. All the code works as expected, including the intentional error generated by (caar (list 1 2 3)):

2/6> (cons 1 2)
(1 . 2)
2/7> 

2/7> (car (cons 1 2))
1
2/8> 

2/8> (cdr (cons 1 2))
2
2/9> 

2/9> (defparameter *cons* (cons 1 2))
*CONS*
2/10> 

2/10> *cons*
(1 . 2)
2/11> 
(setf (car *cons*) 10)
10
2/12> 

2/12> *cons*
(10 . 2)
2/13> 
(setf (cdr *cons*) 20)
20
2/14> 

2/14> *cons*
(10 . 20)
2/15> 
(cons 1 nil)
(1)
2/16> 

2/16> (cons 1 (cons 2 nil))
(1 2)
2/17> 

2/17> (cons 1 (cons 2 (cons 3 nil)))
(1 2 3)
2/18> 

2/18> (list 1)
(1)
2/19> 

2/19> (list 1 2)
(1 2)
2/20> 

2/20> (list 1 2 3)
(1 2 3)
2/21> 

2/21> (defparameter *list* (list 1 2 3 4))
*LIST*
2/22> 

2/22> (first *list*)
1
2/23> 

2/23> (rest *list*)
(2 3 4)
2/24> 

2/24> (first (rest *list*))
2
2/25> 

2/25> (list "foo" (list 1 2) 10)
("foo" (1 2) 10)
2/26> 

2/26> (append (list 1 2) (list 3 4))
(1 2 3 4)
2/27> 

2/27> (defparameter *list-1* (list 1 2))
*LIST-1*
2/28> 

2/28> (defparameter *list-2* (list 3 4))
*LIST-2*
2/29> 

2/29> (defparameter *list-3* (append *list-1* *list-2*))
*LIST-3*
2/30> 

2/30> *list-1*
(1 2)
2/31> 
*list-2*
(3 4)
2/32> 
*list-3*
(1 2 3 4)
2/33> 
(setf (first *list-2*) 0)
0
2/34> 

2/34> *list-2*
(0 4)
2/35> 
*list-3*
(1 2 0 4)
2/36> 
(setf *list* (reverse *list*))
(4 3 2 1)
2/37> 

2/37> (defparameter *x* (list 1 2 3))
*X*
2/38> 

2/38> (nconc *x* (list 4 5 6))
(1 2 3 4 5 6)
2/39> 

2/39> *x*
(1 2 3 4 5 6)
2/40> 
(defun upto (max)
  (let ((result nil))
    (dotimes (i max)
      (push i result))
    (nreverse result)))
UPTO
2/41> 

2/41> (upto 10)
(0 1 2 3 4 5 6 7 8 9)
2/42> 

2/42> *list-2*
(0 4)
2/43> 
*list-3*
(1 2 0 4)
2/44> 
(setf *list-3* (delete 4 *list-3*))
(1 2 0)
2/45> 

2/45> *list-2*
(0)
2/46> 
(defparameter *list* (list 4 3 2 1))

New VARIABLES definition for *LIST*.
*LIST*
2/47> 

2/47> (sort *list* #'<)
(1 2 3 4)
2/48> 

2/48> *list*
(1 2 3 4)
2/49> 
(caar (list 1 2 3))
"{car of non-list}"
2/50> 
(caar (list (list 1 2) 3))
1
2/51> 

2/51> (cadr (list (list 1 2) (list 3 4)))
(3 4)
2/52> 

2/52> (caadr (list (list 1 2) (list 3 4)))
3
2/53> 

2/53> (mapcar #'(lambda (x) (* 2 x)) (list 1 2 3))
(2 4 6)
2/54> 

2/54> (mapcar #'+ (list 1 2 3) (list 10 20 30))
(11 22 33)
2/55> 

[pamoroso]

Chapter 13. Beyond Lists: Other Uses for Cons Cells

I tested the code of chapter 13 of Seibel's book by evaluating the expressions at a XCL Exec. The only required changes were adding a few missing definitions and loading the new loop macro one of the expressions calls.

All the code works as expected:

2/7> (subst 10 1 '(1 2 (3 2 1) ((1 1) (2 2))))
(10 2 (3 2 10) ((10 10) (2 2)))
2/8> 

2/8> (defparameter *set* ())
*SET*
2/9> 

2/9> (adjoin 1 *set*)
(1)
2/10> 

2/10> *set*
NIL
2/11> 
(setf *set* (adjoin 1 *set*))
(1)
2/12> 

2/12> (pushnew 2 *set*)
(2 1)
2/13> 

2/13> *set*
(2 1)
2/14> 
(pushnew 2 *set*)
(2 1)
2/15> 

2/15> (subsetp '(3 2 1) '(1 2 3 4))
T
2/16> 

2/16> (subsetp '(1 2 3 4) '(3 2 1))
NIL
2/17> 

2/17> (assoc 'a '((a . 1) (b . 2) (c . 3)))
(A . 1)
2/18> 

2/18> (assoc 'c '((a . 1) (b . 2) (c . 3)))
(C . 3)
2/19> 

2/19> (assoc 'd '((a . 1) (b . 2) (c . 3)))
NIL
2/20> 

2/20> (cdr (assoc 'a '((a . 1) (b . 2) (c . 3))))
1
2/21> 

2/21> (assoc "a" '(("a" . 1) ("b" . 2) ("c" . 3)) :test #'string=)
("a" . 1)
2/22> 

2/22> (assoc "a" '(("a" . 1) ("b" . 2) ("c" . 3)))
NIL
2/23> 

2/23> (assoc 'a '((a . 10) (a . 1) (b . 2) (c . 3)))
(A . 10)
2/24> 

2/24> (defvar alist nil)
ALIST
2/25> 

2/25> (acons 'new-key 'new-value alist)
((NEW-KEY . NEW-VALUE))
2/26> 

2/26> (setf alist (acons 'new-key 'new-value alist))
((NEW-KEY . NEW-VALUE))
2/27> 

2/27> (pairlis '(a b c) '(1 2 3))
((A . 1) (B . 2) (C . 3))
2/28> 

2/28> (pairlis '(a b c) '(1 2 3))
((A . 1) (B . 2) (C . 3))
2/29> 

2/29> (defparameter *plist* ())
*PLIST*
2/30> 

2/30> (setf (getf *plist* :a) 1)
1
2/31> 

2/31> *plist*
(:A 1)
2/32> 
(setf (getf *plist* :a) 2)
2
2/33> 

2/33> *plist*
(:A 2)
2/34> 
(remf *plist* :a)
T
2/35> 

2/35> *plist*
NIL
2/36> 
(defparameter *plist* ())
*PLIST*
2/37> 

2/37> (setf (getf *plist* :a) 1)
1
2/38> 

2/38> (setf (getf *plist* :a) 2)
2
2/39> 

2/39> (defun process-property (key value)
  (format t "~&processing key ~a and value ~a~%" key value))
PROCESS-PROPERTY
2/40> 

2/40> (defun process-properties (plist keys)
  (loop while plist do
       (multiple-value-bind (key value tail) (get-properties plist keys)
         (when key (process-property key value))
         (setf plist (cddr tail)))))
PROCESS-PROPERTIES
2/41> 

2/41> (process-properties *plist* (list :a))
processing key A and value 2
NIL
2/42> 

2/42> (destructuring-bind (x y z) (list 1 2 3)
  (list :x x :y y :z z))
(:X 1 :Y 2 :Z 3)
2/43> 

2/43> (destructuring-bind (x y z) (list 1 (list 2 20) 3)
  (list :x x :y y :z z))
(:X 1 :Y (2 20) :Z 3)
2/44> 

2/44> (destructuring-bind (x (y1 y2) z) (list 1 (list 2 20) 3)
  (list :x x :y1 y1 :y2 y2 :z z))
(:X 1 :Y1 2 :Y2 20 :Z 3)
2/45> 

2/45> (destructuring-bind (x (y1 &optional y2) z) (list 1 (list 2 20) 3)
  (list :x x :y1 y1 :y2 y2 :z z))
(:X 1 :Y1 2 :Y2 20 :Z 3)
2/46> 

2/46> (destructuring-bind (x (y1 &optional y2) z) (list 1 (list 2) 3)
  (list :x x :y1 y1 :y2 y2 :z z))
(:X 1 :Y1 2 :Y2 NIL :Z 3)
2/47> 

2/47> (destructuring-bind (&key x y z) (list :x 1 :y 2 :z 3)
  (list :x x :y y :z z))
(:X 1 :Y 2 :Z 3)
2/48> 

2/48> (destructuring-bind (&key x y z) (list :z 1 :y 2 :x 3)
  (list :x x :y y :z z))
(:X 3 :Y 2 :Z 1)
2/49> 

2/49> (destructuring-bind (&whole whole &key x y z) (list :z 1 :y 2 :x 3)
  (list :x x :y y :z z :whole whole))
(:X 3 :Y 2 :Z 1 :WHOLE (:Z 1 :Y 2 :X 3))
2/50> 

[masinter]

(count 1 #(1 2 1 2 3 1 2 3 4))
Doesn't give the right result!
There's a bug in the Exec code where it's walking through the input trying to make the code run "undoably", ane choking. I will fix it.

I wonder if we could do a test framework where we check against a shell sbcl.

[pamoroso]

Chapter 14. Files and File I/O

I tested the code of chapter 14 of Seibel's book by evaluating the expressions at a XCL Exec. I had to add some missing definitions and expressions for creating the files processed by the examples in the book, as well as load the new loop port called by one of the expressions.

The Exec issued the following pathname errors as the #p reader macro and the :absolute and :relative directory components are apparently not supported:

Undefined dispatch character #\P for dispatch macro character #\#

ARG NOT DIRECTORY-COMPONENT
(:ABSOLUTE "foo" "bar")

ARG NOT DIRECTORY-COMPONENT
(:RELATIVE "backups")

Other than that the code seems to be working as expected. Here is the full transcript of the session:

NIL
2/7> (with-open-file (s "pclchap14f1.txt" :direction :output :if-exists :supersede)
  (format s "~&This is file pclchap14f1.txt~%And this is a new line.~%"))
NIL
2/8> 

2/8> (let ((in (open "pclchap14f1.txt")))
  (format t "~a~%" (read-line in))
  (close in))
This is file pclchap14f1.txt
T
2/9> 

2/9> (let ((in (open "nonexistent.txt" :if-does-not-exist nil)))
  (when in
    (format t "~a~%" (read-line in))
    (close in)))
NIL
2/10> 

2/10> (let ((in (open "pclchap14f1.txt" :if-does-not-exist nil)))
  (when in
    (loop for line = (read-line in nil)
         while line do (format t "~a~%" line))
    (close in)))
This is file pclchap14f1.txt
And this is a new line.
T
2/11> 

2/11> (with-open-file (s "pclchap14f2.txt" :direction :output :if-exists :supersede)
  (print '(1 2 3) s)
  (print 456 s)
  (format s "~&\"a string\" ; this is a comment~%")
  (format s "~&((a b)~% (c d))~%"))
NIL
2/12> 

2/12> (defparameter *s* (open "pclchap14f2.txt"))
*S*
2/13> 

2/13> (read *s*)
(1 2 3)
2/14> 

2/14> (read *s*)
456
2/15> 

2/15> (read *s*)
"a string"
2/16> 

2/16> (read *s*)
((A B) (C D))
2/17> 

2/17> (close *s*)
T
2/18> 

2/18> (with-open-file (stream "pclchap14f1.txt")
  (format t "~a~%" (read-line stream)))
This is file pclchap14f1.txt
NIL
2/19> 

2/19> (with-open-file (stream "pclchap14f3.txt" :direction :output)
  (format stream "Some text."))
NIL
2/20> 

2/20> (pathname-directory (pathname "/foo/bar/baz.txt"))
<foo>bar>
2/21> 

2/21> (pathname-name (pathname "/foo/bar/baz.txt"))
"baz"
2/22> 

2/22> (pathname-type (pathname "/foo/bar/baz.txt"))
"txt"
2/23> 

2/23> (pathname "/foo/bar/baz.txt")
#.(PATHNAME "<foo>bar>baz.txt")
2/24> 

2/24> (namestring #p"/foo/bar/baz.txt")
Undefined dispatch character #\P for dispatch macro character #\#

2/25> "/foo/bar/baz.txt" is an undefined function.

2/26> 

2/26> (directory-namestring #p"/foo/bar/baz.txt")
Undefined dispatch character #\P for dispatch macro character #\#

2/27> "/foo/bar/baz.txt" is an undefined function.

2/28> 

2/28> (file-namestring #p"/foo/bar/baz.txt")
Undefined dispatch character #\P for dispatch macro character #\#

2/29> "/foo/bar/baz.txt" is an undefined function.

2/30> 

2/30> (make-pathname
  :directory '(:absolute "foo" "bar")
  :name "baz"
  :type "txt")
ARG NOT DIRECTORY-COMPONENT
(:ABSOLUTE "foo" "bar")

2/31> 

2/31> (make-pathname :device "c" :directory '(:absolute "foo" "bar") :name "baz")
ARG NOT DIRECTORY-COMPONENT
(:ABSOLUTE "foo" "bar")

2/32> 

2/32> (defvar input-file (make-pathname
  :directory '(:absolute "foo" "bar")
  :name "baz"
  :type "txt"))
INPUT-FILE
2/33> 

2/33> (make-pathname :type "html" :defaults input-file)
ARG NOT DIRECTORY-COMPONENT
(:ABSOLUTE "foo" "bar")

2/34> 

2/34> (make-pathname :directory '(:relative "backups") :defaults input-file)
ARG NOT DIRECTORY-COMPONENT
(:RELATIVE "backups")

2/35> 

2/35> (make-pathname :directory '(:relative "backups")
               :defaults #p"/foo/bar/baz.txt")
Undefined dispatch character #\P for dispatch macro character #\#

2/36> "/foo/bar/baz.txt" is an undefined function.

2/37> 

2/37> (merge-pathnames #p"foo/bar.html" #p"/www/html/")
Undefined dispatch character #\P for dispatch macro character #\#

2/38> Undefined dispatch character #\P for dispatch macro character #\#

2/39> "/www/html/" is an undefined function.

2/40> 

2/40> (merge-pathnames #p"foo/bar.html" #p"html/")
Undefined dispatch character #\P for dispatch macro character #\#

2/41> Undefined dispatch character #\P for dispatch macro character #\#

2/42> "html/" is an undefined function.

2/43> 

2/43> (enough-namestring #p"/www/html/foo/bar.html" #p"/www/")
Undefined dispatch character #\P for dispatch macro character #\#

2/44> Undefined dispatch character #\P for dispatch macro character #\#

2/45> "/www/" is an undefined function.

2/46> 

2/46> (merge-pathnames
  (enough-namestring #p"/www/html/foo/bar/baz.html" #p"/www/")
  #p"/www-backups/")
Undefined dispatch character #\P for dispatch macro character #\#

2/47> Undefined dispatch character #\P for dispatch macro character #\#

2/48> "/www/" is an undefined function.

2/49> Undefined dispatch character #\P for dispatch macro character #\#

2/50> "/www-backups/" is an undefined function.

2/51> 

2/51> (make-pathname :name "foo" :type "txt")
#.(PATHNAME "{DSK}foo.txt")
2/52> 

2/52> (make-pathname :directory '(:absolute "foo") :name "bar")
ARG NOT DIRECTORY-COMPONENT
(:ABSOLUTE "foo")

2/53> 

2/53> (make-pathname :directory '(:absolute "foo" "bar"))
ARG NOT DIRECTORY-COMPONENT
(:ABSOLUTE "foo" "bar")

2/54> 

2/54> (defvar  user-supplied-name input-file)
USER-SUPPLIED-NAME
2/55> 

2/55> (make-pathname :name "foo" :type "txt" :defaults user-supplied-name)
ARG NOT DIRECTORY-COMPONENT
(:ABSOLUTE "foo" "bar")

2/56> 

2/56> (defvar filename "pclchap14f1.txt")
FILENAME
2/57> 

2/57> (with-open-file (in filename :element-type '(unsigned-byte 8))
  (file-length in))
53
2/58> 

2/58> (let ((s (make-string-input-stream "1.23")))
  (unwind-protect (read s)
    (close s)))
1.23
2/59> 

2/59> (with-input-from-string (s "1.23")
  (read s))
1.23
2/60> 

2/60> (with-output-to-string (out)
            (format out "hello, world ")
            (format out "~s" (list 1 2 3)))
"hello, world (1 2 3)"
2/61> 

2/61> (dribble)

[masinter]

As an Issue, this is getting unwieldly -- hard to find "the next thing to work on", as the problem reports are scattered amongst many reports of successes. How about moving (most of) these posts to a Discussion, while raising separate issues (for groups of related reports, e.g., CL Pathname problems).

[pamoroso]

I agree. I'll update on the work on each chapter or group of chapters in its own discussion, and report any relevant problems by raising separate issues.

[pamoroso]

I posted some notes summarizing the methodology and major findings of the first pass over Practical Common Lisp.

[pamoroso]

My post was shared on Hacker News and is getting some traffic, about 250 views so far.

[pamoroso]

My post was shared also on Lobsters, an aggregator similar to Hacker News but with a focus on computer science.

[eblanton]

I have started a discussion for Stu Shapiro's Common Lisp: An Interactive Approach here: https://github.com/orgs/Interlisp/discussions/1747

[eblanton]

I believe that there is a subtle problem in CL: An Interactive Approach Chapter 8, exercise 8.5. This exercise says:

Check Lisp's value of (type-of '(1 2 3)) and of (type-of '()). Common Lisp divides objects of type list into the empty list and objects of type cons. Conses are all nonempty lists (those constructed by the use of cons).

Medley XCL as of maiko 3ef7d2d and medley 1148cd59 returns CONS for (type-of '(1 2 3)) (expected), but SYMBOL for (type-of '()), which surprised me (SBCL returns NULL).

I did some further exploration:

2/40> (type-of '())
SYMBOL
2/41> (type-of nil)
SYMBOL
2/42> (typep '() 'null)
T
2/44> (subtypep (type-of '()) 'null)
NIL
T

CLtL2 (p.66, Section 4.9, "Determining the Type of an Object") implies that this should return T T, not NIL T (and SBCL does return T T.

I doubt that a casual reader of CL: An Interactive Approach will note this as a problem (the text implies that the two types should be different), but I believe it is nonetheless a bug. I am filing it here for now, but perhaps it should be its own bug.

[MattHeffron]

@eblanton Please write up the (type-of '()) and (subtypep (type-of '()) 'null) errors as their own single (combined) bug issue. I have a fix that I can associate with the bug issue, so it can be reviewed, etc.
(Fixing type-of fixes subtypep.)

[pamoroso]

We're going to transfer this issue to a discussion. If you evaluate the compatibility of Medley Common Lisp with another Common Lisp book, please open a new GitHub discussion.

[rochus-keller]

Is Medley XCL somehow related to this Common Lisp implementation, also named XCL: https://github.com/gnooth/xcl ?