close

#CommonLisp #Lisp #Tip

Sometimes you need to do something only if control in your code zips by so fast that you cannot grab it... and you do not really care if goes by slowly. Like, you know, when you are suspicious that it would be doing something funky rather than going by and doing its business.

In other words, sometimes you are in need of detecting non-local exits from a block of code while ignoring normal returns.

There's an idiom for that - using LET over UNWIND-PROTECT.

;;; © Michał "THEN PAY WITH YOUR BLOOD" Herda 2022

(defun oblivion (thunk)
  (let ((successfulp nil))
    (unwind-protect (multiple-value-prog1 (funcall thunk)
                      (setf successfulp t))
      (unless successfulp
        (error "STOP RIGHT THERE CRIMINAL SCUM")))))

CL-USER> (oblivion (lambda () (+ 2 2)))
4

CL-USER> (block nil (oblivion (lambda () (return-from nil 42))))
;;; Error: STOP RIGHT THERE CRIMINAL SCUM
;;;     [Condition of type SIMPLE-ERROR]

The explanation is simple: we bind a variable with a default value which assumes that there was a non-local exit.

Then we execute our block of code in an UNWIND-PROTECT, and only after it executes successfully we set that value again to denote that running our code succeeded and we are ready to return its values.

The cleanup forms of the UNWIND-PROTECT are conditionalized on the same variable and will only trigger if the SETF SUCCESSFULP T did not execute - and that only happens if there was a non-local exit that prevented it from occurring.


In fact, there's an Alexandria utility that does just that! The macro ALEXANDRIA:UNWIND-PROTECT-CASE is capable of supporting this behavior.

;;; (ql:quickload :alexandria)

