29 May 2020

feedPlanet Lisp

Alexander Artemenko: data-table

This library provides a few methods to work with data tables. Think about it as a limited version of Pandas Dataframe for Common Lisp.

Data-table abilities are really modest. For example, it does not provide methods to investigate data in the table.

To overcome this limitation, we'll use another library - cl-ascii-table and define a describe-object method for data tables:

POFTHEDAY> (defparameter *dt*
             (make-instance 'data-table:data-table
                            :column-names '("Name" "Birthday" "Age")
                            :rows '(("Bob" "1985-05-17" 35)
                                    ("Alice" "1989-02-23" 31)
                                    ("John" "2000-01-03" 20))))

;; This is what we'll wee by default:
POFTHEDAY> (describe *dt*)

Slots with :INSTANCE allocation:
  COLUMN-NAMES                   = ("Name" "Birthday" "Age")
  COLUMN-TYPES                   = (STRING STRING (INTEGER 0 4611686018427387903))
  ROWS                           = (("Bob" "1985-05-17" 35) ("Alice" "1989-02-23" 31))

;; But with custom method we might make it more
;; more convenient:
POFTHEDAY> (defmethod describe-object ((obj data-table:data-table) stream)
             (loop with table = (ascii-table:make-table
                                 (data-table:column-names obj))
                   for row in (data-table:rows obj)
                   do (ascii-table:add-row table row)
                   finally (ascii-table:display table)))

POFTHEDAY> (describe *dt*)
| Name  | Birthday   | Age |
| Bob   | 1985-05-17 |  35 |
| Alice | 1989-02-23 |  31 |
| John  | 2000-01-03 |  20 |

Now let's see what capabilities for data slicing does it have.

Here is how we can retrieve columns. Pay attention, column names are case insensitive. But if case mismatch, column names of the resulting table will be different. Maybe this is a bug:

POFTHEDAY> (describe
            (data-table:select-columns *dt*
                                       '("Name" "Age")))
| Name  | Age |
| Bob   |  35 |
| Alice |  31 |
| John  |  20 |
; No values
POFTHEDAY> (describe
            (data-table:select-columns *dt*
                                       '("name" "age")))
| name  | age |
| Bob   |  35 |
| Alice |  31 |
| John  |  20 |

There is also a way to select a subtable using indices.

This is how we can select contiguous columns with "Name" and "Age" labels:

;; We have to do call this method first.
;; It will fill a list of datatypes.
;; Without filled list of datatypes, make-sub-table will fail :(

POFTHEDAY> (data-table:coerce-data-table-of-strings-to-types *dt*)

POFTHEDAY> (describe
            (data-table:make-sub-table *dt*
                                       :lci 1 :uci 3))
| Birthday   | Age |
| 1985-05-17 |  35 |
| 1989-02-23 |  31 |
| 2000-01-03 |  20 |

If we want to select only the last two rows, then we have to do some math:

;; In pandas.DataFrame this will be just: dt.tail(2)
POFTHEDAY> (let ((rows-count (data-table:number-of-rows *dt*)))
              (data-table:make-sub-table *dt*
                                         :lri (- rows-count 2)
                                         :uri rows-count)))
| Name  | Birthday   | Age |
| Alice | 1989-02-23 |  31 |
| John  | 2000-01-03 |  20 |

Also, we can combine column selection by name with make-sub-table. But this will create an intermediate table.

There is also a method overlay-region to combine two tables. Let's use it to add email for Genry and Mary:

POFTHEDAY> (defparameter *dt*
              '((:id 1 :name "Bob")
                (:id 2 :name "Genry")
                (:id 3 :name "Mary"))))

POFTHEDAY> (describe *dt*)
| ID | NAME  |
|  1 | Bob   |
|  2 | Genry |
|  3 | Mary  |

POFTHEDAY> (data-table:overlay-region
             '((:email "genry@gmail.com")
               (:email "mary@hormail.com")))

POFTHEDAY> (describe *dt*)
| ID               | NAME  |
| genry@gmail.com  | Bob   |
| mary@hormail.com | Genry |
|                3 | Mary  |

POFTHEDAY> ;; Oh, this method modified the original table :(((

To fix the issue, we need to recreate an original table and to specify indexes for applied overlay:

POFTHEDAY> (defparameter *dt*
              '((:id 1 :name "Bob")
                (:id 2 :name "Genry")
                (:id 3 :name "Mary"))))

POFTHEDAY> (data-table:overlay-region
             '((:email "genry@gmail.com")
               (:email "mary@hormail.com")))
            :col-idx 2
            :row-idx 1)

