1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

実践CommonLisp 第24章 行間読み

Posted at

はじめに

実践CommonLispを読んでいて、Lisp初心者な私には頭にも入ってこいないし、何言ってるのか分からないところが多いし、途中で眠くなるしで何度も挫折しそうになりました。
特に第23章以降の実践パートに入ってからは、もうさっぱりです。
これは、アウトプットしながら読むしかないということでこの記事を書こうと思いました。
ちょっと愚痴混じりな記事です。

#24.2 バイナリフォーマットの基礎

(defun read-u2 (in)
  (+ (* (read-byte in) 256) (read-byte in)))

最初に出てくるこのサンプルコード。これをさらっと流してしまうと後々よく分からなくなります。
ここで使われているinという引数がなんなのか、この辺りは何にも書かれていなくて、ちゃんと理解しておく必要があります。

サンプルバイナリファイル

CL-USER> (with-open-file (in "binary/test.bin" :direction :input :element-type '(unsigned-byte 8))
  (loop for c = (read-byte in nil nil)
	while c
	do (format t "~&~x" c)))
F5
80
8D
A8
E6
9D
A2
EE
FF
0
11
22
NIL

このファイルを使ってread-u2を試してみます。

CL-USER> (with-open-file (in "binary/test.bin" :direction :input :element-type '(unsigned-byte 8))
  (format t "~x" (read-u2 in)))
F580
NIL

inにはstreamがくる必要があることが分かりました。

次に、このサンプルコードですが、

(ldb (byte 8 0) #xabcd)
(ldb (byte 8 8) #xabcd)

簡単なので分かりやすそうなんですが、ちょっと説明が足りない気がします。
次のようにすると分かりやすいと思います。

CL-USER> (format t "~x" (ldb (byte 8 0) #xf580))
80
NIL
CL-USER> (format t "~x" (ldb (byte 8 8) #xf580))
F5
NIL
CL-USER> (format t "~x" (ldb (byte 16 0) #xf580))
F580
NIL

byte関数は次のような構成です。

(byte byte-size byte-position)

byte-sizeには取得したいバイト数、byte-positionには取得したい位置を一番右側からのビット数で指定します。

それから、次のサンプルコードのところもいきなり出てくるとよく分からないです。

(defun read-u2 (in)
  (let ((u2 0))
    (setf (ldb (byte 8 8) u2) (read-byte in))
    (setf (ldb (byte 8 0) u2) (read-byte in))
    u2))

ここは次のように見てみると分かりやすいです。

CL-USER> (format t "~x"
		 (let ((u2 0))
		   (setf (ldb (byte 8 8) u2) #xf5)
		   (setf (ldb (byte 8 0) u2) #x80)
		   u2))
F580
NIL

ここまで分かれば次のサンプルコードも、もう分かるはずです。

(defun write-u2 (out value)
  (write-byte (ldb (byte 8 8) value) out)
  (write-byte (ldb (byte 8 0) value) out))

このサンプルコードも次のようにすると分かりやすいです。

CL-USER> (with-open-file (out "binary/test-out.bin" :direction :output :element-type '(unsigned-byte 8))
	   (write-byte (ldb (byte 8 8) #xf580) out)
	   (write-byte (ldb (byte 8 0) #xf580) out))
128

このコードを実行すると次のようなバイナリーファイルができます。
image.png

#24.3 バイナリファイル内の文字列
この章もほとんどが文章のため文字コード、文字エンコーディングについて知らないと、この説明だけで理解するのはとても難しいです。
せめて図による説明が欲しいですね。

詳細は他のサイトにリンクしますが、ここでは概要だけで。
##ASCIIコード
0~127の数値に対して各文字が紐づけられます。

10進数 16進数 文字
0 #x0 ヌル文字
〜〜〜 〜〜〜 〜〜〜
32 #x20 半角スペース
65 #x41 A
66 #x42 B
〜〜〜 〜〜〜 〜〜〜
126 #x7E ~
参考:https://ja.wikipedia.org/wiki/ASCII

##ISO8859-1 (Latin-1)
8ビットで文字を表現できます。
下の表の下位4ビットが列方向、上位4ビットが行方向で表される。例えば4CならLとなります。
image.png
引用元:https://ja.wikipedia.org/wiki/ISO/IEC_8859-1

##UTF-8
Unicode文字列の符号化の1つです。
Unicodeは世界中のさまざまな言語の文字を統一された文字コードで表現できるようにしたものです。
UTF-8は1バイト〜4バイトで可変します。
ASCIIコードと互換性があり、ASCIIコードで表せる文字は1バイトで表現されます。
よく使われるASCIIコードが1バイトで済むことからサイズの節約になります。

Unicode文字コード 符号化後のバイトストリーム(bit表現)
U+000000~U+00007F 0xxxxxxx
U+000080~U+0007FF 110xxxxx 10xxxxxx
U+000800~U+00FFFF 1110xxxx 10xxxxxx 10xxxxxx
U+010000~U+10FFFF 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx

表の「x」に表現する文字のビットが入ります。
例えば、「A」は#x41なので、2進数で表すと 1000001 となります。
これを表に当てはめると、01000001 となります。上位1ビットに0が付加されていることに注目です。
これをUnicode文字コードで表すと、 U+0041 となります。

次に「愛」という文字はこのようになります。
愛は U+611B と紐づいています。

この #x611B を2進数にすると次のようになります。

CL-USER> (format t "~b" #x611b)
110000100011011
NIL

表に当てはめると次のようになります。

image.png

なお、最初のビットで次のように判断することができます。

上位ビット 内容
0 1バイトで表現できる文字
10 先頭バイトではない
110 2バイトで表現できる文字
1110 3バイトで表現できる文字
11110 4バイトで表現できる文字

実際にこの通りになるか確かめてみます。

image.png

UTF-8形式のファイルに「愛」と1文字入力してから、hexl-modeで見てみます。

image.png

このうち下位8ビットにある0aは改行コードなので無視して、#xe6849b が対象の文字コードのはずです。

CL-USER> (format t "~b" #xe6849b)
111001101000010010011011
NIL

先ほど変換した値と比較してみます。
11100110 10000100 10011011
image.png

一致しました。

参考:https://atmarkit.itmedia.co.jp/ait/articles/1603/28/news035.html

次のサンプルコードは、そんなに難しくないですが、こんな感じのバイナリファイルを用意して試してみると分かりやすいです。
image.png

CL-USER> (defconstant +null+ (code-char 0))
+NULL+
CL-USER> (with-open-file (in "binary/test2.bin" :direction :input :element-type '(unsigned-byte 8))
	   (with-output-to-string (s)
	     (loop for char = (code-char (read-byte in))
		   until (char= char +null+) do (write-char char s))))
"ABCD"

writeのほうもこんな感じで

CL-USER> (with-open-file (out "binary/test2-out.bin" :direction :output :element-type '(unsigned-byte 8))
	   (loop for char across "ABCD"
		 do (write-byte (char-code char) out))
	   (write-byte (char-code +null+) out))
		 
0

image.png

ちなみに loop で使われている accross は配列に対して動作します。

CL-USER> (loop for i across "ABCD"
	       do (print i))

#\A 
#\B 
#\C 
#\D 
NIL

#24.4 複合構造

クラス作るところはいいんですが、読み出すための関数というのがちょっとひどいです。

(defun read-id3-tag (in)
  (let ((tag (make-instance 'id3-tag)))
    (with-slots (identifier major-version revision flags size frames) tag
      (setf identifier    (read-iso-8859-1-string in :length 3))
      (setf major-version (read-u1 in))
      (setf revision      (read-u1 in))
      (setf flags         (read-u1 in))
      (setf size          (read-id3-encoded-size in))
      (setf frames        (read-id3-frames in :tag-size size)))
    tag))

これがいきなり出てきて、read-id3-tag関数を以下のように書くことができるって言われても、???です。
この後に read-iso-8859-1-string や read-u1 、read-id3-encoded-size、read-id3-framesなんて出てこないですし、端折りすぎではないかと思うんですよね。

という訳で詳しく見ていこうと思います。

まずは本のそのままのクラスを使います。

(defclass id3-tag ()
  ((identifier    :initarg :identifier    :accessor identifier)
   (major-version :initarg :major-version :accessor major-version)
   (revision      :initarg :revision      :accessor revision)
   (flags         :initarg :flags         :accessor flags)
   (size          :initarg :size          :accessor size)
   (frames        :initarg :frames        :accessor frames)))

このクラスの各スロットに対する説明は第25章ででてきますが、やっぱりサンプルが欲しいです。イメージが湧かないです。
という訳でここを深掘りします。

ID3v2.3の仕様は次の通りです。

##ID3v2.3構造

構造 メモ
ヘッダー
拡張ヘッダー 必要であれば
フレーム フレームヘッダーとそのあとに実際のフレームが続く。
パディング 必要であれば

参考URL : https://id3.org/id3v2.3.0
参考URL : https://www.wdic.org/w/TECH/ID3v2
参考URL : https://tohka383.hatenablog.jp/entry/20120918/1347960578

##ID3v2.3ヘッダー
最初の10byteはヘッダーです。

byte数 項目 メモ
3byte file identifier 必ず "ID3" #x494433 が来る
2byte version ID3v2.3の場合は #x3000。上位バイト(#x30)がメジャーバージョンで、下位バイト(#x00)がリビジョン。
1byte flags 上位1bit目 非同期化フラグ。上位2bit目 拡張ヘッダー有無。上位3bit目 実験的な指標。残りは0
4byte size タグのサイズ。synchsafe整数を使用

synchsafe整数とは、各1byteのうち上位1bitを0として無視し、7bitのみ使用します。タグサイズは4byteのため本来なら32bitですが、上位1bitを捨てるので、28bitとなります。

例: タグサイズ 257byteの場合
0000010 0000001
   ↓
00000010 00000001 (上位1bitが隠れている)
   ↓
#x20 01

##ID3v2.3拡張ヘッダー
ヘッダーのflagsの上位2bit目が1の場合に拡張ヘッダーが存在します。

byte数 項目 メモ
4byte Extended header size 拡張ヘッダーサイズ。v2.3ではsynchsafe整数ではなく32bit整数
2byte Extended Flags 拡張フラグ。上位1bit目が1の場合CRCデータが存在する。残りのbitは全部0
4byte Size of padding パディングサイズ。v2.3ではsynchsafe整数ではなく32bit整数

##ID3v2.3フレーム

byte数 項目 メモ
4byte Frame ID [A-Z0-9]の4文字
4byte Size フレームヘッダー(10byte)を除いたフレームサイズ。v2.3ではsynchsafe整数ではなく32bit整数
2byte Flags フレームヘッダーフラグ

###ID3v2.3フレームヘッダーフラグ
最初のbyteはステータスメッセージ用。次のbyteはエンコード用
%abc00000 %ijk00000

位置 項目 メモ 0 1
a Tag alter preservation タグが不明で変更された場合に、このフレームをどうするか。 保持 破棄
b File alter preservation ファイルが不明で変更された場合に、このフレームをどうするか。 保持 破棄
c Read only このフレームが読み取り専用
i Compression このフレームが圧縮されているかどうか 未圧縮 圧縮
j Encryption このフレームが暗号化されているかどうか 暗号化なし 暗号化あり
k Grouping identity このフレームが他のフレームとグループに属しているか 属していない 属している

##サンプルMP3を見てみる
image.png
音源は オトロジック (CC BY 4.0)からお借りしました。

まずは最初の10byteヘッダー部です。
image.png
最初の3byteにfile identifierが来ます。#x494433ですね。
次に2byteがversionですが、そのうち1byte目がメジャーバージョンで、2byte目がリビジョンです。
なので、#x03がメジャーバージョン。#x00がリビジョンとなります。
次の1byteがflagsです。#x80なので、#b10000000となり、非同期化フラグに1が立っています。
残りの4byteはsizeです。#x00 00 10 00なので、#x10 00を2進数にすると#b0001 0000 0000 0000で、上位1bitを捨てると、#b1000 0000 0000となって、#x800は2048byteとなります。

image.png
ここまでがタグってことですね。

拡張ヘッダーはないので、次はフレームになります。

image.png

最初の4byteはFrame IDです。#x54504531でTPE1と表示されています。
TPE1はアーティスト名みたいです。
次の4byteはsize(フレームサイズ)です。#x0000000aですので、10byteということです。
最後の2byteはFlagsです。#x0000なので、何にもフラグは立っていません。
というわけで、10byteを調べてみると、
image.png
ここではアーティスト名はOtoLogicということが分かります。

次のフレームに行きます。
Frame IDはTIT2です。
TIT2はタイトルみたいです。
サイズは#x14なので20byte。
Flagsは何も立っていないです。
タイトルはFlexatone03-1(Mid)ということが分かります。

次のフレームに行きます。
Frame IDはTALBです。
TALBはアルバム名です。
サイズは#xdなので13byte。
Flagsは何も立っていないです。
ということで、アルバム名はOtoLogic-SEということが分かります。

結構大変でしたが、ID3v2.3のタグを解析することができました。

##改めてクラスを見てみる

もう一度改めて作成しようとしているクラスを見てみます。

(defclass id3-tag ()
  ((identifier    :initarg :identifier    :accessor identifier)
   (major-version :initarg :major-version :accessor major-version)
   (revision      :initarg :revision      :accessor revision)
   (flags         :initarg :flags         :accessor flags)
   (size          :initarg :size          :accessor size)
   (frames        :initarg :frames        :accessor frames)))

もう何を入れるかが明確になっていますね。

##改めてread-id3-tagも見てみる

さてこの関数を知りたかったんですが、やっとたどり着きました。

(defun read-id3-tag (in)
  (let ((tag (make-instance 'id3-tag)))
    (with-slots (identifier major-version revision flags size frames) tag
      (setf identifier    (read-iso-8859-1-string in :length 3))
      (setf major-version (read-u1 in))
      (setf revision      (read-u1 in))
      (setf flags         (read-u1 in))
      (setf size          (read-id3-encoded-size in))
      (setf frames        (read-id3-frames in :tag-size size)))
    tag))

まずは、identifierですが、ID3という3文字が取得できればOKです。
次にmajor-versionは、identifierの次の1byte取得できればよくて#x03が取得できればOK。
revisionも、major-versionの次の1byte取得できればよいです。
その次の1byteがflagsというわけです。
その次の4byteがsizeで、framesには複数のフレームが入ってくることが分かります。

やっと分かってきました。
read-u1は1byte読み込めればいいし、他は専用の関数が必要そうです。

それからこの関数をもっと簡単に分かりやすくしてみます。

CL-USER> (defparameter *tag* (make-instance 'id3-tag))
*TAG*
CL-USER> (with-slots (identifier major-version revision flags size frames) *tag*
	   (setf identifier #x494433)
	   (setf major-version #x03)
	   (setf revision #x00)
	   (setf flags #x00)
	   (setf size 2048)
	   (setf frames "hogehoge"))
"hogehoge"
CL-USER> (describe *tag*)
#<ID3-TAG {10027158C3}>
  [standard-object]

Slots with :INSTANCE allocation:
  IDENTIFIER                     = 4801587
  MAJOR-VERSION                  = 3
  REVISION                       = 0
  FLAGS                          = 0
  SIZE                           = 2048
  FRAMES                         = "hogehoge"
; No value

こんな感じで各スロットに値がセットされる関数ということが分かります。

#24.5 マクロを設計する

第8章から抜粋

だからマクロを書く最初のステップは、マクロを呼び出すときの例を少なくとも1つ書いてみることと、その例がマクロによって展開されるべきコードを書いてみることだ。

呼び出す例が次の通り

  ((file-identifier (iso-8859-1-string :length 3))
   (major-version   u1)
   (revision        u1)
   (flags           u1)
   (size            id3-tag-size)
   (frames          (id3-frames :tag-size size))))

展開されるべきコードが次の通り。

(defclass id3-tag ()
  ((identifier      :initarg :identifier    :accessor identifier)
   (major-version   :initarg :major-version :accessor major-version)
   (revision        :initarg :revision      :accessor revision)
   (flags           :initarg :flags         :accessor flags)
   (size            :initarg :size          :accessor size)
   (frames          :initarg :frames        :accessor frames)))

#24.6 夢を現実に

次はパッケージを定義すべきだということでこの定義がでてきます。

(defpackage :com.gigamonkeys.binary-data
  (:use :common-lisp :com.gigamonkeys.macro-utilities)
  (:export :define-binary-class
           :define-tagged-binary-class
           :define-binary-type
           :read-value
           :write-value
           :*in-progress-objects*
           :parent-of-type
           :current-binary-object
           :+null+))

その前に次のパッケージを定義しておく必要があります。

(in-package :cl-user)

(defpackage :com.gigamonkeys.macro-utilities
  (:use :common-lisp)
  (:export 
   :with-gensyms
   :with-gensymed-defuns
   :once-only
   :spliceable
   :ppme))

定義といっているのが分かりにくいですが、SLIMEを使っている場合は、
defpackageの最後の括弧のところでC-c C-c でコンパイルします。
または、このパッケージをpackage.lispというファイルにして、(load "package.lisp")とloadします。
次に先ほどのcom.gigamonkeys.binary-dataパッケージを同じように定義してやります。

そのあとで次の関数とマクロを定義します。

(in-package :com.gigamonkeys.macro-utilities)

(defmacro with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (make-symbol ,(string n))))
     ,@body))

(defmacro once-only ((&rest names) &body body)
  (let ((gensyms (loop for n in names collect (gensym (string n)))))
    `(let (,@(loop for g in gensyms collect `(,g (gensym))))
      `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
        ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
           ,@body)))))

(defun spliceable (value)
  (if value (list value)))

(defmacro ppme (form &environment env)
  (progn
    (write (macroexpand-1 form env)
           :length nil
           :level nil
           :circle nil
           :pretty t
           :gensym nil
           :right-margin 83
           :case :downcase)
    nil))

REPLに戻って、(in-package :com.gigamonkeys.binary-data)とすればOKです。
ここまでやってやっと準備が整います。

この章はこの後に出てくる内容はちゃんと理解できましたが、次の章に関係してくるので、さらっと見ておきます。

(defun as-keyword (sym) (intern (string sym) :keyword))

string関数はシンボルをstringに変換してくれます。
intern関数は第2引数のpackageに第1引数のシンボルがなければ作成し、あればシンボルを返します。これについては第21章に詳しく書かれています。
今回の第2引数に指定しているkeywordパッケージは標準パッケージでkeywordシンボルはこのパッケージを利用しています。
なので、引数sym(文字列)をキーワードシンボルにインターンする関数ですね。

(defun slot->defclass-slot (spec)
  (let ((name (first spec)))
    `(,name :initarg ,(as-keyword name) :accessor ,name)))

これは次のサンプル実行結果そのままです。

BINARY-DATA> (slot->defclass-slot '(major-version u1))
(MAJOR-VERSION :INITARG :MAJOR-VERSION :ACCESSOR MAJOR-VERSION)

次にマクロdefine-binary-classがでてきます。
24.5章で設計したマクロです。

(defmacro define-binary-class (name slots)
  `(defclass ,name ()
     ,(mapcar #'slot->defclass-slot slots)))

このマクロを定義した上で次のようにREPLで実行すると作りたかったid3-tagのクラスが生成されることが分かります。

BINARY-DATA> (macroexpand-1 '(define-binary-class id3-tag
  ((identifier      (iso-8859-1-string :length 3))
   (major-version   u1)
   (revision        u1)
   (flags           u1)
   (size            id3-tag-size)
   (frames          (id3-frames :tag-size size)))))

(DEFCLASS ID3-TAG NIL
          ((IDENTIFIER :INITARG :IDENTIFIER :ACCESSOR IDENTIFIER)
           (MAJOR-VERSION :INITARG :MAJOR-VERSION :ACCESSOR MAJOR-VERSION)
           (REVISION :INITARG :REVISION :ACCESSOR REVISION)
           (FLAGS :INITARG :FLAGS :ACCESSOR FLAGS)
           (SIZE :INITARG :SIZE :ACCESSOR SIZE)
           (FRAMES :INITARG :FRAMES :ACCESSOR FRAMES)))
T

#24.7 バイナリオブジェクトを読む
defgenericとdefmethodについて理解が足りていないせいか、この章はかなり苦戦しました。
まず次の簡単そうな例がさっぱり分かりませんでした。

(defgeneric read-value (type stream &key)
  (:documentation "Read a value of the given type from the stream."))

からの

(defmethod read-value ((type (eql 'iso-8859-1-string)) in &key length) ...)

(defmethod read-value ((type (eql 'u1)) in &key) ...)

これが理解できなかったです。

そこで、defgenericとdefmethodの説明が書いてある章や、サイトを読み漁りました。
それでもなかなか理解できないのです。 &keyがあるせいで余計わからないのです。
というわけで次のように順を追って理解できたので、説明しておきます。

まずはdefgenericとdefmethodについて、色々と調べていて分かったことです。
まずdefgenericは必須ではないみたいです。

ジェネリック関数はマクロdefgenericで明示的に定義することもできる. ジェネリック関数を定義するためにはdefgenericを呼び出すことは必須ではない. しかしドキュメントやエラー対策の安全ネットを入れるのに都合のよい場所だ.
http://www.asahi-net.or.jp/~kc7k-nd/onlispjhtml/objectOrientedLisp.html

ここでいうジェネリック関数は総称関数のことです。

また、簡単な使い方はLand of Lispのサンプルが分かりやすかったです。

image.png

colorクラスから3つのサブクラスが継承されていて、redクラス、blueクラス、yellowクラスがあります。
このクラスに対して3つのメソッドを定義します。
c1とかc2はパラメータ名でなんでもいいです。
その後に来る2つ目の要素は特定子でクラスの名前かeql特定子がきます。

(defclass color () ())
(defclass red (color) ())
(defclass blue (color) ())
(defclass yellow (color) ())

(defmethod mix ((c1 color) (c2 color))
  "I don't know what color that makes")

(defmethod mix ((c1 blue) (c2 yellow))
  "you made green!")

(defmethod mix ((c1 yellow) (c2 red))
  "you made orange!")

Land of Lispではdefgenericは省略されています。
defgenericを定義するとしたら次のようになるでしょう。

(defgeneric mix (c1 c2)
  (:documentation "色を混ぜる"))

これらのクラスとメソッドを定義して、REPLで次のように実行します。

BINARY-DATA> (mix (make-instance 'red) (make-instance 'blue))
"I don't know what color that makes"
BINARY-DATA> (mix (make-instance 'yellow) (make-instance 'red))
"you made orange!"

eql特定子も試してみます。
サンプルとしては良くないとは思いますが。。。

(defmethod mix ((c1 blue) (c2 (eql nil)))
  "one color!")

このメソッドはc2がnilだったら次のようになります。

BINARY-DATA> (mix (make-instance 'blue) nil)

"one color!"

こんな感じで、メソッドの引数の型に応じて処理を後から追加していくことができます。

もう一回、総称関数を確認してみます。

(defgeneric read-value (type stream &key)
  (:documentation "Read a value of the given type from the stream."))

typeとかstreamとかの引数名も紛らわしいですよね。
colorクラスである程度、簡単なdefgenericとdefmethodの使い方が分かったので、サンプルに似せた次のような総称関数にしてみます。

(defgeneric test-value (arg1 arg2)
  (:documentation "もっと分かりやすく"))

(defmethod test-value ((arg1 (eql 1)) arg2)
  (format t "arg2 -> ~a" arg2))

さっきのcolorクラスのサンプルはc1もc2もクラスだったのに対して、今回はarg1が1で、arg2が引数なので戸惑ったかもしれませんが、こういう使い方もできます。

次のようにREPLで実行できます。

BINARY-DATA> (test-value 1 "hoge")
arg2 -> hoge
NIL

だからこんな風なメソッドを追加することもできます。

(defmethod test-value (arg1 arg2)
  (format t "arg1 -> ~a arg2 -> ~a" arg1 arg2))

REPLでの実行結果

BINARY-DATA> (test-value "hoge" "hogehoge")
arg1 -> hoge arg2 -> hogehoge
NIL

さらに次のようなこともできます。

(defgeneric test-value2 (arg1 arg2 &optional arg3)
  (:documentation "引数をオプションにしたい"))

(defmethod test-value2 (arg1 arg2 &optional arg3)
  (format t "arg1 -> ~a arg2 -> ~a arg3 -> ~a" arg1 arg2 arg3))

引数をオプションにしてみます。(さっきはeql特定子のところで無理やり3つ目をオプションにしましたが)

REPLでの実行結果

BINARY-DATA> (test-value2 "hoge" "hogehoge")
arg1 -> hoge arg2 -> hogehoge arg3 -> NIL
NIL
BINARY-DATA> (test-value2 "hoge" "hogehoge" "hogehogehoge")
arg1 -> hoge arg2 -> hogehoge arg3 -> hogehogehoge
NIL

さらに引数を可変にすることもできます。

(defgeneric test-value3 (arg1 arg2 &rest args)
  (:documentation "引数を可変にしたい"))

(defmethod test-value3 (arg1 arg2 &rest args)
  (format t "arg1 -> ~a arg2 -> ~a~{ args -> ~a~}" arg1 arg2 args))

REPLでの実行結果

BINARY-DATA> (test-value3 1 2)
arg1 -> 1 arg2 -> 2
NIL
BINARY-DATA> (test-value3 1 2 3 4 5)
arg1 -> 1 arg2 -> 2 args -> 3 args -> 4 args -> 5
NIL

そして、だんだんサンプルに迫っていきます。
キーワードパラメータを使ってみます。

(defgeneric test-value4 (arg1 arg2 &key key1)
  (:documentation "キーワードパラメータも使いたい"))

(defmethod test-value4 (arg1 arg2 &key key1)
  (format t "arg1 -> ~a arg2 -> ~a key1 -> ~a" arg1 arg2 key1))

REPLでの実行結果

BINARY-DATA> (test-value4 "hoge" "hogehoge" :key1 "keyhoge")
arg1 -> hoge arg2 -> hogehoge key1 -> keyhoge
NIL

もしキーワードパラメータをメソッドによって使う使わないを分けたい場合はどうしたらよいでしょう。

(defgeneric test-value5 (arg1 arg2 &key)
  (:documentation "キーワードパラメータを使いたい時もある"))

(defmethod test-value5 (arg1 arg2 &key)
  (format t "arg1 -> ~a arg2 -> ~a" arg1 arg2))

(defmethod test-value5 (arg1 arg2 &key key1)
  (format t "arg1 -> ~a arg2 -> ~a key1 -> ~a" arg1 arg2 key1))

REPELでの実行結果

BINARY-DATA> (test-value5 "hoge" "hogehoge")
arg1 -> hoge arg2 -> hogehoge
NIL
BINARY-DATA> (test-value5 "hoge" "hogehoge" :key1 "keyhoge")
arg1 -> hoge arg2 -> hogehoge key1 -> keyhoge
NIL

それでは、もう一度サンプルを見てみましょう。

(defgeneric read-value (type stream &key)
  (:documentation "Read a value of the given type from the stream."))

からの

(defmethod read-value ((type (eql 'iso-8859-1-string)) in &key length) ...)

(defmethod read-value ((type (eql 'u1)) in &key) ...)

もう分かったかと思います。
typeはeql特定子で'iso-8859-1-stringか'u1と比較していて、inにはstreamが入ります。
'iso-8859-1-stringの場合はlengthというキーワードパラメータが引数に追加されます。

やっと分かりました。

ここまで見てきた内容を見れば、このメソッドも理解できます。

(defmethod read-value ((type (eql 'id3-tag)) in &key)
  (let ((object (make-instance 'id3-tag)))
    (with-slots (identifier major-version revision flags size frames) object
      (setf identifier    (read-value 'iso-8859-1-string in :length 3))
      (setf major-version (read-value 'u1 in))
      (setf revision      (read-value 'u1 in))
      (setf flags         (read-value 'u1 in))
      (setf size          (read-value 'id3-encoded-size in))
      (setf frames        (read-value 'id3-frames in :tag-size size)))
    object))

と言ってもこのメソッドを直接書くわけじゃなくてマクロで書かせようとしてます。
章の最後まで読まないと何をしようとしているのか理解できないという。。。

なので、次から同じような構文(setf ・・・)が並んでいるところをどうにかしようとしているのです。

slot->read-valueの中で使用されているnormalize-slot-specを先に見ておきます。
ここがイメージつかないとslot->read-valueは理解できないです。

(defun normalize-slot-spec (spec)
  (list (first spec) (mklist (second spec))))

(defun mklist (x) (if (listp x) x (list x)))

mklistは見たまんまで分かりやすいです。
xがリストだったらそのままxを返す。リストじゃなかったらリストにして返すという関数です。

normalize-slot-specは次の出力例を見た方が分かりやすいです。

BINARY-DATA> (normalize-slot-spec '(major-version u1))
(MAJOR-VERSION (U1))
BINARY-DATA> (normalize-slot-spec '(identifier (iso-8859-1-string :length 3)))
(IDENTIFIER (ISO-8859-1-STRING :LENGTH 3))

identifierは渡した引数がそのまま返っているのに対して、major-versionのほうは、u1がリストになっています。
こんな風に使いたいようです。

では、slot->read-valueを見ていきます。

(defun slot->read-value (spec stream)
  (destructuring-bind (name (type &rest args)) (normalize-slot-spec spec)
    `(setf ,name (read-value ',type ,stream ,@args))))

この中でよくわからなかったのがdestructuring-bindです。
でも使ってみると簡単なマクロでした。

BINARY-DATA> (destructuring-bind (x y z) '(1 2 3)
	   (format t "~d ~d ~d" x y z))
1 2 3
NIL

こんな感じでリストを変数にバインドしてくれます。
slot->read-valueの中で使われているように&restも使えます。

BINARY-DATA> (destructuring-bind (x y &rest args) '(1 2 3 4 5 6 7)
	   (format t "~d ~d ~a" x y args))
1 2 (3 4 5 6 7)
NIL

参考URL:https://t-cool.hateblo.jp/entry/2018/08/14/105602

これでslot->read-valueは理解できました。
あえて説明するまでもないでしょう。

これらを使って作成したマクロから

(defmacro define-binary-class (name slots)
  (with-gensyms (typevar objectvar streamvar)
    `(progn
       (defclass ,name ()
         ,(mapcar #'slot->defclass-slot slots))

       (defmethod read-value ((,typevar (eql ',name)) ,streamvar &key)
         (let ((,objectvar (make-instance ',name)))
           (with-slots ,(mapcar #'first slots) ,objectvar
             ,@(mapcar #'(lambda (x) (slot->read-value x streamvar)) slots))
           ,objectvar)))))

展開した結果は次の通りです。

BINARY-DATA> (define-binary-class id3-tag
	       ((identifier      (iso-8859-1-string :length 3))
		(major-version   u1)
		(revision        u1)
		(flags           u1)
		(size            id3-tag-size)
		(frames          (id3-frames :tag-size size)))

これをSLIMEで C-c RETで展開してみます。

(PROGN
 (DEFCLASS ID3-TAG NIL
           ((IDENTIFIER :INITARG :IDENTIFIER :ACCESSOR IDENTIFIER)
            (MAJOR-VERSION :INITARG :MAJOR-VERSION :ACCESSOR MAJOR-VERSION)
            (REVISION :INITARG :REVISION :ACCESSOR REVISION)
            (FLAGS :INITARG :FLAGS :ACCESSOR FLAGS)
            (SIZE :INITARG :SIZE :ACCESSOR SIZE)
            (FRAMES :INITARG :FRAMES :ACCESSOR FRAMES)))
 (DEFMETHOD READ-VALUE ((#:TYPEVAR (EQL 'ID3-TAG)) #:STREAMVAR &KEY)
   (LET ((#:OBJECTVAR (MAKE-INSTANCE 'ID3-TAG)))
     (WITH-SLOTS (IDENTIFIER MAJOR-VERSION REVISION FLAGS SIZE FRAMES)
         #:OBJECTVAR
       (SETF IDENTIFIER (READ-VALUE 'ISO-8859-1-STRING #:STREAMVAR :LENGTH 3))
       (SETF MAJOR-VERSION (READ-VALUE 'U1 #:STREAMVAR))
       (SETF REVISION (READ-VALUE 'U1 #:STREAMVAR))
       (SETF FLAGS (READ-VALUE 'U1 #:STREAMVAR))
       (SETF SIZE (READ-VALUE 'ID3-TAG-SIZE #:STREAMVAR))
       (SETF FRAMES (READ-VALUE 'ID3-FRAMES #:STREAMVAR :TAG-SIZE SIZE)))
     #:OBJECTVAR)))

defclass id3-tag と defmethod read-valueが両方とも定義されることが分かります。

#24.9
以降の章は何をしたいのかが分からず、ちょっと挫折。。
気が向いたら続きをやるかも

1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?