Planet Lisp is a meta blog that collects the contents of various Lisp-related blogs. It is sponsored by the Lisp-powered Pixel Speech Bubble site. About Planet Lisp @planet_lisp

·

21 hours ago

The latest SBCL handles slot :initform and :type options in a new way. It’s mentioned in the release notes. minor incompatible change: the compiler signals a warning at compile-time when an initform of T, NIL or 0 does not match a STANDARD-CLASS slot’s declared type._ Sounds pretty benign, but it breaks dozens of projects in Quicklisp. (To be fair, most of the failures are caused by a small number of core systems on which many other systems depend.) Here’s an example of the new behavior: (defclass foo () ((name :type string :initform nil))) With the above defclass form, SBCL 2.0.9 will signal a warning at compile time: ; processing (DEFCLASS FOO ...) ; file: foo.lisp ; in: DEFCLASS FOO ; (NAME :TYPE STRING :INITFORM NIL) ; ==> ; (SB-KERNEL:THE* (STRING :SOURCE-FORM NIL :USE-ANNOTATIONS T) NIL) ; ; caught WARNING: ; Constant NIL conflicts with its asserted type STRING. ; See also: ; The SBCL Manual, Node "Handling of Types" ; ; compilation unit finished ; caught 1 WARNING condition This compile-time warning means “failure” as far as loading with ASDF is concerned. If you have both :type and :initform in your slot definitions, and you want to be compatible with the latest SBCL, make sure the initform type matches the slot type. If you want to use NIL as the initform, one easy option is to set the type to (or null <actual type>) .

·

46 hours ago

This library provides a Common Lisp kernel for Jupyter. Jupyter is a scientific environment for experiments. It is good when you want to play with data, to plot graphics and provides some comments in markdown. Jupyter saves your programming session along with results in one file allowing to share your results with other programmers or analytics. Maybe you didn't know, but GitHub is able to render such notebooks. Here I found a large list of interesting notebooks. Take a look at this one, for example: https://github.com/mqlaql/geospatial-data/blob/master/Geospatial-Data-with-Python.ipynb Now, let's return to the Common Lisp. Jupyter is using a protocol allowing to write backends in different programming languages. They are called "kernels". Here is how we can install Common Lisp Jupyter kernel on OSX. I'm using Homebrew and Roswell because they are making everything so easy! [poftheday] brew install zeromq [poftheday] brew install jupyterlab [poftheday] ros install common-lisp-jupyter Now we can start a notebook in console mode: [poftheday] jupyter console --kernel=common-lisp Jupyter console 6.2.0 common-lisp-jupyter: a Common Lisp Jupyter kernel (C) 2019 Tarn Burton (MIT) In [1]: (lisp-implementation-type) Out[1]: "SBCL" In [2]: (lisp-implementation-version) Out[2]: "2.0.8" In [3]: (values 1 2 3) Out[3]: 1 Out[3]: 2 Out[3]: 3 In [4]: (jupyter:file "/Users/art/Desktop/Screenshot 2020-09-25 at 23.50.02.png") Out[4]: /Users/art/Desktop/Screenshot 2020-09-25 at 23.50.02.png And this command will start a webserver with full Jupyter Notebook: # To start a web UI, run [poftheday] jupyter notebook When the browser will open Jupyter, choose this menu to start Common Lisp Jupyter kernel: Now if you enter the same code as we did before in console, you'll see, that web version is able to render our "screenshot" file below the "code cell": It is also very easy to render formulas and to request an input from the user: Also, you can render any HTML along with styles: Or you might define functions which will return HTML or files: This way, libraries extending common-lisp-jupyter may be created. They can do plotting for example, or render graphs, etc. Here how you can make you own classes renderable by Jupyter: Though, it would be nice to make it possible to define render method for object not inherited from the jupyter:result . The developer of this library did a very good job documenting it and providing examples. You will find all of them here. This project is in active development phase. For example, right now support for Jupyter widgets is added. Please, join this effort and make your pull requests to this repository, if you are interested in building CL environment for data science!

·

3 days ago

This is a tiny library by Fernando Borretti. It implements analogue of the UNIX utility which : POFTHEDAY> (which:which "which") #P"/usr/bin/which" POFTHEDAY> (which:which "sbcl") #P"/Users/art/.bin/sbcl" POFTHEDAY> (which:which "python3") #P"/usr/bin/python3" POFTHEDAY> (which:which "missing-binary") NIL That is it. No more, no less. What do you think, when this library can be useful? By the way, there are many other trivial (but useful) libraries. All of them are marked with a trivial tag on #pofthedday site.

·

3 days ago

New projects: cl-base16 — Common Lisp implementation of base16 — GPLv2

cl-bcrypt — Common Lisp system for generating and parsing of bcrypt password hashes — BSD 2-Clause

cl-getx — This is a naive, persisted, in memory (lazy loading) data store for Common Lisp. — MIT

cl-indentify — A code beautifier for Common Lisp. — MIT

cl-kaputt — A Simple Interactive Test Framework for Common Lisp — MIT

cl-mango — A minimalist CouchDB 2.x database client. — BSD3

cl-minify-css — To minify css with common lisp. — GPLv3

cl-rfc4251 — Common Lisp library for encoding and decoding data in RFC 4251 compliant format — BSD 2-Clause

cl-setlocale — FFI to setlocale and ncurses locale helper — 2-clause BSD

cl-ssh-keys — Common Lisp system for generating and parsing of OpenSSH keys — BSD 2-Clause

cl-wave-file-writer — A wave file writer — MIT

class-options — Provides easy access to the defining class and its options during initialization. — Unlicense

compatible-metaclasses — Validates superclasses according to a simple substitution model, thereby greatly simplifying the definition of class mixins. — Unlicense

enhanced-find-class — Provides a canonical way of converting class designators to classes. — Unlicense

evaled-when — Provides a way of extracting and replicating the compile-time side-effects of forms. — Unlicense

file-attributes — Access to file attributes (uid, gid, atime, mtime, mod) — zlib

gadgets — Ben McGunigle's utility collection — Apache License, version 2.0

gooptest — A microcontroller testing framework. — GPL-3.0

kekule-clj — A Kekule widget for Common Lisp Jupyter — MIT

magicffi — cffi interface to libmagic(3) — Simplified BSD License

math —это математическая библиотека, реализующая некоторые алгоритмы: - линейной алгебры; - операций работы с матрицами; - статистические функции; - линейной и билинейной интерполяции; - нахождения приближающих многочленов, реализованная на Common Lisp — GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 or later

messagebox — A library to show a native message box dialog. — zlib

metalock — A metaclass that makes building parallel systems easier by providing each slot within a class a lock which is grabbed automatically. — MIT

nbd — Network Block Device server library. — MIT

object-class — Ensures that special subclasses of standard-object cluster right in front of standard-object in the class precedence list. — Unlicense

picl — Python Itertools in Common Lisp — MIT

pkg-doc — View package documentation in a clim-treeview — BSD Simplified

py4cl2 — Some improvements over py4cl — MIT

shasht — JSON reading and writing for the Kzinti. — MIT

simple-guess — Defines a simple extensible protocol for computing a guess using advisors. — Unlicense

trivial-do — Looping extensions that follow the style of the core DO functions. — MIT

uncursed — Another TUI library, this time without curses. — BSD 3-Clause

xcat — XCAT mass LAN big file distributor — MIT

zippy — A fast zip archive library — zlib Updated projects: 3b-hdr, 3bmd, acclimation, alexandria, algae, anypool, april, atomics, babel, bdef, bst, ci-utils, city-hash, cl-all, cl-aristid, cl-autowrap, cl-base64, cl-bnf, cl-cffi-gtk, cl-collider, cl-conllu, cl-covid19, cl-dot, cl-erlang-term, cl-fix, cl-forms, cl-fuse, cl-gamepad, cl-gserver, cl-html-parse, cl-kraken, cl-liballegro, cl-liballegro-nuklear, cl-markless, cl-migratum, cl-mixed, cl-mpg123, cl-naive-store, cl-patterns, cl-png, cl-pslib, cl-rabbit, cl-readline, cl-redis, cl-renderdoc, cl-rrt, cl-rsvg2, cl-sdl2-ttf, cl-steamworks, cl-stomp, cl-store, cl-str, cl-unification, cl-utils, cl-webkit, cl-zyre, clack-pretend, clast, clawk, clcs-code, climacs, clj, closer-mop, clunit2, com-on, com.google.base, common-lisp-jupyter, commonqt, croatoan, deploy, diff-match-patch, djula, easy-audio, easy-routes, eazy-process, eclector, eos, exscribe, f2cl, fare-quasiquote, fast-io, file-select, fiveam, flare, flexi-streams, flexichain, float-features, font-discovery, fset, functional-trees, gendl, generic-cl, glacier, glsl-toolkit, golden-utils, gtirb, gtirb-capstone, harmony, hu.dwim.asdf, hu.dwim.delico, hu.dwim.walker, hunchentoot-multi-acceptor, hyperluminal-mem, hyperobject, inferior-shell, inner-conditional, ironclad, jingoh, jonathan, jpeg-turbo, kmrcl, lazy, linear-programming, lisp-binary, lisp-gflags, lispcord, literate-lisp, local-time, log4cl, maiden, markup, mcclim, method-hooks, mgl-pax, modf, mutility, named-readtables, nibbles, nodgui, null-package, opticl, origin, osicat, overlord, paren6, parse, pathname-utils, perceptual-hashes, petalisp, phoe-toolbox, pngload, portable-condition-system, postmodern, protobuf, psychiq, py4cl, quilc, quux-hunchentoot, random-state, read-as-string, replic, roan, rpcq, s-graphviz, sanity-clause, sc-extensions, scalpl, sel, serapeum, shadow, sheeple, shellpool, simple-actors, slime, sly, snooze, stumpwm, sxql, tooter, trace-db, trivia, trivial-arguments, trivial-clipboard, trivial-custom-debugger, trivial-garbage, trivial-gray-streams, trivial-utf-8, trucler, uax-14, umbra, unix-opts, vernacular. Removed projects: unicly. To get this update, use (ql:update-dist "quicklisp"). Enjoy!

·

5 days ago

