2019-07-21

Nptの開発状況

Common Lisp npt

今まで開発に注力してきましたが、そろそろ時間が取れなくなってきたので、現時点の完成度をまとめます。
loopマクロの開発が終わってv0.1.13をcommitした時点では、 ANSI Common Lispの関数やらマクロやらが

全996個中　919完成　（92%作成）

となります。
未完成の部分を表にまとめました。

f:id:nptcl:20190721020207p:plain — npt未完成部分

以前、Npt Lispの紹介 - nptclのブログで話題にした足りない部分の進捗は、

CLOSほぼ全部　⇒半分くらい作成、redefineとchange-classがまだ
structure全部　⇒全部作成
loopマクロ全部　⇒全部作成
pretty printing全部　⇒手つかずだが着手
環境に関する関数　⇒未着手
coreファイルの読み書き　⇒全部作成
faslファイルの読み書き　⇒未着手
isqrt関数　⇒未着手
adjust-array関数　⇒半分完成

です。

それで、最初に言った通り、作者は開発時間があまりとれなくなったため、今後の開発速度は遅くなると思います。
せっかくここまで作ったので、中断するわけではなく、遅かろうが何だろうが100％開発までは続けて行こうとは思っています。

あと、Nptを作ってハイ終わりって言うわけでもなく、個人的な別の開発に使って行きたいという目的があるので、 C言語のインターフェイス部分だけ開発されていくかもしれません。
9割もできてりゃあ、やれる事は結構ありますよ。

でもやっぱり100%の方が優先だろうなあ。

2019-07-13

構造体とクラスの読み書きの速度

Common Lisp

Common Lispの構造体とクラスはとても似ています。
一体何が違うのかというと、クラスの方が高機能であるというのは何となくわかります。
では、構造体なんていらないのでは？　と思われるかもしれませんが、 CLtL2には次のような記載があります。

https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node170.html
The defstruct feature is intended to provide ``the most efficient'' structure class.
CLOS classes defined by defclass allow much more flexible structures to be defined and redefined.

つまり効率はstructureを、柔軟性はclassを。
そういう方針で両者は設計されています。

今回の話題は構造体とクラスの効率について記載します。
具体的にはslotの読み書きに関することです。
ちょうどdefstructを実装し終わった所なので、記憶が残っているうちに書き残します。

`slot-value`によるslotの読み書き

クラスも構造体も、どちらもslot-valueが使えます。
まずはこいつから見て行きます。

通常のクラスシステムにおいて、slotを保有しているのは standard-objectのインスタンスです。
つまりは、standard-classに関わる全てのオブジェクトです。
とても分かりづらいですね。
クラスに関係するもの全部だと思ってもらえればいいと思います。

純粋な意味での「オブジェクト指向」とは、全てを「オブジェクト」で表すことです。
で、その「オブジェクト」とは一体何かなのですが、本処理系やCommon Lispに限ったことではなく、オブジェクト指向と呼ばれるものすべてに共通すると思うのですが、オブジェクトはkey-value構造体です。
つまり、keyが与えられたらvalueを返却するというもの。
ここで言うkeyとはslotの名前のことであり、

