Common Lisp における文字列は「文字 (Character)」の列だ。 もしあなたがC言語のように文字列とバイト列の違いが解釈だけ、という思想に馴染んでいるのなら、この辺は考え方をかえる必要がある。 この章では、「文字」と「文字列」、そして日本語を扱う上で避けて通れない「EXTERNAL-FORMAT」を説明する。 また、サンプルとして処理系毎に異なる日本語関連 API をラップするライブラリを作成する。
Common Lisp規格は文字 character と、characterを構成する三種類の文字型、standard-char, base-char, extended-char を定義する。 また、実装が国際化や数学記号なの特定領域のための文字を追加サポートする事も許している。大抵の実装では日本語は character のうちの base-char もしくは extended-char 型としてサポートされている。
次のような式で考えれば簡単だ。
base-char 型 = standard-char + 拡張文字 character 型 = base-char + extended-char = (standard-char + 拡張文字) + extended-char
ここで、規格は base-char が standard-char よりも大きい文字集合であることを要求しているだけなので、日本語のサポートを base-char に追加してもよい。 普段使う時にこんな違いを気にする必要があるか？と思うかもしれないが、移植性を考えるならばbase-charが日本語を含まない処理系を意識しておく必要がある。 さっきの character = base-char + extended-char という関係を思い出そう。日本語の文字がextended-charとして実装されている処理系ではbase-charの配列は 日本語を含む事ができないのだ。解決策は単純で、処理系間での移植性を考慮する場合にはcharacterを使えば良い。
ほとんどのCommon Lisp処理系は文字を内部では Unicode コードポイントとして保持している処理系が多い。大抵の処理系では以下のような結果になるはずである。
CL-USER> (char-code #\あ) 12354
ただし、これはCommon Lispの国際化サポートが Unicode ベースでなければならないという事を意味するわけではない。 単に実装が Unicode ベースというだけの事である。処理系毎のサポート状況は現在の時点 (2008年6月) では以下の通り。
| 処理系 | 内部表現 | char-code-limit |
| -———— | —————————— | -———— |
| AllegroCL | Unicode (16bit) - BMPサポート | 65536 |
| LispWorks | Unicode (16bit) - BMPサポート | 65536 |
| SBCL | Unicode (21bit) | 1114112 |
| CLISP | Unicode (21bit) | 1114112 |
| ECL | Unicode (21bit) | 1114112 |
| CMUCL | 8bit | 256 |
表にない処理系についても、char-code-limit を参照する事で日本語サポートの推定は可能だ。 ただし、内部表現が Unicode である事と、日本語が利用できる事は別であるので注意が必要である。 例えば Embedded Common Lisp 0.9k は char-code-limit のが 1114112 で内部表現は 21bit Unicode であるが、 後述する EXTERNAL-FORMAT がサポートされていないため、日本語の文字を認識する事はできない。
処理系の内部表現に 16bit Unicode と 21bit Unicode の二種類があるが、内部表現が 16bit の処理系では 一部の文字が文字オブジェクトとして扱えない。
;; 21bit Unicode をサポートした処理系 CL-USER> (code-char #x10000) #\LINEAR_B_SYLLABLE_B008_A ;; 21bit Unicode をサポートしない処理系 CL-USER> (code-char #x10000) NIL
日本語でいうと、例えばWindows Vistaで新たに利用可能となった漢字の一部が該当する。
手持ちの処理系が文字型としてサポートしていない範囲の文字を扱うには、ちょうどC言語のように文字をバイト列として扱うことになる。
処理系内内で文字が Unicode コードポイントとして表現されていたとして、 世の中で使われている UTF-8 や EUC-JP、 ShiftJIS での日本語文字列表現と合わせるにはどうするか？ Lisp 処理系が、ファイル等の Lisp の外側 (external) での文字エンコーディングを表現する extenral-format を通じて、変換機能を提供してくれる。
LISP内部表現 <---- external-format ---- ファイル / ストリーム LISP内部表現 ---- external-format ----> ファイル / ストリーム
Common Lisp規格で要求されている EXTERNAL-FORMAT は :default だけであるが、Common Lisp処理系はこの仕様を実装毎に拡張することで、 日本語サポートを提供している。ただし、処理系毎の EXTERNAL-FORMAT サポート状況は次の表のようなバラバラな状態になっている。
| 処理系 | サポートされる EXTERNAL-FORMAT (一部抜粋) |
| ——— | ————————————————————————————————— |
| AllegroCL | :latin1 :ascii :8-bit :iso8859-1 :utf8 :euc-jp :jis :shiftjis |
| LispWorks | :unicode :latin-1 :ascii :macos-roman :jis-x-208 :jis-x-212 :euc-jp :sjis :jis |
| SBCL | :latin1 :utf-8 :eucjp :sjis |
| CLISP | charset:ascii charset:iso-8859-1 charset:utf-8 charset:euc-jp charset:shift-jis charset:iso-2022-jp |
[注] SBCL では標準で iso-2022-jp がサポートされてない点は注意が必要である。外部ライブラリを使うなど、自力で対応する必要がある。
EXTERNAL-FORMATの表現は処理系事にキーワードであったり、リストであったり、オブジェクトであったりとバラバラである。 また、AllegroCL, LispWorks, CLISP は改行コードの取り扱いを EXTERNAL-FORMAT 内に含んでいるが、SBCL では含んでいないなど機能的にも 差異がある。
では早速EXTERNAL-FORMATを使ってみよう。手始めに、EXTERNAL-FORMATを指定して文字列を書き出し、それをバイト列として読み出してみよう。
CL-USER> (with-open-file (s "jstr_utf8.txt" :direction :output :if-exists :supersede :external-format :utf8)
(write-sequence "日本語文字列" s))
"日本語文字列"
CL-USER> (with-open-file (s "jstr_sjis.txt" :direction :output :if-exists :supersede :external-format :sjis)
(write-sequence "日本語文字列" s))
"日本語文字列"
CL-USER> (with-open-file (s "jstr_utf8.txt" :direction :input :element-type '(unsigned-byte 8))
(let ((seq (make-sequence '(vector (unsigned-byte 8)) 18)))
(read-sequence seq s)
seq))
#(230 151 165 230 156 172 232 170 158 230 150 135 229 173 151 229 136 151)
CL-USER> (with-open-file (s "jstr_sjis.txt" :direction :input :element-type '(unsigned-byte 8))
(let ((seq (make-sequence '(vector (unsigned-byte 8)) 12)))
(read-sequence seq s)
seq))
#(147 250 150 123 140 234 149 182 142 154 151 241)
external-format の指定によって外部表現がかわっている事が確認できる。 それぞれのバイト列を、Lispの文字列表現に戻すには、同じ external-format を指定して読み込む。
CL-USER> (with-open-file (s "jstr_utf8.txt" :direction :input :external-format :utf8)
(let ((str (make-string 6)))
(read-sequence str s)
str))
"日本語文字列"
CL-USER> (with-open-file (s "jstr_sjis.txt" :direction :input :external-format :sjis)
(let ((str (make-string 6)))
(read-sequence str s)
str))
"日本語文字列"
このように、文字ストリームに対してはEXTERNAL-FORMATを指定する事で、内部表現と外部の日本語エンコーディングとの変換を 処理してくれる。また、ソケット等のファイル以外のストリームに関しても処理系毎に external-format が指定できるように なっているはずなので、処理系附属のドキュメントを参照してほしい。
Common Lispで日本語を扱う際に、「文字列」と「バイト列」を混在させて扱いたい場合に困った人は多いのではないだろうか。 たとえば次のようなコードを見てみよう。
(with-open-file (s "sample.dat" :direction :ouput :external-format :utf-8) (write-line "日本語" s) (write-sequence #(0 1 2 3 4 5 6 7 8 9) s))
これは、AllegroCL などの単一のストリームに対して、READ-CHAR / READ-BYTE の文字あるいはバイト単位をの I/O が行なえる BIVALENT-STREAM をサポートする処理系以外ではエラーとなる。文字ストリームの ELEMENT-TYPE が 'CHRACTER であるため、 (unsigned-byte 8) のベクタは型が違うため書き込めない。
この問題に対するもっともポータブルな答えは、ストリームを :element-type '(unsigned-byte 8) で開き、 文字列は処理系に備わっている関数をつかって (unsigned-byte 8) のバイト列に変換して書き込むというものだ。 各処理系に備わっている文字列とバイト列の変換を行う関数を次に示す。
| 処理系 | 文字列 => バイト列 | バイト列 => 文字列 |
| ——— | –————————— | –———————— |
| AllegroCL | ext:string-to-octets | ext:octets-to-string |
| LispWorks | ext:encode-lisp-string | ext:decode-external-string |
| SBCL | sb-ext:string-to-octets | sb-ext:octets-to-string |
| CLISP | ext:convert-string-from-bytes | ext:convert-string-tom-bytes |
たとえば、先程のコードを SBCL で記述すると次のようになる。
(with-open-file (s "jstr_mixed.txt"
:direction :output
:if-exists :supersede
:element-type '(unsigned-byte 8))
(write-sequence (sb-ext:string-to-octets "日本語" :external-format :utf-8) s)
(write-sequence #(0 1 2 3 4 5 6 7 8 9) s))
同様に、他の処理系でも一旦バイト列に変換した後 WRITE-SEQUENCE で書き込む事で日本語文字列とバイト列をストリームに 出力することができる。
すべてを (unsigned-byte 8) として取り扱うというやり方は移植性に優れているが、二つ短所がある。 一つ目は効率の問題だ。日本語 - バイト列 - ストリーム という変換は、メモリを余計に消費する。 特にストリームがバッファリングされている場合には……あぁ、神樣。 二つめはストリームとの相性が良くない点だ。エンコーディングにはShiftJISやEUC-JPのようにステートレスに Unicodeと変換可能なものばかりではなく、「状態」をもったものが存在する。たとえばISO-2022-JPは、日本語文字列 をエスケープシーケンス + 日本語を表わすバイト列 + エスケープシーケンスという構成になる。 つまり、文字列を一つ一つバイト列に変換するよりも、ストリームベースの処理が望ましい。 さもなければ…自分でエスケープシーケンスを管理する事になる。
もし文字列とストリームを直接I/OできるAPIがあったなら、あるいはバッファリングを自動でやってくれたなら…。 そんな経緯もあって、FranzからSIMPLE-STREAMという新しいストリームの規格が提唱された。
AllegroCL は SIMPLE-STREAM をサポートしているため柔軟な実装が可能だが、可搬性が高いのは :element-type (unsigned-byte 8) でストリームを開いて操作するやり方である。
なぜ、新たに SIMPLE-STREAM
EXTERNAL-FORMATの実装は15章で扱ったパスネーム以上に実装毎の差異が大きい。 まにやったように、共通のインターフェースを作成してみよう。
(defpackage :net.lispuser.jp (:nicknames :jp) (:use :common-lisp)
(:export
:make-encoding
:encode
:decode
:guess))
(in-package :net.lispuser.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 | ShiftJIS | |
| :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 #'identify)
(:crlf #'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
(let* ((orig (external-format:encode-lisp-string string external-format :start start :end end))
(vec (make-array (length orig) :element-type '(unsigned-byte 8) :displaced-to orig)))
(setf (aref vec (1- (length vec))) 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
(let* ((orig (ext:convert-string-to-bytes string external-format :start start :end end))
(vec (make-array (length orig) :element-type '(unsigned-byte 8) :displaced-to orig)))
(setf (aref vec (1- (length vec))) 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))
バイト列を日本語文字列とみなして文字コードを推定する関数を Scheme 処理系 Gauche からの移植する。 オリジナルの関数は Scheme で C で理解できる形式の文字コード別状態表を作成し、それを C コンパイラでコンパイル する事で実現されているが、Common Lispへのポート時には eval-when を用いて状態表をコンパイル時に展開するように移植した。 動作そのものはベクタをスキャンしつつ各文字コード別の状態表をつかってスコアを計算し、スコアをもとに文字コードを推定するというものである。
(eval-when (:compile-toplevel :load-toplevel :execute)
(defclass <dfa> ()
((name :initarg :name :accessor name-of)
(states :initarg :states :accessor states-of)
#+nil (instances :allocation :class :initform nil)))
(defclass <state> ()
((name :initarg :name :accessor name-of)
(index :initarg :index :accessor index-of)
(arcs :initarg :arcs :accessor arcs-of :initform nil)))
(defclass <arc> ()
((from-state :initarg :from-state :accessor from-state-of)
(to-state :initarg :to-state :accessor to-state-of)
(ranges :initarg :ranges :accessor ranges-of)
(index :initarg :index :accessor index-of)
(score :initarg :score :accessor score-of)))
(defun resolve-states (state-defs)
(let ((states (mapcar (lambda (d i)
(make-instance '<state> :name (car d) :index i))
state-defs
(loop for i from 0 below (length state-defs) collect i))))
(labels ((gen (s d i &aux (num-arcs (length (cdr d))))
(setf (arcs-of s)
(mapcar (lambda (arc aindex)
(make-instance '<arc>
:from-state s
:to-state (or (find-if
(lambda (e)
(eq (name-of e) (cadr arc)))
states))
:ranges (car arc)
:index aindex
:score (caddr arc)))
(cdr d)
(loop repeat num-arcs for x from i collect x)))
(+ i num-arcs))
(fold (fun state arg1 arg2)
(if (or (null arg1) (null arg2))
state
(fold fun
(funcall fun (car arg1) (car arg2) state)
(cdr arg1)
(cdr arg2)))))
(fold #'gen 0 states state-defs)
states)))
;;;;;; DFA
(defmacro define-dfa (name &body states)
(let ((name-st (intern (string-upcase (format nil "+~A-ST+" name))))
(name-ar (intern (string-upcase (format nil "+~A-AR+" name)))))
`(unless (boundp ',name-st)
(let ((dfa (make-instance '<dfa> :name ',name :states (resolve-states ',states))))
(defconstant ,name-st (apply #'vector
(loop for state in (states-of dfa)
collect (let ((vec (make-array 256 :initial-element -1)))
(flet ((b2i (byte) (if (characterp byte) (char-code byte) byte)))
(dolist (br (arcs-of state))
(dolist (range (ranges-of br))
(if (consp range)
(fill vec (index-of br)
:start (b2i (car range))
:end (+ (b2i (cadr range)) 1))
(setf (aref vec (b2i range)) (index-of br)))))
vec)))))
(defconstant ,name-ar (apply #'vector
(loop for arc in (loop for state in (states-of dfa) appending (arcs-of state))
collect (cons (index-of (to-state-of arc)) (score-of arc)))))))))
;;;;; state date from Gauche's guess.scm
;;;
;;; EUC-JP
;;;
(define-dfa eucj
;; first byte
(init
(((#x00 #x7f)) init 1.0d0) ; ASCII range
((#x8e) jis0201_kana 0.8d0) ; JISX 0201 kana
((#x8f) jis0213_2 0.95d0) ; JISX 0213 plane 2
(((#xa1 #xfe)) jis0213_1 1.0d0) ; JISX 0213 plane 1
)
;; jis x 0201 kana
(jis0201_kana
(((#xa1 #xdf)) init 1.0d0)
)
;; jis x 0208 and jis x 0213 plane 1
(jis0213_1
(((#xa1 #xfe)) init 1.0d0))
;; jis x 0213 plane 2
(jis0213_2
(((#xa1 #xfe)) init 1.0d0))
)
;;;
;;; Shift_JIS
;;;
(define-dfa sjis
;; first byte
(init
(((#x00 #x7f)) init 1.0d0) ;ascii
(((#x81 #x9f) (#xe1 #xef)) jis0213 1.0d0) ;jisx0213 plane 1
(((#xa1 #xdf)) init 0.8d0) ;jisx0201 kana
(((#xf0 #xfc)) jis0213 0.95d0) ;jisx0213 plane 2
(((#xfd #xff)) init 0.8d0)) ;vendor extension
(jis0213
(((#x40 #x7e) (#x80 #xfc)) init 1.0d0))
)
;;;
;;; UTF-8
;;;
(define-dfa utf8
(init
(((#x00 #x7f)) init 1.0d0)
(((#xc2 #xdf)) 1byte_more 1.0d0)
(((#xe0 #xef)) 2byte_more 1.0d0)
(((#xf0 #xf7)) 3byte_more 1.0d0)
(((#xf8 #xfb)) 4byte_more 1.0d0)
(((#xfc #xfd)) 5byte_more 1.0d0))
(1byte_more
(((#x80 #xbf)) init 1.0d0))
(2byte_more
(((#x80 #xbf)) 1byte_more 1.0d0))
(3byte_more
(((#x80 #xbf)) 2byte_more 1.0d0))
(4byte_more
(((#x80 #xbf)) 3byte_more 1.0d0))
(5byte_more
(((#x80 #xbf)) 4byte_more 1.0d0))
)
;;;
;;; JIS (ISO2022JP)
;;;
;; NB: for now, we just check the sequence of <ESC> $ or <ESC> '('.
'(define-dfa jis
(init
((#x1b) esc 1.0d0)
(((#x00 #x1a) (#x1c #x1f)) init 1.0d0) ;C0
(((#x20 #x7f)) init 1.0d0) ;ASCII
(((#xa1 #xdf)) init 0.7d0) ;JIS8bit kana
)
(esc
((#x0d #x0a) init 0.9d0) ;cancel
((#\( ) esc-paren 1.0d0)
((#\$ ) esc-$ 1.0d0)
((#\& ) esc-& 1.0d0)
)
(esc-paren
((#\B #\J #\H) init 1.0d0)
((#\I) jis0201kana 0.8d0)
)
(esc-$
((#\@ #\B) kanji 1.0d0)
((#\( ) esc-$-paren 1.0d0)
)
(esc-$-paren
((#\D #\O #\P) kanji 1.0d0))
(esc-&
((#\@ ) init 1.0d0))
(jis0201kana
((#x1b) esc 1.0d0)
(((#x20 #x5f)) jis0201kana 1.0d0))
(kanji
((#x1b) esc 1.0d0)
(((#x21 #x7e)) kanji-2 1.0d0))
(kanji-2
(((#x21 #x7e)) kanji 1.0d0))
)
)
ここまでが、EUC-JP, ShiftJIS, UTF-8, ISO-2022-JP の状態遷移表の定義である。 これらの表の定義は DEFCONSTANT で定義されたベクタに展開される。
最後はこの状態遷移表をつかって文字コードを推定する GUESS である。
(defun guess (vector &optional (scheme :JP))
(case scheme
((:*JP :JP) (guess-jp vector))
(t (error "scheme parameter: supported :*JP only"))))
(defun guess-jp (buffer &aux (len (length buffer)))
(declare (optimize (speed 3) (space 0) (safety 0) (debug 0)))
(macrolet ((dfa-init (dfa-st dfa-ar)
`(vector ,dfa-st ,dfa-ar 0 1.0d0))
(score (dfa) `(svref ,dfa 3))
(state (dfa) `(svref ,dfa 2))
(arcs (dfa) `(svref ,dfa 1))
(states (dfa) `(svref ,dfa 0))
(dfa-alive (dfa) `(>= (the fixnum (state ,dfa)) (the fixnum 0)))
(dfa-next (dfa ch)
`(when (dfa-alive ,dfa)
(when (>= (the fixnum (state ,dfa)) (the fixnum 0))
(let ((temp (svref
(svref (states ,dfa) (state ,dfa))
,ch)))
(if (< (the fixnum temp) (the fixnum 0))
(setf (state ,dfa) -1)
(setf (state ,dfa) (the fixnum (car (svref (arcs ,dfa) temp)))
(score ,dfa) (* (the double-float (score ,dfa))
(the double-float (cdr (svref (arcs ,dfa) temp))))))))))
;; utility
(process-dfa (dfa ch value &rest others)
`(when (dfa-alive ,dfa)
(when (and ,@(mapcar (lambda (dfa) `(not (dfa-alive ,dfa))) others))
(return-from guess-body ,value))
(dfa-next ,dfa ,ch)))
;; result
(iso-2022-jp () :jis)
(euc-jp () :euc-jp)
(shiftjis () :sjis)
(utf-8 () :utf-8))
(block guess-body
(let* ((eucj (dfa-init +eucj-st+ +eucj-ar+))
(sjis (dfa-init +sjis-st+ +sjis-ar+))
(utf8 (dfa-init +utf8-st+ +utf8-ar+))
(top nil))
(declare (dynamic-extent eucj sjis utf8 top))
(loop for c of-type fixnum across buffer
for i of-type fixnum from 0 do
(when (and (= (the fixnum c) (the fixnum #x1b)) (< i len))
(let ((c (aref buffer (the fixnum (1+ i)))))
(when (or (= (the fixnum c) (the fixnum #x24)) ; $
(= (the fixnum c) (the fixnum #x28))) ; (
(return-from guess-body (iso-2022-jp)))))
(process-dfa eucj c (euc-jp) sjis utf8)
(process-dfa sjis c (shiftjis) eucj utf8)
(process-dfa utf8 c (utf-8) sjis eucj)
(when (and (not (dfa-alive eucj)) (not (dfa-alive sjis)) (not (dfa-alive utf8)))
(return nil)))
;; pick highest score
(when (dfa-alive eucj)
(setf top eucj))
(when (dfa-alive utf8)
(if top
(when (<= (the double-float (score top)) (the double-float (score utf8)))
(setf top utf8))
(setf top utf8)))
(when (dfa-alive sjis)
(if top
(when (< (the double-float (score top)) (the double-float (score sjis)))
(setf top sjis))
(setf top sjis)))
(cond ((eq top eucj) (euc-jp))
((eq top utf8) (utf-8))
((eq top sjis) (shiftjis))
(t nil))))))
最後はテストで実施。