Today I found that :read-timeout option of the Dexador does not work as expected and remembered about this small but useful library. It provides the only one macro which executes code and limits it's execution to a given number of seconds. For illustration, I'll use https://httpbin.org This is a service which helps you to test HTTP libraries. If you didn't hear about it, I recommend to look at. Let's retrieve an URL, which responds in 10 seconds. Even with :read-timeout option, dexador waits 10 seconds: POFTHEDAY> (time (nth-value 1 (dex:get "https://httpbin.org/delay/10" :read-timeout 2))) Evaluation took: 10.692 seconds of real time 200 If the site is not responding, a request may hang and block your application. Here is where trivial-timeout comes to the rescue! POFTHEDAY> (trivial-timeout:with-timeout (2) (time (nth-value 1 (dex:get "https://httpbin.org/delay/10")))) Evaluation took: 2.003 seconds of real time before it was aborted by a non-local transfer of control. ; Debugger entered on #<COM.METABANG.TRIVIAL-TIMEOUT:TIMEOUT-ERROR {10055B5373}> Internally, this library generates the implementation-specific code to interrupt the code execution. Here how our example will look like for SBCL: (let ((seconds 2)) (flet ((doti () (progn (time (nth-value 1 (dexador:get "https://httpbin.org/delay/10")))))) (cond (seconds (handler-case (sb-ext:with-timeout seconds (doti)) (sb-ext:timeout (com.metabang.trivial-timeout::c) (declare (ignore com.metabang.trivial-timeout::c)) (error 'com.metabang.trivial-timeout:timeout-error)))) (t (doti))))) And this is the same code, expanded on ClozureCL: (let ((seconds 2)) (flet ((doit nil (progn (time (nth-value 1 (dexador:get "https://httpbin.org/delay/10")))))) (cond (seconds (let* ((semaphore (ccl:make-semaphore)) (result) (process (ccl:process-run-function "Timed Process process" (lambda nil (setf result (multiple-value-list (doit))) (ccl:signal-semaphore semaphore))))) (cond ((ccl:timed-wait-on-semaphore semaphore seconds) (values-list result)) (t (ccl:process-kill process) (error 'com.metabang.trivial-timeout:timeout-error))))) (t (doit))))) Don't know if such running the code in the separate thread can have some side-effects. At least, library's README says that it might be dangerous :)))

·

7 days ago

This is a simple library which allows to define global variables and save/restore their state to some persistent storage. For example, we can define variables for database host and password: ;; In real application you should define these ;; variables in the lisp file: POFTHEDAY> (persistent-variables:defpvar *password*) POFTHEDAY> (persistent-variables:defpvar *db-host*) ;; Then in the REPL you can setup the app POFTHEDAY> (setf *password* "Some $ecret") POFTHEDAY> (setf *db-host* "some-host.internal-to.my-company.com") ;; And save it's state: POFTHEDAY> (with-open-file (stream "/tmp/app.config" :if-does-not-exist :create :if-exists :supersede :direction :output) (persistent-variables:pv-save stream)) ;; At startup your app might restore values for these variables: POFTHEDAY> (with-open-file (stream "/tmp/app.config" :direction :input) (persistent-variables:pv-load stream)) What this system does - it saves all symbols, defined with defpvar into the hash-table. And pv-save/pv-load serializes and deserializes them as sexps: POFTHEDAY> (rutils:print-ht persistent-variables::*persisted*) #{ :DEFAULT '(*DB-HOST* *PASSWORD*) } POFTHEDAY> (with-output-to-string (s) (persistent-variables:pv-save s)) "(\"POFTHEDAY\" \"*DB-HOST*\" \"\\\"some-host.internal-to.my-company.com\\\"\") (\"POFTHEDAY\" \"*PASSWORD*\" \"\\\"Some $ecret\\\"\") " This library can be useful for interactive applications where user can change the settings and they should be restored on restart. You probably also be interested in ubiquitous library which I didn't review yet.

·

9 days ago

