Common Lispから日本語のDictionaryを見る
以前の投稿
ANSI Common LispのDictionaryだけ翻訳したい - nptclのブログでは、
Dictionaryだけを日本語に翻訳して行こうと話しましたが、
残念ながらまだ全部は翻訳できていません。
とはいえ現段階では70％くらい完了しました。
これが終わったらnptをいろいろいじる予定ですが、
CLOSとかMOPとかを完璧にしたいので、
7章「オブジェクト」に引き続き、
4章の「型とクラス」の内容もDictionary含めて全部翻訳してしまいました。
よかったら見てみて下さい。
トップはここ。
https://nptcl.github.io/npt-japanese/md/ansicl/index.html
まあそれはいいとして本題に入ります。
Common Lispから、この日本語訳のDictionaryを参照できるようにしました。
例えば、substって何だったかなあ？というときに
日本語の説明を表示することができます。
配布はここ。
https://github.com/nptcl/npt-japanese
- src/npt-japanese.lisp
上記のファイルをloadするだけで使えます。
asdファイルも用意していますので、
asdf:load-systemなんかでも使えると思います。
読み込みはこんな感じ。
* (load #p"npt-japanese.lisp") * (use-package 'npt-japanese)
ためしにsubstの説明を見てみます。
* (docjp subst) Function SUBST, SUBST-IF, SUBST-IF-NOT,NSUBST, NSUBST-IF, NSUBST-IF-NOT ## 構文 subst new old tree &key key test test-not => new-tree subst-if new predicate tree &key key => new-tree subst-if-not new predicate tree &key key => new-tree nsubst new old tree &key key test test-not => new-tree nsubst-if new predicate tree &key key => new-tree nsubst-if-not new predicate tree &key key => new-tree ## 引数と戻り値 new - オブジェクト old - オブジェクト predicate - 関数名のシンボルか、1つの引数をとりgeneralized-booleanを返却する関数 tree - ツリー test - 2つの引数を取りgeneralized-booleanを返却する関数の指定子 test-not - 2つの引数を取りgeneralized-booleanを返却する関数の指定子 key - 1つの引数を取りgeneralized-booleanを返却する関数の指定子、またはnil new-tree - ツリー ・・・
出力が大量に出るので、
最初の方はスクロールさせないと見えません。
moreとかlessみたいに表示を止めたらいいんでしょうけど
ごめんなさい。
そこまでしません。
候補が2つ以上ある場合は、どれが見たいのか聞かれます。
* (docjp pathname) PATHNAME FUNCTION PATHNAME SYSTEM-CLASS
下の方が見たいというときは次のようにしてください。
* (docjp pathname system-class)
公開しているインターフェースは次の2つだけです。
(defmacro docjp (&rest args) ...) (defun doc-japanese (&rest args) ...)
docjpは、単にdoc-japaneseを呼び出してるだけです。
いちいちquoteするのが面倒だったからマクロで囲みました。
実行例は次の通り。
* (doc-japanese 'subst)
分ってる問題として表とリストの出力はガタガタです。
でもちょっと確認するくらいならこれで十分かな。
base64の変換を作る
C言語とCommon Lispで、base64を扱うコードを作成しました。
base64のコードはすでに何人も作成しており、
C言語では検索するだけでコードがいっぱい出てきます。
Common Lispだとcl-base64あたりが有名かと思います。
それにもかかわらず新しく作成したのは
入力と出力をパイプ処理のように扱いたかったためです。
まあ本当は単に作りたかっただけですけど。
1. base64の入出力
base64とは、バイナリをテキストファイルに変換する機能です。
入力は普通のバイナリデータなので8bitの列です。
それに対して出力はテキストファイルであり、
内部では6bitの列をアルファベットなどに割り当てて表現します。
base64の変換処理である、エンコードを考えましょう。
まずエンコード処理は、入力の8bitの列を6bitの列に変換します。
変換といっても、ただ8bitに並んだデータを
無理やり6bit間隔に分けるだけです。
出力は6bitのデータを1byteで表現するので、
当然入力より出力の方が大きくなります。
つまり入力1byteに対して、出力は1byteか2byteになります。
これが本ライブラリで重要なところです。
次にbase64でエンコードされたテキストを、
元のバイナリファイルに戻すデコード処理を考えます。
デコードは、エンコードのときの事情と逆です。
つまり入力1byteに対して、出力は0byte（なし）か1byteになります。
まとめますと、
- エンコードは入力1byteあたり、出力1byteか2byte
- デコードは入力1byteあたり、出力0byteか1byte
これを頭に入れておいて、base64の関数を使ってみましょう。
2. C言語でbase64のエンコード
まずはC言語でやっていきます。
Common Lispはそのあとです。
C言語で必要なファイルは次の2つです。
エンコードとは、バイナリをテキストに変換する処理です。
初期化処理をしましょう。
struct base64_encode encode; base64_encode_init(&encode);
変数encodeを、関数base64_encode_initで初期化しています。
なお初期化処理に対応する解放関数はありません。
適当に終わらせてもリークは発生しないのでご安心ください。
その次に、必要であれば62文字、63文字、パディングの文字を設定をしてください。
デフォルトでは次のような設定がされています。
encode.char_62 = '+'; encode.char_63 = '/'; encode.char_padding = '=';
パティングを最後に付与するかどうかの設定もできます。
標準ではパティングが出力されるので、
次のように設定されています。
encode.padding = 1;
以上で初期化と設定は完了です。
さっそくエンコードしてみましょう。
例としてABという2byteをbase64で変換してみます。
まずは最初のAから。
char x, y; base64_encode_pipe(&encode, 'A', &x, &y);
エンコードは入力Aという1byteに対して、
出力xの1byteか、あるいはyも含む2byteが返却されます。
次のようにして出力しましょう。
if (x) printf("%c", x); if (y) printf("%c", y);
それでは、次の文字のBを渡します。
base64_encode_pipe(&encode, 'B', &x, &y); if (x) printf("%c", x); if (y) printf("%c", y);
入力はこれで終わりですが、
まだ出力されていない文字があるかもしれません。
関数base_encode_closingを使い、
全ての文字を出力しましょう。
for (;;) { base64_encode_closing(&encode, &x); if (x == 0) break; printf("%c", x); } printf("\n");
これでエンコード完了です。
実行結果は下記の通り。
QUI=
3. C言語でbase64のデコード
デコードとは、base64のテキストを元のバイナリに戻す処理です。
使い方はエンコードとほぼ同じですが、
デコードの場合は入力エラーが起こる可能性があるので、判定する必要があります。
つまりエンコードとは違って、変な入力が突っ込まれるかもしれないのです。
まずは初期化を行います。
struct base64_decode decode; base64_decode_init(&decode);
エンコードと同様、解放関数はないのでリークは発生しません。
文字の設定のデフォルト値は次の通り。
decode.char_62 = '+'; decode.char_63 = '/'; decode.char_padding = '=';
その他の設定もありますが、あとでまとめて説明します。
例として、エンコードの例で出力された
QUI=をデコードしてみます。
まずはQから。
uint8_t x; int check; check = base64_decode_pipe(&decode, 'Q', &x);
checkには実行結果が、
xには変換したデータが入ります。
まずはエラーチェックを行う必要があります。
if (check < 0) { fprintf(stderr, "decode error\n"); exit(1); }
上記のようにエラーが発生した場合は、
終了させるなど適切な処理を行ってください。
例ではexit(1)でプロセスを強制終了させています。
デコードの出力は、0byteか1byteなので、
必ずxを出力すればいいわけではありません。
次のようにcheckを確認してください。
if (check) printf("%c", (int)x);
それでは2文字目のUを出力します。
check = base64_decode_pipe(&decode, 'U', &x); if (check < 0) { fprintf(stderr, "decode error\n"); exit(1); } if (check) printf("%c", (int)x);
3文字目Iと4文字目=も行います。
check = base64_decode_pipe(&decode, 'I', &x); （省略） check = base64_decode_pipe(&decode, '=', &x); （省略）
入力はこれで終わりですので、
関数base_decode_closeで終了します。
if (base64_decode_close(&decode)) { fprintf(stderr, "decode_close error\n"); exit(1); } printf("\n");
これでデコード処理は完了です。
実行すればABが出力されるはずです。
最後にオプションを説明します。
関数base64_decode_initで初期化した直後には、
次の設定を行うことができます。
struct base64_decode decode; base64_decode_init(&decode); decode.ignore_eol = 1; decode.ignore_others = 0; decode.ignore_padding = 0;
ignore_eolは、改行を無視します。
具体的には文字コード0x0Aと0x0Dを無視します。
ignore_eolが0のときに
改行コードが読み込まれるとエラーです。
ignore_othersは、異常な文字を無視します。
つまりbase64で使われる65文字と改行コード2種類の
計67文字以外が現れたとき、
本来であればエラーになるのですが無視するように指示します。
ignore_paddingは、最後に付与されるパディング文字を無視します。
パディング文字を完全に無視するのではなく、
本来あり得ない場所に出現していたり、
あるいは最後4文字に区切られていない場合はエラーになります。
4. Common Lispでbase64のエンコード
それではCommon Lispでやってみましょう。
必要なファイルは次の通り。
まずは読み込みます。
* (load #p"base64.lisp")
hypd-base64というパッケージができるので、使えるようにします。
(defpackage work (:use cl hypd-base64)) (in-package work)
それではABという文字をエンコードしてみます。
まずは構造体の作成から。
(setq encode (base64-encode-init))
C言語のときと同様、オプションを設定できます。
デフォルトは次のようになります。
(setf (base64-encode-char-62 encode) #\+) (setf (base64-encode-char-63 encode) #\/) (setf (base64-encode-char-padding encode) #\=) (setf (base64-encode-padding encode) t)
最初の文字Aを入力に渡します。
(setq v (char-code #\A)) (multiple-value-setq (x y) (base64-encode-pipe encode v))
関数base64-encode-pipeの入力には文字を指定できないため、
変数vに整数を代入してから渡しています。
関数の返却値x, yにはnilか文字が入っているため、
その結果を取り出しましょう。
ただし、C言語と違ってインタラクティブで実行している場合は、
出力しても意味が分からなくなるため、
結果を格納する変数を新たに用意することにします。
(setq value nil)
上記の変数valueに結果を入れていきましょう。
(when x (push x value)) (when y (push y value))
次はBを入力に渡します。
(setq v (char-code #\B)) (multiple-value-setq (x y) (base64-encode-pipe encode v)) (when x (push x value)) (when y (push y value))
入力が終わったらbase64-encode-closingを行います。
(do (v) (nil) (setq v (base64-encode-closing encode)) (if v (push v value) (return nil)))
このclosing処理ですが、
Common LispはC言語と違って
クロージャーやらなにやら便利機能が使えますので、
上記のdo式は次のように書き直すこともできます。
(base64-encode-close encode (lambda (v) (push v value)))
それでは結果を見てみましょう
(setq value (nreverse value)) (format t "~S~%" (coerce value 'string))
結果は下記の通り。
"QUI="
5. Common Lispでbase64のデコード
それではどんどん行きます。
(setq decode (base64-decode-init))
オプションのデフォルトは次のようになります。
(setf (base64-decode-char-62 decode) #\+) (setf (base64-decode-char-63 decode) #\/) (setf (base64-decode-char-padding decode) #\=) (setf (base64-decode-ignore-eol decode) t) (setf (base64-decode-ignore-others decode) nil) (setf (base64-decode-ignore-padding decode) nil)
最初のQを入力します。
(setq value nil) (let ((x (base64-decode-pipe decode #\Q))) (when x (push x value)))
入力を続けます。
(let ((x (base64-decode-pipe decode #\U))) (when x (push x value))) (let ((x (base64-decode-pipe decode #\I))) (when x (push x value))) (let ((x (base64-decode-pipe decode #\=))) (when x (push x value)))
クローズ処理を行います。
(base64-decode-close inst)
それでは結果を見てみましょう
(setq value (nreverse value)) (format t "~S~%" (coerce value 'string))
結果は下記の通り。
"AB"
6. Common Lispで配列を使う
Common Lispにて、入力と出力に配列を使う例を示します。
配列の要素の型は、微妙に異なるので注意してください。
エンコードは、入力がバイナリで出力が文字列です。
デコードは、入力が文字列で出力がバイナリです。
テストしやすくするために、相互変換できる便利な関数を用意しましょう。
(defun coerce-binary (str) (map 'vector (lambda (c) (if (characterp c) (char-code c) c)) str)) (defun coerce-string (str) (map 'string (lambda (c) (if (characterp c) c (code-char c))) str))
試しに実行してみます。
* (coerce-binary "Hello") -> #(72 101 108 108 111) * (coerce-string #(72 101 108 108 111)) -> "Hello"
まずはエンコードする関数を作成します。
(defun base64-encode-binary (input &optional (inst (base64-encode-init))) (with-output-to-string (s) (dotimes (i (length input)) (let ((v (elt input i))) (multiple-value-bind (x y) (base64-encode-pipe inst v) (when x (write-char x s)) (when y (write-char y s))))) (base64-encode-close inst (lambda (v) (write-char v s)))))
実行してみましょう。
* (base64-encode-binary (coerce-binary "ABC")) -> "QUJD"
base64に変換されているのが分かります。
配列から配列へ変換するというものは、
使いやすいかどうかはともかく、
わかりやすいとは思います。
それではデコードの方を作成します。
デコードの場合は、返却値をためるときに使用した
with-output-to-stringのような便利な関数はないので、
vector-push-extendで伸長する仕組みを作りました。
(defun base64-decode-string (input &optional (inst (base64-decode-init))) (let ((r (make-array 16 :adjustable t :fill-pointer 0 :element-type '(mod 256)))) (flet ((push-value (x) (vector-push-extend x r (array-total-size r)))) (dotimes (i (length input)) (let* ((v (elt input i)) (x (base64-decode-pipe inst v))) (when x (push-value x)))) (base64-decode-close inst) r)))
それでは実行してみます。
* (coerce-string (base64-decode-string "QUJD")) -> "ABC"
正しく変換されているのが分かります。
ここまで理解できれば、 base64の処理を好きなように組み込むことができると思います。
ANSI Common LispのDictionaryだけ翻訳したい
Dictionaryだけ翻訳したいです。
Dictionaryだけです。
ANSI Common Lisp仕様書の、各章にあるDictionaryだけを翻訳していきます。
ということで、ここでやって行きます。
まだ全然できていません。
https://nptcl.github.io/npt-japanese/docs/ansicl/index.html
https://nptcl.github.io/npt-japanese/md/ansicl/index.html
どちらも同じ内容ですので、見やすい方を見てください。
ConsesとSequencesだけできていれば、
きっと誰かの役に立つだろうと思い公開しました。
更新はあまりできないかもしれません。
気長にやっていきます。
なお、7章のObjectsだけは先に全部翻訳しました。
ここは前にDictionary以外を翻訳していたので
（ここと
ここ）、
せっかくなので先に全部やってしまおうと思いました。
もともとDictionary以外を翻訳するつもりはなく、
全翻訳は7章だけになります。
いまのnptはこの辺の実装がガタガタですが、
そのうちMetaobject Protocolを含めてちゃんとやりたいですね。
C言語で円周率の値を使う
円周率とは3.14のことです。
本当はもっと桁数があるので、前回の投稿では次のようにしていました。
#define PI 3.141592653589793238462643383276
小数桁数が30の例です。
FreeBSDで次のように実行すれば出てきます。
$ echo 'scale=30; a(1)*4' | bc -l 3.141592653589793238462643383276
では、どうして30桁なんでしょうか。
理由は16桁以上あればいい、くらいの予備知識があったからです。
本当にそれだけで、適当に30にしました。
それなら20桁で十分ですよね、とか、
100桁や1000桁にすればいいのではという話になるわけですが、
100桁はいくら何でも多すぎるのではないでしょか。
なら何桁にすればいいんだ？
何を根拠に言ってるんだ？
ということをちゃんと考えましょう。
円周率を使いたいときはどうしたらいいのか調べて行きます。
1. 標準ではない定数に頼る
標準にこだわらないのであれば、M_PIという定数があるそうです。
これは初めて知りました。
すでにあるものを使えるなら、わざわざ桁数なんかに頭を悩ませる必要はありませんね。
使っていいならぜひぜひ使ってください。
ただ、私は標準にこだわる人なので多分使うことはないと思います。
移植性みたいなことに苦労した経験があるので、やめておこうかなと。
先にネタバレしておきますが、C言語の仕様書では浮動小数の厳密な内容を定義していませんので、
円周率の値は絶対にCPU依存の方法でしか定義できません。
標準にこだわったところでC言語汎用の円周率なんて定義できないのです。
C言語を使うってそういうことなんだろうとあきらめるしかありません。
だから、どうせ何かしら標準以外の方法に頼らなければならないなら
この方法は少しだけおススメできます。
それでは、M_PIを見ていきましょう。
いったい何が書かれているのか確認してみましょう。
まずはFreeBSDのclang環境から。
/usr/include/math.h #define M_E 2.7182818284590452354 /* e */ #define M_LOG2E 1.4426950408889634074 /* log 2e */ #define M_LOG10E 0.43429448190325182765 /* log 10e */ #define M_LN2 0.69314718055994530942 /* log e2 */ #define M_LN10 2.30258509299404568402 /* log e10 */ #define M_PI 3.14159265358979323846 /* pi */ #define M_PI_2 1.57079632679489661923 /* pi/2 */ #define M_PI_4 0.78539816339744830962 /* pi/4 */ #define M_1_PI 0.31830988618379067154 /* 1/pi */ #define M_2_PI 0.63661977236758134308 /* 2/pi */ #define M_2_SQRTPI 1.12837916709551257390 /* 2/sqrt(pi) */ #define M_SQRT2 1.41421356237309504880 /* sqrt(2) */ #define M_SQRT1_2 0.70710678118654752440 /* 1/sqrt(2) */
すげえ、いっぱいある！
続けて、Gentoo Linuxのgcc環境も見てみます。
/usr/include/math.h # define M_E 2.7182818284590452354 /* e */ # define M_LOG2E 1.4426950408889634074 /* log_2 e */ # define M_LOG10E 0.43429448190325182765 /* log_10 e */ # define M_LN2 0.69314718055994530942 /* log_e 2 */ # define M_LN10 2.30258509299404568402 /* log_e 10 */ # define M_PI 3.14159265358979323846 /* pi */ # define M_PI_2 1.57079632679489661923 /* pi/2 */ # define M_PI_4 0.78539816339744830962 /* pi/4 */ # define M_1_PI 0.31830988618379067154 /* 1/pi */ # define M_2_PI 0.63661977236758134308 /* 2/pi */ # define M_2_SQRTPI 1.12837916709551257390 /* 2/sqrt(pi) */ # define M_SQRT2 1.41421356237309504880 /* sqrt(2) */ # define M_SQRT1_2 0.70710678118654752440 /* 1/sqrt(2) */
同じものが書かれていますが、gccは上記以外にも色々と定義されています。
全部書き出しても意味がないので、M_PIを全通り抜き出してみます。
# define M_PI 3.14159265358979323846 /* pi */ # define M_PIl 3.141592653589793238462643383279502884L /* pi */ # define M_PIf16 __f16 (3.141592653589793238462643383279502884) /* pi */ # define M_PIf32 __f32 (3.141592653589793238462643383279502884) /* pi */ # define M_PIf64 __f64 (3.141592653589793238462643383279502884) /* pi */ # define M_PIf128 __f128 (3.141592653589793238462643383279502884) /* pi */ # define M_PIf32x __f32x (3.141592653589793238462643383279502884) /* pi */ # define M_PIf64x __f64x (3.141592653589793238462643383279502884) /* pi */
こんなに使えるんですね。
ちなみに、M_PIlは128bitの浮動小数で使えますよと書かれています。
どういうことなのか、これから説明していきますので覚えておきましょう。
これらの定数を使った場合の利点は、CPUのことなどまるで考慮しなくても良いことです。
たぶん、コンパイラは十分な精度を提供してくれるはず、と思い込むことができます。
非常に良い利点なのですけど、
FreeBSDではlong doubleの円周率が用意されていないので注意してくださいね。
つまり、十分な精度が用意されていません。
困ったものだ。
2. 値を自分で用意する
標準だけを使いたい場合は、自分で定義するしかありません。
ではどうやって定義していくかを見ていきます。
まずは浮動小数型に対して、10進数で表すことができるぎりぎり限界を調べます。
floatは、8桁以上。
doubleは、16桁以上。
long double (Intel 80bit)は、20桁以上。
long double (IEEE754 binary128)は、35桁以上。
ただし、上記の内容は、私が使っているCPUに合った内容です。
C言語の仕様書に載っているわけではありません。
そこはもうあきらめてください。
私のCPUがあたなのCPUと一致しているとは限りませんので、
もしあなたのCPUがIEEE 754に従ってないとか、
あるいは基数10とか16ですよとか、そういう場合は自分自身で計算して桁数を求めてください。
話を戻しましょう。
求めた桁数にすこし余裕を持たせることにします。
結果は次のようになります。
#define PI_FLOAT 3.141592654f #define PI_DOUBLE 3.14159265358979324 #define PI_LONG 3.141592653589793238462643383279502884L
注意点としては、PI_LONGの最後にLを忘れないようにしてください。
忘れるとdoubleに切り捨てられます。
3. 桁数の求め方
どうしてこの値になったのかを詳細に書いていきます。
floatはIEEE754 binary32形式、仮数23bit、hidden bitあり、合計24bit。
doubleはIEEE754 binary64形式、仮数52bit、hidden bitあり、合計53bit。
long doubleのIntel形式は、仮数64bitの、hidden bitなし、合計64bit。
long doubleのIEEE 754 binary128形式は、仮数112bit、hidden bitあり、合計113bit。
基数はすべて2です。
long doubleは、IntelのCPUだと拡張倍精度浮動小数点数と呼ばれる
80bit長の浮動小数を実装しています。
それとは別に、IEEE754ではbinary128形式という別の形式も存在します。
どちらも考慮に入れて考えてみましょう。
まとめると、
floatは、24bit
doubleは、53bit
long double(Intel)は、64bit
long double(IEEE754)は、113bit
では順番に、浮動小数の最大値が10進数で何桁かを求めます。
24bitということは、2の24乗が最大なわけで、出してみればいいんです。
* (expt 2 24) 16777216
これ、何桁かわかりますか？
わからないならこうしましょう。
* (length (princ-to-string (expt 2 24))) 8
8桁だそうです。
もっと頭良さそうに出す方法もあって、
logを使って10の何乗かを出してみます。
こうやって出します。
* (* 24 (log 2 10)) 7.22472
おおよそ7.22桁だと思ってもらえばいいと思います。
中途半端で意味不明なので、繰り上げて8桁にしましょう。
同じようにして全部出してみます。
floatは、24bit -> 7.22 (8桁)
doubleは、53bit -> 15.95 (16桁)
long double(Intel)は、64bit -> 19.27 (20桁)
long double(IEEE754)は、113bit -> 34.02 (35桁)
最低限、この桁数だけ確保すればいいわけです。
実は10進数で表すことができる最低限の桁数は
float.hに定数として設定されています。
ちょっと見てみましょう。
#include <stdio.h> #include <float.h> int main() { printf("%d\n", FLT_DIG); printf("%d\n", DBL_DIG); printf("%d\n", LDBL_DIG); return 0; }
実行結果は下記の通り。
6 15 18
これより大きな桁数であればいいわけなので、 まあまあ合っていると言えるのではないでしょうか。
それではPIに戻ります。
floatの値を出してみます。
多い分には構わないので、小数の部分を8桁+1桁の9桁にします。
実数部も1桁あるので、たぶん十分だと思います。
まず小数10桁だして、最後を四捨五入して9桁にします。
ちなみに、bcコマンドで出すと、最後の桁周辺が怪しい値になるので、
$ echo 'scale=10; a(1)*4' | bc -l 3.1415926532 ★おかしかも
みたいにはしないでください。
10桁と20桁の出力を比べてみます。
3.1415926532 3.14159265358979323844
最後の桁が2ではなく5になっているのが分かります。
ということで、いろいろやって9桁の円周率
#define PI_FLOAT 3.141592654f
が得られました。
同様にdoubleとlong doubleもやっていきます。
#define PI_FLOAT 3.141592654f #define PI_DOUBLE 3.14159265358979324 #define PI_INTEL 3.141592653589793238463L #define PI_LONG 3.141592653589793238462643383279502884L
これらの値が正しく格納されているかどうかは、 浮動小数を16進数で出力すると分かりやすいです。
#include <stdio.h> #define PI_FLOAT 3.141592654f #define PI_DOUBLE 3.14159265358979324 #define PI_INTEL 3.141592653589793238463L #define PI_LONG 3.141592653589793238462643383279502884L int main() { float x; double y; long double z, w; x = PI_FLOAT; y = PI_DOUBLE; z = PI_INTEL; w = PI_LONG; printf("%23.20A\n", x); printf("%23.20A\n", y); printf("%23.20LA\n", z); printf("%23.20LA\n", w); return 0; }
たしかprintfの%Aはc99の機能だったと思います。
実行結果は下記の通り。
0X1.921FB600000000000000P+1 0X1.921FB54442D180000000P+1 0X1.921FB54442D1846A0000P+1 0X1.921FB54442D1846A0000P+1
よさそうですね。
一応補足しますが、実行したPCのCPUはIntel製のため、
IEE754 binary128は確認できません。
あとちょっと話題を広げますが、PI_INTELとPI_LONGって二つも必要でしょうか。
IEEE754のbinary 128というは、
CPUもプログラミング言語もほとんど対応してないようで、
めったにお目にかかれないそうです。
（とはいえgccでは非標準で使えます。mpfrの機能なんでしょうね。）
あまり存在しないものに合わせてもしょうがないので、
PI_INTELの方をlong doubleにしても誰も文句言わないと思います。
しかし桁数は多いに越したことはないので、
わざわざ桁数の少ないPI_INTELを採用する必要もありません。
PI_LONGだけにしましょう。
ということで削除すると次の結果になります。
#define PI_FLOAT 3.141592654f #define PI_DOUBLE 3.14159265358979324 #define PI_LONG 3.141592653589793238462643383279502884L
これで完了です！
ちなみに、私のお気に入りはこれ。
/* $ echo 'scale=40; a(1)*4' | bc -l */ #define PI_FLOAT 3.1415926535897932384626433832795028841968f #define PI_DOUBLE 3.1415926535897932384626433832795028841968 #define PI_LONG 3.1415926535897932384626433832795028841968L
適当に40桁がいちばん楽ですね。
だったら何のためにここまで詳しく語ってきたんだ。
4. 定数の型
適当にしていても何とかなるのが「型」です。
定数の型とは、例えばこんな感じ
3.14はdouble型3.14fはfloat型3.14Lはlong double型
標準ではないM_PIという定数はdouble型です。
C言語には暗黙のキャスト機能がありますので、floatでも使えます。
しかし、long doubleでは使えません。
正確には、使えるのですけど精度が十分ではありません。
それなら初めからlong double型で定数を宣言しておけばいいと思いませんか？
つまり、M_PIなんていらずにM_PIlだけにすればいいのでは？
正しいとも間違ってるとも言えます。
例ですがCommon Lispの定数piは、そういう考えで最大の長さを持つ型の値が格納されています。
見てみましょう。
* pi 3.14159265358979324L0
値がlong-floatになっているのが分かります。
sbclとcclのpiはdouble-float型で格納されていますが、
どちらもそもそもlong-floatという型そのものが存在せず、
double-floatとして扱われます。
C言語もlong double型のPIを一つだけ用意しておけばいいのでは？
それをしない理由は、定数の型によって出力されるコードが変わる可能性があるためです。
ここでは話題にしませんが、当然Common Lispも同じです。
浮動小数の演算は、型が大きい方に自動的にキャストされます。
例えばdoubleとfloatの足し算は、doubleです。
floatとlong doubleの掛け算は、long doubleです。
この暗黙のキャストを、次の例で見てみます。
double multi_long(double x) { return x * PI_LONG; }
関数multi_longは、引数にPIを乗算する関数です。
定数はPI_LONGを使っているので、long doubleで演算されます。
その様子を見てみましょう。
実行例はFreeBSD, amd64, clang, gdbです。
$ cc -g main.c $ gdb a.out (gdb) disassemble multi_long Dump of assembler code for function multi_long: 0x00000000002019e0 <+0>: push %rbp 0x00000000002019e1 <+1>: mov %rsp,%rbp 0x00000000002019e4 <+4>: movsd %xmm0,-0x8(%rbp) 0x00000000002019e9 <+9>: fldl -0x8(%rbp) ★ここを見てほしい★ 0x00000000002019ec <+12>: fldt -0x14d2(%rip) # 0x200520 0x00000000002019f2 <+18>: fmulp %st,%st(1) 0x00000000002019f4 <+20>: fstpl -0x10(%rbp) 0x00000000002019f7 <+23>: movsd -0x10(%rbp),%xmm0 0x00000000002019fc <+28>: pop %rbp 0x00000000002019fd <+29>: ret End of assembler dump.
「★ここを見てほしい★」では、
fldl命令からx87 FPUのSTレジスタが使われているのが分かります。
つまりlong doubleで演算されています。
それでは、doubleの定数を乗算する方も見ていきます。
double multi_double(double x) { return x * PI_DOUBLE; }
逆アセンブルしてみます。
(gdb) disassemble multi_double Dump of assembler code for function multi_double: 0x0000000000201a00 <+0>: push %rbp 0x0000000000201a01 <+1>: mov %rsp,%rbp 0x0000000000201a04 <+4>: movsd -0x1504(%rip),%xmm1 # 0x200508 0x0000000000201a0c <+12>: movsd %xmm0,-0x8(%rbp) 0x0000000000201a11 <+17>: mulsd -0x8(%rbp),%xmm1 0x0000000000201a16 <+22>: movaps %xmm1,%xmm0 0x0000000000201a19 <+25>: pop %rbp 0x0000000000201a1a <+26>: ret End of assembler dump.
multi_longとはちがい、STレジスタではなくxmmレジスタが使われており、
doubleで乗算されているのが分かります。
定数の型をちゃんと意識しないと、
doubleで済むところをlong doubleで演算してしまうということです。
でもそれの何が問題なの？ という話ですが、難しいですね。
何も問題ないかもしれません。
はたしてfloatとdoubleとlong doubleは、
演算の速度に差があるのでしょうか？
その答えは、当たり前なのですがCPU依存です。
大昔にこんなことを聞いたことがあります。
「C言語はdouble使ってりゃいいんだよ。」
たぶんIntelのCPUの話ではないと思うのですが、
CPUによってはdoubleしか演算できず、
floatの場合はわざわざdoubleにキャストしてから演算し、
結果をfloatにキャストして戻すんだそうです。
手間がかかるため、doubleの方が圧倒的に早かったそうです。
amd64の逆アセンブルの例でも、doubleとlong doubleで出力するコードが違っていました。
doubleはxmmレジスタ。
long doubleはSTレジスタです。
演算する場所すら違うので、速度に差が生じる可能性はあります。
確認はしてみたのですが、私の環境でテストした限りでは
multi_doubleとmulti_longの演算時間に差は全くありませんでした。
でも、そんなに簡単な話でもないとは思います。
せっかくなのでfloatの例も見てみましょう。
double multi_float(double x) { return x * PI_FLOAT; }
(gdb) disassemble multi_float Dump of assembler code for function multi_float: 0x00000000002019c0 <+0>: push %rbp 0x00000000002019c1 <+1>: mov %rsp,%rbp 0x00000000002019c4 <+4>: movsd -0x14bc(%rip),%xmm1 # 0x200510 0x00000000002019cc <+12>: movsd %xmm0,-0x8(%rbp) 0x00000000002019d1 <+17>: mulsd -0x8(%rbp),%xmm1 0x00000000002019d6 <+22>: movaps %xmm1,%xmm0 0x00000000002019d9 <+25>: pop %rbp 0x00000000002019da <+26>: ret End of assembler dump.
面白いことに、multi_floatとmulti_doubleは全く同一です。
PI_FLOATをdoubleの定数として格納しているんでしょうね。
定数の型がfloatとdoubleのどちらでもdoubleとして扱われるため、
速度差に影響することはなさそうです。
まあdoubleの演算にfloatの定数を入れたって、
いいこと一つもありませんけどね。
念のため注意書きしておきますが、あくまでも私の実験での話です。
一般的な話ではございません。
適当にまとめます。
何も考えたくないなら、円周率の定数はdouble型を使えばいいと思います。
でも速度が要求されるような場合は、
浮動小数の型を全体的に考えた方がいいかもしれません。
自分が使おうとしているCPUの仕様を少しだけでも調べておいて、
必要に応じて逆アセンブルしてみて下さい。
本当に適当にまとめましたが以上です。
Common LispでFFTを使う
1. はじめに
FFT（高速フーリエ変換）の話題です。
まずは、ただコピーして使えるやつを示します。
そのあと長々と説明します。
(defun fftcore (v n sign) ;; bit reverse (let (a b y) (dotimes (x n) (setq a (ash n -1) y 0 b x) (do () ((zerop a)) (setq y (logior (ash y 1) (logand b 1))) (setq b (ash b -1)) (setq a (ash a -1))) (when (< x y) (rotatef (elt v x) (elt v y))))) ;; fft (do* ((p0 (float (* sign 2.0L0 pi) sign)) (n2 (ash n -1)) (a n2 (ash a -1))) ((< a 1) v) (do* ((n3 (/ n2 a)) (n4 (ash n3 1)) (p1 (/ p0 n4)) (b 0 (1+ b))) ((<= a b)) (do ((n5 (* n4 b)) (c 0 (1+ c)) x y z) ((<= n3 c)) (setq x (+ n5 c)) (setq y (+ x n3)) (setq z (* (elt v y) (cis (* p1 c)))) (setf (elt v y) (- (elt v x) z)) (incf (elt v x) z)))))
2. 使い方
fftcoreは、下記の演算を一括して求めます。
は配列の個数であり、2のべき乗である必要があります。
は変換前の配列の値であり、
は変換後の値です。
は符号であり、通常
か
です。
関数fftcoreの説明をします。
(defun fftcore (v n sign) ...) -> v
vは一次元の配列です。
nは値の個数であり、2のべき乗である必要があります。
たとえば256や1024などになります。
signは符号であり、通常は1.0か-1.0です。
signは符号の他にも意味があり、値の型で演算の精度を決定します。
例えばdouble-floatで演算したい場合は、1.0d0か-1.0d0を指定してください。
配列vは必ずn以上の個数を保有する必要があります。
演算結果は配列vに上書きされます。
関数fftcoreの返却値は、引数vそのものです。
3. 使ってみる
fftcoreの目的は、コピーで手軽に使えることと、必要最小限の機能を提供することです。
ところでみなさんはFFTを使ったことがありますか？
人によっては見たことすらないと思います。
自分は一時期、朝から晩までずっとFFT祭りをしてたことありました。
せっかくなのでその時のやつをCommon Lispで作ってみようと思い公開しました。
ここではフーリエ変換や、離散フーリエ変換の説明はしません。
高速フーリエ変換のアルゴリズムも説明しません。
ただし、使うための入り口だけは説明しなければなりません。
離散フーリエ変換と逆変換の一例を次に示します。
- 離散フーリエ変換
- 逆変換
「一例」です。
FFTに詳しい人が言ってたのをなんとなく覚えているのですが、
正変換の係数が逆変換についてるパターンがあったし、
正変換と逆変換の
の符号が逆になっているのも存在したとのこと。
さらに言うと、係数は、
になってたのもあったんだそうです。
たぶん対称性とかそういうのを考えた結果でしょうね。
人によって違うので、全通りあるらしいです。
だから、fftcoreでは係数の乗算をしないし、符号も決め打ちしなかったのです。
わかんないんで自分でやって下さい。
でも、せっかくなんで一例を作ってみます。
(defun fft (v n &optional (type 'double-float)) (fftcore v n (coerce -1.0 type)) (dotimes (x n v) (setf (elt v x) (/ (elt v x) n)))) (defun ifft (v n &optional (type 'double-float)) (fftcore v n (coerce 1.0 type)))
周波数解析もやってみましょうか。
次のテスト用の信号を用意します。
こんな感じ
(defun a-sin-f-phi (a f x n phi) (* a (sin (+ (/ (* 2.0d0 pi f x) n) phi)))) (defun make-test-signal (v n) (let ((bias 1.23d0) a b c) (dotimes (x n v) (setq a (a-sin-f-phi 2.0d0 1.0d0 x n 0.0d0)) (setq b (a-sin-f-phi 3.0d0 5.0d0 x n 0.0d0)) (setq c (a-sin-f-phi 4.0d0 7.0d0 x n (/ pi 3.0d0))) (setf (elt v x) (complex (float (+ bias a b c) 1.0d0) 0.0d0)))))
それでは、フーリエ変換してみましょう。
(defvar *size* 1024) (let ((v (make-array *size* :element-type '(complex double-float)))) (make-test-signal v *size*) (fft v *size*) (dotimes (i 10) (let* ((z (elt v i)) (re (realpart z)) (im (imagpart z)) (a (abs z))) (format t "~3A: #c(~6F, ~6F) -> ~6F~%" i re im a))))
配列の個数は1024個とりました。
ここは必ず2の何乗の値にしてくださいね。
2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, ...みたいな数のことです。
2の何乗じゃなくてもいいFFTも存在するらしいですが、
やりたいなら自分で作って下さい。
実行結果は下記の通り。
0 : #c( 1.23, 0.0) -> 1.23 1 : #c( -0.0, -1.0) -> 1.0 2 : #c( -0.0, -0.0) -> 0.0 3 : #c( -0.0, 0.0) -> 0.0 4 : #c( 0.0, 0.0) -> 0.0 5 : #c( -0.0, -1.5) -> 1.5 6 : #c( -0.0, 0.0) -> 0.0 7 : #c(1.7321, -1.0) -> 2.0 8 : #c( 0.0, -0.0) -> 0.0 9 : #c( 0.0, -0.0) -> 0.0
それぞれの要素の実部・虚部の他に、絶対値（振幅）を出力しています。
0番目は直流成分なので、1.23がそのまま入っています。
周波数成分は、512以降にも分散されているので、
振幅の値は半分になっています。
1～511番目の振幅を、単純に2倍しましょう。
つまり、
1番目の振幅は2。
5番目の振幅は3。
7番目の振幅は4。
テスト用の信号の振幅があらわされているのが分かります。
4. もともとのソース
もとは、大昔に自分が作ったC言語のソースでした。
とてもひどいものだったので書き直しましたが、こんな感じです。
#define PI 3.141592653589793238462643383276 void fft_double_complex(double complex v[], size_t n, double sign) { size_t x, y, a, b, c, n2, n3, n4, n5; double p0; double complex p1, z; /* bit reverse sort */ for (x = 0; x < n; x++) { y = 0; b = x; for (a = n >> 1; a != 0; a >>= 1) { y = (y << 1) | (b & 1); b >>= 1; } if (x < y) { z = v[x]; v[x] = v[y]; v[y] = z; } } /* fft */ p0 = sign * 2.0 * PI; n2 = n >> 1; for (a = n2; a >= 1; a >>= 1) { n3 = n2 / a; n4 = n3 << 1; p1 = I * p0 / n4; for (b = 0; b < a; b++) { n5 = n4 * b; for (c = 0; c < n3; c++) { x = n5 + c; y = x + n3; z = v[y] * cexp(p1 * c); v[y] = v[x] - z; v[x] += z; } } } }
余談ですが、FreeBSDなら、円周率を求めるときは次のコマンドが便利です。
$ echo 'scale=30; a(1)*4' | bc -l 3.141592653589793238462643383276
Linuxならどうするんだろう。
まあそれはいいとして、さらにもとのソースが存在します。
C99なんて存在すら知らなかったときだったので、
複素数の型を使っていません。
こんな感じでした。
#define PI 3.141592653589793238462643383276 void fft_double(double v[], size_t n, double sign) { size_t x, y, x2, y2, x3, y3, a, b, c, n2, n3, n4, n5; double p0, p1, theta, w1, w2, z1, z2; /* bit reverse sort */ for (x = 0; x < n; x++) { y = 0; b = x; for (a = n >> 1; a != 0; a >>= 1) { y = (y << 1) | (b & 1); b >>= 1; } if (x < y) { x2 = x << 1; x3 = x2 + 1; y2 = y << 1; y3 = y2 + 1; z1 = v[x2]; v[x2] = v[y2]; v[y2] = z1; z2 = v[x3]; v[x3] = v[y3]; v[y3] = z2; } } /* fft */ p0 = sign * 2.0 * PI; n2 = n >> 1; for (a = n2; a >= 1; a >>= 1) { n3 = n2 / a; n4 = n3 << 1; p1 = p0 / n4; for (b = 0; b < a; b++) { n5 = n4 * b; for (c = 0; c < n3; c++) { x = n5 + c; y = x + n3; x2 = x << 1; x3 = x2 + 1; y2 = y << 1; y3 = y2 + 1; theta = p1 * c; w1 = cos(theta); w2 = sin(theta); z1 = v[y2]*w1 - v[y3]*w2; z2 = v[y2]*w2 + v[y3]*w1; v[y2] = v[x2] - z1; v[y3] = v[x3] - z2; v[x2] += z1; v[x3] += z2; } } } }
こちらは、doubleの配列を2倍の長さで用意して、
実部、虚部、実部、虚部、・・・みたいに交互に値を格納していく方式です。
他にもいろいろ探してたら、多次元高速フーリエ変換なんてのもありました。
ただし、この辺りになると速度的に並列実行しないと厳しいと思います。
今回のようなコピーで作れる高速フーリエ変換なんてやめて、
素直に頭いい人たちが作ったライブラリを使うべきなんだと思います。
一応言っておきますが、私は数値解析の専門家じゃないんで、ここのソースは全部怪しいです。
現時点でnptでは動きませんでした。
どうもnptの複素数のexpあたりに問題がありそう（【追記】そうではなくfloat関数にバグがありました。修正済み）。
バグの発見ができてうれしいので、そのうち直します。
もし怪しくてもいいから使いたいという人がいるなら、ご自由にどうぞ。
私は使います。
Common LispでLALR(1)のparserを作る5
前回：Common LispでLALR(1)のparserを作る4 - nptclのブログ
1. 続きです
Common LispでLALR(1)を作りました！
次にやることはでっかい構文を読み込ませることです。
ここではC言語の文法について見ていきます。
2. 大きな構文解析
C言語の構文解析をしてみましょう。
文法は仕様書に書かれています。
;; JTC1/SC22/WG14 - C ;; WG14/N1256 Committee Draft - Septermber 7, 2007 ISO/IEC 9899:TC3 ;; http://www.open-std.org/JTC1/SC22/WG14/ ;; http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1256.pdf ;; ;; A.2 Phrase structure grammar
今回は、私の大好きなc99でやってみます。
文法の部分だけ抽出したファイルは下記の通り。
https://github.com/nptcl/parser/blob/main/c99/c99.lisp
こいつを読み込ませるためのソースを追記します。
(defun read-call-parse (x) (destructuring-bind (car . cdr) x (ecase car (terminal (read-terminal cdr)) (rule (read-rule cdr)) (start (read-start cdr))))) (defun read-parse (file) (with-open-file (input file) (read-call input #'read-call-parse))) (read-parse #p"c99.lisp")
さあ実行しようとmake-tableでShift表を作ったら、とんでもなく遅いんです。
びっくりするくらい遅い！
実は今までnptを使っていたのですけど、ついに力不足になりました。
sbcl先生お願いします！
それでも遅い！
すごいですね、LR(1)って適当に作っただけなら全然ダメ見たいです。
ということで、できる限りの高速化を行ったものを下記に示します。
https://github.com/nptcl/parser/blob/main/c99/parser.lisp
今までテストコードとして作成したparser.lispは超遅いですが、
もともと実用を目指していないので、それはそれで価値があると思います。
ということで、今後バグは修正する予定ですが、高速化せずにそのまま残してあります。
（c99/parser.lispが早い方で、
blog/parser.lispがもともとの遅い方）
高速化のポイントを簡単に説明すると、
- リストの検索部分を
hash-tableにする lengthやfindなどを極力減らす- 状態はソートして集合の比較を高速化
それでも遅いんです。
LR(1)ってとんでもないんですね。
自分の作りが甘いのは確かなのですが、それにしたって大変な処理というのは間違いないでしょう。
遅いのは受け入れることにします。
速度の改善を考えるのではなく、途中の処理をファイルに保存して再開できるような仕組みを考えます。
make-tableを実行した後は、save-table.lispというファイルに状態を保存できるようにしました。
今まで通りソースの解説をしたい気持ちはあるのですが、
元のソースからだいぶ変更が入りましたので、説明はやめておきます。
それより文法の解説をしなければならないことがあります。
3. C言語の文法を見る
仕様書n1256.pdfから、構文ファイルc99.lispを作成するにあたっての注意点を書きます。
まず最初にoptについて。
仕様書を見ると、よくoptと書かれている文法に遭遇します。
例えばこんな感じです。
(6.7.2.1) struct-declarator:
declarator
declarator_opt : constant-expression
declare_optという部分が該当します。
正直よくわからないんですけど、たぶん省略可能という意味なのではないでしょうか。
ということで、次のように書き換えをします。
(6.7.2.1) struct-declarator:
declarator
: constant-expression
declarator : constant-expression
あとは仕様書通りに文法ファイルを作っていけると思います。
ただし元のソースだとだと、誤字脱字の検出ができなかったので結構苦労しました。
最新のソースはそのあたりができるように、
terminalpとnon-terminal-pを修正しています。
そうやってできた文法c99.lispを読み込み、make-tableを実行してみましょう。
時間がかかるので、中間ファイルを生成します。
(read-parse #p"c99.lisp") (make-table) (save-table #p"save-table.lisp")
もし再開したいなら、上記の3行は次の一つに置き換えることができます。
(load-table #p"save-table.lisp")
中間ファイルは6MByteくらいあるので、結構な情報が保存されるようです。
内容はLispの式であらわされますので、テキストエディタで確認できます。
4. Reduceの衝突
さあ問題はmake-reduceです。
実行すると衝突が発生してエラーになります。
しかし、実は衝突が起こるのは分かっていたことなので、
エラーで中断させるのではなくwarningが出力するように改造しておきましょう。
state-action-checkを下記のように書き換えます。
(defun state-action-check (list a b c) (destructuring-bind (x y z) list (unless (state-action-check-p y z b c) ;(error "~S/~S error, ~S, ~S." y b list (list a b c)) (when (rule-p z) (setq z (rule-left z))) (when (rule-p c) (setq c (rule-left c))) (warn "~S/~S error, ~A, ~A." y b (list x y z) (list a b c)))))
それでは実行してみます。
WARNING: S/R error, (ELSE S 1886), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1886), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1757), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1757), (ELSE R SELECTION-STATEMENT). WARNING: R/R error, (( R PRIMARY-EXPRESSION), (( R TYPEDEF-NAME). WARNING: R/R error, (* R PRIMARY-EXPRESSION), (* R TYPEDEF-NAME). WARNING: R/R error, (; R PRIMARY-EXPRESSION), (; R TYPEDEF-NAME). WARNING: R/R error, (( R PRIMARY-EXPRESSION), (( R TYPEDEF-NAME). WARNING: R/R error, (* R PRIMARY-EXPRESSION), (* R TYPEDEF-NAME). WARNING: R/R error, (; R PRIMARY-EXPRESSION), (; R TYPEDEF-NAME). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 1), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: S/R error, (IDENTIFIER S 846), (IDENTIFIER R DECLARATION-SPECIFIERS). WARNING: R/R error, () R IDENTIFIER-LIST), () R TYPEDEF-NAME). WARNING: R/R error, (, R IDENTIFIER-LIST), (, R TYPEDEF-NAME). WARNING: R/R error, (( R DIRECT-DECLARATOR), (( R TYPEDEF-NAME). WARNING: R/R error, () R DIRECT-DECLARATOR), () R TYPEDEF-NAME). WARNING: R/R error, ([ R DIRECT-DECLARATOR), ([ R TYPEDEF-NAME). WARNING: R/R error, (( R PRIMARY-EXPRESSION), (( R TYPEDEF-NAME). WARNING: R/R error, () R PRIMARY-EXPRESSION), () R TYPEDEF-NAME). WARNING: R/R error, (* R PRIMARY-EXPRESSION), (* R TYPEDEF-NAME). WARNING: R/R error, ([ R PRIMARY-EXPRESSION), ([ R TYPEDEF-NAME). WARNING: S/R error, (IDENTIFIER S 22), (IDENTIFIER R SPECIFIER-QUALIFIER-LIST). WARNING: S/R error, (IDENTIFIER S 22), (IDENTIFIER R SPECIFIER-QUALIFIER-LIST). WARNING: S/R error, (IDENTIFIER S 22), (IDENTIFIER R SPECIFIER-QUALIFIER-LIST). WARNING: S/R error, (IDENTIFIER S 22), (IDENTIFIER R SPECIFIER-QUALIFIER-LIST).
うーん、なんだこれ。
予想していたのは、いわゆるdangling elseというものだったのですが、
明らかにelse以外の衝突が発生しています。
Shift/Reduceだけだったら見ないふりできたんですけど、
Reduce/Reduceも起きてませんか？
これって何なんだ。
先に言っておきますが、
WARNING: S/R error, (ELSE S 1757), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1757), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1886), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1886), (ELSE R SELECTION-STATEMENT).
このelseの衝突は、dangling elseと呼ばれるものです。
Shiftを優先すれば解決できるという絶対起こるものなので
いまは気にしなくていいです。
しかしそのほかのやつは一体何なんだ？
5. 問題を見ていく
この衝突は迷いました。
衝突の内容を追いかけていく限りだと、
おそらくはtypedefによって定義された型の名前が、
変数名と競合しているようです。
まずは下記の競合を見てみましょう。
WARNING: R/R error, (( R PRIMARY-EXPRESSION), (( R TYPEDEF-NAME). WARNING: R/R error, (* R PRIMARY-EXPRESSION), (* R TYPEDEF-NAME). WARNING: R/R error, (; R PRIMARY-EXPRESSION), (; R TYPEDEF-NAME). WARNING: R/R error, (( R PRIMARY-EXPRESSION), (( R TYPEDEF-NAME). WARNING: R/R error, (* R PRIMARY-EXPRESSION), (* R TYPEDEF-NAME). WARNING: R/R error, (; R PRIMARY-EXPRESSION), (; R TYPEDEF-NAME).
これはprimary-expressionとtypedef-nameのReduce/Reduceの衝突です。
両方をたどって行くと、identifierで衝突が生じているようです。
identifierは、変数名や関数名などを表す終端記号です。
primary-expressionは式に関する非終端記号であり、
さらにたどって行くとblock-itemという非終端記号に到着します。
block-itemとは、関数なんかのボディ部であり、{と}で囲まれた部分のことです。
void aaa(void) { /* ここです */ }
block-itemは、宣言declarationと文statementの2つの構文を取ります。
;; (6.8.2) (rule block-item -> declaration) (rule block-item -> statement)
宣言declarationとは
int a;
みたいなものであり、文statementとは
a = 10 + 20;
のようなものです。
それでは、次の記述はいったいなんだと思いますか？
hello;
これが競合の元です。
宣言declarationなのか文statementなのか、区別がつかないと言っています。
分かりづらいと思いますので、例文を示します。
typedef int hello; void aaa(void) { hello; }
上記の場合は、変数がひとつも無い宣言です。
変数宣言って
int a, b, c;
みたいに記載できますが、
どうも変数がひとつもなくてもぎりぎりセーフらしいです。
例えばこんな感じ。
int;
まあしっかり警告が出ますけどね。
続いて式の例を示します。
int hello = 100; void aaa(void) { hello; }
上記の場合は、変数がただ配置された式です。
もちろん意味は全くないです。
構文解析においては、両者の区別がつかず、
意味解析の時点でようやく判定できるというものです。
下手すりゃあ意味解析でも無理かもしれません。
確認する方法があります。
typedefの型を表す構文は下記の通り。
;; (6.7.7) (terminal identifier) (rule typedef-name -> identifier)
これがidentifierと競合するからおかしなことになっているわけです。
そこで一時的にtypedefの型を使う場合の文法を変更してしまいます。
;; (6.7.7) (terminal aaa identifier) (rule typedef-name -> aaa identifier)
aaaという文言がないとtypedefの型を使えないようにしました。
C言語で表すならこんな感じ。
typedef int hello; aaa hello a, b, c;
それではmake-tableを実行します。
WARNING: S/R error, (ELSE S 1886), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1886), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1757), (ELSE R SELECTION-STATEMENT). WARNING: S/R error, (ELSE S 1757), (ELSE R SELECTION-STATEMENT).
衝突が全部消えてしまった。
一個か二個くらい消えてくれればラッキーと思ってたのですが、全部消えたの？
つまりはただtypedef-nameだけが問題だったということになります。
いちおう言っておきますが、上に出てる4つの衝突はdangling elseなので問題ありません。
というか、これ本当にあってるの？
なんとなくだけどparser.lispが悪いわけではなさそうなんですよね。
構文があっているとしても衝突は実際に生じているわけで、
それをどう処理していいのか迷います。
ぜんぜんわかりませんでした。
さんざん悩んでて検索したら、この話題がありました。
- y2q_actionman’s ゴミクズチラ裏
CL-Yacc と C言語文法の微妙な関係
https://y2q-actionman.hatenablog.com/entry/cl_yacc_and_the_lexer_hack
y2q_actionmanさん、すごく勉強になりました！
どうもそういうものらしいです。
たぶん合ってるっぽい。
話を見る限りだと、字句解析と構文解析が連携してtokenを決定する必要があるようです。
そんなことしなきゃダメなのか。
ちょっと勉強し直してきます。
とりあえず対処はこんな感じにしました。
;; (6.7.7) ;(terminal identifier) ;(rule typedef-name -> identifier) (terminal typedef-identifier) (rule typedef-name -> typedef-identifier)
identifierではなく、typedef-identifierという別のtokenにしてごまかしました。
字句解析ががんばってidentifierとtypedef-identifierを使い分ければいいのではないでしょうか。
make-reduceも問題なく通りました。
あと、忘れてましたがelseは放置したのでどうなってるのか知りません。
それではLR(1)で次のC言語っぽいソースを読み込ませてみます。
int main() { return 0; }
それがこちら。
(execute-parse '(int identifier #\( #\) #\{ return constant #\; #\}))
どこがmain関数なんだよといった見た目をしております。
実行結果は下記の通り。
NIL (INT IDENTIFIER #\( #\) #\{ RETURN CONSTANT #\; #\}) (INT) (IDENTIFIER #\( #\) #\{ RETURN CONSTANT #\; #\}) (TYPE-SPECIFIER) (IDENTIFIER #\( #\) #\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS) (IDENTIFIER #\( #\) #\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS IDENTIFIER) (#\( #\) #\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DIRECT-DECLARATOR) (#\( #\) #\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DIRECT-DECLARATOR #\() (#\) #\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DIRECT-DECLARATOR #\( #\)) (#\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DIRECT-DECLARATOR) (#\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DECLARATOR) (#\{ RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{) (RETURN CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN) (CONSTANT #\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN CONSTANT) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN PRIMARY-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN POSTFIX-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN UNARY-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN CAST-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN MULTIPLICATIVE-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN ADDITIVE-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN SHIFT-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN RELATIONAL-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN EQUALITY-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN AND-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN EXCLUSIVE-OR-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN INCLUSIVE-OR-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN LOGICAL-AND-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN LOGICAL-OR-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN CONDITIONAL-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN ASSIGNMENT-EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN EXPRESSION) (#\; #\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ RETURN EXPRESSION #\;) (#\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ JUMP-STATEMENT) (#\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ STATEMENT) (#\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ BLOCK-ITEM) (#\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ BLOCK-ITEM-LIST) (#\}) (DECLARATION-SPECIFIERS DECLARATOR #\{ BLOCK-ITEM-LIST #\}) NIL (DECLARATION-SPECIFIERS DECLARATOR COMPOUND-STATEMENT) NIL (FUNCTION-DEFINITION) NIL (EXTERNAL-DECLARATION) NIL (TRANSLATION-UNIT) NIL ACCEPT
うまくいってるように見えます。
6. おわり
最後はLALR(1)です。
こちらも、難なくうまくいきました！
とはいっても出力は同じなので結果は出しません。
かわりに、状態数をカウントしたものを出します。
LR(1)は、状態2004個
LALR(1)は、状態451個
どこかで、LR(1)は10000くらい生成されて、
LALR(1)では10分の1になるって書いてた気がします。
C++とかならそうなるのかな？
もし今回やったことを自分でもやってみたいなら、
githubのc99/ディレクトリを保存して
$ sbcl --script main.lisp
みたいに実行すればいいと思います。
Common LispでLALR(1)のparserを作る4
前回：Common LispでLALR(1)のparserを作る3 - nptclのブログ
1. 続きです
Common LispでLR(1)の表を作りました！
あとは実行してみて、そのあとでLALR(1)もやってみます。
2. 構文解析の実行
実行するためには、新たにスタックが必要になります。
すでに構文解析用のスタック*stack*がありますが、あれも使いますし別のやつがもう一つ必要です。
*transit*という名前で作ってみます。
(defvar *transit* nil) (defun push-transit (x) (declare (type unsigned-byte x)) (push x *transit*)) (defun pop-transit () (unless *transit* (error "pop-transit error.")) (pop *transit*)) (defun top-transit () (unless *transit* (error "top-transit error.")) (car *transit*)) (defun init-transit () (setq *transit* nil) (push-transit 0))
もうほとんど*stack*と同じですね。
何が違うのかというと、*stack*の方はshift/reduceで使いましたが、
*transit*の方は、状態の番号を格納して使います。
こちらのスタックは、init-transitで0をpushしています。
つまり初期状態が0だということです。
それでは実行するためのコードを作ります。
(defun execute-parse (x) (init-stack) (init-transit) (set-input x) (call-execute))
execute-parseは、*stack*と*transit*を初期化した後、
set-inputで入力を設定します。
つまり変数の初期化です。
そのあとcall-executeを実行します。
(defun call-execute () (output-stack-input) (let* ((index (top-transit)) (state (get-state index)) (ahead (top-input))) (multiple-value-bind (type next) (find-action-state ahead state) (ecase type (s (shift-execute next) (call-execute)) (r (reduce-execute next) (call-execute)) (a (accept-execute))))))
call-executeは、まず最初にoutput-stack-inputを実行して
*stack*と*input*の内容を出力します。
別に出力いらないや、っていうなら削除してください。
そのあと、top-transitとget-stateで現在の状態を取得。
top-inputで、入力をひとつ先読みします。
先読みしたaheadと状態を引数に、find-action-stateで遷移先の情報を取得します。
もしShiftなら、shift-executeを実行して再帰呼出でループ。
もしReduceなら、reduce-executeを実行して再帰呼出でループ。
もしAcceptなら、accept-executeを実行してcall-executeを終了。
find-action-stateから順番に見ていきましょう。
(defun find-action-state (v state) (dolist (x (state-action state)) (destructuring-bind (a b c) x (when (eql a v) (return (values b c))))))
これは、状態stateのactionから、記号vに対応するものを検索しています。
見つからなかったらnilが返却されますが、
呼び出し元のcall-executeのecaseに引っかかってエラーになります。
それでは、Shiftが実行されたときの関数を見ていきます。
(defun shift-execute (next) (shift-test) (push-transit next))
shift-test関数は、一番最初に確認として作った関数です。
やっていることは、inputからpopして、stackにpushするというもの。
そのあと、push-transitでnextをpushしています。
*transit*の先頭の値が現在の状態になるので、
状態が変化するということになります。
Reduceを見てみましょう。
(defun reduce-execute (rule) (let ((left (rule-left rule)) (right (rule-right rule))) (reduce-call left right) (dolist (ignore right) (pop-transit)) (goto-execute)))
こちらはShiftとは違い複雑です。
まず規則からleftとrightを取得し、reduce-callを呼び出します。
reduce-callも本当に最初の方に作った関数です。
*stack*から必要な分だけpopして、そのあとpushするというものです。
これはこれであっているのですが、同じ数だけ*transit*もpopする必要があります。
ということで、dolistでpopしています。
Reduceの難しいところは、この状態でgotoの遷移表を見る必要があるのです。
処理はgoto-executeに引き継がれます。
(defun find-goto-state (v state) (dolist (x (state-goto state)) (destructuring-bind (a b) x (when (eql a v) (return b))))) (defun goto-execute () (let* ((index (top-transit)) (state (get-state index)) (sym (top-stack))) (aif (find-goto-state sym state) (push-transit it) (error "find-goto-state error, ~S, ~S." index sym))))
goto-executeは、まず*transit*から現在の状態を取得します。
さらに、*stack*から一番上にある非終端記号を取得します。
取得した状態と、非終端記号をもとに、goto表から次の状態を取得してpush-transitで遷移します。
find-goto-state関数は、非終端記号vと状態stateからgoto表を検索するというものです。
これでReduceの動作は完了です。
最後のacceptを確認します。
(defun accept-execute () (format t "ACCEPT~%"))
ただ完了報告をしているだけです。
この状態で、*stack*にはたった一つの開始記号が格納されています。
構文ツリーなんかを作っていた場合は、
このタイミングで取り出して終了となります。
3. LR(1)の実行テスト
それでは早速やってみましょう。
(parse-terminal + * [ ] int) (parse-start expr) (parse-rule expr -> expr + term) (parse-rule expr -> term) (parse-rule term -> term * fact) (parse-rule term -> fact) (parse-rule fact -> [ expr ]) (parse-rule fact -> int) (make-table) (make-reduce) (output-table) (execute-parse '(int * [ int + int ]))
実行結果は下記の通り。
0 : INT:S:19 [:S:6 FACT:20 TERM:21 EXPR:1 1 : END:A:NIL +:S:2 2 : INT:S:19 [:S:6 FACT:20 TERM:3 3 : END:R:1 +:R:1 *:S:4 4 : INT:S:19 [:S:6 FACT:5 5 : END:R:3 +:R:3 *:R:3 6 : INT:S:17 [:S:12 FACT:16 TERM:15 EXPR:7 7 : ]:S:18 +:S:8 8 : INT:S:17 [:S:12 FACT:16 TERM:9 9 : ]:R:1 +:R:1 *:S:10 10 : INT:S:17 [:S:12 FACT:11 11 : ]:R:3 +:R:3 *:R:3 12 : INT:S:17 [:S:12 FACT:16 TERM:15 EXPR:13 13 : ]:S:14 +:S:8 14 : ]:R:5 +:R:5 *:R:5 15 : ]:R:2 +:R:2 *:S:10 16 : ]:R:4 +:R:4 *:R:4 17 : ]:R:6 +:R:6 *:R:6 18 : END:R:5 +:R:5 *:R:5 19 : END:R:6 +:R:6 *:R:6 20 : END:R:4 +:R:4 *:R:4 21 : END:R:2 +:R:2 *:S:4 NIL (INT * [ INT + INT ]) (INT) (* [ INT + INT ]) (FACT) (* [ INT + INT ]) (TERM) (* [ INT + INT ]) (TERM *) ([ INT + INT ]) (TERM * [) (INT + INT ]) (TERM * [ INT) (+ INT ]) (TERM * [ FACT) (+ INT ]) (TERM * [ TERM) (+ INT ]) (TERM * [ EXPR) (+ INT ]) (TERM * [ EXPR +) (INT ]) (TERM * [ EXPR + INT) (]) (TERM * [ EXPR + FACT) (]) (TERM * [ EXPR + TERM) (]) (TERM * [ EXPR) (]) (TERM * [ EXPR ]) NIL (TERM * FACT) NIL (TERM) NIL (EXPR) NIL ACCEPT
うまくいってる！
長かった！
4. LALR(1)の作成
さあどんどん行きましょう。
LALR(1)はどうやって作るのでしょうか。
もし同じコアの集合が複数あるなら、ひとつにまとめてしまうのです。
コアとは、left, alpha, betaのことであり、
コアが同じということはaheadだけが異なっているものです。
例えばこんな感じ。
([A -> B . C, a] [B -> . D, a/b] [B -> . E, c]) と ([A -> B . C, b] [B -> . D, b] [B -> . E, d/e]) が同じ
どうやってひとつにするかというと、aheadをunionします。
つまり次のようになります。
([A -> B . C, a/b] [B -> . D, a/b] [B -> . E, c/d/e])
いろんな方法があると思いますが、
ここでは新しい状態を作成しようと思います。
そのあと、マージ元の2つに向いている番号を、すべてマージ先に変更します。
マージと番号更新が終わったら、マージ元の全ての状態を削除します。
全然簡単じゃないですね。
書いてあることは難しくないのですが、
実際に作るとなれば結構な作業量になります。
でもやってみます。
もう飽きてきたので一気に説明します。
(defun make-lalr () (dolist (x *state*) (when (update-lalr x) (return (make-lalr)))))
make-lalrはLR(1)をLALR(1)に変換する関数です。
やっていることは、全ての状態をdolistで取得し、
ひとつずつupdate-lalrで更新していくのですが、
もし更新が行われた場合はmake-lalrを再帰呼出して最初からやり直します。
なにも更新が行われなくなった時点で完了です。
(defun update-lalr (x) (multiple-value-bind (merge remove) (split-lalr x *state*) (when merge (setq *state* remove) (let ((x (merge-lalr merge))) (replace-lalr x merge remove) t))))
update-lalrは、引数の状態xだけを見て、状態遷移表を更新する関数です。
split-lalrは、コアが同じもののリストmergeと、
それを除外したリストremoveを返却します。
merge-lalrは、コアが同じ状態をまとめて新規の状態を作ります。
replace-lalrは、全ての状態をたどって行き、遷移表の状態番号を更新します。
順番に見ていきます。
(defun split-lalr (x list) (when (find-others-lalr x list) (let (merge remove) (dolist (y list) (if (equal-state-lalr x y) (push y merge) (push y remove))) (values merge remove))))
split-lalrは、状態xと同じコアの集合と、違うコアの集合を返却します。
まず最初に、find-others-lalrで自分以外の同じコアがあるかどうかを判定します。
存在するのであれば、dolistを用いてmergeとremoveを返却します。
(defun find-others-lalr (x list) (dolist (y list) (and (not (eql x y)) (equal-state-lalr x y) (return t))))
find-others-lalrは、自分以外の同じコアを持つ状態を取得します。
同じコアかどうかの判定は、equal-state-lalrで行います。
(defun equal-grammar-lalr (x y) (and (equal (grammar-left x) (grammar-left y)) (equal (grammar-alpha x) (grammar-alpha y)) (equal (grammar-beta x) (grammar-beta y)))) (defun equal-state-lalr (x y) (let ((x (state-list x)) (y (state-list y))) (equalset x y :test #'equal-grammar-lalr)))
equal-state-lalrは、二つの集合に対して、equalsetで判定を行います。
同じコアかどうかは、equal-grammar-lalr関数にて行います。
これで、同じコアの集合mergeが取得できました。
次にマージする関数を見ていきます。
(defun merge-lalr (list) (aprog1 (reduce #'merge-state-lalr list) (setf (state-index it) *state-index*) (push it *state*) (incf *state-index*)))
マージ作業は難しく考えたくなかったので、
Common Lispのreduce関数に任せることにしました。
構文解析のreduceとは関係ないので注意。
merge-state-lalr関数とreduceにより、
全てをマージした状態がitに束縛されます。
返却された状態itは*state*に登録されていない一時的なものなので、
aprog1のbody部でちゃんと設定します。
通し番号の設定を行い、*state*にpushしています。
(defun merge-state-lalr (x y) (let ((list (merge-list-lalr x y)) (action (merge-action-lalr x y)) (goto (merge-goto-lalr x y))) (make-state :list list :action action :goto goto)))
これは単に集合listと、action, gotoをマージして、
新規の状態インスタンスを作成しているだけです。
(defun merge-grammar-lalr (x y) (grammar-instance (grammar-left x) (grammar-alpha x) (grammar-beta x) (union (grammar-ahead x) (grammar-ahead y)))) (defun merge-list-lalr (x y) (let ((listx (state-list x)) (listy (state-list y)) list) (dolist (v listx) (aif (find v listy :test #'equal-grammar-lalr) (push (merge-grammar-lalr v it) list) (error "Invalid state, ~S, ~S." x y))) list))
merge-list-lalrは集合と集合をマージします。
dolistで片方の集合をひとつずつ扱い、
findでマージするべきもうひとつの要素を探します。
merge-grammar-lalrは、aheadをunionで結合したインスタンスを返却します。
(defun merge-action-lalr (x y) (let ((x (state-action x)) (y (state-action y))) (union x y :test 'equal))) (defun merge-goto-lalr (x y) (let ((x (state-goto x)) (y (state-goto y))) (union x y :test 'equal)))
merge-action-lalrは、状態のaction表をマージします。
merge-goto-lalrは、状態のgoto表をマージします。
どちらもunionとequalだけで何とかなります。
マージ作業は以上です。
削除も完了していますので、あとは番号を置き換えるだけです。
(defun replace-lalr (x merge list) (let (a b) (setq b (state-index x)) (dolist (m merge) (setq a (state-index m)) (dolist (inst list) (replace-action-lalr inst a b) (replace-goto-lalr inst a b)))))
replace-lalrは、2つのdolistがあります。
まずは削除された集合mergeで繰り返しを行い、古い番号を取得します。
新しい番号は、引数xから取得します。
古い番号をa、新しい番号をbに代入しています。
2つめのdolistで、状態一つ一つに対してa -> bの置換を行っています。
(defun replace-action-lalr (inst a b) (let ((list (state-action inst))) (dolist (x list) (and (eq (cadr x) 's) (eql (caddr x) a) (setf (caddr x) b))) (setq list (delete-duplicates list :test 'equal)) (setf (state-action inst) list))) (defun replace-goto-lalr (inst a b) (let ((list (state-goto inst))) (dolist (x list) (when (eql (cadr x) a) (setf (cadr x) b))) (setq list (delete-duplicates list :test 'equal)) (setf (state-goto inst) list)))
replace-action-lalrは、actionテーブルを置き換えます。
replace-goto-lalrは、gotoテーブルを置き換えます。
どちらも遷移先を見つけては、setfで強引に置き換えています。
置換後は重複が出てきますので、delete-duplicatesでひとつにしています。
駆け足で説明してきましたが、これでLALR(1)の処理は完了です。
5. LALR(1)の実行テスト
テストの内容はLR(1)と同じにします。
(parse-terminal + * [ ] int) (parse-start expr) (parse-rule expr -> expr + term) (parse-rule expr -> term) (parse-rule term -> term * fact) (parse-rule term -> fact) (parse-rule fact -> [ expr ]) (parse-rule fact -> int) (make-table) (make-reduce) (make-lalr) (output-table) (execute-parse '(int * [ int + int ]))
実行結果は下記の通り。
0 : INT:S:26 [:S:31 FACT:24 TERM:22 EXPR:1 1 : END:A:NIL +:S:23 22 : ]:R:2 +:R:2 END:R:2 *:S:27 23 : INT:S:26 [:S:31 FACT:24 TERM:25 24 : ]:R:4 +:R:4 *:R:4 END:R:4 25 : ]:R:1 +:R:1 END:R:1 *:S:27 26 : ]:R:6 +:R:6 *:R:6 END:R:6 27 : INT:S:26 [:S:31 FACT:29 28 : ]:R:5 +:R:5 *:R:5 END:R:5 29 : ]:R:3 +:R:3 *:R:3 END:R:3 30 : ]:S:28 +:S:23 31 : INT:S:26 [:S:12 FACT:24 TERM:22 EXPR:30 NIL (INT * [ INT + INT ]) (INT) (* [ INT + INT ]) (FACT) (* [ INT + INT ]) (TERM) (* [ INT + INT ]) (TERM *) ([ INT + INT ]) (TERM * [) (INT + INT ]) (TERM * [ INT) (+ INT ]) (TERM * [ FACT) (+ INT ]) (TERM * [ TERM) (+ INT ]) (TERM * [ EXPR) (+ INT ]) (TERM * [ EXPR +) (INT ]) (TERM * [ EXPR + INT) (]) (TERM * [ EXPR + FACT) (]) (TERM * [ EXPR + TERM) (]) (TERM * [ EXPR) (]) (TERM * [ EXPR ]) NIL (TERM * FACT) NIL (TERM) NIL (EXPR) NIL ACCEPT
うまくいってます。
遷移表はだいぶ変わっているのが分かります。
しかも短くなっています。
実行結果は当然変わらずです。
