Skip to content

Instantly share code, notes, and snippets.

View privet-kitty's full-sized avatar

Hugo Sansaqua privet-kitty

50 followers · 0 following
  • Japan
View GitHub Profile
@privet-kitty
privet-kitty / yapt.lisp
Last active February 9, 2019 04:18
Yet another parametric type in Common Lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam)
(use-package '(:fiveam :sb-mop)))
(defclass parametric-class (class)
((parameters :initform nil :initarg :parameters)
(cache-reified-classes :initform (make-hash-table :test #'equalp)
:initarg :cache-reified-classes)))
(defclass parametric-structure-class (structure-class parametric-class)
((original-direct-slots :initform nil :initarg :original-direct-slots)))
@privet-kitty
privet-kitty / bsearch.lisp
Created January 26, 2019 00:49
(defun bsearch (item vector &key (key #'identity) (test #'eql) (start 0) (end (length vector)) (compare #'<) (default nil))
"By hyotang666. See https://hyotang666.github.io/archives/bsearch.html"
(declare (type fixnum start end)
(type simple-vector vector)
(type function key test compare)
(dynamic-extent key test compare))
(assert (<= 0 start end (length vector)))
(labels ((on-the-node (center %)
(declare (type fixnum center %))
(if (zerop center)
@privet-kitty
privet-kitty / wild-pathname.md
Created December 8, 2018 08:58
On the portability of wild-pathname

Portability of wild pathname

On most CL implementations, cl:parse-namestring (or #P"...") interprets a unix-like pathname including wildcard (e.g. "/foo/**/bar/qux*.lisp") in a common way. However, there are minor differences in behaviour and facility. Below is a table summarizing the points.

* as one directory

SBCL CCL CLISP ABCL ECL ACL LW
(pathname-match-p #P"/foo/bar/baz" #P"/foo/*/baz") T T T T T T T

** as zero or more directories

@privet-kitty
privet-kitty / asdf-extension.md
Last active December 8, 2018 08:57
foo.asd defines a new module component that gathers all .lisp files in the directory. foo-infer.asd extends package-inferred-system and auto-generates each `foo/bar/all'-type subsystem.

ASDFの拡張についてのメモ

ASDFではソースファイルを扱うためにいちいちコンポーネントとして登録する必要があり、ディレクトリ中のすべてのソースファイルをまとめて扱うという機能がない。これはpackage-inferred-systemを使った場合も同じで、ASDFが.asdファイルから特定のソースファイルに辿りつくためにはどこかでファイル名を指定する必要がある。この点について、ASDFの拡張を考える。

最初にpackage-inferred-systemを使わない場合（例はfoo.asd）を扱い、その後でpackage-inferred-systemの拡張（例はfoo-infer.asd）について検討する。

cl-source-module: ディレクトリ中のすべてのソースファイルを含むモジュール

このようなコンポーネントはmoduleのサブクラスとして簡単に書ける。ただ、foo.asdでの実装はやや単純すぎるか。実用するとしたら、初回のcomponent-childrenの呼び出しでchildrenスロットに結果を保持しておき、２回目以降は、既存のcl-source-fileについては新しいオブジェクトを作らないようにするべきだろう。

  • :recursive tオプションで、直下だけでなく再帰的にソースファイルを収集するというデザインもありかもしれない。
@privet-kitty
privet-kitty / insert-matrix-multiplication.el
Created November 6, 2018 16:21
Elisp to insert an unrolled matrix mutiplication.
;; One day I wanted to write a (unrolled) multiplication of 3*3
;; matrices in JavaScript. That is:
;;
;; return [[A[0][0]*B[0][0]+A[0][1]*B[1][0]+A[0][2]*B[2][0],
;; A[0][0]*B[0][1]+A[0][1]*B[1][1]+A[0][2]*B[2][1],
;; A[0][0]*B[0][2]+A[0][1]*B[1][2]+A[0][2]*B[2][2]],
;; [A[1][0]*B[0][0]+A[1][1]*B[1][0]+A[1][2]*B[2][0],
;; A[1][0]*B[0][1]+A[1][1]*B[1][1]+A[1][2]*B[2][1],
;; A[1][0]*B[0][2]+A[1][1]*B[1][2]+A[1][2]*B[2][2]],
;; [A[2][0]*B[0][0]+A[2][1]*B[1][0]+A[2][2]*B[2][0],
@privet-kitty
privet-kitty / query-download-count.ros
Created October 22, 2018 07:44
Roswell version of https://gist.github.com/privet-kitty/a1289618ceeae4689e07b70b0896476f
#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
;;
;; Get the download counts for all the released assets in a GitHub repo.
;; Usage: ./query-download-count.ros <user> <repository>
;;
@privet-kitty
privet-kitty / github-download-count.lisp
Created October 18, 2018 11:23
;; Get the download counts for all the released assets in a GitHub repo.
;; Usage example:
;; (count-downloads "froggey" "Mezzano")
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload '(:dexador :jsown)))
(defun count-downloads (user repository)
(let ((releases-dat (jsown:parse (dex:get (format nil "https://api.github.com/repos/~A/~A/releases" user repository)))))
@privet-kitty
privet-kitty / wininet.c
Last active September 2, 2018 14:43
Test for wininet
#include <windows.h>
#include <wininet.h>
#include <stdio.h>
/*
Roswell on Windows signals an error when download_simple() is called
for some HTTPS pages: HttpSendRequest() fails. (Error code is 12029.)
This code is a rough reproduction of download_windows.c
https://github.com/roswell/roswell/blob/master/src/download_windows.c
@privet-kitty
privet-kitty / type-propagation.lisp
Last active September 26, 2018 12:07
Type propagation problem on SBCL
;;; A difference between DECLARE TYPE and CHECK-TYPE produces an
;;; optimization problem on SBCL.
(declaim (inline add-with-declaring-type!))
(defun add-with-declaring-type! (vector1 vector2)
(declare (vector vector1 vector2))
(loop for idx below (length vector1)
do (incf (aref vector1 idx) (aref vector2 idx))
finally (return vector1)))
@privet-kitty
privet-kitty / temporary-file.lisp
Last active August 28, 2018 20:41
UIOP replaces cl-fad.
;;
;; Handle temporary file with UIOP
;;
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :cl-ftp)
(ql:quickload :quri))
(defparameter *dat-url* (quri:uri "ftp://ftp.cs.joensuu.fi/pub/color/spectra/mspec/munsell380_800_1.asc.gz"))
(defparameter *dat-filename* "munsell-joensuu-matt1.dat")