Adding question-mark suffixed aliases for Common Lisp predicate functions

README.md

Blog 2021/12/12

<- previous | index | next ->

Adding question-mark suffixed aliases for Common Lisp predicate functions

Having come from Scheme, Clojure, and Janet, one of the things which struck me about Common Lisp is that most of the predicate functions have a p suffix, rather than a ? suffix (e.g. evenp rather than even?).

You can create an alias for a function like so:

(setf (fdefinition (quote even?)) (function evenp))

So I wrote a little Bash script which grabs the list of symbols from the Hyperspec, filters out just the predicate functions, and then code-gen's a Common Lisp file which creates aliases for all of them.

You can then load and use them:

$ clisp -i qmark.cl 
  i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo
  I I I I I I I      8     8   8           8     8     o  8    8
  I  \ `+' /  I      8         8           8     8        8    8
   \  `-+-'  /       8         8           8      ooooo   8oooo
    `-__|__-'        8         8           8           8  8
        |            8     o   8           8     o     8  8
  ------+------       ooooo    8oooooo  ooo8ooo   ooooo   8

Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2006

;; Loading file qmark.cl ...
;; Loaded file qmark.cl
[1]> (even? 2)
T

The script and the resulting Common Lisp file are attached.

codegen-qmark-cl.sh

#!/bin/bash

# Create aliases with a question-mark suffix for all Common Lisp predicate
# functions which end with a 'p' (e.g. evenp -> even?).

set -e
#set -x

cd /tmp

if ! test -e X_AllSym.htm ; then
    curl -O http://www.lispworks.com/documentation/HyperSpec/Front/X_AllSym.htm
fi

cat X_AllSym.htm \
    | grep '^<LI>' \
    | sed 's|.*<B>||' \
    | sed 's|</B>.*||' \
    > symbols.txt

cat symbols.txt \
    | grep 'p$' \
    | grep -v -e '^exp$' -e '^gentemp$' -e '^loop$' -e '^map$' \
    | grep -v -e '^next-method-p$' -e '^pop$' -e '^pprint-pop$' \
    | grep -v -e '^remprop$' -e '^sleep$' -e '^step$' -e '^vector-pop$' \
    > predicates.txt

rm -f qmark.cl
echo "; question-mark suffixed aliases for all 'p' predicate functions:" > qmark.cl
for pred in $(cat predicates.txt) ; do
    predq=$(echo $pred | sed 's|-p$|?|' | sed 's|p$|?|')
    echo "(setf (fdefinition (quote ${predq})) (function ${pred}))" >> qmark.cl
done

# extras:
echo "(setf (fdefinition (quote nil?)) (function null))" >> qmark.cl

cd - >/dev/null
mv /tmp/qmark.cl .

qmark.cl

; question-mark suffixed aliases for all 'p' predicate functions:
(setf (fdefinition (quote adjustable-array?)) (function adjustable-array-p))
(setf (fdefinition (quote alpha-char?)) (function alpha-char-p))
(setf (fdefinition (quote alphanumeric?)) (function alphanumericp))
(setf (fdefinition (quote array-has-fill-pointer?)) (function array-has-fill-pointer-p))
(setf (fdefinition (quote array-in-bounds?)) (function array-in-bounds-p))
(setf (fdefinition (quote array?)) (function arrayp))
(setf (fdefinition (quote bit-vector?)) (function bit-vector-p))
(setf (fdefinition (quote both-case?)) (function both-case-p))
(setf (fdefinition (quote bound?)) (function boundp))
(setf (fdefinition (quote char-greater?)) (function char-greaterp))
(setf (fdefinition (quote char-less?)) (function char-lessp))
(setf (fdefinition (quote char-not-greater?)) (function char-not-greaterp))
(setf (fdefinition (quote char-not-less?)) (function char-not-lessp))
(setf (fdefinition (quote character?)) (function characterp))
(setf (fdefinition (quote compiled-function?)) (function compiled-function-p))
(setf (fdefinition (quote complex?)) (function complexp))
(setf (fdefinition (quote cons?)) (function consp))
(setf (fdefinition (quote constant?)) (function constantp))
(setf (fdefinition (quote digit-char?)) (function digit-char-p))
(setf (fdefinition (quote end?)) (function endp))
(setf (fdefinition (quote equal?)) (function equalp))
(setf (fdefinition (quote even?)) (function evenp))
(setf (fdefinition (quote fbound?)) (function fboundp))
(setf (fdefinition (quote float?)) (function floatp))
(setf (fdefinition (quote function?)) (function functionp))
(setf (fdefinition (quote graphic-char?)) (function graphic-char-p))
(setf (fdefinition (quote hash-table?)) (function hash-table-p))
(setf (fdefinition (quote input-stream?)) (function input-stream-p))
(setf (fdefinition (quote integer?)) (function integerp))
(setf (fdefinition (quote interactive-stream?)) (function interactive-stream-p))
(setf (fdefinition (quote keyword?)) (function keywordp))
(setf (fdefinition (quote list?)) (function listp))
(setf (fdefinition (quote logbit?)) (function logbitp))
(setf (fdefinition (quote lower-case?)) (function lower-case-p))
(setf (fdefinition (quote minus?)) (function minusp))
(setf (fdefinition (quote number?)) (function numberp))
(setf (fdefinition (quote odd?)) (function oddp))
(setf (fdefinition (quote open-stream?)) (function open-stream-p))
(setf (fdefinition (quote output-stream?)) (function output-stream-p))
(setf (fdefinition (quote package?)) (function packagep))
(setf (fdefinition (quote pathname-match?)) (function pathname-match-p))
(setf (fdefinition (quote pathname?)) (function pathnamep))
(setf (fdefinition (quote plus?)) (function plusp))
(setf (fdefinition (quote random-state?)) (function random-state-p))
(setf (fdefinition (quote rational?)) (function rationalp))
(setf (fdefinition (quote readtable?)) (function readtablep))
(setf (fdefinition (quote real?)) (function realp))
(setf (fdefinition (quote simple-bit-vector?)) (function simple-bit-vector-p))
(setf (fdefinition (quote simple-string?)) (function simple-string-p))
(setf (fdefinition (quote simple-vector?)) (function simple-vector-p))
(setf (fdefinition (quote slot-bound?)) (function slot-boundp))
(setf (fdefinition (quote slot-exists?)) (function slot-exists-p))
(setf (fdefinition (quote special-operator?)) (function special-operator-p))
(setf (fdefinition (quote standard-char?)) (function standard-char-p))
(setf (fdefinition (quote stream?)) (function streamp))
(setf (fdefinition (quote string-greater?)) (function string-greaterp))
(setf (fdefinition (quote string-less?)) (function string-lessp))
(setf (fdefinition (quote string-not-greater?)) (function string-not-greaterp))
(setf (fdefinition (quote string-not-less?)) (function string-not-lessp))
(setf (fdefinition (quote string?)) (function stringp))
(setf (fdefinition (quote subset?)) (function subsetp))
(setf (fdefinition (quote subtype?)) (function subtypep))
(setf (fdefinition (quote symbol?)) (function symbolp))
(setf (fdefinition (quote tail?)) (function tailp))
(setf (fdefinition (quote type?)) (function typep))
(setf (fdefinition (quote upper-case?)) (function upper-case-p))
(setf (fdefinition (quote vector?)) (function vectorp))
(setf (fdefinition (quote wild-pathname?)) (function wild-pathname-p))
(setf (fdefinition (quote y-or-n?)) (function y-or-n-p))
(setf (fdefinition (quote yes-or-no?)) (function yes-or-no-p))
(setf (fdefinition (quote zero?)) (function zerop))
(setf (fdefinition (quote nil?)) (function null))