(slot-value instance 'key) -> value

ということになります。

このkey-value構造体を実装する方法は色々ありますが、 nptではただの配列を使っています。
assocやplistに近い構造だと思ってもらえればいいと思います。
つまり検索には線形探索が使われるので、O(n)だけの時間がかかります。

これはどうなんだろう？
遅くはないかどうか少し考えました。

以前、インスタンスにhash-tableを使うように実装したことがありました。
うまく行けば探索がO(1)で済むようになるわけです。
でもやめました。
やめた理由はメモリ容量が多い事です。
あとhash-tableは何だかんだでオーバーヘッドが大きいので、 slotが一万個、十万個くらいないとhash-tableの恩恵が受けられないのではないでしょうか。

オブジェクト指向というシステムにおいて何が大量に生成されるかというと、スロットではなくインスタンスだと思います。
それなのにひとつひとつにhash-tableは余りに無駄が多すぎると判断しました。

調べたわけではありませんが、たぶんどの実装も線形探索になっているのではないでしょうか。
つまり、slotは大量にあればあるだけ動作は遅くなります。

slotにアクセスする命令は下記の4つにまとまっています。

slot-value
slot-boundp
slot-exists-p
slot-makunbound

この関数すべてが線形探索を実施していると考えてください。
そんなに安くはない関数なのです。

今までの話はクラスだけではなく構造体にも当てはまりますが、クラスとは違っている部分がいくつかあります。

まず構造体のインスタンスはstandard-objectではなくstructure-objectです。
両者の違いは何でしょうか。
構造体でもクラスでも、どちらもslot-valueが扱えるということは、実装面から見れば、ジェネリック関数であるslot-value-using-classに standard-objectとstructure-objectを両方定義しておいて、別々の方法で読み書きをするということになります。

しかしnptの場合はどちらも全く同じものを使っています。
分ける必要性があまりありませんから。
他の処理系であるsbclやらclispやらも同じように実装しているのかと思います。

ここで言いたかったことは、構造体もクラスもslot-valueを使うのであれば違いはなく、次のようなコストがかかるということです。

slot-valueは線形探索でO(n)だけの時間がかかります
slot-valueはジェネリック関数を裏で呼んでいます

次はアクセス関数について見て行きます。

関数による読み書き（`defstruct`, `defclass`共通）

関数による読み書きとは、slotに対してreader/writer/accessorを経由するやり方です。
つまり、slot-valueを使わずに値を取得します。

構造体の場合は、何もオプションを指定しなければ、全てのスロットに対して自動的に関数が生成されます。
クラスは、オプションを指定することでジェネリック関数が生成されます。

・構造体の場合
(defstruct aaa bbb)
  -> aaa-bbb, (setf aaa-bbb) という関数が生成される

・クラスの場合
(defclass aaa ()
  ((bbb :accessor aaa-bbb)))
  -> aaa-bbb, (setf aaa-bbb) というジェネリック関数が生成される

構造体は、関数を生成します。
クラスは、ジェネリック関数を生成します。

両者は似ていますが、速度面においては差が出てきます。
関数を使っている構造体の方が圧倒的に早く処理されます。

ジェネリック関数はどのような動きをするでしょうか。
最悪なケースとしては、実行するとまずはジェネリック関数に登録されているすべてのmethodを寄せ集め、引数の型から合致するmethodを選別します。
そのあと、method-combinationの実行によりLisp式が生成されます。
Lisp式はそのままでは実行できませんので、 evalかcompileにより実行形式に変換されます。
生成された関数をはじめの引数に結びつけることで、ようやくreader/writer/accessorが実行されます。

つまりジェネリック関数が呼ばれるたびに、 evalかcompileが毎回走るかもしれないということです。
普通に考えると遅すぎます。

この辺りは規約に書かれているわけではないので処理系依存ですが、もしかしたら本当に毎回evalが実行するような処理系があるかもしれません。
当然、これだと全く使い物にならないため、キャッシュを用いる方法が提案されています。

The Art of the Metaobject Protocolという書籍では、ジェネリック関数に与えられた引数の型をキーにして、 method-combinationが生成した関数をhash-tableに保存する方法が紹介されています。
その方法を用いると、初回実行は上記で説明したようにevalやcompileが実行されますが、 2回目からは、引数の型をチェックし、 hash-tableを検索するだけで関数が実行できることになります。

ここでの結論は速度においては大切です。
構造体は純粋な関数を呼ぶため早いです。
しかしクラスはジェネリック関数が呼ばれるため、早くてもhash-tableの検索が1回動いた後で関数が実行されます。

ここで言いたかったこと。

構造体のアクセス関数呼び出しは、純粋な関数なので早い
クラスのアクセス関数呼び出しは、ジェネリック関数なので遅い

ちなみにslot-value関数も、裏ではジェネリック関数であるslot-value-using-classを呼ぶため、ある程度のコストがかかることを覚えておいた方がいいです。

関数による読み書き（`defstruct`）

それでは関数が呼ばれたあとの内容について見て行きます。
構造体は、クラスと違って再定義が禁止されています（正確には未定義）。
よって、生成された関数は、その構造体のみを対象にすることができます。

構造体の定義で作成した関数なんだから当たり前じゃないかと思われるかもしれませんが、defclassの方は再定義や変更が許されるので、クラスのslotの内容が変わるかもしれないのです。

構造体は変更の心配がないため、もしstructure-objectのvalueの格納場所が配列であるならば、

(elt slots 3)  ;; このスロットに対応する値は3番目

のように数値を直接指定しておくことができます。
線形探索ではないので、処理はたぶんO(1)で完了します。
例外があり、構造体が(:type list)で生成された場合は nth関数が呼ばれるのと同じなのでそんなに早くはありません。

実際には値の返却だけではなく前処理が少しあります。
それは、引数が構造体であるかどうかと、構造体が:include含めて型と合っているかどうかの判定です。

構造体の関数は、slot-valueに比べると、とても速いことがわかります。
slot-valueは便利ですが、それほど早くないかもしれないということもわかってもらえるかと思います。

ここで言いたかったこと。

構造体のアクセス関数は、配列指定なので早い
構造体のslot-value関数は、線形探索なので遅い

関数による読み書き（`defclass`）

一方、クラスの場合は構造体とは全く変わり、slot-valueと何も変わりません。
せっかく苦労して呼び出されたジェネリック関数ですが、ただ単純にslot-valueを呼んでいるだけなのです。

理由は再定義とクラス変更があるためです。
変更されたあと、関数は一体何を対象に読み込めばよいのかということと、関数を実行したときに、例えばupdate-instance-for-redefined-classみたいな関数をどうやって呼べばいいかなどの色々な問題があり、それらをすべて考慮しなければならないのは大変だということで、 slot-valueを使った処理と一致するようにと規約で制定されています。

以前は構造体と同じように配列を直で指定しようと考えていました。つまり、クラス再定義やchange-classなどの実行契機でアクセス関数の対象メソッドを総入れ替えするというものです。

でも規約でそこまでするなと書かれているような気がするので、今では単純にslot-valueを呼ぶだけです。 slotが既に存在していないとか、そういうのを一切気にしていません。

ここで言いたかったこと。

クラスのアクセス関数は、slot-valueと同じなので遅い。

まとめ

slotのアクセスは次の順に早い

構造体のアクセス関数　★一番早い
構造体とクラスのslot-value
クラスのアクセス関数

2019-07-01

npt-amalgamationの作成

npt Common Lisp C言語

私はnptというCommon Lisp処理系を細々と開発しています。
まだ目標であるANSI Common Lispの機能は完成していませんが、以前紹介したときに言った「sqlite3みたいにamalgamationをやってみたい」というのが先にできたので公開します。

npt-amalgamation
https://github.com/nptcl/npt-amalgamation

npt-amalgamationとは、nptのソースコードをまとめて数個のソースファイルにしたものです。
テストケースは除外されていますが、本体のnptと同じようにコンパイルできます。
現段階では下記の3つのファイルにまとめました。

lisp.c
lisp.h
shell.c

実行例を示しますが、次のように適当にコンパイルしても何となく動いてしまいます。

$ cc lisp.c shell.c -lm
$ ./a.out
(defun aaa (x) (if (<= x 1) 1 (* x (aaa (1- x)))))
AAA
(aaa 111)
1762952551090244663872161047107075788761409536026565516041574063347346955087248316436555574598462315773196047662837978913145847497199871623320096254145331200000000000000000000000000
^D
$

C言語のモジュールとして使うためのインターフェイスは何も整備されていませんが、そのうちどうにかしたいです。

2019-06-26

C言語のconstの使い方

C言語

今までconstの書き方がよくわかっていませんでした。
で、調べたら予想以上に難しかったです。

本投稿ではconstの使い方を記載していくわけですが、規約を調査したわけではなく、Cコンパイラで実験した内容です。もしかしたらおかしい所があるかもしれません。
実験に使用したコンパイラは、FreeBSD 11.1 clang, Gentoo Linux gcc, Windows 10 Visual Studio 2017付属のやつです。

`const`の意味

constとは定数を宣言するときに使います。
書き込み不可という意味が強いと思います。

簡単な例としては下記の通り。

const int a = 100;

別の書き方もあります。

int const a = 100;

意味は同じになります。
あるいは2つ書いても同じです。

const int const a = 100;  /* 警告 */

しかしconstを重複させるのはダメのようで、コンパイル時に警告が出ました。

あと、古いC言語だと、intに限って省略できたはず。
つまり、

const int a = 100;
は
const a = 100;  /* 警告 */

と記載できます。
でもこれは今のC言語だと規約レベルでダメだったような記憶があります。
clangとgccでは警告が出ました。

では、もし値を代入しようとした場合はどうなるでしょうか。
下記の例を示します。

const int a = 100;
a = 200;  /* エラー */

この場合は、コンパイルエラーとなりますので、実行できません。
なんとかして無理やり代入するとどうなるでしょうか。

#include <stdio.h>
int main()
{
    const int a = 100;
    *((int *)&a) = 200;  /* 危険 */
    printf("%d\n", a);
    return 0;
}

実行結果

$ cc main.c
$ ./a.out
200
$

やったね、うまく行きました。
でも確かこれはかなり危険だったはず。

上記の例はコンパイラとOSによって挙動が変わります。
constの定数は、書き込み不可のメモリ領域に配置することが許されています。実行例では書き込み可能な領域に配置されたようですが、もし書き込み不可の領域を書き換えようとした場合は、 OSレベルにて不具合が生じるため、最悪Segmentation violationコースとなります。

上記の実行はGentoo Linux+gccによるものです。
FreeBSD+clangでは、なぜか100が返却されました。

`const`ポインタの書き方

constはポインタにも使用できます。
詳しく見ていく前に、まずは書き方から。

通常の変数の場合、constは、重複と省略を考慮しないのであれば、次の2通りの方法があると説明しました。

const char a;
char const a;

ポインタの場合は、ポインタを表すアスタリスク*が一つ増えるごとに、 constの書ける位置が1つずつ増えていきます。

charのポインタであるchar *の場合は、次の3通りの位置に記載できます。

const char *a;
char const *b;
char *const c;

aとbは同じ意味となります。
ではポインタのポインタの……ポインタの場合はどうなるでしょうか。
例えば、

char ******a;

の全てにconstをつけたものは、次のどちらかになります。

const char *const *const *const *const *const *const a;
char const *const *const *const *const *const *const a;

アスタリスクが6個で、constの書ける場所は8か所。
そのうち、上記の2例は同じ意味なので、値を定数として指定できるのは7か所ということになります。

もうこの時点で簡単ではないです。
constの記載する位置は、一見規則正しく並んでいるようなのですが、左から一番目と二番目が同じ意味であり、かつ重複不可なので混乱するのです。

ではconstの位置によって何が変わるのでしょうか。
引き続き、

char ******a;

をconstにする場合を考えて行きます。
変数aは、式で宣言したときと同じ数のアスタリスクを付けると、指定した型そのものになります。

つまり、******aの型はcharなので、

******a = 'Z';

みたいに書けるわけです。
このcharをconstとして定数と宣言したい場合は、一番左側にconstを付けます。一番左と言っても書き方は二通りあるため、例えば次のどちらかとなります。

const char ******a;
char const ******a;

一方、式でアスタリスクを一つもつけない場合は全く逆となります。
つまり、aの型はchar ******であり、 constを指定したい場合は一番右側にconstを付けます。

char ******const a;

*aをconstにしたい場合は、

char *****const *a;

**aをconstにしたい場合は、

char ****const **a;

と順番にずれていくわけです。

constを2つ以上宣言することも可能であり、**aと***aをconstにしたい場合は、

char ***const *const **a;

となります。

初期化と代入

初期化とは、変数宣言時に値を設定することです。
例えばこんな感じ。

int a = 100;

代入とは、変数に値を格納することです。
例えばこんな感じ。

a = 100;

const変数を初期化する、あるいは代入する場合は、両辺の各constがどうなっているのかを合わせて調査して行き、問題がある場合はエラーか警告が出力されます。

このチェックは、次の3段階に分けて行われます。

右から1番目のconst
右から2番目のconst
右から3番目以降のconst

これらをひとつずつちゃんと説明していきます。

右から1番目の`const`

右から1番目のconstとは、例えば

int ****const a;

のような場合です。
これは変数そのもののconstなので、代入は禁止されますが初期化は禁止されません。

初期化とは

int ****const a = b;

みたいなものです。
初期値を与えられなければ定数にもできないので、当然有効な宣言となります。

一方、const指定されたということで、

a = b;

とするのは値を変更することになるのでエラーです。

当たり前のことですよね。
でも、右から1番目のconstは、右から2番目、3番目とは違って、ポインタとは一切関係がないと覚えておくといいと思います。

右から2番目の`const`

例えば、

const int ****const *ptr;

のような場合です。
よく文字列を扱うときに、

const char *ptr;
char const *ptr;

と宣言しますが、まさにこの場合が該当します。

右から2番目のconstは、それ以外のconstとは違っていて特別な判定がされます。
初期化と代入で、チェックの内容は変わりません。
例えば、下記の場合を考えます。

a = b;

もしbよりもaの方が制限がきつくなる場合はOKです。
しかし逆にbよりもaの方が制限が緩くなれば警告が発せられます。

つまり、せっかく値をconstで保護をしていたにも関わらず、それを解除するような代入をする場合は警告になるのです。

次の宣言があったとします。

const char *a;
char *b;

このとき、

a = b; /* OK */
b = a; /* 警告 */

となります。

ちなみにこの右から2番目のチェックは、違反していた場合はコンパイルエラーではなく警告が出力されます。
たぶんコンパイルは継続されるので実行ファイルができてしまいます。
しかし正しいと思わずにちゃんと原因を突き止めるべきであり、もし問題ないならば明にキャストしましょう。

右から3番目以降の`const`（gcc, clang）

恐ろしいことにVisual Studio 2017と挙動が異なりました。
まずはgcc, clang編。

3番目以降は、初期化か代入を行う際には、 constと非constが全て同じでなければなりません。

右辺にconstと指定されていたら、左辺もconstです。
2番目みたいに、左辺constで右辺非constは許されません。
左辺が非constなら、右辺も非constでなければなりません。

こちらも違反した場合は、エラーではなく警告が出力されます。

それでは例をあげます。

char ****a = NULL;
char const *const *const *const *const b = a; /* 警告 */

右から1番目、2番目はOKですが、3番目以降のconstが合っていないので違反です。

char ****a = NULL;
char ***const *const b = a; /* OK */

3番目以降が全て非constなのでOKです。

char const **const **const a = NULL;
char const **const *const *b;
b = a; /* OK */

このとき、

aは(const, なし, const, なし,  const)です。
bは(const, なし, const, const, なし )です。

右から1番目は、const→なしなのでOK。
右から2番目は、なし→constなのでOK。
右から3番目以降は、全て一致するのでOK。

右から3番目以降の`const`（Visual Studio 2017）

コンパイル間で挙動が変わったので、Visual Studio 2017編です。
こちらは単純に、右から2番目と同じです。
つまり、非const→constへの値の変更は許されます。

なので下記の例

char ****a = NULL;
char const *const *const *const *const b = a;

は、gcc, clangではエラーでしたが、 Visual Studio 2017では問題なくコンパイルが通りました。

もし移植性を考慮するなら、こちらではなくより厳しいgcc, clangの方に合わせればいいと思います。

修飾子の複合

c89時点でC言語の修飾子は6個あると記憶しています。

register
auto
extern
const
static
volatile

今はもっとあるんでしょうか、知らないですけど。

constと同じように記載できるのは、volatileとrestrictだそうです。
なんですかrestrictって。
c99から出てきたようですが、あまりよく知らない人なので今回は無視。

それで、これらを複合すると、一見してよくわからないことになったりします。
例えばchar *にconstとvolatileを合わせたい場合はどうしたらいいでしょうか。
volatileの記載する位置は、constと変わりません。
そして、constとvolatileは、同じ位置に順番は関係なく記載できます。
例えば下記の通り。

char *a;  /* 通常のポインタ */
const volatile char *b;  /* charにconstとvolatile */
char volatile const *c;  /* bと同じ */
const char *volatile d;  /* charがconstでポインタがvolatile */
volatile char const *const volatile e;  /* charもポインタもconst volatile */

ではvolatileの初期化と代入は、constとはどう違っているのでしょうか。
簡単に説明すると次の通り。

右から1番目は、volatileでは制約は無し
あとはconstと同じ

ではconstとvolatileが合わさって宣言された場合はどうなるのか。
ただconstとvolatileを分けて考えればいいだけです。
例えば次の通り。

const char *a;
const volatile char *b;
b = a; /* 問題なし */
a = b; /* エラー */

続いて、次の例を考えます。

volatile char const *volatile const *volatile **const a = NULL;
char const volatile *const *volatile *volatile *volatile b;
b = a;  /* エラー */

このとき、

aは（v+c, v+c,   volatile, なし,     const）
bは（v+c, const, volatile, volatile, volatile）

右から1番目は、volatileは制約なし、const→なしとなるのでOK。
右から2番目は、なし→volatileなのでOK。
右から3番目以降は、4番目がv+c→constなのでエラー。

引き続き、次の例を考えます。

volatile char const *const *volatile **const a = NULL;
char const volatile *const *volatile *volatile *volatile b;
b = a;  /* OK */

このとき

aは（v+c, const, volatile, なし,     const）
bは（v+c, const, volatile, volatile, volatile）

つまり、代入は問題なしです。

2019-06-24

整数を英語で表現する5（Lispコード）

Common Lisp

だいぶ前に、整数を英語で表現する方法について説明しました。

整数を英語で表現する1 - nptclのブログ
 整数を英語で表現する2（中学レベル） - nptclのブログ
 整数を英語で表現する3（巨大な数） - nptclのブログ
 整数を英語で表現する4（序数と負数） - nptclのブログ

これらの説明に基づいて、Common Lispで実装しましたので配布します。

cwsystem
https://github.com/nptcl/cwsystem

以下、説明です。

`radix-string`

整数を英語で表現するには、関数radix-stringを使用します。
機能は(format nil "~R" x)と同じですが、速度とメモリが許す限り巨大な数値を表せます。
いくつか例を示します。

通常の使用

(cwsystem:radix-string 123)
"one hundred twenty-three"

マイナス

 (cwsystem:radix-string -4)
"minus four"

序数

(cwsystem:radix-string 20 nil)
"twentieth"

巨大な数

(cwsystem:radix-string (ash 1 200))
"one novendecillion six hundred six octodecillion nine hundred thirty-eight septendecillion forty-four sedecillion two hundred fifty-eight quindecillion nine hundred ninety quattuordecillion two hundred seventy-five tredecillion five hundred forty-one duodecillion nine hundred sixty-two undecillion ninety-two decillion three hundred forty-one nonillion one hundred sixty-two octillion six hundred two septillion five hundred twenty-two sextillion two hundred two quintillion nine hundred ninety-three quadrillion seven hundred eighty-two trillion seven hundred ninety-two billion eight hundred thirty-five million three hundred one thousand three hundred seventy-six"

`unit-string`

3桁区切りの単位を取得する関数unit-stringもあります。

通常の使用

(cwsystem:unit-string 0)
"thousand"

(cwsystem:unit-string 1)
"million"

(cwsystem:unit-string 2)
"billion"

The Conway-Wechsler Systemの3桁

(cwsystem:unit-string 789)
"novemoctogintaseptingentillion"

序数

(cwsystem:unit-string 345 nil)
"quinquadragintatrecentillionth"

3桁の連結

(cwsystem:unit-string 1234567890)
"milliquattuortrigintaducentilliseptensexagintaquingentillinonagintaoctingentillion"

2019-06-15

sbclのスクリプトファイル作成

Common Lisp

FreeBSD, Linuxでsbclのスクリプトファイルを作成するメモです。

長々と書きますので、結果だけを先に示します。
スクリプトファイルの1行目には次のように記載すると便利ですね。

#!/usr/bin/env -S sbcl --script

スクリプトファイルの作成

sbclには引数--scriptを指定することにより、スクリプトファイルを読み込むことができます。
つまりは次のように呼び出しを行うことができます。

$ sbcl --script script-file.lisp

しかしこのオプションは、おそらく上記のようにコマンドラインで実行するためのものではなく、スクリプトファイルに組み込んで使うものだと思います。
問題はこれをどのように記載するかです。

Unix系のOSでは、テキストファイルの1行目を#!で開始することで、スクリプトに渡す実行ファイルを指定することができます。
開始1byteから#で始める必要があるので、UTF-8のBOMありはエラーになるので注意。

例えば次の通り。

#!/usr/bin/sbcl --script
(format t "Hello~%")

実行してみます。

$ cat > test.sh
#!/usr/bin/sbcl --script
(format t "Hello~%")
^D
$ chmod +x test.sh
$ ./test.sh
Hello

うまく行ったならおめでとう！
でも、上記の書き方だとダメな場合があります。

sbclの場所が違う

Linuxだと/usr/bin/sbclですが、FreeBSDでは/usr/local/bin/sbclとなります。
次のように変更することで動作はします。

#!/usr/local/bin/sbcl --script
(format t "Hello~%")

あるいはsymbolic linkを作成するのでもいいと思います。

# ln -s /usr/local/bin/sbcl /usr/bin/sbcl

しかしこれは問題を解決したと言えるのでしょうか？
実行ファイルの場所が違う問題は、sbclに限らずUnix系ではよく生じる問題です。
一般的には/usr/bin/envを用いて解決します。 envは実行するファイルを環境変数PATHから探し呼び出します。
次のような記載を見たことがある人もいると思います。

#!/usr/bin/env perl
...

今の場合はperlではなくsbclですが、 /usr/binも/usr/local/binもPATHに登録されているのであれば、同じように置き換えることで実行できるかもしれません。

#!/usr/bin/env sbcl --script
(format t "★注意：たぶん失敗する~%")

たぶん失敗すると記載したように、これだとうまく行かないかもしれません。
どうもFreeBSD 6.0までは上記でうまく行けたようなのです。
しかし問題があったためkernelに仕様変更が生じました。
今は次のように、引数-Sを記載するのが正しいとのことです。

#!/usr/bin/env -S sbcl --script
(format t "Hello~%")

これはFreeBSDだけではなくLinuxも正しく動作します。

動作確認を行う場合は、引数のチェックを含めて行った方が良いです。
例えば次のスクリプトファイルを用意します。

#!/usr/bin/env -S sbcl --script
(format t "~S~%" sb-ext:*posix-argv*)

スクリプト名をtest.shとしたときの実行結果を下記に示します。

$ ./test.sh
("sbcl")
$ ./test.sh 10 20 30
("sbcl" "10" "20" "30")

sbclに渡す引数を変更したい

スクリプトで実行するsbclの引数を変更したい場合があります。
例えば--coreを指定したい場合はどうするべきでしょうか。

$ ./test.sh --core /path/to/sbcl.core
("sbcl" "--core" "/path/to/sbcl.core")

たぶん目的とは違った結果になってしまいます。
このように、スクリプトの引数に指定しても何の解決にもなりません。

スクリプトに埋め込む

一つの方法は、スクリプトの1行目に埋め込むことです。
例えば次のようなスクリプトファイルを作成します。

#!/usr/bin/env -S sbcl --core /path/to/sbcl.core --script
(format t "~S~%" sb-ext:*posix-argv*)

これはこれで良いのですが、もし移植性を考えるのであれば、この方法は使用できないでしょう。

実行するsbclを別のものにする

例えば$HOME/bin/上にsbclというスクリプトを作り、それをPATHに登録する方法です。
実行するsbclそのものを変更するため、元々のスクリプトには手を入れる必要がありません。

ユーザーが使用するshellによって手順が変わりますが、今はbashを使っているものとします。
login時にシステムが自動的に$HOME/binをPATHに追加してくれるならよいのですが、たぶん自分で設定する必要があると思います。
次の手順を実施します。

$ cd $HOME
$ mkdir bin
$ chmod 700 bin
$ vi .bashrc
最終行に下記を追記
export PATH="$HOME/bin:$PATH"

$ vi .bash_profile
次の内容を追記
if [[ -r $HOME/.bashrc ]]; then
  source $HOME/.bashrc
fi

次にsbcl本体のスクリプトファイルを作成します。

$ cd $HOME/bin
$ touch sbcl
$ chmod +x sbcl
$ vi sbcl

次の内容で保存します。

#!/bin/sh
/usr/bin/sbcl --core /path/to/sbcl.core "$@"

一度logoutしてからloginしなおします。
次に起動確認を行います。

$ which sbcl
/home/xxx/bin/sbcl
$ sbcl --version
SBCL 1.4.12

引数のチェックを行ったスクリプトを用意します。

#!/usr/bin/env -S sbcl --script
(format t "~S~%" sb-ext:*posix-argv*)

実行確認を行います。

$ ./test.sh
("/usr/bin/sbcl")
$ ./test.sh 10 20 30
("/usr/bin/sbcl" "10" "20" "30")

なお、.bashrc, .bash_profile, .profileあたりのファイルは、 login時、bash実行時、sshなど外部接続時にて、読み込まれるファイルが違ったりしますので、必要に応じてチェックしてみてください。

2019-06-14

日本のWebサイトから情報を取得

Common Lisp

Common Lispにより、Webから特定の情報を取得する方法について考えます。

例えば、あるサイトから自分の住んでいる場所の天気だけを取得するような場合です。
私は日本語しかわからないので、当然日本のサイトを対象にします。
そうなるとエンコードの問題が出てきます。

本投稿では、下記のライブラリを用いてWebからの情報取得を行います。

CL-PPCRE
https://edicl.github.io/cl-ppcre/
Drakma
https://edicl.github.io/drakma/
CL-HTML-Parse
https://www.cliki.net/CL-HTML-Parse
Anaphora
https://common-lisp.net/project/anaphora/

自作のライブラリも使います。

strjis
https://github.com/nptcl/strjis
http://nptcl.hatenablog.com/entry/2019/06/13/024132
unmatch
http://nptcl.hatenablog.com/entry/2019/06/13/132538

処理系はsbclを用います。

方法は、htmlファイルをLispオブジェクトに変換してパターンマッチで検索するというものです。
日本語のサイトを対象とするので、エンコードの取り扱いを行わなければなりません。
まずはstrjisでどのように読み込むかを考えます。
そのあとunmatchで検索を行います。

htmlファイルの取得

URIからhttp経由で情報を取得する場合は、drakmaライブラリを使用します。
http-requestを行う時点でexternal-formatを指定できるのですが、日本語のサイトの場合はhtmlファイルを読み込まないうちは、一体どのエンコードで記載されているのかがわかりません。

仕方がないのでhttp-requestはbinaryデータを取得することにします。

(defparamter +uri+ "http://.../")
(drakma:http-request +uri+ :force-binary t)
-> #(...)

エンコードタイプは、htmlファイルの中に、

<meta http-equiv="content-type" content="text/html; charset=Shift_JIS">

のような形で記載されています。

【追記】下記の記載方法もあるそうです。

<meta charset="euc-jp">

このフォームの対応は最後にまとめて記載します。

しかし、データを取得する際にはまずエンコード問題を解決しなければなりません。そこで、取得したbinaryデータを強制的にascii形式に変換することにします。

(setq x (drakma:http-request +uri+ :force-binary t))

(let ((strjis:*recovery-unicode* nil))
  (strjis:coerce-string x :input 'ascii :recovery t))
-> 文字列

変数*recovery-unicode*をnilに設定することで、 asciiコード以外の全て文字を削除することができます。
返却された文字列が正しいhtmlファイルだと仮定して、 cl-parse-htmlに読み込ませます。

(cl-html-parse:parse-html
  (let ((strjis:*recovery-unicode* nil))
    (strjis:coerce-string x :input 'ascii :recovery t)))
-> tree

返却値はhtmlの内容を表したtreeとなります。
ここから、contents-typeを取得する方法を考えます。

パターンマッチ

unmatchを使い、tree構造から特定の内容を検索する機能を追加します。

(defun first-match-list (match body)
  (when (consp body)
    (multiple-value-bind (a b) (funcall match body)
      (or a (if b a
              (or (first-match-list match (car body))
                  (first-match-list match (cdr body))))))))

(defun list-match-list (match body)
  (let (ret)
    (labels ((rec (x) (when (consp x)
                        (multiple-value-bind (a b) (funcall match x)
                          (when (or a b)
                            (push a ret)))
                        (rec (car x))
                        (rec (cdr x)))))
      (rec body))
    (nreverse ret)))

(defun call-match-pattern (proc match data body)
  (let ((g (gensym)))
    `(,proc
       (lambda (,g) (unmatch:ifmatch ,match ,g (progn ,@body)))
       ,data)))

(defmacro first-match (match data &body body)
  (call-match-pattern 'first-match-list match data body))

(defmacro list-match (match data &body body)
  (call-match-pattern 'list-match-list match data body))

マクロfirst-matchとlist-matchはどちらもifmatchと似ていますが、パターンマッチの対象をtreeとみなして遡って検索していくことが違います。
マクロfirst-matchは、最初にマッチしたものを処理して返却します。
マクロlist-matchは、マッチしたすべてのものを処理してリストとして返却します。

contents-typeを取得する場合は次のようになります。

(defun meta-content-charset (html)
  (first-match (:meta :http-equiv ?x :content ?y) html
    (when (equalp ?x "content-type")
      ?y)))

cl-html-parseの内容を変数treeとしたとき、実行結果は例えば次のようになります。

(meta-content-charset tree)
-> "text/html; charset=Shift_JIS"

このように、cl-html-parseとunmatchを組み合わせることで、特定の情報を抽出することができます。

エンコード情報の取得

htmlファイルのbinaryデータから、エンコードタイプを取得するコードを下記に示します。

(defparameter +guess-html-charset-string+
  (cl-ppcre:create-scanner "^.+(?i)charset(?-i)\\s*=\\s*\\\"?(\\S+)\\\"?\\s*$"))
(defun guess-html-charset-string (html)
  (awhen (meta-content-charset html)
    (multiple-value-bind (str group)
      (cl-ppcre:scan-to-strings +guess-html-charset-string+ it)
      (when str
        (elt group 0)))))

(defun guess-html-encoding-string (str)
  (string-upcase
    (remove-if-not #'alphanumericp str)))

(defun guess-html-encoding-windows (str)
  (and (<= 3 (length str))
       (string= (subseq str 0 3) "WIN")))

(defun guess-html-encoding-html (html)
  (awhen (guess-html-charset-string html)
    (let ((str (guess-html-encoding-string it)))
      (cond ((string= str "UTF8") :utf8)
            ((string= str "ASCII") :utf8)
            ((string= str "JIS") :jis)
            ((string= str "ISO2022JP") :jis)
            ((string= str "EUC") :eucjis)
            ((string= str "EUCJP") :eucjis)
            ((string= str "EUCJIS") :eucjis)
            ((string= str "SHIFTJIS") :shiftjis)
            ((string= str "SJIS") :shiftjis)
            ((string= str "CP932") :shiftjis)
            ((string= str "MS932") :shiftjis)
            ((guess-html-encoding-windows str) :shiftjis)))))

(defun guess-html-encoding (x)
  (guess-html-encoding-html
    (cl-html-parse:parse-html
      (let ((strjis:*recovery-unicode* nil))
        (strjis:coerce-string x :input 'ascii :recovery t)))))

使用例を示します。

(setq x (drakma:http-request +uri+ :force-binary t))

(guess-html-encoding x)
-> :SHIFTJIS

htmlファイルの内容取得

エンコードさえ取得できればあとは簡単です。

(defun fetch (uri &key (guess :utf8))
  (let* ((x (drakma:http-request uri :force-binary t))
         (encode (or (guess-html-encoding x) guess)))
    (cl-html-parse:parse-html
      (strjis:coerce-string x :input encode))))

(fetch +uri+)
-> ((:!DOCTYPE ...) (:HTML ...))

エンコード情報の取得は万能ではなく失敗することもあるため、引数:guessにてデフォルトのエンコードタイプを指定できるようにしています。

では、取得したhtmlからパターンマッチで検索していきます。

検索: 最初にマッチした情報を返却する

次の実行例を考えます。

(first-match ((:form :action _ :method ?x . _) . ?body) (fetch +uri+)
  (when (equalp ?x "post")
    ?body))
-> tree

マッチする内容は、例えば次のようなhtml構文の内容です。

<form action="call.cgi" method="POST" id="callid">
[ここの内容が返却されます]
</form>

first-matchは先頭から検索をしていき、最初にヒットした内容がbody句で処理されます。パターンマッチの候補が複数あった場合でも、最初の内容だけが対象となります。

検索: マッチした情報を集めてリストで返却

次の実行例を考えます。

(list-match (:a :href ?x . _) (fetch +uri+)
  ?x)
-> list

マッチする内容は、例えば次のようなhtml構文を寄せ集めたリストです。

<a href="ここの内容が返却されます">

例えば下記のようになります。

("/inex.html" "/path/to/" "http://.../")

検索: 最初にマッチした内容から、別の検索で情報を集める

上記二例の複合です。

(first-match ((:form :action _ :method ?x . _) . ?body) (fetch +uri+)
  (when (equalp ?x "post")
    (list-match (:a :href ?x . _) ?body
      ?x)))

最初にマッチした<form...>の内容から、<a href...>を集めてリストとして返却します。

最後に

これらの方法を使うことで、特定の情報を取得することもできますし、 FORMから必要なhidden情報を集めてPOSTしたりすることもできます。 drakmaはcookieに対応しているため、例えばログインを行ったりすることもできます。作者はこの方法を使って自動化を行っていたことがありました。

ただし、実際にWebの自動化を行う場合は、たぶん誰かがすでに作っているであろう専門のライブラリを使った方が楽かもしれません。

【追記】別のcharset記載について

charsetの記載方法は下記のフォームもあるそうです。

<meta charset="euc-jp">

対応したLispコードを下記に示します。

;;
;;  guess-html-encoding
;;
(defun guess-html-encoding-upcase (str)
  (string-upcase
    (remove-if-not #'alphanumericp str)))

(defun guess-html-encoding-windows (str)
  (and (<= 3 (length str))
       (string= (subseq str 0 3) "WIN")))

(defun guess-html-encoding-string (x)
  (let ((x (guess-html-encoding-upcase x)))
    (cond ((string= x "UTF8") :utf8)
          ((string= x "ASCII") :utf8)
          ((string= x "JIS") :jis)
          ((string= x "ISO2022JP") :jis)
          ((string= x "EUC") :eucjis)
          ((string= x "EUCJP") :eucjis)
          ((string= x "EUCJIS") :eucjis)
          ((string= x "SHIFTJIS") :shiftjis)
          ((string= x "SJIS") :shiftjis)
          ((string= x "CP932") :shiftjis)
          ((string= x "MS932") :shiftjis)
          ((guess-html-encoding-windows x) :shiftjis))))

(defun guess-html-encoding-charset1 (x)
  ;; <meta charset="euc-jp">
  (first-match (:meta :charset ?x . _) x
    (guess-html-encoding-string ?x)))

(defparameter +guess-html-encoding-charset2+
  (cl-ppcre:create-scanner "^.+(?i)charset(?-i)\\s*=\\s*\\\"?(\\S+)\\\"?\\s*$"))
(defun guess-html-encoding-charset2 (x)
  ;; <meta http-equiv="content-type" content="text/html; charset=Shift_JIS">
  (first-match (:meta :http-equiv ?x :content ?y) x
    (when (and (equalp ?x "content-type")
               (stringp ?y))
      (multiple-value-bind (str group)
        (cl-ppcre:scan-to-strings +guess-html-encoding-charset2+ ?y)
        (when str
          (guess-html-encoding-string
            (elt group 0)))))))

(defun guess-html-encoding-html (x)
  (cl-html-parse:parse-html
    (let ((strjis:*recovery-unicode* nil))
      (strjis:coerce-string x :input 'ascii :recovery t :size #x010000))))

(defun guess-html-encoding (x)
  (let ((x (guess-html-encoding-html x)))
    (or (guess-html-encoding-charset1 x)
        (guess-html-encoding-charset2 x))))


;;  fetch
(defun fetch (uri &key (guess :utf8))
  (let* ((x (drakma:http-request uri :force-binary t))
         (encode (or (guess-html-encoding x) guess)))
    (cl-html-parse:parse-html
      (strjis:coerce-string x :input encode :size #x010000))))

slot-valueによるslotの読み書き

関数による読み書き（defstruct, defclass共通）

関数による読み書き（defstruct）

関数による読み書き（defclass）

まとめ

constの意味

constポインタの書き方

初期化と代入

右から1番目のconst

右から2番目のconst

右から3番目以降のconst（gcc, clang）

右から3番目以降のconst（Visual Studio 2017）

修飾子の複合

radix-string

unit-string

スクリプトファイルの作成

sbclの場所が違う

sbclに渡す引数を変更したい

スクリプトに埋め込む

実行するsbclを別のものにする

htmlファイルの取得

パターンマッチ

エンコード情報の取得

htmlファイルの内容取得

検索: 最初にマッチした情報を返却する

検索: マッチした情報を集めてリストで返却

検索: 最初にマッチした内容から、別の検索で情報を集める

最後に

【追記】別のcharset記載について

`slot-value`によるslotの読み書き

関数による読み書き（`defstruct`, `defclass`共通）

関数による読み書き（`defstruct`）

関数による読み書き（`defclass`）

`const`の意味

`const`ポインタの書き方

右から1番目の`const`

右から2番目の`const`

右から3番目以降の`const`（gcc, clang）

右から3番目以降の`const`（Visual Studio 2017）

`radix-string`

`unit-string`