今回は、最初に、UNICODE の基本多言語面より後のコードを UTF-8 にエンコードする機能の追加と、この逆変換として UTF-8 から UNICODE へ、デコードするプログラムを示します。
次に、新たに追加した binary-buffer の機能を利用してバイナリデータを取り扱う方法を説明します。次に、これをファイルに出力し、次いでそれを
binary-buffer に読み戻す方法を説明します。以上を利用して、UNICODE文字セットの基本多言語面にある文字コードを全て UTF-8 にエンコードし binary-buffer に書き込み、それをファイルに書き出します。UNICODE エンコードとデコード
UNICODE → UTF-8 のエンコーダ（
integer->utf-8）を拡張してUNICODE の全文字集合を取り扱うことが出来るように拡張します。逆に、UTF-8 にエンコードされたデータをデコードする関数 （utf-8->integer）を示します。
(define integer->utf-8
(lambda (c)
(cond
((and (>= c 0) (<= c #x7f)) (list c))
((and (>= c #x80) (<= c #x7ff))
(list (bits-or #xc0 (bits-shift-right c 6))
(bits-or #x80 (bits-and c #x3f))))
((and (>= c #x800) (<= c #xffff))
(list (bits-or #xe0 (bits-shift-right c 12))
(bits-or #x80 (bits-and (bits-shift-right c 6) #x3f))
(bits-or #x80 (bits-and c #x3f))))
((and (>= c #x10000) (<= c #x1fffff))
(list (bits-or #xf0 (bits-shift-right c 18))
(bits-or #x80 (bits-and (bits-shift-right c 12) #x3f))
(bits-or #x80 (bits-and (bits-shift-right c 6) #x3f))
(bits-or #x80 (bits-and c #x3f))))
((and (>= c #x200000) (<= c #x3ffffff))
(list (bits-or #xf8 (bits-shift-right c 24))
(bits-or #x80 (bits-and (bits-shift-right c 18) #x3f))
(bits-or #x80 (bits-and (bits-shift-right c 12) #x3f))
(bits-or #x80 (bits-and (bits-shift-right c 6) #x3f))
(bits-or #x80 (bits-and c #x3f))))
((and (>= c #x4000000) (<= c #x7fffffff))
(list (bits-or #xfc (bits-shift-right c 30))
(bits-or #x80 (bits-and (bits-shift-right c 24) #x3f))
(bits-or #x80 (bits-and (bits-shift-right c 18) #x3f))
(bits-or #x80 (bits-and (bits-shift-right c 12) #x3f))
(bits-or #x80 (bits-and (bits-shift-right c 6) #x3f))
(bits-or #x80 (bits-and c #x3f))))
(else '()))))
(define utf-8->integer
(lambda (ls)
(define invalid?
(lambda (n ls)
(if (not (= (length ls) n))
#t
(let loop ((ls (cdr ls)))
(if (null? ls)
#f
(if (not (= (bits-and (car ls) #xc0) #x80))
#t
(loop (cdr ls))))))))
(define bond
(lambda (ls acc)
(if (null? ls)
acc
(bond (cdr ls)
(bits-or (bits-shift-left acc 6)
(bits-and (car ls) #x3f))))))
(if (or (null? ls) (not (pair? ls)))
-1
(let ((lead (car ls)))
(cond
((zero? (bits-and lead #x80))
(if (null? (cdr ls)) lead -1))
((= (bits-and lead #xe0) #xc0)
(if (invalid? 2 ls)
-1
(bond (cdr ls) (bits-and (car ls) #x1f))))
((= (bits-and lead #xf0) #xe0)
(if (invalid? 3 ls)
-1
(bond (cdr ls) (bits-and (car ls) #x0f))))
((= (bits-and lead #xf8) #xf0)
(if (invalid? 4 ls)
-1
(bond (cdr ls) (bits-and (car ls) #x07))))
((= (bits-and lead #xfc) #xf8)
(if (invalid? 5 ls)
-1
(bond (cdr ls) (bits-and (car ls) #x03))))
((= (bits-and lead #xfe) #xfc)
(if (invalid? 6 ls)
-1
(bond (cdr ls) (bits-and (car ls) #x01))))
(else -1))))))
> (integer->char (utf-8->integer (integer->utf-8 (char->integer #\Z))))
#\Z
> (integer->char (utf-8->integer (integer->utf-8 (char->integer #\南))))
#\南
> (integer->char (utf-8->integer (integer->utf-8 (char->integer #\無))))
#\無
> (integer->char (utf-8->integer (integer->utf-8 (char->integer #\λ))))
#\λ
>
binary-buffer
binary-buffer は、numb-lambda の拡張機能で、標準 Scheme にはありません。これは、Java では、
byte 配列に相当し、C言語に例えると unsigned char の配列や malloc で確保したメモリ領域に相当します。中間コードコンパイラの実装では、中間コードやデータをこの領域に書き込み、プログラムを実行したりファイルに出力したりします。早速、REPLで実習してみましょう。
その前に、はじめに作成したコードを unicode.scm というファイル名でアップロードしておきますので、ダウンロードして、numb-lambda を動作させるディレクトリ（フォルダ）に保存してください。
numb-lambda を起動したら、この unicode.scm をロードします。
> (load "unicode.scm")
それでは、続けて
binary-buffer の使用例を示します。セミコロン (
;) から、行末まではコメントです。
> (define core (binary-buffer-create #x100000)) ;1Mバイトのバイナリバッファを確保します
> core
*binary-buffer*
> (binary-buffer-size core) ;サイズを取得します
1048576
> (binary-buffer-store! core #x00000 #x01234567 'tetra) ;4バイトの整数を格納します
> (binary-buffer-store! core #x00004 #x89abcdef 'tetra)
> (binary-buffer-store! core #x00008 #x03bb 'wyde) ;2バイトの整数を格納します
> (binary-buffer-store! core #x0000c #xce 'byte) ;1バイトの整数を格納します
> (binary-buffer-store! core #x0000d #xbb 'byte)
> (binary-buffer-load core #x00000 'tetra) ;4バイト読み出します
19088743
> (integer->hex-string (binary-buffer-load core #x00000 'tetra) 8) ;16進文字列に変換します
"#x01234567"
> (binary-buffer-load core #x00004 'tetra) ;MSBが立っていると符号はマイナスになります
-1985229329
> (integer->hex-string (binary-buffer-load core #x00004 'tetra) 8)
"#x89abcdef"
> ;2バイトの整数を読み出して、それを UNICODE と解釈し、文字に変換して表示する
(begin
(display
(integer->char (binary-buffer-load core #x00008 'wyde)))
(newline))
λ
> ; UTF-8 をデコードする
(integer->char
(utf-8->integer
(list (binary-buffer-load core #x0000c 'byte)
(binary-buffer-load core #x0000d 'byte))))
#\λ
> (binary-buffer-create n )n バイトのバイナリバッファを確保します。
(binary-buffer-size core )バイナリバッファのサイズを返します。
(binary-buffer-store! core offset val sym )バイナリバッファ core のオフセット offset に整数値 val を書き込みます。sym は、
byte, wyde, tetra のいずれかのシンボルを指定します。これは、バイナリバッファに書き込むバイト数を表しており、それぞれ、1, 2, 4 バイトを意味します。2バイト以上を書き込むときは、ビッグエンディアンとなっています。(binary-buffer-load core offset sym )バイナリバッファ core のオフセット offset から、整数値 val を読み込みます。sym は、
byte, wyde, tetra のいずれかのシンボルを指定します。これは、バイナリバッファから読み込むバイト数を表しており、それぞれ、1, 2, 4 バイトを意味します。バイナリバッファの内容をファイルに書き込む
次のサンプルコードを見てください。
(let ((port (open-file "binary.dat" "wb"))
(n 16))
(binary-write port core n)
(close-port port))
binary.dat というファイルが出来上がります。各関数を見ていきましょう。
(open-file path "wb")path で参照できるファイルをバイナリ書き込みモード（
wb）でオープンし、ポートを返します。(binary-write port core n )バイナリ書き込みモードでオープンしたポートに、core の先頭から n バイトのバイナリデータを書き込みます。
(close-port port )ポートをクローズします。
バイナリファイルの読み込み
次のサンプルコードを見てください。
> (define another-core (binary-buffer-create 16))
> ;
(let ((port (open-file "binary.dat" "rb"))
(n 16))
(binary-read port another-core n)
(close-port port))
> (integer->hex-string (binary-buffer-load another-core #x00000 'wyde) 8)
"#x00000123"
> (integer->hex-string (binary-buffer-load another-core #x00000 'tetra) 8)
"#x01234567"
> (integer->hex-string (binary-buffer-load another-core #x00004 'tetra) 8)
"#x89abcdef"
> (integer->hex-string (binary-buffer-load another-core #x0000c 'wyde) 4)
"#xcebb"
>
各関数を見ていきましょう。
(open-file path "rb")path をバイナリ読み込みモード（"rb"）でオープンしポートを返します。クローズする際には、
close-port を使うことができます。(binary-read port core n )ポート port から、バイナリバッファ core に、n バイト分のデータを読み込みます。
UNICODE基本多言語面の文字集合をファイルに書き込む
次のコードを使うと、UNICODE基本多言語面の文字集合全てをファイルに書き込むことができます。
(define char-start #x21)
(define char-stop #x10000)
(define line-max 40)
(define core-max
(let ((n (- char-stop char-start)))
(+ (* n 3) (* (quotient n line-max) 2))))
(load "unicode.scm")
(define core-fill
(lambda (core)
(let loop ((c char-start) (pos 0))
(if (>= c char-stop)
(cons core pos)
(loop (+ c 1)
(if (= c #x7f)
pos
(let loop ((u (integer->utf-8 c)) (pos pos))
(if (null? u)
(if (not
(zero?
(remainder
(- c -1 char-start (if (> c #x7f) 1 0))
line-max)))
pos
(begin
(binary-buffer-store! core pos #x0d 'byte)
(binary-buffer-store!
core (+ pos 1) #x0a 'byte)
(+ pos 2)))
(begin
(binary-buffer-store! core pos (car u) 'byte)
(loop (cdr u) (+ pos 1)))))))))))
(define write-core
(lambda (core-and-size path)
(let ((core (car core-and-size))
(size (cdr core-and-size))
(port (open-file path "wb")))
(binary-write port core size)
(close-port port))))
(write-core
(core-fill (binary-buffer-create core-max))
"utf8chars.txt")
以上、すべて、これまでに登場した関数やスペシャルフォームでできています。読み難いですか。確かに S 式は慣れないと読み難いことと思います。我が国において LISP ユーザーの裾野が広がらないのは、こういったことが理由になっているのでしょう。LISP を最初に設計したマッカーシー先生は、プログラマが S 式を書くことを想定していませんでした。M 式という人間に読み易い形式を設計していたのですが、プログラマが選択したのは、S 式の方でした。
これらの式をひとつづつ REPL に入力していくか、ファイルに落として
load することにより、utf8chars.txt という UNICODE ファイルが出来上がります。これは Windows のメモ帳 （notepad）などでオープンすることが出来ます。随分と奇妙な文字が多数あるのが確認できます。
中には点字も含まれています。注意として、フォントは UNICODE の文字セットをより多くサポートしたものを使うことです。例えば IPAフォントなどに設定するとよいと思います。
今回は以上です。次回からは、いよいよ中間コードコンパイラを作成するために試行錯誤をしていく予定です。参考文献として以下を利用します。これは、改訂版が出版されていますが、筆者の手元にある版を活用します。
コンパイラ Ｉ － 原理・技法・ツール －
著者 A.V.エイホ、R. セシィ、J.D.ウルマン
訳者 原田賢一
発行所 サイエンス社
ISBN 4-7819-0585-4
コンパイラ ＩＩ － 原理・技法・ツール －
著者 A.V.エイホ、R. セシィ、J.D.ウルマン
訳者 原田賢一
発行所 サイエンス社
ISBN 4-7819-0586-2