(catch 'foo
  (alexandria:unwind-protect-case ()
      (throw 'foo 1)
    (:abort (format t "ABORTED"))))

Thanks to Stelian Ionescu for the heads-up!

#CommonLisp #Lisp

I wrote a kinda-long post in which:

  • I try to give an overview of how I perceive the current troublesome situation regarding ASDF and SBCL and everyone and everything else,
  • I try to brainstorm and describe some ways forward and out of this impasse.

Because of its length (and because of current Movim technical issues wrt rendering Markdown and Common Lisp), it's on its own separate page. You can read it here.

#CommonLisp #Lisp

> Let us say, for the sake of simplicity, a fence or gate erected across a road. The more modern type of reformer goes gaily up to it and says, 'I don't see the use of this; let us clear it away.' To which the more intelligent type of reformer will do well to answer: 'If you don't see the use of it, I certainly won't let you clear it away. Go away and think. Then, when you can come back and tell me that you do see the use of it, I may allow you to destroy it.' > > -- Wikipedia - Chesterton's fence

Advertisement time

UIOP:DEFINE-PACKAGE is the part of UIOP that I personally use the most - it fills (IMO) the biggest hole in the Common Lisp package system, which is CLHS Macro DEFPACKAGE saying:

> If the new definition is at variance with the current state of that package, the consequences are undefined; (...)

This means that removing an export from a DEFPACKAGE can cause your implementation to wag a finger at you, and also ignore your attempt at removing it.

CL-USER> (defpackage #:foo (:use) (:export #:bar))
#<PACKAGE "FOO">

CL-USER> (defpackage #:foo (:use) (:export))
;; WARNING: FOO also exports the following symbols:
;;   (FOO:BAR)
;; See also:
;;   The ANSI Standard, Macro DEFPACKAGE
;;   The SBCL Manual, Variable *ON-PACKAGE-VARIANCE*
#<PACKAGE "FOO">

CL-USER> (loop for sym being the external-symbols of :foo 
               collect sym)
(FOO:BAR)

The solution is to manually call UNEXPORT on FOO::BAR, at which point SBCL will calm down and let you evaluate the second DEFPACKAGE form in peace.

DEFINE-PACKAGE, in the same situation, will do "the right thing" (read: the thing I personally expect it to) and adjust the package's export list to be consistent with the one provided to it.

CL-USER> (uiop:define-package #:foo (:use) (:export #:bar))
#<PACKAGE "FOO">

CL-USER> (uiop:define-package #:foo (:use) (:export))
#<PACKAGE "FOO">

CL-USER> (loop for sym being the external-symbols of :foo 
               collect sym)
NIL

There's plenty of other useful options, such as :MIX, :REEXPORT and all, but there's one of them that looks... A bit off.

Mystery time

The option :UNINTERN is specified to call CL:UNINTERN on some symbols when the package is defined.

Hold up, wait a second, though. Uninterning symbols? During package definition?

When a package is defined for the first time, there are no symbols to unintern. This means that this option is only useful when a package already exists, and therefore UIOP:DEFINE-PACKAGE is used to redefine it.

This, and uninterning cannot be used to achieve "partial :use", that is, to remove symbols from packages that are :used in the current package in order to only "use a part of" this other package. That simply isn't doable in Common Lisp - :use imports all of the symbols exported by another package, except those that are explicitly :shadowed.

So, again, what's the point? Scroll down only if you'd like the mystery to be spoiled to you.


Story time

Let's assume a very simple situation:

(defpackage #:bar
  (:use)
  (:export #:symbol))

We have a single package which exports a single symbol. That package was created by some software which we use, and the symbol BAR:SYMBOL is useful to us in some way.

And then, while our Lisp image is still running, we'd like to upgrade this software to a new version. That is, we'd like to load a new version of that software and disregard the old one. In the new version of our software, the package structure looks like this:

(defpackage #:foo
  (:use)
  (:export #:symbol))

(defpackage #:bar
  (:use #:foo)
  (:export #:symbol))

It seems that the symbol named SYMBOL was moved into another package, possibly because that is where the implementation of that symbol has been moved to. Oh well, looks understandable from a software architecture point of view!

...and then trying to load the upgraded version will fail at the very beginning. Worse - it might fail, since we have just stepped into undefined behavior area, as stated in the beginning of this post.

In particular, DEFPACKAGE FOO will be evaluated without any problem, but a keen eye will notice an error which will be signaled the moment we evaluate DEFPACKAGE BAR. The currently existing package contains its own version of the symbol named SYMBOL, whereas the new requirement is to :USE the package FOO, which has its own symbol named SYMBOL - a classic package name conflict.

What is the producer of this piece of software to do now in order to ensure a smooth transition?

One way forward is to DELETE-PACKAGE before moving on with the upgrade, but that's pretty explosive - if BAR exported any other symbols, naming e.g. class definitions, then this means trouble for us. Another way forward is to manually call UNINTERN before calling DEFPACKAGE, but only if the package already exists - and that is a little bit messy.

And this is exactly the problem that is meant to be solved by UIOP:DEFINE-PACKAGE. In particular, this utility is capable of automatically changing the structure of the underlying package to resolve conflicts in favor of the newly added symbols. We can simply use it as a drop-in replacement for DEFPACKAGE, like this:

(defpackage #:foo
  (:use)
  (:export #:symbol))

(uiop:define-package #:bar
  (:use #:foo)
  (:export #:symbol))

That change allows this code to compile and load without errors. In particular, we can verify that BAR:SYMBOL correctly resolves to the new symbol from package FOO:

CL-USER> 'bar:symbol
FOO:SYMBOL

So, that's one upgrading problem less, solved by using UIOP:DEFINE-PACKAGE instead of DEFPACKAGE.

...but, uh, what about DEFINE-PACKAGE :UNINTERN? That's still not the end of the story.

Edge case time

Let us assume that you are the developer of Lisp software who is working on it and you are testing the scenario in which you upgrade one version of software to another. The technique described above works well with regard to upgrading software, but let's say that your package definition looked like this:

(defpackage #:foo
  (:use)
  (:intern #:some #:totally-random #:stuff))

And you want to replace it with the following:

(uiop:define-package #:foo
  (:use)
  (:intern #:some #:totally-randomized #:stuff))

The explanation is that TOTALLY-RANDOM was a symbol that was useful (and used) in the previous version of software, but the new version uses something better, which also has a better name - TOTALLY-RANDOMIZED.

And all is fine and well, until you go into your REPL and see this:

image1.png

The syntax completion is suggesting the old symbol even though it no longer bears any meaning. It means that you, as the programmer, need to hit the key to navigate downwards and select the proper symbol, which can annoy you to no avail. That's a pet peeve.

But it also means that you have the possibility of introducing bugs into the system by using the old version of a function - or, worse, breaking the build by using a symbol that is only present on systems upgraded from the old version and not ones which had the new version loaded start from scratch.

That's actually scary.

And that's the concrete edge case solved by :UNINTERN!

(uiop:define-package #:foo
  (:use)
  (:intern #:totally-randomized)
  (:unintern #:totally-random))

Using this fixes the syntax completion:

image2.png

Evaluating this :UNINTERN option inside DEFINE-PACKAGE will either be a no-op (if the symbol doesn't exist, e.g. when defining the package from scratch) or automatically unintern the old symbol from the system (if it exists, e.g. when upgrading the package to a newer version).

In particular, the second option will happen even if the current shape of the source code no longer has any other mentions of it and even if this :UNINTERN call seems to make no sense.

In this context, :UNINTERN is something protecting the programmer from a danger that may no longer be relevant for current versions of the software, but was once something that the programmer considered important enough to remove during a software upgrade. This :UNINTERN should stay in the source code for however long it is supported to make upgrades from the versions of software which still used this symbol to the current version.

Hell of an edge case, eh? As always, it's an edge case until you hit it and need a tool for solving it - and :UNINTERN fits that description pretty damn well.

And let's not think about the scenario where your software needs to reintroduce that symbol later on, possibly for different purposes... and support all the upgrade paths along the way.


This, and I heard that it's useful when developing, especially with one-package-per-file style (which also includes ASDF's package-inferred systems); I heard that it's more convenient to jump to the top of the file, add a (:UNINTERN #:FOO) clause to the UIOP:DEFINE-PACKAGE there, reevaluate the form, remove the clause, and keep on hacking, rather than change Emacs buffers in order to jump into the REPL and evaluate a (UNINTERN '#:FOO) form there.

Personally, though, I don't share the sentiment - I can use C-↓ or C-↑ anywhere in the file to go out of whatever form my cursor is in, write a (UNINTERN '#:FOO), C-c C-c that form to get Slime to evaluate it, and then delete the form and continue hacking.

Conclusion

UIOP:DEFINE-PACKAGE's :UNINTERN option is useful in the rare and obscure situations when all of the following are true:

  • you are hot-patching an existing Lisp image and do not want to restart it,
  • you need to redefine a package (possibly as a part of a software upgrade),
  • you need to ensure that, after such a redefinition, a symbol with a given name is not internal in a given package.

This is useful e.g. for avoiding invalid syntax completions inside your Lisp image.

Thanks

Thanks to Robert Goldman and Phoebe Goldman for helping me solve the mystery of :UNINTERN.

Thanks to Francis St-Amour for his long and painful review of this post.

Thanks to Catie from #lispcafe on Libera Chat and Gnuxie for shorter, less painful reviews of this post.

#CommonLisp #Lisp

Let's consider the following function:

(defun make-adder (x huge-p)
  (lambda (y) (+ x y (if huge-p 1000 0))))

The result of calling (MAKE-ADDER 10) closes over HUGE-P and makes a runtime check for its value.

CL-USER> (disassemble (make-adder 10 nil))
; disassembly for (LAMBDA (Y) :IN MAKE-ADDER)
; Size: 65 bytes. Origin: #x53730938                          ; (LAMBDA (Y) :IN MAKE-ADDER)
; 38:       488975F8         MOV [RBP-8], RSI
; 3C:       488BD3           MOV RDX, RBX
; 3F:       E8EC012DFF       CALL #x52A00B30                  ; GENERIC-+
; 44:       488B75F8         MOV RSI, [RBP-8]
; 48:       4881FE17011050   CMP RSI, #x50100117              ; NIL
; 4F:       BFD0070000       MOV EDI, 2000
; 54:       B800000000       MOV EAX, 0
; 59:       480F44F8         CMOVEQ RDI, RAX
; 5D:       E8CE012DFF       CALL #x52A00B30                  ; GENERIC-+
; 62:       488BE5           MOV RSP, RBP
; 65:       F8               CLC
; 66:       5D               POP RBP
; 67:       C3               RET
; 68:       CC10             INT3 16                          ; Invalid argument count trap
; 6A:       6A20             PUSH 32
; 6C:       E8FFFA2CFF       CALL #x52A00470                  ; ALLOC-TRAMP
; 71:       5B               POP RBX
; 72:       E958FFFFFF       JMP #x537308CF
; 77:       CC10             INT3 16                          ; Invalid argument count trap
NIL

It would be better for performance if the test was only made once, in MAKE-ADDER, rather than on every call of the adder closure. MAKE-ADDER could then return one of two functions depending on whether the check succeeds.

(defun make-adder (x huge-p)
  (if huge-p
      (lambda (y) (+ x y 1000))
      (lambda (y) (+ x y 0))))

A brief look at the disassembly of this fixed version shows us that we're right:

CL-USER> (disassemble (make-adder 10 nil))
; disassembly for (LAMBDA (Y) :IN MAKE-ADDER)
; Size: 21 bytes. Origin: #x53730BC7                          ; (LAMBDA (Y) :IN MAKE-ADDER)
; C7:       488BD1           MOV RDX, RCX
; CA:       E861FF2CFF       CALL #x52A00B30                  ; GENERIC-+
; CF:       31FF             XOR EDI, EDI
; D1:       E85AFF2CFF       CALL #x52A00B30                  ; GENERIC-+
; D6:       488BE5           MOV RSP, RBP
; D9:       F8               CLC
; DA:       5D               POP RBP
; DB:       C3               RET
NIL

Still, with more flags than one, this style of writing code is likely to become unwieldy. For three flags, we would need to write something like this for the runtime version:

(defun make-adder (x huge-p enormous-p humongous-p)
  (lambda (y) (+ x y
                 (if huge-p 1000 0)
                 (if enormous-p 2000 0)
                 (if humongous-p 3000 0))))

But it would look like this for the macroexpand-time version:

(defun make-adder (x huge-p enormous-p humongous-p)
  (if huge-p
      (if enormous-p
          (if humongous-p
              (lambda (y) (+ x y 1000 2000 3000))
              (lambda (y) (+ x y 1000 2000 0)))
          (if humongous-p
              (lambda (y) (+ x y 1000 0 3000))
              (lambda (y) (+ x y 1000 0 0))))
      (if enormous-p
          (if humongous-p
              (lambda (y) (+ x y 0 2000 3000))
              (lambda (y) (+ x y 0 2000 0)))
          (if humongous-p
              (lambda (y) (+ x y 0 0 3000))
              (lambda (y) (+ x y 0 0 0))))))

The total number of combinations for n boolean flags is 2^n, making it hard to write and maintain code with so many branches. This is where WITH-MACROEXPAND-TIME-BRANCHING comes into play. Using it, we can write our code in a way that looks similar to the runtime-check version:

(defun make-adder (x huge-p enormous-p humongous-p)
  (with-macroexpand-time-branching (huge-p enormous-p humongous-p)
    (lambda (y) (+ x y
                   (macroexpand-time-if huge-p 1000 0)
                   (macroexpand-time-if enormous-p 2000 0)
                   (macroexpand-time-if humongous-p 3000 0)))))

This code gives us the clarity of runtime-checked version and the performance of a macroexpand-time-checked version. A total of eight versions of the body (and therefore, eight possible LAMBDA forms) are generated. At runtime, only one of them is selected, based on the boolean values of the three flags we provided.

Three conditional operators are provided - MACROEXPAND-TIME-IF, MACROEXPAND-TIME-WHEN, and MACROEXPAND-TIME-UNLESS, mimicking the syntax of, respectively, IF, WHEN, and UNLESS.

It is possible to use the variable *MACROEXPAND-TIME-BRANCH-BYPASS* for bypassing macroexpand-time branching; this is useful e.g. when trying to read the macroexpansions or when debugging. If that variable is set to true, the behavior of the macroexpander is modified:

  • WITH-MACROEXPAND-TIME-BRANCHING expands into a PROGN form,
  • MACROEXPAND-TIME-IF expands into an IF form,
  • MACROEXPAND-TIME-WHEN expands into a WHEN form,
  • MACROEXPAND-TIME-UNLESS expands into an UNLESS form.

Trying to use MACROEXPAND-TIME-IF, MACROEXPAND-TIME-WHEN, or MACROEXPAND-TIME-UNLESS outside the lexical environment established by WITH-MACROEXPAND-TIME-BRANCHES will signal a PROGRAM-ERROR.

Trying to use a branch name MACROEXPAND-TIME-IF, MACROEXPAND-TIME-WHEN, or MACROEXPAND-TIME-UNLESS that wasn't declared in WITH-MACROEXPAND-TIME-BRANCHES will signal a PROGRAM-ERROR.


Grab the code from GitHub.

#CommonLisp #Lisp

Someone noted that they'd like a stream that can append to an existing stream with a fill pointer, like the stream that with-output-to-string can produce, except with indefinite extent. A little bit of Lisp hackery produced something that seems to work, even if greatly untested (yet).

;;; A fill pointer output stream with indefinite extent

(defclass fill-pointer-output-stream
    (trivial-gray-streams:fundamental-character-output-stream)
  ((string :accessor fill-pointer-output-stream-string :initarg :string))
  (:default-initargs :string (a:required-argument :string)))

(defmethod trivial-gray-streams:stream-line-column
    ((stream fill-pointer-output-stream)))

(defmethod trivial-gray-streams:stream-start-line-p
    ((stream fill-pointer-output-stream)))

(defmethod trivial-gray-streams:stream-write-char
    ((stream fill-pointer-output-stream) char)
  (vector-push-extend char (fill-pointer-output-stream-string stream)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

CL-USER> (let* ((string (make-array 0 :element-type 'character :fill-pointer 0))
                (stream (make-instance 'fill-pointer-output-stream :string string)))
           (write-string "asdf" stream)
           (close stream)
           string)
"asdf"

Because of the upheaval at Freenode, I've migrated to Libera Chat along with a bunch of other Lisp programmers. We have used that as a chance to make some small changes to the channel structure:

  • #commonlisp is the on-topic Common Lisp channel (formerly #lisp),
  • #lisp is the somewhat on-topic discussion about all Lisp dialects (formerly ##lisp),
  • the rest of the channel names should work the same.

The first two lines of the above were mentioned because #lisp on Freenode used to have a non-trivial volume of people asking questions about Scheme or Emacs Lisp due to the too-generic channel name. Naming the Common Lisp channel #commonlisp resolves this issue, at the cost of sacrificing a lucrative and attractive five-character channel name.

#Lisp #CommonLisp

;;;; License: don't use this at home

(defmacro defnth (n)
  (let ((var (gensym "LIST"))
        (name (intern (substitute #\- #\Space (format nil "~:@(~:R~)" n)))))
    `(defun ,name (,var) (nth (1- ,n) ,var))))

CL-USER> (defnth 1234)
ONE-THOUSAND-TWO-HUNDRED-THIRTY-FOURTH

CL-USER> (one-thousand-two-hundred-thirty-fourth (loop for i from 1 below 2000 collect i))
1234

#CommonLisp #Lisp

Joram Schrijver, known as mood on Freenode, has implemented package-local nicknames on CLISP.

If anyone is anyhow familiar with the CLISP codebase and is capable of reviewing that merge request, please review it - it is an important last step in pushing support for package-local nicknames across all of the Common Lisp ecosystem. (They are already supported by SBCL, CCL, ECL, Clasp, ABCL, ACL, and will be supported in LispWorks 7.2)