LISPUSER

(defpackage :jp (:nicknames :jp) (:use :common-lisp)
          (:export
           :make-encoding
           :encode
           :decode
           :guess))
(in-package :jp)

external-format を指定する方法は処理系毎に次の表のようになっている。

処理系	external-format 指定子
———	–————————————————————————
AllegroCL	キーワードもしくは (crlf-base-ef [キーワード])
LispWorks	'([キーワード] :eol-type [:lf/:cr/:crlf])
SBCL	キーワードで指定
CLISP	(ext:make-encoding "エンコーディング名" :line-terminator [:unix/:mac/:dos]

これらを統合して、共通なインターフェースを作成する。サポートする文字集合は以下の通り。

:default	処理系のデフォルト
:ascii	ASCII (8-bit Char)
:utf8	UTF-8
:sjis	Shift_JIS
:euc-jp	EUC-JP
:jis	JIS (ISO-2022-JP)	SBCLでは未サポート

また、改行コードは処理系がサポートしている限り UNIXで良く利用される :lf, Apple製OSでメジャーな :cr, Microsoft系 OS で使用される :crlf を指定できようにする。

(defun make-encoding (charset &key (eol-style :lf))
  #+allegro
  (let ((charset (ecase charset
                 (:ascii :ascii)
                 (:utf8 :utf8)
                 (:sjis :shiftjis)
                 (:euc-jp :euc)))
      (func   (ecase eol-style
                (:lf #'identity)
                (:crlf #'excl:crlf-base-ef))))
    (funcall func charset))
  #+lispworks
  `(,(ecase charset
          (:asci :ascii)
          (:utf :utf-8)
          (:sjis :sjis)
          (:euc-jp :euc-jp)
           (:jis :jis)))
     :eol-style ,(ecase eol-style ((:cr :lf :crlf) eol-style)))
  #+sbcl (declare (ignore eol-style))
  #+sbcl
  (ecase charset
    (:ascii :ascii)
    (:utf8 :utf-8)
    (:sjis :cp932)
    (:euc-jp :eucjp))
  #+clisp
  (let ((charset (ecase charset
                 (:ascii "ISO-8859-1")
                 (:utf8 "UTF-8")
                 (:sjis "Shift_JIS")
                 (:euc-jp "EUC-JP")
                 (:jis "ISO-2022-JP")))
      (eol-style (ecase eol-style
                   (:cr :mac)
                   (:lf :unix)
                   (:crlf :dos))))
    (ext:make-encoding :charset charset
                   :line-terminator eol-style)))

ただし SBCL では改行コードの指定は EXTERNAL-FORMAT に含まれないため、指定しても効果はない。

Lisp文字列からバイト列へと変換するためのラッパー ENCODE を作成する。 :start, :end 引数を指定する事により 文字列の一部分を変換する事も可能である。処理系によっては、末尾をヌル文字で終端するオプションを備えているため、互換オプションを用意する。

(defun encode (string external-format &key (start 0) end (null-terminate nil))
  #+allegro
  (excl:string-to-octets string :external-format external-format :start start :end end :null-terminate null-terminate)
  #+lispworks
  (if null-terminate
      (concatenate '(vector (unsigned-byte 8)) (external-format:encode-lisp-string string external-format :start start :end end) #(0))
      (external-format:encode-lisp-string string external-format :start start :end end))
  #+sbcl
  (sb-ext:string-to-octets string :external-format external-format :start start :end end :null-terminate null-terminate)
  #+clisp
  (if null-terminate
      (concatenate '(vector (unsigned-byte 8)) (ext:convert-string-to-bytes string external-format :start start :end end) #(0))
      (ext:convert-string-to-bytes string external-format :start start :end end)))

これで、MAKE-ENCODING によって作成したエンコーディングを使って文字列からバイト列への変換が可能となる。 ただし、AllegroCL が備えている機能のうち、新しく確保した配列のかわりに指定した配列を書換える機能はポータブルに実現する方法がないため、サポートしない。

バイト列から文字列への変換を行うラッパー DECODE はもっと簡単な定義であ る。ここでも、AllegroCL の機能のうち、指定した配列を書換える機能はサポートされない。

(defun decode (vector external-format &key (start 0) end)
  #+allegro
  (excl:octets-to-string vector :external-format external-format :start start :end end)
  #+lispworks
  (external-format:decode-external-string vector external-format :start start :end end)
  #+sbcl
  (sb-ext:octets-to-string vector :external-format external-format :start start :end end)
  #+clisp
  (ext:convert-string-from-bytes vector external-format :start start :end end))

さて、ここまでで一応ラッパーは完成したが、このままでは単に性能が悪化するだけであるため、おもしろくない。 そこでCommon Lisp規格に含まれている最適化方式である define-compiler-macro と inline による最適化を実施してみよう。

define-compiler-macro はコンパイル時にのみ処理されるマクロである。 このマクロの有用なところは、コンパイル時に関数の引数に指定されたパラメータをチェックして変形が可能であるという点だ。 次のような関数呼び出しを見てみよう。

 (jp:encode "日本語" (jp:make-encoding :sjis))

これは、文字列、external-format の指定がすべて定数であるから、指定した引数から値を計算すると

 #(147 250 150 123 140 234)

と等価である。この変換をコンパイル時に実施するようにしてみよう。

まず最初に jp:encode と jp:raw-encode のように関数を分離する。jp:encode をコンパイルする時に、コンパイラマクロを 使って引数がすべて定数なら jp:raw-encode を呼び出してその場で結果を計算し、もし引数に変数が混ざっていた場合には 単なる jp:raw-encode の呼び出しへとマクロ展開をおこなう。

また、この際に合わせて関数呼び出しの階層が増えて効率が落ちないようにinline宣言をおこなって関数がインライン展開されるようにしておく。

(eval-when (:compile-toplevel :load-toplevel :execute)

  (declaim (inline raw-make-encoding))
  (defun raw-make-encoding (charset eol-style)
    ...)
  (defun make-encoding (charset &key (eol-style :crlf))
    (raw-make-encoding charset eol-style))

  (declaim (inline raw-encode))
  (defun raw-encode (string external-format start end null-terminate)
    ...)

  (defun encode (string external-format &key (start 0) end (null-terminate nil))
    (raw-encode string external-format start end null-terminate))

  (declaim (inline raw-decode))
  (defun raw-decode (vector external-format start end &aux (usb8-array (coerce vector '(vector (unsigned-byte 8)))))
    ...)
  (defun decode (vector external-format &key (start 0) end)
    (raw-decode vector external-format start end))

)

次に実際に encoe / decode 引数が定数の場合に値を展開するコンパイラマクロを定義する。 まず external-format 以外のパラメータをすべて定数であるかをチェックし、 さらに external-format が定数あるいは (make-encoding [定数]) の呼び出しであるかをチェックする。 すべてのチェックを通ったら、コンパイル時に値が決定できるという事なので、その場で encode を実施して 結果の文字列を返す。それ以外の場合は raw-encode の呼び出しを実施する。

(define-compiler-macro encode (string external-format &key (start 0) end (null-terminate nil))
  (if (and (every #'constantp (list string start end null-terminate))
         (or (constantp external-format)
             (and (consp external-format)
                  (eq (first external-format) 'make-encoding)
                  (every #'constantp (cdr external-format)))))
      (let ((ef (if (and (consp external-format) (eq (first external-format) 'make-encoding))
                  (apply #'make-encoding (cdr external-format))
                  external-format)))
      (raw-encode string ef start end null-terminate))
      `(raw-encode ,string ,external-format ,start ,end ,null-terminate)))

(define-compiler-macro decode (string external-format &key (start 0) end)
  (if (and (every #'constantp (list string start end))
         (or (constantp external-format)
             (and (consp external-format)
                  (eq (first external-format) 'make-encoding)
                  (every #'constantp (cdr external-format)))))
      (let ((ef (if (and (consp external-format) (eq (first external-format) 'make-encoding))
                  (apply #'make-encoding (cdr external-format))
                  external-format)))
      (raw-decode string ef start end))
      `(raw-decode ,string ,external-format ,start ,end)))

ここまですると、コンパイルした後には raw-decode がインライン展開された状態になり、関数呼び出しのオーバーヘッドが削減される。 ほとんどの処理系では encode/decode を使った関数を disassemble すると encode/decode は言うに及ばず raw-encode/raw-decode も 消えさって処理系の変換関数を呼び出しているのがわかるだろう。まずはコンパイラマクロによる最適化が効く例を御覧いただこう。

CL-USER> (disassemble (lambda () (funcall #'ja:encode "日本語" charset:cp932)))
 
Disassembly of function :LAMBDA
(CONST 0) = #(147 250 150 123 140 234)
0 required arguments
0 optional arguments
No rest parameter
No keyword parameters
2 byte-code instructions:
0     (CONST 0)                           ; #(147 250 150 123 140 234)
1     (SKIP&RET 1)
NIL

いかがだろうか？コンパイル後には変換後のベクタしか残っていない。 続けてコンパイラマクロによる最適化が効かない場合を見てみよう。

CL-USER> (disassemble (lambda () (funcall #'ja:encode "日本語" (if (= (random 2) 0) charset:cp932 charset:euc-jp))))

Disassembly of function :LAMBDA
(CONST 0) = 2
(CONST 1) = CHARSET:CP932
(CONST 2) = CHARSET:EUC-JP
(CONST 3) = "日本語"
(CONST 4) = :START
(CONST 5) = 0
(CONST 6) = :END
(CONST 7) = CONVERT-STRING-TO-BYTES
0 required arguments
0 optional arguments
No rest parameter
No keyword parameters
reads special variables: CHARSET:CP932 CHARSET:EUC-JP
17 byte-code instructions:
0     (CONST&PUSH 0)                      ; 2
1     (PUSH-UNBOUND 1)
3     (CALLS2&PUSH 247)                   ; RANDOM
5     (CALLS2&JMPIF 172 L21)              ; ZEROP
8     (GETVALUE&PUSH 2)                   ; CHARSET:EUC-JP
10    L10
10    (CONST&PUSH 3)                      ; "日本語"
11    (LOAD&PUSH 1)
12    (CONST&PUSH 4)                      ; :START
13    (CONST&PUSH 5)                      ; 0
14    (CONST&PUSH 6)                      ; :END
15    (NIL&PUSH)
16    (CALL 6 7)                          ; CONVERT-STRING-TO-BYTES
19    (SKIP&RET 2)
21    L21
21    (GETVALUE&PUSH 1)                   ; CHARSET:CP932
23    (JMP L10)
NIL

ここでも、encode はコンパイラマクロにより raw-encode に展開され、raw-encode はインライン展開された convert-string-to-bytes が呼び出されている。