;; But new column has no name now :(
POFTHEDAY> (describe *dt*)
| ID | NAME  | NIL              |
|  1 | Bob   | NIL              |
|  2 | Genry | genry@gmail.com  |
|  3 | Mary  | mary@hormail.com |

It would be nice to have support for indices and joins like in Pandas. That is what I expect from the data manipulation library.

We've viewed almost all core functions of the data-table library. There are also data coercion and comparison functions. But I think this library has lots of room for improvement.

Maybe @guicho271828 has plans to build a dataframe library as supplementary to his NumCL?

29 May 2020 12:15am GMT

27 May 2020

feedPlanet Lisp

Alexander Artemenko: cl-ppcre-unicode

This system adds Unicode support to the cl-ppcre.

What does it mean? It means that after loading cl-ppcre-unicode you'll be able to match against Unicode symbol properties.

A property matcher has a special syntax in cl-ppcre's regexps: \p{PropertyName}.

Here is an example:

;; This is how we can find out a position
;; of the first Cyrillic letter:

POFTHEDAY> (ppcre:scan "\\p{Cyrillic}"

;; Here we are extracting a
;; sequence of Emoji from the text:
POFTHEDAY> (ppcre:regex-replace
            ".*?([\\p{Emoticons}|\\p{Supplemental Symbols and Pictographs}]+).*"
            "Hello, Lisper! 🤗😃 How are you?"

We are using two different Unicode classes as properties because these two characters belong to different classes.

You can use cl-unicode to discover the character's unicode class:

POFTHEDAY> (cl-unicode:code-block #\😃)

POFTHEDAY> (cl-unicode:code-block #\🤗)
"Supplemental Symbols and Pictographs"

The way, how cl-ppcre-unicode works is very interesting. It turns out that cl-ppcre has a special hook which allows you to define a property resolver.

For example, if you want to have a special property for vowels, you might do something like that:

POFTHEDAY> (defun my-property-resolver (property-name)
             (if (string-equal property-name
                 (rutils:fn vovel-p (character)
                   (member character '(#\A #\E #\I #\O #\U)
                           :test #'char-equal))

POFTHEDAY> (setf cl-ppcre:*property-resolver*

;; And now we can use the "Vowel" property in any
;; regular expressions!
POFTHEDAY> (ppcre:regex-replace-all
            "Hello, Lisper! How are you?"
"Hll, Lspr! Hw r y?"

Isn't this cool!? 🤪

27 May 2020 8:15pm GMT

26 May 2020

feedPlanet Lisp

Alexander Artemenko: jose

JOSE is an implementation of Javascript Object Signing and Encryption.

This @nitro_idiot's library implements a JSON Web Signature and allows to encode, decode and inspect JWT tokens.

JOSE can be useful to implement signed token exchange between microservices.

I found a great article on what JWT, JWS and JWE are. Read it you want more about them. To demonstrate, how does token inspection work, I took a JWT token from the article and parsed it with Common Lisp JOSE:

POFTHEDAY> (jose/jwt:inspect-token

(("exp" . 1401912171) ("iat" . 1401908271) ("hd" . "wso2.com")
  . "825249835659-te8qgl701kgonnomnp4sqv7erhu1211s.apps.googleusercontent.com")
 ("email_verified" . T) ("at_hash" . "zf86vNulsLB8gFaqRwdzYg")
 ("email" . "prabath@wso2.com")
  . "825249835659-te8qgl701kgonnomnp4sqv7erhu1211s.apps.googleusercontent.com")
 ("sub" . "110502251158920147732") ("iss" . "accounts.google.com"))

(("alg" . "RS256") ("kid" . "78b4cf23656dc395364f1b6c02907691f2cdffe1"))

#(77 82 175 250 151 114 190 77 160 91 203 6 176 38 236 158 74 172 173 45 19 248
  125 52 198 118 58 17 57 8 126 2 49 126 139 111 22 126 72 192 169 183 199 32
  76 167 45 5 21 237 17 111 145 237 240 1 9 87 163 221 91 44 115 242 179 32 95
  97 209 57 106 146 163 244 95 17 245 41 5 190 34 58 202 184 91 111 10 126 213
  185 31 66 0 227 133 102 53 158 179 83 134 19 168 244 173 225 51 225 200 80
  189 124 253 131 252 120 59 37 10 51 165 4 84 125 181 147 36)

Inspect returns payload, headers and the signature.

There are also two methods encode and decode. Here is how we can use them to issue and verify JWT token:

POFTHEDAY> (defparameter
               *secret* (ironclad:ascii-string-to-byte-array
                         "I Love Common Lisp!"))

POFTHEDAY> (defparameter
             (jose:encode :hs256 *secret*
                          '(("user"  . "Bob")
                            ("email" . "bob@gmail.com"))))

;; Now this token can be sent to the authenticated
;; user so that user can pass it back during API calls:
POFTHEDAY> *token*

;; And when we'll receive such API call,
;; we can know who this user is.
POFTHEDAY> (jose:decode :hs256 *secret*
(("user" . "Bob") ("email" . "bob@gmail.com"))
(("alg" . "HS256") ("typ" . "JWT"))

A cool feature of JWT token is that it is signed and you can trust the payload's content. Let's pretend, that Bob is the "evil hacker" who wants to get access to another account.

To do this, Bob will modify payload and use header and sign from the original token:

POFTHEDAY> (defun replace-payload (token new-payload)
             (rutils:with (((original-header rutils:_ original-sign)
                            (str:split "." token))
                            (jonathan:to-json new-payload :from :alist))
                            (jose/base64:base64url-encode json-payload)))
               (str:join "."
                         (list original-header

POFTHEDAY> (defparameter *new-token*
             (replace-payload *token*
                              '(("user"  . "Alice")
                                ("email" . "alice@wonderland.in"))))

;; Now we'll try to decode token on the server-side
;; and receive error from JOSE:
POFTHEDAY> (jose:decode :hs256 *secret*
; Debugger entered on #<JOSE/ERRORS:JWS-VERIFICATION-ERROR {1005C37033}>
; Evaluation aborted on #<JOSE/ERRORS:JWS-VERIFICATION-ERROR {1005C37033}>

;; But we still can inspect bad token because
;; it's content is not encrypted:
POFTHEDAY> (jose:inspect-token *new-token*)

(("email" . "alice@wonderland.in") ("user" . "Alice"))

(("alg" . "HS256") ("typ" . "JWT"))

#(52 184 32 229 28 101 40 51 106 195 87 42 21 77 63 31 43 8 187 236 206 236 144
  88 81 3 118 33 145 122 115 172)

BTW, as you can see, tokens are not encoded, they are signed. Because of that, you should pass them only over encrypted channels.

26 May 2020 8:15pm GMT

25 May 2020

feedPlanet Lisp

Alexander Artemenko: cl-collider

This library is an interface to a very interesting algorithmic audio synthesizer - SuperCollider. SuperCollider itself has a builtin programming language, but cl-collider makes it possible to write music in lisp interactively.

Here is how a simple program in sclang looks like:

// 60Hz Gabber Rave 1995

SynthDef(\gabberkick, {
    var snd, freq, high, lfo;
    freq = \freq.kr(440) * (Env.perc(0.001, 0.08, curve: -1).ar * 48 * \bend.kr(1)).midiratio;
    snd = Saw.ar(freq);
    snd = (snd * 100).tanh + ((snd.sign - snd) * -8.dbamp);
    high = HPF.ar(snd, 300);
    lfo = SinOsc.ar(8, [0, 0.5pi]).range(0, 0.01);
    high = high.dup(2) + (DelayC.ar(high, 0.01, lfo) * -2.dbamp);
    snd = LPF.ar(snd, 100).dup(2) + high;
    snd = RLPF.ar(snd, 7000, 2);
    snd = BPeakEQ.ar(snd, \ffreq.kr(3000) * XLine.kr(1, 0.8, 0.3), 0.5, 15);
    snd = snd * Env.asr(0.001, 1, 0.05).ar(2, \gate.kr(1));
    Out.ar(\out.kr(0), snd * \amp.kr(0.1));

SynthDef(\hoover, {
    var snd, freq, bw, delay, decay;
    freq = \freq.kr(440);
    freq = freq * Env([-5, 6, 0], [0.1, 1.7], [\lin, -4]).kr.midiratio;
    bw = 1.035;
    snd = { DelayN.ar(Saw.ar(freq * ExpRand(bw, 1 / bw)) + Saw.ar(freq * 0.5 * ExpRand(bw, 1 / bw)), 0.01, Rand(0, 0.01)) }.dup(20);
    snd = (Splay.ar(snd) * 3).atan;
    snd = snd * Env.asr(0.01, 1.0, 1.0).kr(0, \gate.kr(1));
    snd = FreeVerb2.ar(snd[0], snd[1], 0.3, 0.9);
    snd = snd * Env.asr(0, 1.0, 4, 6).kr(2, \gate.kr(1));
    Out.ar(\out.kr(0), snd * \amp.kr(0.1));

var durations;
durations = [1, 1, 1, 1, 3/4, 1/4, 1/2, 3/4, 1/4, 1/2];
        instrument: \gabberkick,
        amp: -23.dbamp,
        freq: 60,
        legato: 0.8,
        ffreq: Pseq((0..(durations.size * 4 - 1)).normalize, inf).linexp(0, 1, 100, 4000),
        dur: Pseq(durations, inf),
        bend: Pfuncn({ |x| if(x < (1/2), 0.4, 1) }, inf) <> Pkey(\dur),
        instrument: \hoover,
        amp: -20.dbamp,
        midinote: 74,
        dur: durations.sum * 2,
        sustain: 7,
]).play(TempoClock(210 / 60));

I wasn't able to translate it into the Lisp form, because cl-collider does not have documentation and diving into it will require too much time. However, there is a working code example from its README, which you can try in the REPL:

POFTHEDAY> (named-readtables:in-readtable :sc)
POFTHEDAY> (setf sc:*s* (sc:make-external-server
                         "localhost" :port 48800))
POFTHEDAY> (use-package :sc)

POFTHEDAY> (defsynth saw-synth ((note 60) (dur 4.0))
             (let* ((env (env-gen.kr (env [0 .2 0]
                                          [(* dur .2) (* dur .8)])
                                     :act :free))
                    (freq (midicps note))
                    (sig (lpf.ar (saw.ar freq env)
                                 (* freq 2))))
               (out.ar 0 [sig sig])))

POFTHEDAY> (defun make-melody (time n &optional (offset 0))
             (when (> n 0)
               (at time (synth 'saw-synth
                               :note (+ offset (alexandria:random-elt
                                                '(62 65 69 72)))))
               (let ((next-time (+ time (alexandria:random-elt
                                         '(0 1 2 1.5)))))
                 (callback next-time #'make-melody
                           next-time (- n 1) offset))))

POFTHEDAY> (make-melody (quant 4) 16)
POFTHEDAY> (make-melody (+ 4 (quant 4)) 16 12)

;; This will stop the music
POFTHEDAY> (sc:stop)

Here is a demo, showing how does live coding works with cl-collider:


To try cl-collider, you'll need to install a SuperCollider. On OSX it is as simple as doing:

brew cask install supercollider

25 May 2020 8:15pm GMT

Michał Herda: Call for review: package-local nicknames on CLISP

#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)

25 May 2020 8:05pm GMT

Michał Herda: Lisp Koans 2.0

#CommonLisp #Lisp

I have rewritten the Common Lisp Koans to fix the many issues that sort-of plagued the code.

You can see, inspect, and download the outcome here.

25 May 2020 8:04pm GMT

Michał Herda: Parentheses and indentation

#CommonLisp #Lisp

Claim: You know you've got used to reading Lisp when you no longer care about the parentheses and instead read Lisp by indentation. And this is how it is supposed to be read.

(Warning: this post has a slight rant tone to it.)

Let us consider three versions of read-file-into-string, a Common Lisp utility function adapted from the Alexandria source code. The questions are: How are they different? How do they work? What do they say about the code that is executed?

            ;;; Version A

(defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
  (flet ((read-stream-content-into-string (stream)
           (check-type buffer-size (integer 1))
           (let ((*print-pretty* nil)
                 (buffer (make-array buffer-size :element-type 'character)))
             (with-output-to-string (datum)
               (loop :for bytes-read := (read-sequence buffer stream)
                     :do (write-sequence buffer datum :start 0 :end bytes-read)
                     :while (= bytes-read buffer-size))))))
    (with-open-file (stream pathname :direction :input
                                     :external-format external-format)
      (read-stream-content-into-string stream :buffer-size buffer-size))))

            ;;; Version B

(defun read-file-into-string ((pathname &key (buffer-size 4096) external-format)))
  (flet (read-stream-content-into-string (stream)
          (check-type buffer-size (integer 1)
          (let ((*print-pretty* nil))
                (buffer (make-array buffer-size :element-type 'character))
            (with-output-to-string (datum)))
              (loop :for bytes-read := (read-sequence buffer stream)
                    :do (write-sequence buffer datum :start 0 :end bytes-read))
                    :while (= bytes-read buffer-size)))
    (with-open-file ((stream pathname :direction :input
                                      :external-format external-format)))
      (read-stream-content-into-string stream :buffer-size buffer-size)))))))

            ;;; Version C

(defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
  (flet ((read-stream-content-into-string (stream)
           (check-type buffer-size (integer 1))
    (let ((*print-pretty* nil)
      (buffer (make-array buffer-size :element-type 'character)))
      (with-output-to-string (datum)
        (loop :for bytes-read := (read-sequence buffer stream)
              :do (write-sequence buffer datum :start 0 :end bytes-read)
              :while (= bytes-read buffer-size))))))
        (with-open-file (stream pathname :direction :input
                                         :external-format external-format)
          (read-stream-content-into-string stream :buffer-size buffer-size))))


You are free to check these in a Common Lisp REPL in case of doubts.

The answer is that A and B tell the same story to the programmer, even though B won't compile. Many starting and ending parentheses in version B have been removed, duplicated, or displaced, which makes that code incomprehensible to the Lisp compiler.

C, however, does compile and work just like A does, and the Lisp compiler will not see any difference between forms from A and C. This is because C is a copy of A with broken indentation. The only thing that differs is the whitespace at the begining of each line.

To a Lisp programmer, version C is much more dangerous than B: while trying to evaluate the code from version B provides immediate feedback (it won't compile, it's broken code!), version C will instead silently work in a way that is not expected.

The intent conveyed by version A is that most of the space is taken by a local function, which is why most of the middle is indented more heavily than the bottom lines that form the actual body of read-file-into-string. Version C instead assumes that the only thing done by the local function is a check-type assertion - it is the only form indented in a way that denotes the body of a local function. The rest of function body implies that we first call some function named buffer on a freshly created array. Then, we open a with-output-to-string context, and perform everything else - which are the loop iteration and the subsequent with-open-file form - inside that context.

Such indentation is actively hostile towards the programmer, as I have intentionally created it to be misleading; it is therefore unlikely to find it in Lisp code that is actively used. Still, it is a proof of concept that it is possible to mislead a Lisp programmer, either by someone who either actively tries to do it or by one who is novice enough to not know better - and therefore, indirectly, a proof that indentation pays a crucial role in understanding and parsing Lisp code by humans.

To make another proof, we can take this example in another direction, a very extreme one this time. We will take the code from version A and remove all the parentheses from it (except where they are required to parse the context), leaving only indenation in place.

            ;;; Version D

defun read-file-into-string pathname &key (buffer-size 4096) external-format
  flet read-stream-content-into-string stream
         check-type buffer-size integer 1
         let *print-pretty* nil
             buffer make-array buffer-size :element-type 'character
           with-output-to-string datum
             loop :for bytes-read := read-sequence buffer stream
                  :do write-sequence buffer datum :start 0 :end bytes-read
                  :while = bytes-read buffer-size
    with-open-file stream pathname :direction :input
                                   :external-format external-format
      read-stream-content-into-string stream :buffer-size buffer-size


Suddenly, we get something strangely pythonesque. Code scopes are no longer defined by parentheses and instead they are defined purely by whitespace. Lisp programmers might also be put off by the sudden lack of parentheses.

And yet, this example - at least to me - reads very similar to the Lisp code from variant A. Again, this is because the indentation for both pieces of code is identical: it is clear where a given block or subblock goes deeper, where it continues at the same depth, and where it ends, and this is the information that a Lisp programmer uses when parsing code meant for human consumption.

There's a valid point that needs to be taken into account here - that one needs to be somewhat proficient Lisp semantics in order to know the argument counts for each form that is executed. In the above example, one needs to know that make-array takes one mandatory argument and may then take a number of keyword arguments, that write-sequence takes two mandatory arguments and keyword args, that check-type takes a variable and a type, and so on. Such knowledge comes only from using the language in depth, but, thankfully, it is knowledge that relates to the right side of each line of such program, rather than to the left part. And the left is where the indentation is.

When writing Lisp, two tasks are not meant to be done by humans: managing parentheses and indenting code. The programmer's focus should be on what happens between the parentheses and whose meaning and order is provided by indentation.

  • When I write Lisp, I do not pay any attention about the indentation; emacs automatically indents my code for me as I write it thanks to electric-indent and aggressive-indent.
  • When I write Lisp, I do not need to pay any attention to closing or counting parentheses: emacs automatically inserts them in pairs and prevents me from deleting a lone paren thanks to smartparens, and I have a visual color cue that informs me about the depth of a given paren thanks to rainbow-delimiters.
  • When I write Lisp, I do not need to pay much attention to where exactly I insert a new subform: if I misplace a form within my Lisp expression, emacs will automatically indent it for me, and I will notice that it is not indented at the level where I expected it to be. I can then fix its position, again, thanks to smartparens.

This is also why I consider writing Lisp code to be almost impossible without support from an editor that performs these tasks for the programmer. Even more, I consider sharing Lisp code to be impossible if that code is not formatted correctly, because then this code will not be indented correctly and will therefore either require other Lisp programmers who read it to put extra cognitive load to try and understand it, or, worse - it will give them outright wrong and misleading information about what a given piece of Lisp code does.

Oh, and while we're at it, Lisp also solves the tabs-versus-spaces debate. It is impossible to indent Lisp with tabs only, unless either tabs are exactly one-space wide or one chooses the worst possible option of both at the same time in the same lines.

So, spaces it is.

25 May 2020 8:04pm GMT

24 May 2020

feedPlanet Lisp

Alexander Artemenko: trivial-ssh

This system is a simple wrapper around cl-libssh2 which is binding to the libssh2. Trivial SSH provides a few macros to safely establish a connection, open and close streams.

In the next example we'll connect to the host and run two commands to get its hostname and OS description:

;; Make this before Quickloading the system:
;; brew upgrade libssh2

POFTHEDAY> (flet ((read-lines (s)
                    (loop for line = (read-line s nil nil)
                          while line
                          collect line)))

             (ssh:with-connection (conn "" (ssh:agent "root"))
                (ssh:with-command (conn iostream "hostname -f")
                                  (read-lines iostream))
                (ssh:with-command (conn iostream "lsb_release --id --release --codename")
                                  (read-lines iostream)))))
("Distributor ID:  Ubuntu"
 "Release: 18.04"
 "Codename:        bionic")

Also, there is are commands to upload and download files using SCP protocol. Here is how we can copy the bootstrap file to the host and execute it:

POFTHEDAY> (ssh:with-connection (conn "" (ssh:agent "root"))
               (ssh:upload-file conn "install.sh" "/tmp/install.sh")
               (ssh:with-command (conn stream "chmod +x /tmp/install.sh"))
                 (ssh:with-command (conn stream "/tmp/install.sh")))

The cool part of with-command macro is that you have a communication stream and can read output during the command execution. Here we are installing Emacs on the remote host and can observe the process:

Here is the code from this sample:

POFTHEDAY> (flet ((-> (from to)
                    (loop for line = (read-line from nil nil)
                       while line
                       do (write-string line to)
             (ssh:with-connection (conn ""
                                        (ssh:agent "root"))
                   (conn stream "apt-get update &&
                                apt-get install -y emacs-nox")
                   (-> stream *standard-output*))))


Found that cl-libssh2 does not support agent forwarding. Because of that, I'm not able to call git pull on the remote machine.

I tried to patch cl-libssh2 to support the latest libssh2 where agent forwarding was supported in August 2019, but this patch does not work yet.

If somebody is interested to help me with that, he might try this pull-request:


24 May 2020 8:15pm GMT

Leo Zovic: Subverting Common Lisp Types And Emacs Interaction For Clj

Ok, so profiling the extra-low-hanging-fruit in terms of generic function performance revealed that it didn't do much in our situation. My next idea was to subvert the Common Lisp type system to give our set and map primitives some hints about what kind of equality operations to use.

I'm once again starting this piece before having written the code it'll be explaining, so this is less a thoughtful tour and more a stream-of-consciousness account of the writing.

Defining Types

Assuming the thing you're defining fits into the pre-existing Common Lisp types, you're fine. As soon as you want to do something like define polymorphic key/value structures you are, near as I can tell, on your fucking own bucko.

So I guess I'm rolling my own here?

Ok, the good news is that I'm in just enough of a hacky mood that I don't give a flying fuck how shitty this is going to be. That... might come back to bite me later, but we'll burn that bridge and salt it as we pass.

Here's how I have to define type map.

(deftype map (&optional keys vals)
  (let ((sym (intern (format nil "MAP-TYPE-~a-~a" keys vals) :clj)))

    (unless (fboundp sym)
      (setf (fdefinition sym) (kv-types keys vals)))

    `(and (satisfies map?) (satisfies ,sym))))

This feels batshit insane. In order to properly define a polymorphic key/value type, I have to manually intern predicates that deal with the specific types in question at declaration time. The problem is that satisfies specifically only accepts a symbol that must refer to a function of one argument that's meant to return a boolean. If it could take lambda terms, I could do something like

(defun kv-type (k-type v-type)
  (lambda (thing)
    (and (map? thing)
         (every (lambda (pair)
                  (and (typep (car pair) k-type)
                       (typep (cdr pair) v-type)))
                (values thing)))))
(satisfies (kv-type 'keyword 'integer))

This is, unfortunately, off the table. Oh well. The complete definitions for both map and set types is

(defun map? (thing)
  (typep thing 'cl-hamt:hash-dict))

(defun map-type? (type)
  (and type
       (listp type)
       (eq (car type) 'map)))

(defun kv-types (k-type v-type)
  (lambda (map)
     (lambda (memo k v)
       (and memo (typep k k-type) (typep v v-type)))
     map t)))

(deftype map (&optional keys vals)
  (let ((sym (intern (format nil "MAP-TYPE-~a-~a" keys vals) :clj)))

    (unless (fboundp sym)
      (setf (fdefinition sym) (kv-types keys vals)))

    `(and (satisfies map?) (satisfies ,sym))))

(defun set? (thing)
  (typep thing 'cl-hamt:hash-set))

(defun set-type? (type)
  (and type
       (listp type)
       (eq (car type) 'set)))

(defun seq-types (v-type)
  (lambda (set)
     (lambda (memo elem)
       (and memo (typep elem v-type)))
     set t)))

(deftype set (&optional vals)
  (let ((sym (intern (format nil "SET-TYPE-~a" vals) :clj)))

    (unless (fboundp sym)
      (setf (fdefinition sym) (seq-types vals)))

    `(and (satisfies set?) (satisfies ,sym))))

Once I've got that, I can declare things. Like,

CLJ> (let ((a {:a 1 :b 2}))
  (declare (type (map keyword t) a))
{:A 1 :B 2}

Checking for equalities

There's some more work to do. The whole point of this exercise is Once I've got a type declared, I need to do the work I actually care about. Which is: figure out which of the built-in structural equality operations is the most efficient I can use while also being as correct as possible.

(defun fullest-equality (equalities)
   (lambda (e) (member e equalities :test #'eq))
   '(clj:== cl:equalp cl:equal cl:eql cl:eq cl:string= cl:=)))

(defun equality-function (name) (fdefinition name))

(defun equality-of (type)
    ((member type '(integer number float ratio rational bignum bit complex long-float short-float signed-byte unsigned-byte single-float double-float fixnum))
    ((member type '(string simple-string))
    ((member type '(atom symbol keyword package readtable null stream random-state))
    ((member type '(standard-char character pathname))
    ((member type '(cons list))
    ((and (listp type) (eq 'or (first type)))
     (fullest-equality (mapcar #'equality-of (rest type))))
    ((member type '(hash-table sequence array bit-vector simple-array simple-bit-vector simple-vector vector))
    ((and (listp type) (member (car type) '(array simple-array simple-bit-vector simple-vector vector)))
    ((member type '(compiled-function function))
    (t 'clj:==)))

It's a fairly naive binding table, completely inextensible for the moment, that maps a type to the name of an equality operation that will accurately compare them. Hopefully, I mean. As long as I didn't fuck something up.

CLJ> (equality-of '(map keyword t))
CLJ> (equality-of 'keyword)
CLJ> (equality-of 'list)
CLJ> (equality-of 'hash-table)
CLJ> (equality-of 'string)

Seems legit.

Putting it all together

The next step is, we want to use this equality selection procedure to make our map and set constructors pick a better one than == if it can.

(defparameter *type* nil)
(defun alist->map (alist &key equality)
  (let ((equality (or equality
                      (if (map-type? *type*)
                          (equality-function (equality-of (second *type*)))
    (loop with dict = (cl-hamt:empty-dict :test equality)
       for (k . v) in alist do (setf dict (cl-hamt:dict-insert dict k v))
       finally (return dict))))

(defun list->map (lst &key equality)
  (assert (evenp (length lst)) nil "Map literal must have an even number of elements")
  (let ((equality (or equality
                      (if (map-type? *type*)
                          (equality-function (equality-of (second *type*)))
    (loop with dict = (cl-hamt:empty-dict :test equality)
       for (k v) on lst by #'cddr
       do (setf dict (cl-hamt:dict-insert dict k v))
       finally (return dict))))
(defun list->set (lst)
  (let ((equality (if (set-type? *type*)
                      (equality-function (equality-of (second *type*)))
     (lambda (set elem)
       (cl-hamt:set-insert set elem))
     lst :initial-value (cl-hamt:empty-set :test equality))))

So, we've got a *type* special var that we can use to declare the type of the map/set we're defining, and if it's set, we use it to pick an appropriate equality. Otherwise, we just go with #'==, because that's as general as it gets.

CLJ> (list->set (list 1 2 3 4))
#{3 2 1 4}
CLJ> (cl-hamt::hamt-test (list->set (list 1 2 3 4)))
CLJ> (let ((*type* '(set integer))) (list->set (list 1 2 3 4)))
#{3 2 1 4}
CLJ> (let ((*type* '(set integer))) (cl-hamt::hamt-test (list->set (list 1 2 3 4))))
CLJ> (list->map (list :a 1 :b 2 :c 3))
{:A 1 :C 3 :B 2}
CLJ> (cl-hamt::hamt-test (list->map (list :a 1 :b 2 :c 3)))
CLJ> (let ((*type* '(map keyword t))) (cl-hamt::hamt-test (list->map (list :a 1 :b 2 :c 3))))


It doesn't fit all of our use cases though.

CLJ> {:a 1 :b 2 :c 3}
{:A 1 :C 3 :B 2}
CLJ> (let ((*type* '(map keyword t))) {:a 1 :b 2 :c 3})
{:A 1 :C 3 :B 2}
CLJ> (let ((*type* '(map keyword t))) (cl-hamt::hamt-test {:a 1 :b 2 :c 3}))

The problem is that, because we have reader syntax for our maps and sets, this decision kicks in too late to deal with them. We unfortunately also need a reader macro to handle type declarations.

Reader Macro for Type Declaration

The naive solution here is

(defun type-literal-reader (stream sub-char numarg)
  (declare (ignore sub-char numarg))
  (let* ((*type* (read stream))
         (form (read stream))
         (val (eval form)))
    (assert (typep val *type*) nil "Type checking failure ~s ~s" *type* form)

  (:dispatch-macro-char #\# #\# #'type-literal-reader))

I don't really want to define this as using :: because of the headache-inducing implications of doing (make-dispatch-macro-character #\:). I'm trying to avoid those for the moment. Same story with #:, because uninterned symbols are common and I don't want to stomp them here. So, I had to pick something else, and arbitrarily accepted ## even though #t or #T would have been equally reasonable choices.

This technically works.

CLJ> {:a 1 :b 2 :c 3}
{:A 1 :C 3 :B 2}
CLJ> ## (map keyword t) {:a 1 :b 2 :c 3}
{:A 1 :C 3 :B 2}
CLJ> (cl-hamt::hamt-test ## (map keyword t) {:a 1 :b 2 :c 3})

But I want to avoid calling eval as part of it. The more macro-like version would look something more like

(defun type-literal-reader (stream sub-char numarg)
  (declare (ignore sub-char numarg))
  (let* ((*type* (read stream))
         (form (read stream))
         (res (gensym)))
    (if *type*
        `(let ((,res ,form))
           (check-type ,res ,*type*)

It still works...

CLJ> ## (map keyword t) {:a 1 :b 2}
{:A 1 :B 2}
CLJ> (cl-hamt::hamt-test ## (map keyword t) {:a 1 :b 2})

... but has the added bonuses of not calling eval and also making use of check-type, which we couldn't do if we wanted to do that check inline at read time.

I don't really like the syntax1, but that's good enough for now2.

Performance implications

(defun untyped-benchmark (&key (times 10000))
  (loop repeat times
     do (let* ((m {:a 1 :b "two" :c :three :d 44})
               (inserted (insert m (cons :test-key :test-value))))
          (list (len m)
                (lookup inserted :test-key)
                (len inserted)))))

(defun typed-benchmark (&key (times 10000))
  (loop repeat times
     do (let* ((m ## (map keyword t) {:a 1 :b "two" :c :three :d 44})
               (inserted (insert m (cons :test-key :test-value))))
          (list (len m)
                (lookup inserted :test-key)
                (len inserted)))))

With the above defined in benchmark.lisp, running the benchmarks and reporting them with M-x slime-profile-report slime-profile-reset gives us...

CLJ> (untyped-benchmark :times 1000000)
measuring PROFILE overhead..done
  seconds  |     gc     |     consed    |   calls   |  sec/call  |  name
     1.230 |      0.068 | 1,076,698,880 | 1,000,000 |   0.000001 | CLJ::INSERT
     0.931 |      0.000 |        32,768 | 2,000,000 |   0.000000 | CLJ::LEN
     0.617 |      0.000 |     1,679,216 | 1,000,000 |   0.000001 | CLJ::LOOKUP
     0.000 |      0.018 |    59,768,832 |         1 |   0.000000 | CLJ::UNTYPED-BENCHMARK
     0.000 |      0.000 |             0 | 1,000,000 |   0.000000 | CLJ:==
     2.778 |      0.086 | 1,138,179,696 | 5,000,001 |            | Total

estimated total profiling overhead: 9.09 seconds
overhead estimation parameters:
  1.8e-8s/call, 1.8179999e-6s total profiling, 8.8e-7s internal profiling

These functions were not called:

CLJ> (typed-benchmark :times 1000000)
  seconds  |     gc     |     consed    |   calls   |  sec/call  |  name
     1.195 |      0.040 | 1,076,307,616 | 1,000,000 |   0.000001 | CLJ::INSERT
     0.768 |      0.000 |             0 | 2,000,000 |   0.000000 | CLJ::LEN
     0.605 |      0.000 |             0 | 1,000,000 |   0.000001 | CLJ::LOOKUP
     0.000 |      0.004 |    59,703,296 |         1 |   0.000000 | CLJ::TYPED-BENCHMARK
     2.568 |      0.044 | 1,136,010,912 | 4,000,001 |            | Total

estimated total profiling overhead: 7.27 seconds
overhead estimation parameters:
  1.8e-8s/call, 1.8179999e-6s total profiling, 8.8e-7s internal profiling

These functions were not called:

A pretty goddamn tiny difference. I'm not sure this approach is worth much more effort, but I'll plug away for a bit longer to see how elegant I can make it. In the meantime,

Emacs Interaction Improvements

So, the sad thing about all of this is that I've been lying to you. Whenever I show you those nice readouts from the SLIME repl that says something like {:a 1 :b 2}, that's a result of me correcting it. Because, by default, when I type {, what I get is {$. Which I then have to manually backspace and correct. Using this shiny new syntax in Common Lisp mode is also less than ideal, because the default paredit doesn't provide s-exp support for curly braces. It's not as simple as adding

"{" 'paredit-open-curly
"}" 'paredit-close-curly

to a mode-map somewhere, because that does pair them, but doesn't help with navigation.

After messing around with modifying existing syntax-tables, redefining matching-paren, and poking around in paredit internals, the solution I settled on was just adding a mode-hook to a bunch of lisp modes and slime-repl modes that activates the clojure-mode-syntax-table.

You can do this in your .emacs file by doing something like

(defun use-clojure-syntax-table () (set-syntax-table (set-syntax-table clojure-mode-syntax-table)))
(add-hook 'common-lisp-mode-hook 'use-clojure-syntax-table)
(add-hook 'slime-mode-hook 'use-clojure-syntax-table)
(add-hook 'slime-repl-mode-hook 'use-clojure-syntax-table)

I added it to my .emacs by doing

(hooks (common-lisp lisp emacs-lisp scheme lisp-interaction slime clojure slime-repl)
       (lambda ()
         (setq autopair-dont-activate t)
         (autopair-mode -1))
       (lambda () (set-syntax-table (set-syntax-table clojure-mode-syntax-table))))

Which is both more thorough and more extensive, but requires me to define some conveniences first.

The next time I write about CLJ, the SLIME repl snippets will not be a lie.

  1. Ideally, the type annotation would be declared like (:: type form), :: type form, or possibly type :: form. However, infix operators are more complicated to deal with, and : already has various meanings in Common Lisp that would make using it as a read-macro-char more complicated than I'd like. Specifically, as hinted at above, doing (make-dispatch-macro-character #\:) instantly complicates the parsing of keywords, uninterned-symbols and any qualified name you end up typing. I'll read up on it a bit and see if there's a way to fall through to the default behavior somehow, but in the absence of that option, this is absolutely more hassle than it's worth.
  2. Possible future improvements include inferring the type of a map literal based on its initial values, and storing the type annotation somehow so that it can be checked against by insert later. I'm not sure any of this is worth the time, and once we pick an appropriate interface, it'll be easy to change internals later.

24 May 2020 2:21pm GMT

23 May 2020

feedPlanet Lisp

Alexander Artemenko: cl-change-case

This cool library is able to transform strings from one time of delimiters to others.

Previously I've used kebab, but cl-change-case is much more featureful:

POFTHEDAY> (cl-change-case:path-case "foo-bar-bazz")
POFTHEDAY> (cl-change-case:path-case "foo-bar_bazz")
POFTHEDAY> (cl-change-case:path-case "foo-bar-bazz")
POFTHEDAY> (cl-change-case:sentence-case "foo-bar-bazz")
"Foo bar bazz"
POFTHEDAY> (cl-change-case:snake-case "foo-bar-bazz")
POFTHEDAY> (cl-change-case:camel-case "foo-bar-bazz")
POFTHEDAY> (cl-change-case:no-case "foo-bar-bazz")
"foo bar bazz"
POFTHEDAY> (cl-change-case:header-case "foo-bar-bazz")

When this can be useful? In cases when you interop with other systems, but want to use :this-style-of-symbols in Lisp. For example, you might generate identifiers for JavaScript or Python.

Another case is when you want to output labels for UI. Here I have a function which will render an HTML table describing a CLOS object:

POFTHEDAY> (defclass user ()
             ((created-at :initarg :created-at)
              (name :initarg :name)
              (num-posts :initarg :num-posts)))

POFTHEDAY> (defun render (object)
             (let* ((class-name (type-of object))
                    (class (find-class class-name))
                    (slots (closer-mop:class-slots class)))
               (cl-who:with-html-output-to-string (*standard-output* nil :indent t)
                  (loop for slot in slots
                        for slot-name = (closer-mop:slot-definition-name slot)
                        for label = (cl-change-case:sentence-case (symbol-name slot-name))
                        for value = (rutils:fmt "~A"
                                                (slot-value object slot-name))
                        do (cl-who:htm
                             (:th (cl-who:esc label))
                             (:td (cl-who:esc value)))))))))

POFTHEDAY> (render (make-instance 'user
                                  :name "Bob"
                                  :created-at "2020-05-22"
                                  :num-posts 42))
  <th>Created at</th>
  <th>Num posts</th>

23 May 2020 8:15pm GMT