CommonLispでREPLを使った開発

2015-02-13 · 2768 文字 · 6 分くらいで読めます

Common Lisp

Programming · Common Lisp

tamuraです。

動機

REPLを使った開発がどれくらい効率が良いか実際にやってみました。

例としてbase64エンコーダを作っていきます。ロジックはウィキペディアに書いてあります。 http://ja.wikipedia.org/wiki/Base64

一度qiitaにもbase64エンコーダを書いたのですが無駄が多かったため作り直しました。 (http://qiita.com/tamurashingo@github/items/fd3a56b0d6b8d40ed74c)

文字列を数値の列にしたい

文字を数値に変換するのは char-code が使えます。ここら辺は適当にググリます。

CL-USER> (char-code #\\a)
97

文字列をコードの列にするにはmap系を使えば良さそうです。

CL-USER> (mapcar #'char-code "abc")
The value "abc" is not of the expected type LIST.
   [Condition of type TYPE-ERROR]

; Evaluation aborted on #<TYPE-ERROR #x2100E7FB3D>.

mapcarはリストにしか使えないのでmapを使います。

CL-USER> (map 'list #'char-code "abcdef")
(97 98 99 100 101 102)

ビット演算をしたい

先頭の6ビットの取り出し

まず先頭の6ビットを取り出します。たぶんldbとbyteを組み合わせて使うはずです。 http://www.gigamonkeys.com/book/practical-parsing-binary-files.html ここらへんとかを見た感じだと。

CL-USER> (format nil "~8,'0b" 97)
"01100001"

ここから 011000 を抜き出したいです。

下2桁を除けばいいので

CL-USER> (ldb (byte 8 2) 97)
24
CL-USER> (format nil "~6,'0b" (ldb (byte 8 2) 97))
"011000"

でいけました。

次の6ビットの取り出し

97の先頭6ビットを抜き出すと残りは2ビットなので、次の文字を持ってきます。

残りの2ビットの取り出し

CL-USER> (ldb (byte 2 0) 97)
1
CL-USER> (format nil "~2,'0b" (ldb (byte 2 0) 97))
"01"

次のビットとの合成

残りの2ビットは8ビット分左へシフトします。そして論理和を取れば10ビットになります。

CL-USER> (logior (ash (ldb (byte 2 0) 97) 8)
                 98)
354
CL-USER> (format nil "~10,'0b" (logior (ash (ldb (byte 2 0) 97) 8)
                                       98))
"0101100010"

先頭6ビットの取得

CL-USER> (ldb (byte 10 4) 354)
22
CL-USER> (format nil "~6,'0b" (ldb (byte 10 4) 354))
"010110"

のこりはこうなります。

CL-USER> (ldb (byte 4 0) 354)
2
CL-USER> (format nil "~4,'0b" (ldb (byte 4 0) 354))
"0010"

複数の文字を処理したい

以上の結果から

先頭6ビットの取り出し

(ldb (byte ビット長 (- ビット長 6)) 全ビット)

残り

(ldb (byte (- ビット長 6) 0) 全ビット)

でループさせれば複数の文字を処理できそうです。

(loop for ch in (map 'list #'char-code "abc")
      for buf = ch then (logior (ash buf 8) ch)
      for bitlen = 8 then (+ bitlen 8)
      do (loop for i from 1 to (/ bitlen 6)
               :do
                 (let* ((remain (- bitlen 6))
                        ;; 先頭6ビット
                        (6bit (ldb (byte bitlen remain) buf)))
                   ;; 6ビット表示
                   (format t "~6,'0b(~d)~%" 6bit 6bit)
                   ;; 残り
                   (setf buf (ldb (byte remain 0) buf))
                   (setf bitlen (- bitlen 6)))))

こんな感じに

CL-USER> (loop for ch in (map 'list #'char-code "abc")
            for buf = ch then (logior (ash buf 8) ch)
            for bitlen = 8 then (+ bitlen 8)
            do (loop for i from 1 to (/ bitlen 6)
                  do
                    (let* ((remain (- bitlen 6))
                           ;; 先頭6ビット
                           (6bit (ldb (byte bitlen remain) buf)))
                      ;; 6ビット表示
                      (format t "~6,'0b(~d)~%" 6bit 6bit)
                      ;; 残り
                      (setf buf (ldb (byte remain 0) buf))
                      (setf bitlen (- bitlen 6)))))

011000(24)
010110(22)
001001(9)
100011(35)
NIL

あまりに対応したい

3文字だったら 8 x 3 = 24 → 24 / 6 = 4 であまりが出ませんが、2文字等の場合はあまりが出ます。あまりが出たら0で埋めて6bitにする必要があります。

bitlenが1の場合 -> 5bitシフト bitlenが2の場合 -> 4bitシフト … (ash buf (- 6 bitlen)) すればよさそうです。

CL-USER> (format nil "~6,'0b" (ash #b1 (- 6 1)))
"100000"
CL-USER> (format nil "~6,'0b" (ash #b01 (- 6 2)))
"010000"
CL-USER> (format nil "~6,'0b" (ash #b010 (- 6 3)))
"010000"
CL-USER> (format nil "~6,'0b" (ash #b0101 (- 6 4)))
"010100"
CL-USER> (format nil "~6,'0b" (ash #b01011 (- 6 5)))
"010110"
CL-USER> (format nil "~6,'0b" (ash #b010111 (- 6 6)))
"010111"

CL-USER> (loop for ch in (map 'list #'char-code "abcdefg")
            for buf = ch then (logior (ash buf 8) ch)
            for bitlen = 8 then (+ bitlen 8)
            do (loop for i from 1 to (/ bitlen 6)
                  do
                    (let* ((remain (- bitlen 6))
                           ;; 先頭6ビット
                           (6bit (ldb (byte bitlen remain) buf)))
                      ;; 6ビット表示
                      (format t "~6,'0b(~d)~%" 6bit 6bit)
                      ;; 残り
                      (setf buf (ldb (byte remain 0) buf))
                      (setf bitlen (- bitlen 6))))
            finally
              ;; あまりが発生したら末尾に0を埋めて6ビットにする
              (when (/= bitlen 0)
                (format t "~6,'0b[~d]~%" (ash buf (- 6 bitlen)) (ash buf (- 6 bitlen)))))

011000(24)
010110(22)
001001(9)
100011(35)
011001(25)
000110(6)
010101(21)
100110(38)
011001(25)
110000[48]
NIL

数値を文字に変換したい

次はこれを文字列にします。 0 -> A 1 -> B という変換なので配列を用意してそこに添え字えアクセスするような形式で取ってくれば良さそうです。これは aref を使えばできます。

CL-USER> (aref "abc" 0)
#\a
CL-USER> (aref "abc" 1)
#\b
CL-USER> (flet ((to-enc (x)
                  (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x)))
           (loop for ch in (map 'list #'char-code "abcdefg")
              for buf = ch then (logior (ash buf 8) ch)
              for bitlen = 8 then (+ bitlen 8)
              do (loop for i from 1 to (/ bitlen 6)
                    do
                      (let* ((remain (- bitlen 6))
                             ;; 先頭6ビット
                             (6bit (ldb (byte bitlen remain) buf)))
                        ;; 文字化
                        (format t "~c" (to-enc 6bit))
                        ;; 残り
                        (setf buf (ldb (byte remain 0) buf))
                        (setf bitlen (- bitlen 6))))
              finally
              ;; あまりが発生したら末尾に0を埋めて6ビットにする
                (when (/= bitlen 0)
                  (format t "~c" (to-enc (ash buf (- 6 bitlen)))))))

YWJjZGVmZw
NIL

ここまでformatで標準出力に出していたのですが値を保持するように修正します。

(flet ((to-enc (x)
         (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x)))
  (let ((enc '()))
    (loop for ch in (map 'list #'char-code "abcdefg")
          for buf = ch then (logior (ash buf 8) ch)
          for bitlen = 8 then (+ bitlen 8)
          do (loop for i from 1 to (/ bitlen 6)
                do
                  (let* ((remain (- bitlen 6))
                         ;; 先頭6ビット
                         (6bit (ldb (byte bitlen remain) buf)))
                    ;; 文字化
                    (push (to-enc 6bit) enc)
                    ;; 残り
                    (setf buf (ldb (byte remain 0) buf))
                    (setf bitlen (- bitlen 6))))
          finally
          ;; あまりが発生したら末尾に0を埋めて6ビットにする
            (when (/= bitlen 0)
              (push (to-enc (ash buf (- 6 bitlen))) enc)))
    (nreverse enc)))

4文字区切りに対応させたい

base64エンコードは最後に4文字区切りにしてあまりを=で補うため、YWJjZGVmZwはYWJjZGVmZw==と補正されなくてはいけません。

このときは - 1文字 -> === - 2文字 -> == - 3文字 -> = こうなってほしいです。

4で割ったあまりで4から引けば行けそうです。

CL-USER> (- 4 (mod 1 4))
3
CL-USER> (- 4 (mod 2 4))
2
CL-USER> (- 4 (mod 3 4))
1
CL-USER> (- 4 (mod 4 4))
4
CL-USER> (- 4 (mod 0 4))
4

ああ、いけませんでした。0や4のときは0になってほしいのに4になってしまっています。単純化しようとして失敗です。

じつはmodにマイナスを渡すとできたりします。 https://www.cs.cmu.edu/Groups/AI/html/hyperspec/HyperSpec/Body/funmodcmrem.html

CL-USER> (mod -1 4)
3
CL-USER> (mod -2 4)
2
CL-USER> (mod -3 4)
1
CL-USER> (mod -0 4)
0
CL-USER> (mod -4 4)
0

指定された回数分 = を表示してやればOKです。

CL-USER> (format nil "~{~C~}" '(#\= #\=))
"=="
CL-USER> (format nil "~{~C~}" (make-sequence 'list 3 :initial-element #\=))
"==="
CL-USER> (format nil "~{~C~}" (make-sequence 'list (mod -1 4) :initial-element #\=))
"==="

こんな感じの関数になれば良さそうです。

(lambda (enc-list)
  (let ((pad-len (mod (- (length enc-list)) 4)))
    (format nil "~{~C~}~{~C~}" enc-list
                               (make-sequence 'list pad-len :initial-element #\=))))
CL-USER> (funcall #'(lambda (enc-list)
                      (let ((pad-len (mod (- (length enc-list)) 4)))
                        (format nil "~{~C~}~{~C~}" enc-list
                                                   (make-sequence 'list pad-len :initial-element #\=))))
                  '(#\a #\b #\c))

"abc="
CL-USER> (funcall #'(lambda (enc-list)
                      (let ((pad-len (mod (- (length enc-list)) 4)))
                        (format nil "~{~C~}~{~C~}" enc-list
                                                   (make-sequence 'list pad-len :initial-element #\=))))
                  '(#\a #\b #\c #\d))

"abcd"
CL-USER> (funcall #'(lambda (enc-list)
                      (let ((pad-len (mod (- (length enc-list)) 4)))
                        (format nil "~{~C~}~{~C~}" enc-list
                                                   (make-sequence 'list pad-len :initial-element #\=))))
                  '(#\a #\b #\c #\d #\e))

"abcde==="

先ほどの処理に組み込みます

(flet ((to-enc (x)
         (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x))
       (pad (enc-list)
         (let ((pad-len (mod (- (length enc-list)) 4)))
           (format nil "~{~C~}~{~C~}" enc-list
                                      (make-sequence 'list pad-len :initial-element #\=)))))
  (let ((enc '()))
    (loop for ch in (map 'list #'char-code "abcdefg")
          for buf = ch then (logior (ash buf 8) ch)
          for bitlen = 8 then (+ bitlen 8)
          do (loop for i from 1 to (/ bitlen 6)
                do
                  (let* ((remain (- bitlen 6))
                         ;; 先頭6ビット
                         (6bit (ldb (byte bitlen remain) buf)))
                    ;; 文字化
                    (push (to-enc 6bit) enc)
                    ;; 残り
                    (setf buf (ldb (byte remain 0) buf))
                    (setf bitlen (- bitlen 6))))
          finally
          ;; あまりが発生したら末尾に0を埋めて6ビットにする
            (when (/= bitlen 0)
              (push (to-enc (ash buf (- 6 bitlen))) enc)))
    (pad (nreverse enc))))

実行してみます。

CL-USER> (flet ((to-enc (x)
                  (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x))
                (pad (enc-list)
                  (let ((pad-len (mod (- (length enc-list)) 4)))
                    (format nil "~{~C~}~{~C~}" enc-list
                                               (make-sequence 'list pad-len :initial-element #\=)))))
           (let ((enc '()))
             (loop for ch in (map 'list #'char-code "abcdefg")
                for buf = ch then (logior (ash buf 8) ch)
                for bitlen = 8 then (+ bitlen 8)
                do (loop for i from 1 to (/ bitlen 6)
                      do
                        (let* ((remain (- bitlen 6))
                               ;; 先頭6ビット
                               (6bit (ldb (byte bitlen remain) buf)))
                          ;; 文字化
                          (push (to-enc 6bit) enc)
                          ;; 残り
                          (setf buf (ldb (byte remain 0) buf))
                          (setf bitlen (- bitlen 6))))
                finally
                ;; あまりが発生したら末尾に0を埋めて6ビットにする
                  (when (/= bitlen 0)
                    (push (to-enc (ash buf (- 6 bitlen))) enc)))
             (pad (nreverse enc))))

"YWJjZGVmZw=="

よさそうです。

関数にしたい

引数をstrとして関数にしてみます。

(defun base64-enc (str)
  (flet ((to-enc (x)
           (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x))
         (pad (enc-list)
           (let ((pad-len (mod (- (length enc-list)) 4)))
             (format nil "~{~C~}~{~C~}" enc-list
                                        (make-sequence 'list pad-len :initial-element #\=)))))
    (let ((enc '()))
      (loop for ch in (map 'list #'char-code str)
            for buf = ch then (logior (ash buf 8) ch)
            for bitlen = 8 then (+ bitlen 8)
            do (loop for i from 1 to (/ bitlen 6)
                  do
                    (let* ((remain (- bitlen 6))
                           ;; 先頭6ビット
                           (6bit (ldb (byte bitlen remain) buf)))
                      ;; 文字化
                      (push (to-enc 6bit) enc)
                      ;; 残り
                      (setf buf (ldb (byte remain 0) buf))
                      (setf bitlen (- bitlen 6))))
            finally
            ;; あまりが発生したら末尾に0を埋めて6ビットにする
              (when (/= bitlen 0)
                (push (to-enc (ash buf (- 6 bitlen))) enc)))
      (pad (nreverse enc)))))

ユニットテストをしたい

テストを書きます。 base64エンコードの結果は https://www.base64encode.org/ ここの結果を使っています。

まずは与える引数と期待する結果のリストです。

CL-USER> (setf test-list '(("a"       . "YQ==")
                           ("ab"      . "YWI=")
                           ("abc"     . "YWJj")
                           ("abcd"    . "YWJjZA==")
                           ("abcde"   . "YWJjZGU=")
                           ("abcdef"  . "YWJjZGVm")
                           ("abcdefg" . "YWJjZGVmZw==")))

(("a" . "YQ==") ("ab" . "YWI=") ("abc" . "YWJj") ("abcd" . "YWJjZA==") ("abcde" . "YWJjZGU=") ("abcdef" . "YWJjZGVm") ("abcdefg" . "YWJjZGVmZw=="))

こいつをループで回します。

CL-USER> (loop for (arg . expect) in test-list
            do
              (let ((result (string= (base64-enc arg) expect)))
                (format t "testing  ~A -> ~A ... ~:[NG~;OK~]~%" arg expect result)))

;Compiler warnings :
;   In an anonymous lambda form: Undeclared free variable TEST-LIST
testing  a -> YQ== ... OK
testing  ab -> YWI= ... OK
testing  abc -> YWJj ... OK
testing  abcd -> YWJjZA== ... OK
testing  abcde -> YWJjZGU= ... OK
testing  abcdef -> YWJjZGVm ... OK
testing  abcdefg -> YWJjZGVmZw== ... OK
NIL

すべてOKです。

動機