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

masinter · 2021-12-05T19:17:19Z

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 · 2022-03-04T15:57:12Z

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:

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

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

masinter · 2022-03-12T21:43:14Z

@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 · 2022-03-12T21:46:21Z

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

reflektoin · 2022-03-20T13:40:04Z

@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 · 2022-03-24T05:36:57Z

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

reflektoin · 2022-03-24T11:16:58Z

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 · 2024-03-09T13:13:36Z

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 · 2024-03-09T13:25:42Z

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 · 2024-03-09T18:04:13Z

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 · 2024-03-10T13:09:57Z

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 · 2024-03-10T15:29:53Z

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

pamoroso · 2024-03-10T16:12:03Z

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

pamoroso · 2024-03-11T16:15:08Z

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 · 2024-03-12T16:48:37Z

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 · 2024-03-13T11:06:27Z

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 · 2024-03-15T16:00:37Z

Chapter 8. Macros: Defining Your Own

I tested the code in chapter 8 of Seibel's book.

I only added some function or macro calls that are missing from the chapter, as well as some macroexpand-1 calls to produce output similar to that of the book. Although the code contains a few loop calls, this time I didn't rewrite them but used instead the experimental loop port of PR #1579.

All the code works as expected:

2/8> (defun foo (x)
  (when (> x 10) (print 'big)))
FOO
2/9> 

2/9> (foo 15)

BIG 
BIG
2/10> 

2/10> (defun primep (number)
  (when (> number 1)
    (loop for fac from 2 to (isqrt number) never (zerop (mod number fac)))))
PRIMEP
2/11> 

2/11> (defun next-prime (number)
  (loop for n from number when (primep n) return n))
NEXT-PRIME
2/12> 

2/12> (defmacro do-primes (var-and-range &rest body)
  (let ((var (first var-and-range))
        (start (second var-and-range))
        (end (third var-and-range)))
    `(do ((,var (next-prime ,start) (next-prime (1+ ,var))))
         ((> ,var ,end))
       ,@body)))
DO-PRIMES
2/13> 

2/13> (do-primes (p 0 19)
  (format t "~d " p))
2 3 5 7 11 13 17 19 
NIL
2/14> 

2/14> (defmacro do-primes ((var start end) &body body)
  `(do ((,var (next-prime ,start) (next-prime (1+ ,var))))
       ((> ,var ,end))
     ,@body))

New FUNCTIONS definition for DO-PRIMES.
DO-PRIMES
2/15> 

2/15> (do-primes (p 0 19)
  (format t "~d " p))
2 3 5 7 11 13 17 19 
NIL
2/16> 

2/16> (defmacro do-primes-a ((var start end) &body body)
  (append '(do)
          (list  (list (list var
                             (list 'next-prime start)
                             (list 'next-prime (list '1+ var)))))
          (list (list (list '> var end)))
          body))
DO-PRIMES-A
2/17> 

2/17> (do-primes-a (p 0 19)
  (format t "~d " p))
2 3 5 7 11 13 17 19 
NIL
2/18> 

2/18> (do-primes (p 0 19) (format t "~d " p))
2 3 5 7 11 13 17 19 
NIL
2/19> 

2/19> (macroexpand-1 '(do-primes (p 0 19) (format t "~d " p)))
(DO ((P (NEXT-PRIME 0) (NEXT-PRIME (1+ P)))) ((> P 19)) (FORMAT T "~d " P))
T
2/20> 

2/20> (macroexpand-1 '(do-primes (p 0 (random 100)) (format t "~d " p)))
(DO ((P (NEXT-PRIME 0) (NEXT-PRIME (1+ P)))) ((> P (RANDOM 100))) (FORMAT T "~d " P))
T
2/21> 

2/21> (defmacro do-primes ((var start end) &body body)
  `(do ((ending-value ,end)
        (,var (next-prime ,start) (next-prime (1+ ,var))))
       ((> ,var ending-value))
     ,@body))

New FUNCTIONS definition for DO-PRIMES.
DO-PRIMES
2/22> 

2/22> (macroexpand-1 '(do-primes (p 0 (random 100)) (format t "~d " p)))
(DO ((ENDING-VALUE (RANDOM 100)) (P (NEXT-PRIME 0) (NEXT-PRIME (1+ P)))) ((> P ENDING-VALUE)) (FORMAT T "~d " P))
T
2/23> 

2/23> (defmacro do-primes ((var start end) &body body)
  `(do ((,var (next-prime ,start) (next-prime (1+ ,var)))
        (ending-value ,end))
       ((> ,var ending-value))
     ,@body))

New FUNCTIONS definition for DO-PRIMES.
DO-PRIMES
2/24> 

2/24> (macroexpand-1 '(do-primes (ending-value 0 10)
  (print ending-value)))
(DO ((ENDING-VALUE (NEXT-PRIME 0) (NEXT-PRIME (1+ ENDING-VALUE))) (ENDING-VALUE 10)) ((> ENDING-VALUE ENDING-VALUE)) (PRINT ENDING-VALUE))
T
2/25> 

2/25> (macroexpand-1 '(let ((ending-value 0))
  (do-primes (p 0 10)
    (incf ending-value p))
  ending-value))
(LET ((ENDING-VALUE 0)) (DO-PRIMES (P 0 10) (INCF ENDING-VALUE P)) ENDING-VALUE)
NIL
2/26> 

2/26> (defmacro do-primes ((var start end) &body body)
  (let ((ending-value-name (gensym)))
    `(do ((,var (next-prime ,start) (next-prime (1+ ,var)))
          (,ending-value-name ,end))
         ((> ,var ,ending-value-name))
       ,@body)))

New FUNCTIONS definition for DO-PRIMES.
DO-PRIMES
2/27> 

2/27> (macroexpand-1 '(do-primes (ending-value 0 10)
  (print ending-value)))
(DO ((ENDING-VALUE (NEXT-PRIME 0) (NEXT-PRIME (1+ ENDING-VALUE))) (#:BOTTOM-628 10)) ((> ENDING-VALUE #:BOTTOM-628)) (PRINT ENDING-VALUE))
T
2/28> 

2/28> (macroexpand-1 '(let ((ending-value 0))
  (do-primes (p 0 10)
    (incf ending-value p))
  ending-value))
(LET ((ENDING-VALUE 0)) (DO-PRIMES (P 0 10) (INCF ENDING-VALUE P)) ENDING-VALUE)
NIL
2/29> 

2/29> (defmacro with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (gensym)))
     ,@body))
WITH-GENSYMS
2/30> 

2/30> (defmacro do-primes ((var start end) &body body)
  (with-gensyms (ending-value-name)
    `(do ((,var (next-prime ,start) (next-prime (1+ ,var)))
          (,ending-value-name ,end))
         ((> ,var ,ending-value-name))
       ,@body)))

New FUNCTIONS definition for DO-PRIMES.
DO-PRIMES
2/31> 

2/31> (loop for n in '(a b c) collect `(,n (gensym)))
((A (GENSYM)) (B (GENSYM)) (C (GENSYM)))
2/32> 

2/32> (macroexpand-1 '(with-gensyms (ending-value-name)
    `(do ((,var (next-prime ,start) (next-prime (1+ ,var)))
          (,ending-value-name ,end))
         ((> ,var ,ending-value-name))
       ,@body)))
(LET ((ENDING-VALUE-NAME (GENSYM))) (IL:BQUOTE (DO (((IL:\\\, VAR) (NEXT-PRIME (IL:\\\, START)) (NEXT-PRIME (1+ (IL:\\\, VAR)))) ((IL:\\\, ENDING-VALUE-NAME) (IL:\\\, END))) ((> (IL:\\\, VAR) (IL:\\\, ENDING-VALUE-NAME))) (IL:\\\,@ BODY))))
T
2/33> 

2/33> (defmacro with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (gensym)))
     ,@body))
WITH-GENSYMS
2/34> 

2/34> (loop for n in '(a b c) collect `(,n (gensym)))
((A (GENSYM)) (B (GENSYM)) (C (GENSYM)))
2/35> 

2/35> (defmacro once-only ((&rest names) &body body)
  (let ((gensyms (loop for n in names collect (gensym))))
    `(let (,@(loop for g in gensyms collect `(,g (gensym))))
      `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
        ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
           ,@body)))))
ONCE-ONLY
2/36> 

2/36> (defmacro do-primes ((var start end) &body body)
  (once-only (start end)
    `(do ((,var (next-prime ,start) (next-prime (1+ ,var))))
         ((> ,var ,end))
       ,@body)))

New FUNCTIONS definition for DO-PRIMES.
DO-PRIMES
2/37> 

2/37> (do-primes (p 0 19)
  (format t "~d " p))
2 3 5 7 11 13 17 19 
NIL
2/38>

pamoroso · 2024-03-16T13:21:22Z

Chapter 9. Practical: Building a Unit Test Framework

I tested the code in chapter 9 of Seibel's book. Some of the expressions contain loop calls, so I loaded the experimental loop port of PR #1579. In addition I defined the with-gensyms macro of chapter 8 which is required too.

With these changes the code works as expected. It's a significant milestone in this series of compatibility tests because the code implements the first practical project of the book, a simple but useful application not designed just as an example for learning purposes.

2/6> (= (+ 1 2) 3)
T
2/7> 

2/7> (= (+ 1 2 3) 6)
T
2/8> 

2/8> (= (+ -1 -3) -4)
T
2/9> 

2/9> (defun test-+ ()
  (and
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -3) -4)))
TEST-+
2/10> 

2/10> (test-+)
T
2/11> 

2/11> (defun test-+ ()
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ 1 2) 3) '(= (+ 1 2) 3))
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ 1 2 3) 6) '(= (+ 1 2 3) 6))
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ -1 -3) -4) '(= (+ -1 -3) -4)))