Dawn of the second day. According to the internet, the thing I intend to build is called a Roguelikelike, teetering on the very edge of being a Roguelike. So it goes; we'll see if I end up taking the title or not. Last time, we laid out the basics of prisoner s, their interactions and their strategies. This time, lets get some different scenarios and some player interaction going. Scenarios Payoff matrices involve deciding who gets what bonus or penalty as a result of an interaction. Given a pair of defect / cooperate choices, a payoff-matrix will return the scores to be delivered to each player in turn. (defun payoff-matrix (cc-a cc-b cd-a cd-b dc-a dc-b dd-a dd-b) (let ((tbl {(cons :cooperate :cooperate) (list cc-a cc-b) (cons :defect :cooperate) (list dc-a dc-b) (cons :cooperate :defect) (list cd-a cd-b) (cons :defect :defect) (list dd-a dd-b)})) (lambda (a b) (lookup tbl (cons a b))))) Now we can define some basic scenarios. A dilemma is the name I'll pick for the situation where co-operating is better for the group, and both defecting is the worst thing for everyone, but a single defector will end out better off by defecting. (defparameter dilemma (payoff-matrix 3 3 1 5 5 1 0 0)) A stag-hunt is a situation where a pair of players can pool their resources for a greater prize, and ignore each other for the lesser. If either player attempts to hunt the stag alone, they get nothing, while their defecting partner still gets a rabbit. (defparameter stag-hunt (payoff-matrix 3 3 0 1 1 0 1 1)) A trade is one in which both parties benefit, but to which both parties must agree. (defparameter trade (payoff-matrix 3 3 0 0 0 0 0 0)) A theft is one where a player takes from the other. But if both players cooperate, or both try to rob each other, they come to an impasse. (defparameter theft (payoff-matrix 0 0 -3 3 3 -3 0 0)) A trap is a situation where cooperating leads to disaster, ignoring the situation leads to no gain, and defect ing to make it clear to your partner that you don't intend to follow ends up benefiting both players. (defparameter trap (payoff-matrix -3 -3 2 2 2 2 0 0)) The last scenario I'll concern myself with is the mutual-prediction . Where guessing what your partner/opponent will choose benefits you, and failing to do so does nothing. (defparameter mutual-prediction (payoff-matrix 3 3 0 0 0 0 3 3)) Adventure In order to move through the world, our prisoner s need a world to move through. Let us begin at the ending. (defparameter ending {:description "You have come to the end of your long, perilous journey."}) There is nothing to do at the end other than display this fact. (defun repl! (adventure) (format t "~%~%~a~%~%" (lookup adventure :description))) THE-PRISONERS> (repl! ending) You have come to the end of your long, perilous journey. NIL THE-PRISONERS> But what led us here was a choice. An adventure is more than a description, it's also the options, a prisoner , the scenario , and a way to continue the action. continue ing means making a choice and effectively playing the opposing/cooperating prisoner and abiding by the results. (defun mk-adventure () (let ((prisoner (polo))) {:description "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\"" :cooperate "accept" :defect "refuse" :prisoner prisoner :scenario trade :continue (lambda (choice) (let ((their-choice (play prisoner))) (update! prisoner choice) (funcall trade choice their-choice) ending))})) This sort of adventure also takes a bit more machinery to run from the repl . We need to present the description , but also get an appropriate choice from the user. Getting that choice is a bit more complicated than you might think at first. (defun get-by-prefix (lst prefix) (let ((l (length prefix))) (loop for elem in lst when (and (>= (length elem) l) (== (subseq elem 0 l) prefix)) do (return elem)))) (defun get-repl-choice (adventure) (let* ((responses (mapcar #'string-downcase (list (lookup adventure :cooperate) (lookup adventure :defect)))) (r-map {(string-downcase (lookup adventure :cooperate)) :cooperate (string-downcase (lookup adventure :defect)) :defect}) (by-pref nil) (resp "")) (loop until (and (symbolp resp) (setf by-pref (get-by-prefix responses (string-downcase (symbol-name resp))))) do (format t "~a/~a:" (lookup adventure :cooperate) (lookup adventure :defect)) do (setf resp (read))) (lookup r-map by-pref))) Well behaved players are easy to deal with, true... THE-PRISONERS> (get-repl-choice (mk-adventure)) Accept/Refuse:acc :COOPERATE T THE-PRISONERS> (get-repl-choice (mk-adventure)) Accept/Refuse:ref :DEFECT T THE-PRISONERS> (get-repl-choice (mk-adventure)) Accept/Refuse:a :COOPERATE T ... but we want to be a bit more general than that. THE-PRISONERS> (get-repl-choice (mk-adventure)) Accept/Refuse:fuck you Accept/Refuse:Accept/Refuse:boo Accept/Refuse: (error 'error) Accept/Refuse: (quit) Accept/Refuse:r :DEFECT T THE-PRISONERS> That's the only hard par though. Interacting with the game once we're sure we have valid input from our player is relatively simple. (defun repl! (adventure) (format t "~%~%~a~%~%" (lookup adventure :description)) (when (contains? adventure :continue) (let ((choice (get-repl-choice adventure))) (repl! (funcall (lookup adventure :continue) choice))))) THE-PRISONERS> (repl! (mk-adventure)) A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?" Accept/Refuse:acc You have come to the end of your long, perilous journey. NIL THE-PRISONERS> This is obviously not the perilous journey being spoken of. At least, not all of it. The simplest way to extend it into one is to wrap scenario s around our existing adventure . (defun mk-adventure () (let ((def (defector))) {:description "A muscled street thug approachs, knife drawn." :cooperate "surrender" :defect "run" :prisoner def :scenario theft :continue (lambda (choice) (let ((their-choice (play def))) (update! def choice) (funcall theft choice their-choice)) (let ((prisoner (polo))) {:description "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\"" :cooperate "accept" :defect "refuse" :prisoner prisoner :scenario trade :continue (lambda (choice) (let ((their-choice (play prisoner))) (update! prisoner choice) (funcall trade choice their-choice) ending))}))})) THE-PRISONERS> (repl! (mk-adventure)) A muscled street thug approachs, knife drawn. Surrender/Run:run A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?" Accept/Refuse:acc You have come to the end of your long, perilous journey. NIL THE-PRISONERS> Of course, since we want it to be much longer and more perilous, we'll want that process automated to at least some degree. (defun wrap-scenario (adventure scenario) (insert scenario (cons :continue (lambda (choice) (let* ((them (lookup scenario :prisoner)) (their-choice (play them))) (update! them choice) (funcall (lookup scenario :scenario) choice their-choice) adventure))))) (defun mk-adventure () (wrap-scenario (wrap-scenario ending {:description "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\"" :cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade}) {:description "A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\"" :cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft})) This isn't enough for the Roguelikelike title, and I don't think I'll get there today, but I do want the ability to make an arbitrarily long adventure. The dumbest way of doing this is to make a list of scenarios, and pick from them when the need arises. (defun random-scenario () (pick (list {:description "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\"" :cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade} {:description "A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\"" :cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft}))) (defun mk-adventure (&key (scenarios 5)) (let ((adventure ending)) (loop repeat scenarios do (setf adventure (wrap-scenario adventure (random-scenario)))) adventure)) An adventure of even 5 scenarios will end up being repetitive since we currently only have a grand total of two. But we can do something about that... (defun random-scenario () (pick (list {:description "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\"" :cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade} {:description "A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\"" :cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft} {:description "As you walk through an expansive market square, a gambler motions you over. \"Fancy your chances at evens or odds?" :cooperate "Evens!" :defect "Odds!" :prisoner (gambler) :scenario mutual-prediction} {:description "A hunter approaches you in a forest clearing. \"Hallo there, young one. Would you help me hunt a deer? I've had enough hares for now, but I promise we'll eat well if we work together!\"" :cooperate "<Nocks bow>" :defect "Rather go my own way" :prisoner (dantes) :scenario stag-hunt} {:description "\"Hey follow me into this bear trap!\"" :cooperate "Sure; I've grown tired of living" :defect "No. No, I'd rather not." :prisoner (robin) :scenario trap} {:description "You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run." :cooperate "It's too tempting" :defect "No; I hold strong" :prisoner (dantes) :scenario theft} {:description "At the end of your travails with your co-conspirator, you get to the treasure first and can pocket some if you want." :cooperate "Take it" :defect "No, we split fairly" :prisoner (gambler :defect 5) :scenario dilemma}))) This gives me some ideas about how to go about generating scenarios a lot more programmatically, but I'll leave that for later, when I'm in the right frame of mind to do cosmetic improvements. THE-PRISONERS> (repl! (mk-adventure)) At the end of your travails with your co-conspirator, you get to the treasure first and can pocket some if you want. Take it/Split fairly:split You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run. It's too tempting/No:it's "Hey follow me into this bear trap!" Sure; I've grown tired of living/No. No, I'd rather not.:no You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run. It's too tempting/No:it's A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?" accept/refuse:accept You have come to the end of your long, perilous journey. NIL THE-PRISONERS> This is about as far as I'm going today, and I'm not entirely sure how far I'm going during my next session. As always, I'll let you know.

·

10 days ago

Ok, so I guess I'm doing this. In hopes of participating in the Autumn Lisp 2020 Game Jam, I'm going to write a multiplayer game. It's going to deal with players in several ways, implement 1FA, and probably end up being asymmetric and heavily infulenced by some readings that The Cabal have been doing lately. But don't worry about that for the moment. Piece by piece The basics (in-package #:the-prisoners) (named-readtables:in-readtable clj:syntax) I'm using asd file. I'm using clj . You can find it on my github , and it'll be included as part of thefile. Ahem. Prisoners can do two things. They can cooperate or they can defect . (defun coop? (res) (eq :cooperate res)) (defun defe? (res) (eq :defect res)) In order to play a game, you take the game function and apply it to the ordered list of prisoners that will be playing. (defun play! (game &rest players) (apply game players)) A two-player, one-time game looks like this: We take two prisoner s We ask them to either cooperate or defect We tell each of them what the other did We score them To start with, we're going with a payoff matrix that looks like | Cooperate | Defect ------------------------------ Cooperate | 3, 3 | 1, 5 ------------------------------ Defect | 5, 1 | 0, 0 ------------------------------ We might play with this later, but lets pretend we won't have the time. (defun one-time (player-a player-b) (let ((a (funcall (lookup player-a :strategy))) (b (funcall (lookup player-b :strategy)))) (if-let (update (lookup player-a :update)) (funcall update b)) (if-let (update (lookup player-b :update)) (funcall update a)) (cond ((and (coop? a) (coop? b)) (list 3 3)) ((and (coop? a) (defe? b)) (list 1 5)) ((and (defe? a) (coop? b)) (list 5 1)) (t (list 0 0))))) The two simplest possible prisoners we can have are one who always :cooperate s, and one who always :defect s. A prisoner needs to be able to take into account what their opponent did last time, and separately, do something. (defun defector () {:name :defector :strategy (lambda () :defect)}) (defun cooperator () {:name :cooperator :strategy (lambda () :cooperate)}) We can now play. Would you like to play a game? The Simplest Game THE-PRISONERS> (play! #'one-time (defector) (cooperator)) (5 1) THE-PRISONERS> (play! #'one-time (cooperator) (defector)) (1 5) THE-PRISONERS> (play! #'one-time (cooperator) (cooperator)) (3 3) THE-PRISONERS> (play! #'one-time (defector) (defector)) (0 0) THE-PRISONERS> There are other, simple kinds of prisoners. One is the prisoner who tosses a coin and does what it tells them to. (defun gambler () {:name :gambler :strategy (lambda () (nth (random 2) (list :cooperate :defect)))}) The more general case doesn't necessarily flip a coin, but can weigh either :cooperate or :defect more strongly. (defun gambler (&key (cooperate 1) (defect 1)) (let ((total (+ cooperate defect)) (moves (concatenate 'list (loop repeat cooperate collect :cooperate) (loop repeat defect collect :defect)))) {:name (intern (format nil "GAMBLER~a/~a" cooperate defect) :keyword) :strategy (lambda () (nth (random total) moves))})) This way, we can get a true coin-flipper. THE-PRISONERS> (gambler) {:NAME :GAMBLER1/1 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B5824B}>} THE-PRISONERS> Or someone who mostly cooperates/defects, but sometimes defects/cooperates. THE-PRISONERS> (gambler :cooperate 5) {:NAME :GAMBLER5/1 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B69F0B}>} THE-PRISONERS> (gambler :defect 5) {:NAME :GAMBLER1/5 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B6C38B}>} THE-PRISONERS> How do they play against each of the others? Lets find out. The Second Simplest Game (defun matches (elems &key (mirror? t)) (loop for (a . rest) on elems while rest if mirror? collect (cons a a) append (loop for b in rest collect (cons a b)))) (defun all-against-all! (game matches) (reduce (lambda (memo res) (merge-by #'+ memo res)) (loop for (a . b) in matches collect (let ((res (play! game a b))) {(lookup a :name) (first res) (lookup b :name) (second res)})))) This lets us see who does better against everyone. THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5)))) {:GAMBLER1/5 13 :GAMBLER1/1 9 :GAMBLER5/1 8 :DEFECTOR 10 :COOPERATOR 8} THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5)))) {:GAMBLER1/5 8 :GAMBLER1/1 7 :GAMBLER5/1 8 :DEFECTOR 15 :COOPERATOR 10} THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5)))) {:GAMBLER1/5 10 :GAMBLER1/1 7 :GAMBLER5/1 8 :DEFECTOR 15 :COOPERATOR 8} THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5)))) {:GAMBLER1/5 11 :GAMBLER1/1 10 :GAMBLER5/1 11 :DEFECTOR 10 :COOPERATOR 6} THE-PRISONERS> The defector comes out on top here. And the mostly-defecting gambler doesn't do bad either. Of course, this is what we would expect from the one-time game. An iterated game is like a series of one-time games, and it keeps a running total of the score. (defun iterated (&key (iterations 10)) (lambda (player-a player-b) (loop repeat iterations for (a b) = (one-time player-a player-b) sum a into a-sum sum b into b-sum finally (return (list a-sum b-sum))))) It plays about how you'd expect THE-PRISONERS> (play! (iterated) (defector) (cooperator)) (50 10) THE-PRISONERS> (play! (iterated) (cooperator) (cooperator)) (30 30) THE-PRISONERS> (play! (iterated) (defector) (defector)) (0 0) THE-PRISONERS> And setting the world at its' own throat works the way you'd expect of this process so far. THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5)))) {:GAMBLER1/5 119 :GAMBLER1/1 117 :GAMBLER5/1 105 :DEFECTOR 135 :COOPERATOR 100} THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5)))) {:GAMBLER1/5 132 :GAMBLER1/1 109 :GAMBLER5/1 103 :DEFECTOR 120 :COOPERATOR 100} THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5)))) {:GAMBLER1/5 100 :GAMBLER1/1 124 :GAMBLER5/1 92 :DEFECTOR 130 :COOPERATOR 96} THE-PRISONERS> There are more elaborate strategies we can call upon. I won't implement them all here, but these have been thought of. Thoughtful Players Robin alternates between cooperating and defecting. (defun robin () (let ((prev :cooperate)) {:name :robin :strategy (lambda () (if (coop? prev) (setf prev :defect) (setf prev :cooperate)))})) And then, there are the simplest strategies that consider their opponent. (defun polo () (let ((prev nil)) {:name :polo :update (lambda (opponent-action) (setf prev opponent-action)) :strategy (lambda () (or prev :cooperate))})) (defun dantes () (let ((plan :cooperate)) {:name :dantes :update (lambda (action) (when (defe? action) (setf plan :defect))) :strategy (lambda () plan)})) With the addition of these, it's no longer obviously a defector s game. THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 164 :DANTES 131 :GAMBLER1/1 150 :GAMBLER5/1 169 :DEFECTOR 150 :COOPERATOR 184 :POLO 120 :ROBIN 147} THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 168 :DANTES 126 :GAMBLER1/1 176 :GAMBLER5/1 159 :DEFECTOR 165 :COOPERATOR 184 :POLO 129 :ROBIN 136} THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 158 :DANTES 121 :GAMBLER1/1 154 :GAMBLER5/1 156 :DEFECTOR 150 :COOPERATOR 184 :POLO 123 :ROBIN 154} THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 163 :DANTES 131 :GAMBLER1/1 163 :GAMBLER5/1 161 :DEFECTOR 175 :COOPERATOR 184 :POLO 117 :ROBIN 146} THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 789 :DANTES 656 :GAMBLER1/1 940 :GAMBLER5/1 964 :DEFECTOR 720 :COOPERATOR 1056 :POLO 585 :ROBIN 752} THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 845 :DANTES 651 :GAMBLER1/1 892 :GAMBLER5/1 959 :DEFECTOR 775 :COOPERATOR 1054 :POLO 609 :ROBIN 719} THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 788 :DANTES 651 :GAMBLER1/1 929 :GAMBLER5/1 946 :DEFECTOR 775 :COOPERATOR 1044 :POLO 609 :ROBIN 744} THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 859 :DANTES 651 :GAMBLER1/1 867 :GAMBLER5/1 952 :DEFECTOR 765 :COOPERATOR 1048 :POLO 609 :ROBIN 729} THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 833 :DANTES 666 :GAMBLER1/1 920 :GAMBLER5/1 953 :DEFECTOR 775 :COOPERATOR 1046 :POLO 603 :ROBIN 720} THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 8325 :DANTES 6436 :GAMBLER1/1 9255 :GAMBLER5/1 9544 :DEFECTOR 7565 :COOPERATOR 10508 :POLO 8976 :ROBIN 7383} THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 8365 :DANTES 6531 :GAMBLER1/1 9289 :GAMBLER5/1 9531 :DEFECTOR 7645 :COOPERATOR 10486 :POLO 6018 :ROBIN 7379} THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 8407 :DANTES 6546 :GAMBLER1/1 9139 :GAMBLER5/1 9574 :DEFECTOR 7590 :COOPERATOR 10554 :POLO 6117 :ROBIN 7389} THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 8063 :DANTES 6371 :GAMBLER1/1 9231 :GAMBLER5/1 9492 :DEFECTOR 7555 :COOPERATOR 10508 :POLO 6084 :ROBIN 7412} THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 8068 :DANTES 6456 :GAMBLER1/1 9165 :GAMBLER5/1 9614 :DEFECTOR 7395 :COOPERATOR 10516 :POLO 6003 :ROBIN 7451} THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))) {:GAMBLER1/5 8241 :DANTES 6356 :GAMBLER1/1 9150 :GAMBLER5/1 9579 :DEFECTOR 7545 :COOPERATOR 10480 :POLO 9021 :ROBIN 7392} THE-PRISONERS> When it's a prisoner against the world, the makeup of the world makes a difference in which prisoner ultimately wins. (defun winner (results) (let ((max nil) (score nil)) (loop for (k . v) in (as-list results) do (if (or (not score) (> v score)) (setf score v max (cons k v)))) max)) Currently, with mirror matches happening, the world is tilted towards cooperator s. THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10554) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10532) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10486) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10536) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10478) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10502) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10540) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10516) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))) (:COOPERATOR . 10476) THE-PRISONERS> Without mirror matches, it's still mostly a cooperator s' game, but not quite so strongly. THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:DEFECTOR . 7665) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:ROBIN . 7497) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:COOPERATOR . 7512) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:COOPERATOR . 7580) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:COOPERATOR . 7516) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:COOPERATOR . 7528) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:DEFECTOR . 7615) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:DEFECTOR . 7610) THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil))) (:COOPERATOR . 7550) THE-PRISONERS> This wasn't the end. It was step one.

·

10 days ago

This template engine is interesting because it allows mixing lisp code blocks and HTML in a way simple enough to be used by non-lisp developers and designers. It's interesting feature is that each template definition includes the arguments list. Here is how we can define templates for user list from the previous post about cl-emb: POFTHEDAY> (eco:compile-string " <% deftemplate user (nickname name) () %> <a href=\"/users/<%= nickname %>\"><%= name %></a> <% end %> ") POFTHEDAY> (eco:compile-string " <% deftemplate user-list (users) () %> <ul> <% loop for (nickname name) in users do %> <li><%- user nickname name %><% end %></li> <% end %> </ul> <% end %> ") POFTHEDAY> (eco-template:user-list '(("bob" "Bob Hopkins") ("alice" "Alice Cooker"))) " <ul> <li> <a href=\"/users/bob\">Bob Hopkins</a> </li> <li> <a href=\"/users/alice\">Alice Cooker</a> </li> </ul> " Also, there is a way to load templates from the files with .eco extensions. There is an ASDF extension which allows defining these templates as components of your ASDF system. Documentation does not cover this, but the template components should be defined like this: (defsystem mysite :defsystem-depends-on (eco) :components ((:module "src" :depends-on "templates" :components ((:file "backend-code") (:file "utils"))) (:module "templates" :components ((:eco-template "index-page") (:eco-template "users"))))) Well, let's measure Eco's performance! POFTHEDAY> (eco:compile-string " <% deftemplate perform (title items) () %> <title><%= title %></title> <ul> <% loop for item in items do %> <li><%= item %></li> <% end %> </ul> <% end %> ") POFTHEDAY> (time (loop repeat 1000000 do (eco-template:perform "Foo Bar" '("One" "Two" "Three")))) Evaluation took: 2.135 seconds of real time 2.144360 seconds of total run time (2.121050 user, 0.023310 system) [ Run times consist of 0.141 seconds GC time, and 2.004 seconds non-GC time. ] 100.42% CPU 4,713,480,570 processor cycles 1,008,017,904 bytes consed This is slower than half of the tested template engines. It took place between cl-who and print-html . I've expected it will be faster :( The chart with all html template engines performance can be found here.

·

11 days ago

This is an interesting templating library. The most interesting features are: named template pieces can call each other;

debug mode allows to inspect generated code;

different escape methods. Here is how template functions can be reused: POFTHEDAY> (cl-emb:register-emb "user" "<a href=\"/users/<% @var nickname %>\"><% @var name %></a>") POFTHEDAY> (cl-emb:register-emb "user-list" " <ul> <% @loop users %> <li><% @call user %></li> <% @endloop %> </ul> ") POFTHEDAY> (cl-emb:execute-emb "user-list" :env '(:users ((:nickname "bob" :name "Bob Hopkins") (:nickname "alice" :name "Alice Cooker")))) " <ul> <li><a href=\"/users/bob\">Bob Hopkins</a></li> <li><a href=\"/users/alice\">Alice Cooker</a></li> </ul> " Let's see which code was generated for "user-list". To make this work, we'll need to set *debug* variable and recompile the template: POFTHEDAY> (cl-emb:pprint-emb-function "user-list") (LAMBDA ( &KEY CL-EMB-INTERN::ENV CL-EMB-INTERN::GENERATOR-MAKER CL-EMB-INTERN::NAME) (DECLARE (IGNORABLE CL-EMB-INTERN::ENV CL-EMB-INTERN::GENERATOR-MAKER)) (LET ((CL-EMB-INTERN::TOPENV CL-EMB-INTERN::ENV) (CL-EMB-INTERN::TEMPLATE-PATH-DEFAULT (IF (TYPEP CL-EMB-INTERN::NAME 'PATHNAME) CL-EMB-INTERN::NAME *DEFAULT-PATHNAME-DEFAULTS*))) (DECLARE (IGNORABLE CL-EMB-INTERN::TOPENV CL-EMB-INTERN::TEMPLATE-PATH-DEFAULT)) (WITH-OUTPUT-TO-STRING (*STANDARD-OUTPUT*) (PROGN (WRITE-STRING " <ul> ") (DOLIST (CL-EMB-INTERN::ENV (CL-EMB::AUTOFUNCALL (CL-EMB::GETF-EMB "users"))) (WRITE-STRING " <li>") (FORMAT T "~A" (LET ((CL-EMB:*ESCAPE-TYPE* CL-EMB:*ESCAPE-TYPE*)) (CL-EMB:EXECUTE-EMB "user" :ENV CL-EMB-INTERN::ENV :GENERATOR-MAKER CL-EMB-INTERN::GENERATOR-MAKER))) (WRITE-STRING "</li> ")) (WRITE-STRING " </ul> "))))) As you can see, cl-emb generates a straight forward Lisp code. Now let's check how fast cl-emb is and compare it to HTML template engines reviewed in previous days: POFTHEDAY> (cl-emb:register-emb "render" " <title><% @var title %></title> <ul> <% @loop items %><li><% @var value %></li><% @endloop %> </ul> ") POFTHEDAY> (time (loop repeat 1000000 do (cl-emb:execute-emb "render" :env '(:title "Foo Bar" :items ((:value "One") (:value "Two") (:value "Three")))))) Evaluation took: 1.436 seconds of real time 1.441475 seconds of total run time (1.421158 user, 0.020317 system) [ Run times consist of 0.104 seconds GC time, and 1.338 seconds non-GC time. ] 100.35% CPU 3,172,183,256 processor cycles 767,974,304 bytes consed That is pretty fast. Slightly slower than Spinneret but faster than Zenekindarl . To learn more about cl-emb's features, read it's docs!