New FUNCTIONS definition for TEST-+.
TEST-+
2/12> 

2/12> (test-+)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
pass ... (= (+ -1 -3) -4)
NIL
2/13> 

2/13> (defun report-result (result form)
  (format t "~:[FAIL~;pass~] ... ~a~%" result form))
REPORT-RESULT
2/14> 

2/14> (defun test-+ ()
  (report-result (= (+ 1 2) 3) '(= (+ 1 2) 3))
  (report-result (= (+ 1 2 3) 6) '(= (+ 1 2 3) 6))
  (report-result (= (+ -1 -3) -4) '(= (+ -1 -3) -4)))

New FUNCTIONS definition for TEST-+.
TEST-+
2/15> 

2/15> (test-+)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
pass ... (= (+ -1 -3) -4)
NIL
2/16> 

2/16> (defmacro check (form)
  `(report-result ,form ',form))
CHECK
2/17> 

2/17> (defun test-+ ()
  (check (= (+ 1 2) 3))
  (check (= (+ 1 2 3) 6))
  (check (= (+ -1 -3) -4)))

New FUNCTIONS definition for TEST-+.
TEST-+
2/18> 

2/18> (test-+)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
pass ... (= (+ -1 -3) -4)
NIL
2/19> 

2/19> (defmacro check (&body forms)
  `(progn
     ,@(loop for f in forms collect `(report-result ,f ',f))))

New FUNCTIONS definition for CHECK.
CHECK
2/20> 

2/20> (defun test-+ ()
  (check
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -3) -4)))

New FUNCTIONS definition for TEST-+.
TEST-+
2/21> 

2/21> (test-+)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
pass ... (= (+ -1 -3) -4)
NIL
2/22> 

2/22> (defun report-result (result form)
  (format t "~:[FAIL~;pass~] ... ~a~%" result form)
  result)

New FUNCTIONS definition for REPORT-RESULT.
REPORT-RESULT
2/23> 

2/23> (test-+)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
pass ... (= (+ -1 -3) -4)
T
2/24> 

2/24> (defmacro with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (gensym)))
     ,@body))
WITH-GENSYMS
2/25> 

2/25> (defmacro combine-results (&body forms)
  (with-gensyms (result)
    `(let ((,result t))
      ,@(loop for f in forms collect `(unless ,f (setf ,result nil)))
      ,result)))
COMBINE-RESULTS
2/26> 

2/26> (defmacro check (&body forms)
  `(combine-results
    ,@(loop for f in forms collect `(report-result ,f ',f))))

New FUNCTIONS definition for CHECK.
CHECK
2/27> 

2/27> (test-+)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
pass ... (= (+ -1 -3) -4)
T
2/28> 

2/28> (defun test-+ ()
  (check
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -3) -5)))

New FUNCTIONS definition for TEST-+.
TEST-+
2/29> 

2/29> (test-+)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
FAIL ... (= (+ -1 -3) -5)
NIL
2/30> 

2/30> (defun test-* ()
  (check
    (= (* 2 2) 4)
    (= (* 3 5) 15)))
TEST-*
2/31> 

2/31> (defun test-arithmetic ()
  (combine-results
   (test-+)
   (test-*)))
TEST-ARITHMETIC
2/32> 

2/32> (test-arithmetic)
pass ... (= (+ 1 2) 3)
pass ... (= (+ 1 2 3) 6)
FAIL ... (= (+ -1 -3) -5)
pass ... (= (* 2 2) 4)
pass ... (= (* 3 5) 15)
NIL
2/33> 

2/33> (defvar *test-name* nil)
*TEST-NAME*
2/34> 

2/34> (defun report-result (result form)
  (format t "~:[FAIL~;pass~] ... ~a: ~a~%" result *test-name* form)
  result)

New FUNCTIONS definition for REPORT-RESULT.
REPORT-RESULT
2/35> 

2/35> (test-arithmetic)
pass ... NIL: (= (+ 1 2) 3)
pass ... NIL: (= (+ 1 2 3) 6)
FAIL ... NIL: (= (+ -1 -3) -5)
pass ... NIL: (= (* 2 2) 4)
pass ... NIL: (= (* 3 5) 15)
NIL
2/36> 

2/36> (defun test-+ ()
  (let ((*test-name* 'test-+))
    (check
      (= (+ 1 2) 3)
      (= (+ 1 2 3) 6)
      (= (+ -1 -3) -4))))

New FUNCTIONS definition for TEST-+.
TEST-+
2/37> 

2/37> (defun test-* ()
  (let ((*test-name* 'test-*))
    (check
      (= (* 2 2) 4)
      (= (* 3 5) 15))))

New FUNCTIONS definition for TEST-*.
TEST-*
2/38> 

2/38> (test-arithmetic)
pass ... TEST-+: (= (+ 1 2) 3)
pass ... TEST-+: (= (+ 1 2 3) 6)
pass ... TEST-+: (= (+ -1 -3) -4)
pass ... TEST-*: (= (* 2 2) 4)
pass ... TEST-*: (= (* 3 5) 15)
T
2/39> 

2/39> (defmacro deftest (name parameters &body body)
  `(defun ,name ,parameters
    (let ((*test-name* ',name))
      ,@body)))
DEFTEST
2/40> 

2/40> (deftest test-+ ()
  (check
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -3) -4)))
TEST-+
2/41> 

2/41> (test-+)
pass ... TEST-+: (= (+ 1 2) 3)
pass ... TEST-+: (= (+ 1 2 3) 6)
pass ... TEST-+: (= (+ -1 -3) -4)
T
2/42> 

2/42> (deftest test-arithmetic ()
  (combine-results
   (test-+)
   (test-*)))

New FUNCTIONS definition for TEST-ARITHMETIC.
TEST-ARITHMETIC
2/43> 

2/43> (test-arithmetic)
pass ... TEST-+: (= (+ 1 2) 3)
pass ... TEST-+: (= (+ 1 2 3) 6)
pass ... TEST-+: (= (+ -1 -3) -4)
pass ... TEST-*: (= (* 2 2) 4)
pass ... TEST-*: (= (* 3 5) 15)
T
2/44> 

2/44> (deftest test-math ()
  (test-arithmetic))
TEST-MATH
2/45> 

2/45> (test-math)
pass ... TEST-+: (= (+ 1 2) 3)
pass ... TEST-+: (= (+ 1 2 3) 6)
pass ... TEST-+: (= (+ -1 -3) -4)
pass ... TEST-*: (= (* 2 2) 4)
pass ... TEST-*: (= (* 3 5) 15)
T
2/46>

pamoroso · 2024-03-16T13:47:29Z

Chapter 10. Numbers, Characters, and Strings

I tested the code of chapter 10 of Seibel's book, which involved adding just a couple of missing definitions. Evaluating the expressions at a XCL Exec works as expected:

2/6> 10
10
2/7> 
20/2
10
2/8> 
#xa
10
2/9> 
123
123
2/10> 
+123
123
2/11> 
-123
-123
2/12> 
123.
123
2/13> 
2/3
2/3
2/14> 
-2/3
-2/3
2/15> 
4/6
2/3
2/16> 
6/3
2
2/17> 
#b10101
21
2/18> 
#b1010/1011
10/11
2/19> 
#o777
511
2/20> 
#xDADA
56026
2/21> 
#36rABCDEFGHIJKLMNOPQRSTUVWXYZ
14157129052476716477680982259082647747323
2/22> 
1.0
1.0
2/23> 
1e0
1.0
2/24> 
1d0
1.0
2/25> 
123.0
123.0
2/26> 
123e0
123.0
2/27> 
0.123
0.123
2/28> 
.123
0.123
2/29> 
123e-3
0.123
2/30> 
123E-3
0.123
2/31> 
0.123e20
1.23E+19
2/32> 
123d23
1.23E+25
2/33> 
#c(2      1)

#C(2 1)
2/34> 
#c(2/3  3/4)

#C(2/3 3/4)
2/35> 
#c(2    1.0)

#C(2.0 1.0)
2/36> 
#c(2.0  1.0d0)

#C(2.0 1.0)
2/37> 
#c(1/2  1.0)

#C(0.5 1.0)
2/38> 
#c(3      0)

3
2/39> 
#c(3.0  0.0)

#C(3.0 0.0)
2/40> 
#c(1/2    0)

1/2
2/41> 
#c(-6/3   0)

-2
2/42> 
(+ 1 2)
3
2/43> 

2/43> (+ 1 2 3)
6
2/44> 

2/44> (+ 10.0 3.0)
13.0
2/45> 

2/45> (+ #c(1 2) #c(3 4))
#C(4 6)
2/46> 

2/46> (- 5 4)
1
2/47> 

2/47> (- 2)
-2
2/48> 

2/48> (- 10 3 5)
2
2/49> 

2/49> (* 2 3)
6
2/50> 

2/50> (* 2 3 4)
24
2/51> 

2/51> (/ 10 5)
2
2/52> 

2/52> (/ 10 5 2)
1
2/53> 

2/53> (/ 2 3)
2/3
2/54> 

2/54> (/ 4)
1/4
2/55> 

2/55> (+ 1 2.0)
3.0
2/56> 

2/56> (/ 2 3.0)
0.6666667
2/57> 

2/57> (+ #c(1 2) 3)
#C(4 2)
2/58> 

2/58> (+ #c(1 2) 3/2)
#C(5/2 2)
2/59> 

2/59> (+ #c(1 1) #c(2 -1))
3
2/60> 

2/60> (defvar x 5.82)
X
2/61> 

2/61> (defvar y 1.36)
Y
2/62> 

2/62> (+ (* (floor    (/ x y)) y) (mod x y))
5.82
2/63> 

2/63> (+ (* (truncate (/ x y)) y) (rem x y))
5.82
2/64> 

2/64> (incf x)
6.82
2/65> 

2/65> (decf x)
5.82
2/66> 

2/66> (incf x 10)
15.82
2/67> 

2/67> (decf x 10)
5.8199997
2/68> 

2/68> (= 1 1)
T
2/69> 

2/69> (= 10 20/2)
T
2/70> 

2/70> (= 1 1.0 #c(1.0 0.0) #c(1 0))
T
2/71> 

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

2/72> (/= 1 2)
T
2/73> 

2/73> (/= 1 2 3)
T
2/74> 

2/74> (/= 1 2 3 1)
NIL
2/75> 

2/75> (/= 1 2 3 1.0)
NIL
2/76> 

2/76> (< 2 3)
T
2/77> 

2/77> (> 2 3)
NIL
2/78> 

2/78> (> 3 2)
T
2/79> 

2/79> (< 2 3 4)
T
2/80> 

2/80> (< 2 3 3)
NIL
2/81> 

2/81> (<= 2 3 3)
T
2/82> 

2/82> (<= 2 3 3 4)
T
2/83> 

2/83> (<= 2 3 4 3)
NIL
2/84> 

2/84> (max 10 11)
11
2/85> 

2/85> (min -12 -10)
-12
2/86> 

2/86> (max -1 2 -3)
2
2/87> 

2/87> "foo\"bar"
"foo\"bar"
2/88> 
(format t "foo\"bar")
foo"bar
NIL
2/89> 

2/89> (string= "foobarbaz" "quuxbarfoo" :start1 3 :end1 6 :start2 4 :end2 7)
T
2/90> 

2/90> (string/= "lisp" "lissome")
3
2/91> 

2/91> (string< "lisp" "lisper")
4
2/92> 

2/92> (string< "foobar" "abaz" :start1 3 :start2 1)
5
2/93>

pamoroso · 2024-03-16T17:22:19Z

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 · 2024-03-17T10:29:24Z

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 · 2024-03-17T12:28:27Z

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 · 2024-03-17T17:44:42Z

(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 · 2024-03-18T12:59:18Z

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 · 2024-03-18T15:50:04Z

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 · 2024-03-18T21:26:39Z

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 · 2024-04-14T10:55:35Z

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

pamoroso · 2024-04-15T20:53:25Z

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

pamoroso · 2024-04-16T10:38:19Z

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

masinter added the Common Lisp label Dec 5, 2021

masinter mentioned this issue Dec 7, 2021

Want ANSI Common Lisp conformance #572

Open

masinter added good first issue Good for newcomers help wanted Extra attention is needed labels Dec 13, 2021

masinter removed the Common Lisp label Apr 5, 2023

masinter mentioned this issue Nov 23, 2023

Website "Get Involved" page update? #1431

Open

masinter mentioned this issue Mar 10, 2024

EOL behavior on copy-paste of multiple lines and and comments #1575

Open

pamoroso mentioned this issue Mar 16, 2024

import an LOOP macro #1579

Merged

This was referenced Mar 20, 2024

Missing pathnames features #1598

Open

Invalid expression error when passing vector to CL:COUNT #1603

Closed

Unprocessed form tail error from CL:LOOP #1614

Open

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

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

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

masinter commented Dec 5, 2021 •

edited

reflektoin commented Mar 4, 2022

masinter commented Mar 12, 2022

masinter commented Mar 12, 2022

reflektoin commented Mar 20, 2022

masinter commented Mar 24, 2022

reflektoin commented Mar 24, 2022

pamoroso commented Mar 9, 2024

pamoroso commented Mar 9, 2024

masinter commented Mar 9, 2024

pamoroso commented Mar 10, 2024

masinter commented Mar 10, 2024

pamoroso commented Mar 10, 2024

pamoroso commented Mar 11, 2024

pamoroso commented Mar 12, 2024

pamoroso commented Mar 13, 2024

pamoroso commented Mar 15, 2024

pamoroso commented Mar 16, 2024

pamoroso commented Mar 16, 2024

pamoroso commented Mar 16, 2024

pamoroso commented Mar 17, 2024

pamoroso commented Mar 17, 2024

masinter commented Mar 17, 2024

pamoroso commented Mar 18, 2024

masinter commented Mar 18, 2024

pamoroso commented Mar 18, 2024

pamoroso commented Apr 14, 2024

pamoroso commented Apr 15, 2024 •

edited

pamoroso commented Apr 16, 2024

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

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

Comments

masinter commented Dec 5, 2021 • edited

reflektoin commented Mar 4, 2022

masinter commented Mar 12, 2022

masinter commented Mar 12, 2022

reflektoin commented Mar 20, 2022

masinter commented Mar 24, 2022

reflektoin commented Mar 24, 2022

pamoroso commented Mar 9, 2024

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

Chapter 3. Practical: A Simple Database

pamoroso commented Mar 9, 2024

masinter commented Mar 9, 2024

pamoroso commented Mar 10, 2024

Chapter 4. Syntax and Semantics

masinter commented Mar 10, 2024

pamoroso commented Mar 10, 2024

pamoroso commented Mar 11, 2024

Chapter 5. Functions

pamoroso commented Mar 12, 2024

Chapter 6. Variables

pamoroso commented Mar 13, 2024

Chapter 7. Macros: Standard Control Constructs

pamoroso commented Mar 15, 2024

Chapter 8. Macros: Defining Your Own

pamoroso commented Mar 16, 2024

Chapter 9. Practical: Building a Unit Test Framework

pamoroso commented Mar 16, 2024

Chapter 10. Numbers, Characters, and Strings

pamoroso commented Mar 16, 2024

Chapter 11. Collections

pamoroso commented Mar 17, 2024

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

pamoroso commented Mar 17, 2024

Chapter 13. Beyond Lists: Other Uses for Cons Cells

masinter commented Mar 17, 2024

pamoroso commented Mar 18, 2024

Chapter 14. Files and File I/O

masinter commented Mar 18, 2024

pamoroso commented Mar 18, 2024

pamoroso commented Apr 14, 2024

pamoroso commented Apr 15, 2024 • edited

pamoroso commented Apr 16, 2024

masinter commented Dec 5, 2021 •

edited

pamoroso commented Apr 15, 2024 •

edited