·

12 days ago

This library is a port of Django templates. Its coolest feature are: template inheritance;

autoreload;

internationalization. Also, there is nice documentation. In presence of documentation, I won't provide many examples. Instead, let's implement a small function for our HTML templating engines performance test. I didn't find the way to load a template from the string. That is why we need to set up the library and let it know where to search template files: POFTHEDAY> djula:*current-store* #<DJULA:FILE-STORE {100248A8C3}> POFTHEDAY> (djula:find-template djula:*current-store* "test.html") ; Debugger entered on #<SIMPLE-ERROR "Template ~A not found" {1003D5F073}> [1] POFTHEDAY> ; Evaluation aborted on #<SIMPLE-ERROR "Template ~A not found" {1003D5F073}> POFTHEDAY> (djula:add-template-directory "templates/") ("templates/") Now we need to write such template to the templates/test.html : <h1>{{ title }}</h1> <ul> {% for item in items %} <li>{{ item }}</li> {% endfor %} </ul> And we can test it: POFTHEDAY> (djula:find-template djula:*current-store* "test.html") #P"/Users/art/projects/lisp/lisp-project-of-the-day/templates/test.html" (defparameter +welcome.html+ (djula:compile-template* "welcome.html")) POFTHEDAY> (with-output-to-string (s) (djula:render-template* (djula:compile-template* "test.html") s :title "Foo Bar" :items '("One" "Two" "Three"))) "<h1>Foo Bar</h1> <ul> <li>One</li> <li>Two</li> <li>Three</li> </ul> " It is time to measure performance: ;; We need this to turn off autoreloading ;; and get good performance: POFTHEDAY> (pushnew :djula-prod *features*) POFTHEDAY> (defparameter *template* (djula:compile-template* "test.html")) POFTHEDAY> (defun render (title items) (with-output-to-string (s) (djula:render-template* *template* s :title title :items items))) POFTHEDAY> (time (loop repeat 1000000 do (render "Foo Bar" '("One" "Two" "Three")))) Evaluation took: 4.479 seconds of real time 4.487983 seconds of total run time (4.453540 user, 0.034443 system) [ Run times consist of 0.183 seconds GC time, and 4.305 seconds non-GC time. ] 100.20% CPU 9,891,631,814 processor cycles 1,392,011,008 bytes consed Pay attention to the line adding :djula-prod to the *features* . It disables auto-reloading. Withf enabled auto-reloading rendering is 2 times slower and takes 10.6 microseconds. I could recommend Djula to everybody who works in a team where HTML designers are writing templates and don't want to dive into Lisp editing. With Djula they will be able to easily fix templates and see results without changing the backend's code. Also, today I've decided to create a base-line function which will create HTML using string concatenation as fast as possible. This way we'll be able to compare different HTML templating engines with the hand-written code: POFTHEDAY> (defun render-concat (title items) "This function does not do proper HTML escaping." (flet ((to-string (value) (format nil "~A" value))) (apply #'concatenate 'string (append (list "<title>" (to-string title) "</title>" "<ul>") (loop for item in items collect "<li>" collect (to-string item) collect "</li>") (list "</ul>"))))) POFTHEDAY> (render-concat "Foo Bar" '("One" "Two" "Three")) "<title>Foo Bar</title><ul><li>One</li><li>Two</li><li>Three</li></ul>" POFTHEDAY> (time (loop repeat 1000000 do (render-concat "Foo Bar" '("One" "Two" "Three")))) Evaluation took: 0.930 seconds of real time 0.938568 seconds of total run time (0.919507 user, 0.019061 system) [ Run times consist of 0.114 seconds GC time, and 0.825 seconds non-GC time. ] 100.97% CPU 2,053,743,332 processor cycles 864,022,384 bytes consed Writing to stream a little bit slower, so we'll take as a base-line the result from render-concat : POFTHEDAY> (defun render-stream (title items) "This function does not do proper HTML escaping." (flet ((to-string (value) (format nil "~A" value))) (with-output-to-string (out) (write-string "<title>" out) (write-string (to-string title) out) (write-string "</title><ul>" out) (loop for item in items do (write-string "<li>" out) (write-string (to-string item) out) (write-string "</li>" out)) (write-string "</ul>" out)))) WARNING: redefining POFTHEDAY::RENDER-STREAM in DEFUN RENDER-STREAM POFTHEDAY> (time (loop repeat 1000000 do (render-stream "Foo Bar" '("One" "Two" "Three")))) Evaluation took: 1.208 seconds of real time 1.214637 seconds of total run time (1.196847 user, 0.017790 system) [ Run times consist of 0.102 seconds GC time, and 1.113 seconds non-GC time. ] 100.58% CPU 2,667,477,282 processor cycles 863,981,472 bytes consed By, the way, I tried to use str:replace-all for escaping < and > symbols in the handwritten version of the render-concat function. But its performance degraded dramatically and became 36 microseconds. str:replace-all uses cl-ppcre for text replacement. What should I use instead?

·

23 days ago



Another month already. Fortunately there's a lot of stuff to talk about for Kandria this time around, so I hope you're ready for a beefy summary! This month was originally intended to be focused on marketing and recruitment, but for more reasons than one that's not entirely how it went down after all. The biggest reason among the bunch being that it has proven really hard for me to concentrate on that - they're topics I have no experience with, so I don't feel very comfortable dealing with them at all. Regardless, there's been a few things I've done to help in that regard: There is now a lengthy game design document that should hopefully give a good idea of what the game should be and should be about. It's mostly meant as a communication tool for future team members, to help them get up to speed on the project, and for potential team members to evaluate whether this project is something for them. If you have a read through it, I would appreciate your thoughts on it a lot! Being in an opinion vacuum doesn't help with creativity. Next I started working on an official job listing. It's not quite done yet and I want to run it by a few people before I get it out there, but if you are or know pixel artists or writers, I'd appreciate it tremendously if you could keep an eye open for the listing. I'll make another announcement about it on all the channels once it's out. Edit: the job listing is now out: https://kandria.com/team-search.html?a I've also started a thread on some forums to try and spread awareness of the game, but I'm worrying that I'm spreading myself too thin and can't tend to all of the outlets as much as I'd like. There's already email, Twitter, and Discord to take care of besides that. With Kandria not being a full-time job yet, I'm not sure how much time I should be spending on the social media channels, rather than spending it on development. Maybe I should reserve a day for it every week? Either way, top priority for the coming few weeks will be finding new team members, and I'll definitely have to invest some more energy to get that going. I've also made some good progress on the code and art side: first I've implemented some more dynamic interactions to make the environment feel more alive: These, especially the under water physics, still need some work in the future, but for only having spent a single day on them they already look quite promising. I have a few more ideas for dynamic interactions like that that I want to try and implement soon, too. All in all this should really help to make the world feel more alive and real, rather than being just a static map of tiles. Sort of adjacent to this I created a custom distortion effect that'll be useful for indicating damage and death: Then there were mechanical changes to the game: so far you could climb up walls indefinitely. I've decided to change this and implement a simple stamina system, as this will allow greater control over where the player can or cannot go, thus making it possible to block off certain routes and regions until later. It should also provide for more interesting platforming challenges and interactions with other elements like the rope. Finally there were a bunch of good bugfixes thanks to public feedback! These aren't rolled out in the latest downloadable prototype yet, but they'll be in the next one, which I hope to release sometime this month. I've also automated deployment almost fully, allowing me to upload new updates at the push of a button. For now I'm keeping the public prototypes at a staggered release schedule, with a separate rolling release tester group on Steam. I'll provide more info about the Steam testing group once I have a better bug reporting system in place. Then I've gotten back to re-integrating the dialog system. This is now pretty much done, the only missing component is the quest system that controls what dialog can be active at what point and things like that. I'll probably get to that next once I've rounded up some more issues with audio, though more on that in a second. The dialog system I have in Kandria is pretty powerful, and I've written a lengthy bit about it in the weekly newsletter. I also started working on profile animations for that: They'll need some more work though, as I'm not convinced they fit very well into the dialog box as I've got it so far. I think I'll have to try out anti-aliasing to smoothen the animations out some more. Maybe that'll make it feel more at home with the pretty crisp textbox. That's not very high on my list of priorities though, so I'll keep it for another time. Finally, after months of pretty painful debugging and coding, I've made a breakthrough with my audio engine! It's now conceptually complete and just needs some good integration testing within Kandria. The good news is that, aside from a missing reverb implementation, it should offer everything I need for Kandria, and more, so using it for all of my future projects is definitely on the table. Since this has been such a long and arduous journey, I wanted to take some good time to explain the system. If you're interested in that, you can read about it here. Suffice to say, the next prototype release will finally have sound! It'll be a bit before the sound in Kandria will be custom and accompanied by nice, composed music specifically for the game, though. Music and sound is something I've been thinking about for a long time, but I'm purposefully putting it off for much later, as I know it needs to fit the places, story, and characters, all of which have not been sufficiently worked out yet. Looking back at the roadmap that I published in June, it seems like I'm getting ahead pretty well despite the many issues that propped up along the way. A lot of the big blockers have already been fixed, and with a bigger team the rest should get ahead pretty well, too. I don't want to jinx it, but it's looking like the March deadline for the vertical slice is doable! Alright, so to summarise the plan for this month: complete the job listing, re-integrate the quest system, add some preliminary sounds and music, improve the bug reporting, and release the 0.0.3 demo. We'll see how much of that, if not more, I get done by next month. If you want to get the weekly updates with more details on what's going on until then, subscribe to the newsletter!

·

23 days ago



It turns out that sound processing is pretty difficult. I've been hacking away at an almost from-scratch rewrite of Shirakumo's sound systems for the past few months and it's caused a lot of anguish. Now, Harmony is not a new system. It dates back quite a few years, and I had even written another article on it previously. However, this previous version had several serious flaws and problems, some of which penetrating all the way through the audio stack. With the rewrite I'm however now much more confident in the quality and usability of the system. First though, a bit of terminology: in digital audio processing, audio is represented as a sequence of samples; regularly recorded amplitudes of the audio signal. These samples are recorded at a constant rate, the "sample rate," which often is either 44.1kHz or 48kHz. Often each sample is represented as a float going from -1 to +1, and multiple such sample sequences are combined to form the signal for as many channels as you need (stereo, surround, etc.) When processing audio data, a limited sequence of samples is kept in a buffer, which processors can then operate on. The initial problem with the system was one of resampling: the system was written with the assumption that one could keep a constant samplerate throughout the entire audio processing pipeline. This, however, turned out to not be suitable. The issue manifested itself on Windows, where the output backend could require a different samplerate to the one the system was initially configured for. Thus, at least at the end-points, resampling would be required. This immediately lead to another problem though: the system was also written with the assumption that every part of the pipeline could consume and produce a full audio buffer every time it was run. However, with resampling, border issues appear and it's not always possible to consume the full input buffer. This issue permeates throughout the processing pipeline, as now the final processor cannot consume all data, and so when the system is run next, the processor before the last cannot produce a full buffer as it would overwrite data. Ultimately though, the fixed samplerate and fixed buffer size design lead to a restriction that made it impossible to represent certain effects like a speed change, which would produce and consume samples at different rates. And so, pretty much everything had to be rewritten to work with this in mind. To spare you the troublesome process of figuring out a design, let's just jump to what the system is like now: At the most basic level resides the bip-buffer interface, which implements a lockless bipartite buffer. It's lockless so that one thread can write, and another can read from it simultaneously. It's bipartite so that the regions it hands out are always consecutive regions of memory, rather than wrapping around like in a ring buffer. This interface is implemented by buffer s and pack s. buffer s represent internal audio samples of one channel in float format, whereas pack s represent external audio samples in any format, with any number of channels. Then there's the parts that actually perform audio processing. These are called segment s, and follow a generic interface that allows them to do their work, and also allows them to be introspected. Namely they each have a number of input fields, a number of output fields, and a number of parameter fields. To the input and output fields you can attach a buffer , which will cause the segment s to exchange data. Assembling a network is then just a matter of creating the segment s, creating a buffer for each connection, and then setting them at the appropriate in/out fields. At the endpoints, where you need to exchange data with other systems such as file decoders or device drivers, you'll probably want to make use of the unpacker and packer segments, which perform the necessary encoding to translate between the float buffer s and the compact pack s. These segments will also perform sample rate conversion as necessary. Since we have proper bip buffers connecting everything, a segment can now consume and produce at a variable rate without needing to be aware of the rates going on in the rest of the system. The rates will automatically propagate through the system as the buffers are updated. Now, all of this behaviour, including many practical standard segment s are implemented in a C library called libmixed. Audio has some pretty severe latency restrictions, and that's why, with great pain, I decided to implement the bulk of the audio processing in C, rather than Lisp. This has cost me a lot of time, but I still think the performance gains are worth it, or I would have had to spend similar, if not more time, trying to match the performance with Lisp code. I hope that this kind of thing will no longer be necessary at some point in the future, but for now this is where we are. Anyway, being implemented in C also means it can be useful for people outside of Lisp, and I really do hope that others will take advantage of libmixed, as I think it has a lot of useful work behind it. To my knowledge there's currently no free (as in BSD) and capable audio processing system out there. The library also offers a plugin and reflection/introspection API so that one could build a GUI that can represent segments and buffers in a very generic fashion, allowing users to easily plug together processing networks. Now, one level above libmixed sits cl-mixed, the Lisp bindings library that takes care of the low level stuff and wraps it all in a nice Lisp interface. It also takes care of offering some support structures where needed, such as managing the input locations when dealing with variable input segments such as mixers. It also offers a ton of extension systems for interacting with various file formats and playback backends: ALSA Linux playback

Linux playback CoreAudio macOS playback

macOS playback FLAC FLAC file decoding

FLAC file decoding Jack JackAudio playback

JackAudio playback OSS OSS playback (BSD)

OSS playback (BSD) PulseAudio Linux desktop playback

Linux desktop playback SDL2 SDL2 integration if you're already using SDL2

SDL2 integration if you're already using SDL2 WASAPI Windows Vista+ playback

Windows Vista+ playback WAV WAV file decoding

WAV file decoding WinMM Windows 3.0+ playback

Windows 3.0+ playback XAudio2 Windows 8+ playback

Windows 8+ playback mpg123 MP3 decoding

MP3 decoding out123 Cross-platform playback (C blob) I'd like to add more decoders, and at some point also input for the various operating system backends, but for now this is more than plenty. Some of the backends still have issues (WinMM, XAudio2, CoreAudio), which I have spent a long time trying to figure out already, so far unsuccessful. I'm not too bothered about WinMM and XAudio2, but CoreAudio definitely needs to be made to work properly soon. The reason these backends are implemented in Lisp is so that there's no additional dependencies on shared libraries that might be versioned and interact poorly when deployed. Since the actual work performed in their respective segment amounts to requesting a buffer region and performing one call, the performance impact from it should also be entirely negligible. cl-mixed also offers a virtual segment that allows you to implement a segment in Lisp and integrate it into a standard pipeline. This is possible thanks to the standardised architecture in libmixed, and can be very useful to experiment with effects very quickly. If I ever intend on developing a new effects segment, I'll definitely implement it in Lisp first to take advantage of rapid prototyping, before lowering it down to C if performance should become an issue. On that note, cl-mixed actually uses static-vectors to implement the backing storage of pack s and buffer s, as well as all of the bip-buffer protocol. This means that you can interact with packs and buffers from Lisp as if they were normal Lisp arrays, without ever having to worry about FFI. That said, cl-mixed will not do buffer management or resource management in general for you. You'll still have to manually create and free segments and buffers and make sure they're connected. You'll also have to run the mixing loop yourself and make sure you do that often enough to not cause stuttering. This is where Harmony steps in. Being the high-level component, it imposes a bit of architecture on you, but in turn takes care of a lot of lower level plumbing. In effect, with Harmony you can perform playback as easily as: (harmony:start (harmony:make-simple-server)) (harmony:play "music.mp3" :mixer :music :loop T) (harmony:play "effect.wav" :mixer :effect :location '(10 0 0)) It'll take care of detecting the appropriate backend for your platform, setting up channel conversion and basic mixing infrastructure, allocating and re-using buffers, automatically cleaning up when a sound source ends, and performing low-latency audio processing in the background. It can also do fun stuff like automatically creating a network to apply effects to a source. (harmony:play "music.wav" :mixer :music :effects '((mixed:speed-change :speed-factor 2.0) (mixed:pitch :pitch 0.5))) Which would play the music at double the speed, but with a pitch correction applied so that the notes should still be the correct frequency. Hopefully this will make it easy enough to use for games without having to worry about all the low level detail aspects. I'm going to find out how well this all works soon, as it's now at a stable enough state that I can start working it into Kandria. If you're interested in using these systems or contributing to them, let me know! I'd be happy to provide assistance. If you like my work in general and want to donate, you can do that too, either on GitHub Sponsors for recurring donations, or on Ko-Fi for one-time donations. Thanks for reading!

·

25 days ago

·

28 days ago

This system implements an LTSV logs parser and serializer. LTSV is based on TSV format but each field has a name. This lets us easily add new fields and to process logs in a manageable way: POFTHEDAY> (cl-ltsv:alist-ltsv '(("message" . "Hello world!") ("request_id" . 100500))) "message:Hello world! request_id:100500" POFTHEDAY> (cl-ltsv:parse-line *) (("message" . "Hello world!") ("request_id" . "100500")) LTSV is based on TSV format which has some escaping rules for tabs, newlines and backslashes, but LTSV FAQ says forget about escaping, we don't need it for our access logs. I think this decision makes LTSV unusable for general-purpose logs. For example, if you have newlines or tabs in the logged value, a log will be broken: POFTHEDAY> (concatenate 'string "Hello" '(#\Newline #\Tab) "World!") "Hello World!" ;; This call should produce a single line, ;; replacing a newline with

and tab with \t: POFTHEDAY> (cl-ltsv:alist-ltsv (list (cons "message" *))) "message:Hello World!" ;; Parsing does not process escaped symbols either: POFTHEDAY> (cl-ltsv:parse-line "message:Hello\

\\tWorld!") (("message" . "Hello\

\\tWorld!")) That is all I have for today. Probably tomorrow we'll catch a more interesting library.

·

29 days ago

This system provides a framework for building parsers in a functional way. Smug parsers are lisp functions which can be combined together to process complex grammar. Actually, it can process anything, not only the text - any data source which can be read token by token is suitable. Documentation on smug is extremely good! I'll how only the basics. Good job, @drewcrampsie. Read the official tutorial to learn in deep how this sytem works! Today we'll create a parser which will be able to transform texts like "3 days ago" into the local-time-duration:duration objects. To start, let's create a simple parser which will match a digit character: POFTHEDAY> (defun .digit () (smug:.is #'digit-char-p)) POFTHEDAY> (smug:run (.digit) "17 hours ago") ((#\1 . "7 hours ago")) We can use .map to capture a sequence of digits matched to the parser: POFTHEDAY> (smug:run (smug:.map 'list (.digit)) "17 hours ago") (((#\1 #\7) . " hours ago") ((#\1) . "7 hours ago")) ;; We also might produce strings: POFTHEDAY> (smug:run (smug:.map 'string (.digit)) "17 hours ago") (("17" . " hours ago") ("1" . "7 hours ago")) Now it is time to transform it into the number. I'll wrap all code into the parser function and use smug:.bind to process the captured values: POFTHEDAY> (defun .integer () (smug:.bind (smug:.map 'string (.digit)) (lambda (text) (smug:.identity (read-from-string text))))) POFTHEDAY> (smug:run (.integer) "17 hours ago ") ((17 . " hours ago ") (1 . "7 hours ago ")) It is time to parse time units: POFTHEDAY> (smug:run (smug:.prog1 (smug:.string-equal "hour") ;; This will "eat" the "s" letter ;; on the end of the plural form ;; if it is used: (smug:.string-equal "s")) "hours ago") (("hour" . " ago")) ;; Again, we'll want to convert the string into the keyword and to wrap ;; the parser into a function: POFTHEDAY> (defun .unit () (smug:.bind (smug:.prog1 (smug:.or (smug:.string-equal "hour") (smug:.string-equal "minute") (smug:.string-equal "second")) ;; This will "eat" the "s" letter ;; on the end of the plural form ;; if it is used: (smug:.or (smug:.string-equal "s") (smug:.identity nil))) (lambda (text) (smug:.identity (alexandria:make-keyword (string-upcase text)))))) POFTHEDAY> (smug:run (.unit) "hours ago") ((:HOUR . " ago")) And finally, we need a parser to process optional suffix pointing to the time in past: POFTHEDAY> (defun .in-past-p () (smug:.or (smug:.string-equal "ago") (smug:.identity nil))) POFTHEDAY> (smug:run (.in-past-p) "ago") (("ago" . "")) POFTHEDAY> (smug:run (.in-past-p) "some") ((NIL . "some")) It is time to combine our parsers into a more complex one which will return a local-time-duration : POFTHEDAY> (defun .whitespace () (smug:.is #'member '(#\Space #\Tab #\Newline))) POFTHEDAY> (defun .duration () (smug:.let* ((value (.integer)) (_ (.whitespace)) (unit (.unit)) (_ (.whitespace)) (in-past (.in-past-p))) (let* ((seconds (* value (ecase unit (:hour (* 60 60)) (:minute 60) (:second 1)) (if in-past -1 1))) (duration (make-instance 'local-time-duration:duration :sec seconds))) (smug:.identity duration)))) ;; A few checks if everything is OK: POFTHEDAY> (smug:parse (.duration) "17 hours ago") #<LOCAL-TIME-DURATION:DURATION [0/-61200/0] -17 hours> POFTHEDAY> (smug:parse (.duration) "5 minute ") #<LOCAL-TIME-DURATION:DURATION [0/300/0] 5 minutes> That is it for today. And again, to learn more, read SMUG's documentation. It is one of the best-documented Lisp systems I've ever seen: http://smug.drewc.ca/smug.html Thank you, @drewcrampsie!

·

30 days ago

This is the library by MichaÅ‚ "phoe" Herda. It extends CLOS allowing to use lists of symbols as class names: POFTHEDAY> (list-named-class:defclass (:user :model) () ()) POFTHEDAY> (list-named-class:defclass (:user :view) () ()) POFTHEDAY> (list-named-class:defgeneric render (obj)) POFTHEDAY> (list-named-class:defmethod render ((obj (:user :view))) (format nil "Rendered User View")) POFTHEDAY> (list-named-class:make-instance '(:user :view)) #<(:USER :VIEW) {10076F6CC3}> POFTHEDAY> (render *) "Rendered User View" This can be useful when classes are defined using some macros. Not sure why somebody should prefer such class-names instead of symbols. Here are some examples of list-named-class usage I found in the wild: https://github.com/RaptorLauncher/Gateway/blob/5fc2d404cd53854f570b8debbd869053d3a71043/wip/messages/hello.lisp

https://github.com/RaptorLauncher/Gateway/blob/035701b804873265b9eb59e1b97a92645aa4388b/wip/library/base/impl/standard-message.lisp

·

31 days ago

This is a small library by @thebaggers allows you to define functions which work only specified amount of time. You can use it to define a named function or to create a lambda. This will print a greeting only 10 seconds since definition: POFTHEDAY> (temporal-functions:defun-t foo () (temporal-functions:before (temporal-functions:seconds 10) (print "Hello Lisp World!"))) POFTHEDAY> (foo) "Hello Lisp World!" "Hello Lisp World!" POFTHEDAY> (foo) "Hello Lisp World!" "Hello Lisp World!" POFTHEDAY> (foo) NIL POFTHEDAY> (temporal-functions:expiredp (foo)) T It is possible to create a function which starts doing something after the specified amount of time: POFTHEDAY> (temporal-functions:tlambda () (temporal-functions:after (temporal-functions:seconds 10) (print "Now I'm working!"))) #<CLOSURE (LAMBDA ()) {1001D5183B}> POFTHEDAY> (funcall *) NIL POFTHEDAY> (funcall **) "Now I'm working!" "Now I'm working!" There are also other constructions like then , repeat , each , until and once . But I wasn't able to figure out the right way to use them. It would be wonderful if @thebaggers update the documentation!

·

32 days ago

So apparently, there's no bcrypt implementation for Common Lisp. There's an ffi wrapper which isn't in quicklisp , but that's all I could find. Which is mildly annoying, because as mentioned last time, I need to store tokens basically the same way I would store passwords. There doesn't seem to be anything similar at a cursory glance, although it's always possible I missed something. Oh well. According to the Wikipedia article pseudocode, it looks like the essence of the algorithm is use the password as a key

to encrypt the plaintext "OrpheanBeholderScryDoubt" using blowfish in ECB mode

in mode repeatedly some number of times (determined by the cost argument) And the end result is a sufficiently one-way function that lets you store some string to compare with input later without actually keeping that string on file. So. tomb I preface this by saying that I am not a crypto nerd. Probably don't use this in production anywhere, and definitely don't use it anywhere security is an actual concern. I'm not aware of a way to back out the initial plaintext, but you should take Schneier's advice about what to think of that. That being said, I've got this toy project with a bcrypt -shaped hole in its :depends-on list, and I may as well try something. ;;;; src/tomb.lisp (in-package #:tomb) (defparameter *gen* (session-token:make-generator :token-length 16)) (defun entomb (string &key (salt (funcall *gen*)) (cost 10) (cipher-name :blowfish)) (let* ((arr (ironclad:ascii-string-to-byte-array (concatenate 'string string salt))) (initial-hash (hash-for-tomb arr cipher-name)) (cipher (ironclad:make-cipher cipher-name :key initial-hash :mode :ecb)) (output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash)))) (ironclad:encrypt cipher initial-hash output) (loop repeat (expt 2 cost) do (ironclad:encrypt-in-place (ironclad:make-cipher cipher-name :key output :mode :ecb) output)) (format nil "$0w$~a$~a$~a$~a" cipher-name cost salt (ironclad:byte-array-to-hex-string output)))) (defun hash-for-tomb (arr cipher-name) (ironclad:digest-sequence (case cipher-name (:threefish512 :sha512) (:threefish1024 :skein1024) (t :sha256)) arr)) (defun tomb-matches? (string hashed) (destructuring-bind (name cipher-name cost salt hash) (split-sequence:split-sequence #\$ hashed :remove-empty-subseqs t) (declare (ignore hash)) (assert (string= name "0w")) (let ((cost (parse-integer cost)) (cipher-name (intern cipher-name :keyword))) (string= (entomb string :salt salt :cost cost :cipher-name cipher-name) hashed)))) Principles first. Sane defaults - We don't want to make the user1 do any more work than they have to. Which means that the minimal call to the top level interface should be something that goes String -> String rather than needing the user to generate their own salt, specify a cipher or do any type conversions. Flexible implementation - We shouldn't assume a particular salting strategy, input size, or cipher. We need to limit ourselves to ECB mode, because changing that is deep magic that I'm not getting anywhere near without a deeper understanding. Use Crypto Primitives - Speaking of deep magic, we're not writing anything ourselves from the bytes up. ironclad is a thing, and it works well if sometimes counter-intuitively, and I fully intend to take advantage. With that out of the way, here's tomb , which is sort of like crypt . ... (defun entomb (string &key (salt (funcall *gen*)) (cost 10) (cipher-name :blowfish)) (let* ((arr (ironclad:ascii-string-to-byte-array (concatenate 'string string salt))) (initial-hash (hash-for-tomb arr cipher-name)) (cipher (ironclad:make-cipher cipher-name :key initial-hash :mode :ecb)) (output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash)))) (ironclad:encrypt cipher initial-hash output) (loop repeat (expt 2 cost) do (ironclad:encrypt-in-place (ironclad:make-cipher cipher-name :key output :mode :ecb) output)) (format nil "$0w$~a$~a$~a$~a" cipher-name cost salt (ironclad:byte-array-to-hex-string output)))) ... The core function is entomb . It takes a string (your password/passphrase), and optionally also salt , cost and cipher-name . If you don't pass in any of those, it chooses sane defaults, including using session-token / cl-isaac to generate a secure random salt value. The first thing we do is concatenate the string and salt values, convert the result to an ironclad byte-array , then hash it. Hashing it using some secure digest method that produces the appropriate number of bytes to be used as a key for the chosen cipher . ... (defun hash-for-tomb (arr cipher-name) (ironclad:digest-sequence (case cipher-name (:threefish512 :sha512) (:threefish1024 :skein1024) (t :sha256)) arr)) ... It looks like sha256 is good enough for most of the ECB capable ciphers in ironclad , but threefish512 and threefish1024 need larger keys than it provides, so we use other approaches when using those ciphers. I don't want to make it too easy to use weaker ciphers, so I don't bother using hashes that result in keys smaller than sha256 . ... (cipher (ironclad:make-cipher cipher-name :key initial-hash :mode :ecb)) (output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash)))) (ironclad:encrypt cipher initial-hash output) (loop repeat (expt 2 cost) do (ironclad:encrypt-in-place (ironclad:make-cipher cipher-name :key output :mode :ecb) output)) (format nil "$0w$~a$~a$~a$~a" cipher-name cost salt (ironclad:byte-array-to-hex-string output)))) ... Next up, we initialize an ironclad cipher with the appropriate base state, and allocate an output simple-array to stuff the results in. Then we use the initialized cipher to ironclad:encrypt our input hash (complete with salt ) and put the results in output . Once that's done, we encrypt-in-place the output with the same settings, changing out the key each time. The thing we're encrypting the first time though is the key (with itself), and every subsequent layer of encryption also uses itself as the key. Once we've done this, we stitch everything together into a string that contains documentation about its' creation. (defun tomb-matches? (string hashed) (destructuring-bind (name cipher-name cost salt hash) (split-sequence:split-sequence #\$ hashed :remove-empty-subseqs t) (declare (ignore hash)) (assert (string= name "0w")) (let ((cost (parse-integer cost)) (cipher-name (intern cipher-name :keyword))) (string= (entomb string :salt salt :cost cost :cipher-name cipher-name) hashed)))) tomb-matches? takes a string and an entomb ed string, and returns a yay or nay about whether they match. It does this by decomposing the entomb ed string in a way that lets it figure out what arguments to pass to entomb , and does so on the input string. Next Step This library is now on github in case you are like me, and want to experiment with low-security-but-principled systems. For my part, I'll probably add it to quicklisp , and definitely as a requirement to cl-vote so that I can put together a good recovery token system. It mildly amuses me to think that knowing that token in this case is technically a "known plaintext" attack.

·

33 days ago

This is a small library by @codeninja_blog. It provides only a macro to wrap and remember any form and a function to force its evaluation. For example, let's create a few functions which accept and return lazy objects: POFTHEDAY> (defun request-name () (lazy:lazy (format t "What is your name?~%") (read-line))) POFTHEDAY> (defun greet (name) (lazy:lazy (format nil "Hello ~A!~%" (lazy:lazy-value name)))) POFTHEDAY> (greet (request-name)) #<LAZY::THUNK UNREALIZED> POFTHEDAY> (lazy:lazy-value *) What is your name? Bob "Hello Bob! " ;; Second attempt to get the greeting value ;; is not request for the user's name: POFTHEDAY> (lazy:lazy-value **) "Hello Bob! " Or we can build a simple lazy sequences library. This function will create a sequence of numbers: POFTHEDAY> (defun make-lazy-sequence (&optional (start 0) (step 1)) (lazy:lazy (values start (make-lazy-sequence (+ start step) step)))) This one will skip a number of items: POFTHEDAY> (defun lazy-skip (n lazy-sequence) (lazy:lazy (loop do (multiple-value-bind (item rest) (lazy:lazy-value lazy-sequence) (when (zerop n) (return (values item rest))) (decf n) (setf lazy-sequence rest))))) And this one will force lazy evaluation and transform the sequence into the list: POFTHEDAY> (defun lazy-to-list (n lazy-sequence) (loop with result = nil do (multiple-value-bind (item rest) (lazy:lazy-value lazy-sequence) (when (zerop n) (return (nreverse result))) (push item result) (setf lazy-sequence rest) (decf n)))) And of cause we need a generic map function to apply transformations: POFTHEDAY> (defun lazy-mapcar (func sequence) (lazy:lazy (multiple-value-bind (item rest) (lazy:lazy-value sequence) (values (funcall func item) (lazy-mapcar func rest))))) Here is how we can apply these functions to process a lazy sequence: POFTHEDAY> (make-lazy-sequence) POFTHEDAY> (lazy-skip 5 *) POFTHEDAY> (lazy-mapcar (lambda (x) (format t "Multiplying ~A to ~A~%" x x) (* x x)) *) POFTHEDAY> (lazy-to-list 3 *) Multiplying 5 to 5 Multiplying 6 to 6 Multiplying 7 to 7 Multiplying 8 to 8 (25 36 49) But this will work only with my pull request which makes the lazy-value return all values, returned by original form. Anyway, lazy is a small and very nice library. Thank you, @codeninja_blog.

·

34 days ago

This library allows to dynamically create CLOS classes as a mixin composition. Mixins are choosen depending on parameters given to the constructor. For example, if we have in our system users, which can be authenticated and additionally can be admins, then we can to define their classes like: POFTHEDAY> (defclass user () ()) POFTHEDAY> (defclass authenticated () ((email :initarg :email))) POFTHEDAY> (defclass admin () ()) Now we need to tell the system how to apply our mixins when different parameters are passed. If there is :email , then the user will be considered authenticated. If there is :is-admin t - he is the admin. POFTHEDAY> (dynamic-classes:add-parameter->dynamic-class :user :email 'authenticated) NIL POFTHEDAY> (dynamic-classes:add-parameter->dynamic-class :user :is-admin 'admin) NIL We also have to declare these methods to make the framework do its job. Probably this can be avoided if only the default implementation was specialized not on class-type (eql nil) . POFTHEDAY> (defmethod dynamic-classes:include-class-dependencies ((class-type (eql :user)) dynamic-class class-list &rest parameters) "This method can modify list of classes used to combine into a new class for given parameters. Or some restrictions can be applied." (declare (ignorable dynamic-class parameters)) class-list) POFTHEDAY> (defmethod dynamic-classes:existing-subclass ((class-type (eql :user)) class-list) "This method allows to return a custom class. If it returns nil, the first class from the class-list will be choosen." (declare (ignorable class-list)) (values nil)) Now let's check how it works. There is a function to create and return the class depending on the parameters: POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user) USER POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email "some@gmail.com") USER-AND-AUTHENTICATED POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email nil) USER-AND-AUTHENTICATED POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email "some@gmail.com" :is-admin t) USER-AND-AUTHENTICATED-AND-ADMIN POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :is-admin t) USER-AND-ADMIN Do you see there a strange behavior? We can pass the nil as an email and user will be considered authenticated or we can use :is-admin without email and will get unauthenticated admin class! Fortunately, there is a hook to apply additional restrictions: POFTHEDAY> (defmethod dynamic-classes:include-class-dependencies ((class-type (eql :user)) dynamic-class class-list &rest parameters) (declare (ignorable dynamic-class parameters)) ;; If email is not given we don't want consider ;; the user authenticated: (when (and (member :email parameters) (null (getf parameters :email))) (rutils:removef class-list 'authenticated)) ;; And if :is-admin nil then he is not an admin: (when (and (member :is-admin parameters) (null (getf parameters :is-admin))) (rutils:removef class-list 'admin)) ;; Also, we need admins always be authenticated: (when (and (member 'admin class-list) (not (member 'authenticated class-list))) (error "Admin should have an email!")) class-list) POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email "some@gmail.com" :is-admin t) USER-AND-AUTHENTICATED-AND-ADMIN POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email "some@gmail.com" :is-admin nil) USER-AND-AUTHENTICATED POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email nil :is-admin nil) USER POFTHEDAY> (dynamic-classes:determine-dynamic-class :user 'user :email nil :is-admin t) ; Debugger entered on #<SIMPLE-ERROR "Admin should have an email!" {100B6CAD73}> Now we need to wrap this into a single constructor make-user which will return objects of different class depending on arguments: POFTHEDAY> (defun make-user (&rest args &key email is-admin) (declare (ignore email is-admin)) (let ((class (apply #'dynamic-classes:determine-dynamic-class :user 'user args))) (apply #'make-instance class ;; We don't store is-admin as the slot: (rutils:remove-from-plist args :is-admin)))) POFTHEDAY> (make-user) #<USER {1006704893}> POFTHEDAY> (make-user :email "blah@min.or") #<USER-AND-AUTHENTICATED {1006779083}> POFTHEDAY> (make-user :email "blah@min.or" :is-admin t) #<USER-AND-AUTHENTICATED-AND-ADMIN {10067C26C3}> POFTHEDAY> (make-user :is-admin t) ; Debugger entered on #<SIMPLE-ERROR "Admin should have an email!" {10067D0193}> To make these classes print in a human-readable way, use print-items library, reviewed in the post #0145. The more sophisticated use of the dynamic-classes can be found in the cl-containers library. It uses dynamic-classes to mix container and iterator classes to give them different traits depending on constructor's parameters.

·

34 days ago

CLJ in Practice I finally got around to using clj in a prototyping context. And it's going relatively smoothly so far. My only real complaint is that I seem to have to put (named-readtables:in-readtable clj:syntax) at the top of every file where I want to use my cool new map / set literal syntax. I'm hoping there's some way to fix this by just putting it at the top of a package file or something, but that naive solution doesn't seem to work. At first glance, there doesn't seem to be a way to express "load this project with a given, non-default readtable ", and I'm not entirely sure why yet. Return to cl-vote The project I put some work into is an old piece of arcana from the earlier days of the Toronto CS Cabal. A simple voting system to help us decide what we're reading in a given week. The next step I'm going to take is implementing the actual voting. Step one was just the authentication system. So here's the deal. Passwords suck, public keys aren't really being used widely for website/app authentication, and that doesn't seem to be something I can easily change. Authenticator apps and 2FA are propagating though. For low-security-requirement situtations, one plausible alternative to passwords is just using that authenticator. So, like, 1FA. The current state of cl-vote is an implementation of such a system in Common Lisp. The workflow looks like this: You register by picking a user name that hasn't already been picked. The system instantly sends you to a screen that displays a QR code compatible with FreeOTP or Authy or whatever When you want to log in later, enter your username and your authentication code That's fairly simple. There's no need to remember passwords, though you do now need your phone or authenticator app/browser plugin/what-have-you. Considering Humane Interfaces During the construction of this, I briefly considered taking the Raskin approach of letting users log in with just their "password"s. Mechanically, this would involve iterating through the entire user database in order to find if there's anyone whose next code matches the input at login. I decided against it for three reasons It opens up the attack surface; instead of guessing a particular users' next code an attacker now needs to guess any valid code that collides with any existing user. Still improbably, but lets not throw caution to the wind entirely , huh?

, huh? Makes login more expensive; instead of getting a particular user entry and checking their code against the given one, I need to do it for each user until I find a matching one. In the extreme case, like a user database big enough to shard, this will take an extremely long time. Which segues nicely into

long time. Which segues nicely into Makes login more inconsistent; if we hit the negative extreme case, it might take long enough to verify codes that the given code might have expired in the meantime, giving us false negatives. This doesn't feel like something that would happen too often, but it's not something that's trivially or implicitly soluble either. A user name solves enough problems that I'm content burdening users with the task of picking one. Considering Further Security Once I combine it with some form of hammering protection, this system is resistant to the sorts of guessing attacks that plague password systems. It's still not resistant against server database breaches. Granted, this particular one is tricky to crack in that way because it's immune to injection attacks as a result of its' data storage model 1, but that's cold comfort. If you did manage to expropriate a user record, you'd gain access to that users' shared secret and could thereafter generate correct solutions for their account at will. That's sort of the point. One thing I could do, as a web app proprietor, is keep client fingerprints around and be a bit more cautious about logins coming from devices that a user hasn't used before. It's not entirely clear to me what to do if I detect an anomaly. I guess one thing I could do is request a challenge answer through a different contact method. Like an SMS sender or email, to which I would send a challenge generated by a session-specific secret key and then expect a response. Doing that would also effectively mitigate the database expropriation attack. It wouldn't mitigate a successful server takeover, but I'm not sure there's a reasonable way to mitigate that at all yet. This might be good enough. Considering Account Recovery Account recovery codes are a thing that 2FA systems use to "make" "sure" that a user can still get into their account if they lose their phone/authenticator token/whatever. The way this works is by having the user write down a bunch of codes, each of which can presumably be used for a one-time entry into the system without other authentication methods being available. Cool, I guess. I haven't had to use them yet, and I suspect the sorts of systems I'm planning to build lend themselves more easily to the "make a new account" recovery path than this, but it might still be worth doing. Mechanically, this means generating some number of alphanumeric codes that are either easy to write down or easy to remember. Then giving the user a workflow where they can enter one of these codes, at which point they are logged in but the code they used is marked as expired. I'm going to try to implement a couple of these extras, then get bored and move on to the main point. Which is collective decision making.

·

37 days ago

This system is similar to bordeaux-threads but has some unique features. What I like is that portable-threads forces you to give the thread a name. No more Anonumous threads! Also, there is a shortcut macro to start any code in a thread without wrapping it into an explicit lambda: POFTHEDAY> (portable-threads:spawn-form (format t "Running in ~S thread" (portable-threads:thread-name (portable-threads:current-thread)))) Running in "Form (FORMAT T ...)" thread #<SB-THREAD:THREAD "Form (FORMAT T ...)" FINISHED values: NIL {10051E61C3}> Or there is also a shortcut to run periodical tasks in the thread: POFTHEDAY> (defun periodic () (format t "[~A] Running in ~S thread~%" (local-time:now) (portable-threads:thread-name (portable-threads:current-thread)))) POFTHEDAY> (portable-threads:spawn-periodic-function #'periodic 5 :count 3 :verbose t) ;; Spawning periodic-function thread for... #<SB-THREAD:THREAD "Periodic Function" RUNNING {100466CDB3}> [2020-08-23T14:00:35.207071+03:00] Running in "Periodic Function" thread [2020-08-23T14:00:40.214253+03:00] Running in "Periodic Function" thread [2020-08-23T14:00:45.215454+03:00] Running in "Periodic Function" thread ;; Exiting periodic-function thread Another cool feature not found in bordeaux-threads is thread hibernation. Any thread can fall asleep and be awakened later: POFTHEDAY> (defun do-the-job () (format t "Started a thread ~A~%" (portable-threads:thread-name (portable-threads:current-thread))) ;; Now we'll fall asleep until somebody will ;; call awake. (portable-threads:hibernate-thread) (format t "Thread ~A works again!~%" (portable-threads:thread-name (portable-threads:current-thread)))) POFTHEDAY> (defparameter *thread* (portable-threads:spawn-thread "Worker" #'do-the-job)) Started a thread Worker POFTHEDAY> (portable-threads:thread-whostate *thread*) "Alive" ;; Now we wake thread up: POFTHEDAY> (portable-threads:awaken-thread *thread*) Thread Worker works again! 0 There are other interesting helpers like protected calls to work with lists. Read the documentation to find more gems!

·

37 days ago

This system makes it very easy to create and use a generator in Python style. This code demostrates how a simple generator works in Python. The generator creates an iterable object and values can be extracted by calling the next function: In [1]: def simple(): ...: yield 1 ...: print('LOG: Going to the second yield') ...: yield 2 ...: In [2]: simple() Out[2]: <generator object simple at 0x10752a050> In [3]: next(_2) Out[3]: 1 In [4]: next(_2) LOG: Going to the second yield Out[4]: 2 In [5]: next(_2) ------------------ StopIteration The similar generator can be implemented with snakes : POFTHEDAY> (snakes:defgenerator simple () (snakes:yield 1) (format t "LOG: Going to the second yield~%") (snakes:yield 2)) POFTHEDAY> (simple) #<SNAKES:BASIC-GENERATOR {1008454D4B}> POFTHEDAY> (funcall *) LOG: Going to the second yield 1 POFTHEDAY> (funcall **) 2 POFTHEDAY> (funcall ***) SNAKES:GENERATOR-STOP Here is the more interesting example of the generator which produces an infinite sequence of Fibonacci numbers: POFTHEDAY> (snakes:defgenerator fib () (loop with a = 0 with b = 1 for new-b = (+ a b) do (snakes:yield a) (setf a b b new-b))) POFTHEDAY> (snakes:take 20 (fib)) (0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181) ;; Or we can skip first 50 numbers and output 5 next: POFTHEDAY> (snakes:generator->list (snakes:islice (fib) 50 55)) (12586269025 20365011074 32951280099 53316291173 86267571272) There are also other features like: anonymous generators;

yield-from form;

forms to iterate over generators;

functions ported from Python's itertools ;

; integration with iterate library. Snakes has a comprehensive documentation which covers all its features.

·

38 days ago

This is a little wrapper around TeX language to make it compatible with Lisp's sexps. Written by @eugeneia_. Here is a little example, I've taken from the documentation: POFTHEDAY> (defun tex-menu (menu) (texp:deftex item (caption price) (texp:$ caption) " " (texp:$ (texp:escape "$")) (texp:$ price) (texp:br) (texp::bigskip)) (loop for (caption price) in menu do (texp:tex (item {(texp:$ (texp:escape caption))} {(texp:$ (texp:escape price))}))) (texp:tex (bye))) POFTHEDAY> (tex-menu '(("Mozzarella Sticks" "5.99") ("Onion Rings" "4.99") ("Spinach" "5.99"))) \def \item #1#2{#1 \$#2 \bigskip } \item {Mozzarella Sticks}{5.99}\item {Onion Rings}{4.99}\item {Spinach}{5.99}\bye To render the DVI file, save this output into the file example.tex and run tex example.tex . (On OSX you can install TeX using brew cask install mactex .) This command will generate example.tex file which will look like that: With this system, you can use full power or the Lisp to write publishing systems. For example, Geneva documentation system uses it to generate TeX and LaTeX outputs.

·

39 days ago

This system implements an interesting algorithm suitable for storing binary tries or transmitting them over the wire without overhead on storing pointers. There is almost no information about this algorithm on the internet. The best description I found is: https://datprotocol.github.io/book/ch01-01-flat-tree.html Also, there are versions for Go, C, JS, Rust and Kotlin listed here: https://github.com/mafintosh/flat-tree Let's try to serialize a binary tree, represented by lists into a flat vector. First, we need to prepare a vector which size depends on the depth of the tree: ;; Here is a tree: ;; / ;; * ;; + 15 100.0 ;; A B POFTHEDAY> (defparameter *structure* '(/ (* (+ a b) 15) 100.0)) POFTHEDAY> (defparameter *depth* (rutils:tree-depth *structure*)) POFTHEDAY> *depth* 4 POFTHEDAY> (defparameter *size* (expt 2 *depth*)) POFTHEDAY> (defparameter *data* (make-array (list (expt 2 *depth*)) :initial-element nil)) #(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL) Missing nodes are filled with nils. Flat-tree is not a data-structure; it is an algorithm to calculate the tree node's index in the flat vector. That is why we need to write a function which will take lists forming a binary tree and dump it into the vector as a "flat-tree": POFTHEDAY> (defun fill-tree (vector obj depth offset) (let ((index (flat-tree:index depth offset))) (cond ((listp obj) (setf (aref vector index) (first obj)) (fill-tree vector (second obj) (1- depth) 0) (fill-tree vector (third obj) (1- depth) 1)) ;; If it is a symbol (t (setf (aref vector index) obj)))) (values vector obj)) 