2011-08-31

16進ダンプ

REPLから使いたくなって書いた。

(defun hex-dump (seq &key (address-length 8) (address-offset 0))
(labels ((x->char (x)
(let ((c (code-char x)))
(if (and (standard-char-p c) (graphic-char-p c)) c #\.)))
(x->str (l)
(coerce (mapcar #'x->char l) 'string))
(print-header ()
(princ (make-string address-length :initial-element #\=))
(let ((l '#.(loop for n below 16 collect n)))
(format t "== ~{+~x ~}=================~%" l)))
(print-address (i)
(format t (format nil "~~~a,'0x : " address-length)
(+ address-offset i)))
(print-byte (b)
(format t "~2,'0x " b))
(print-text (l)
(format t "| ~a~%" (x->str l)))
(print-padding (n)
(princ (make-string (* n 3) :initial-element #\space)))
(reduce-fn (state byte)
(destructuring-bind (col row txt) state
(when (and (zerop col) (zerop (mod row 10)))
(print-header))
(when (zerop col)
(print-address (* row 16)))
(print-byte byte)
(when (= col 15)
(print-text (nreverse txt)))
(if (= col 15)
(list 0 (1+ row) nil)
(list (1+ col) row (cons byte txt))))))
(fresh-line)
(destructuring-bind (col row txt)
(reduce #'reduce-fn seq :initial-value (list 0 0 nil))
(declare (ignore row))
(unless (zerop col)
(print-padding (- 16 col))
(print-text (nreverse txt))))
(fresh-line)))
view raw gistfile1.lisp hosted with ❤ by GitHub

使い方は以下の通り。(unsigned-byte 8)を要素に持つシーケンスを扱える。十行ごとにヘッダが入り、アドレス表示部分は長さ(標準で8桁)とオフセットを指定できる。テキスト表示部分はstandard characterかつgraphicな文字だけ表示できる。

> (hex-dump (sb-ext:string-to-octets "string"))
========== +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F =================
00000000 : 73 74 72 69 6E 67                               | string
NIL
>

2011-08-05

cl-fn

昨日のdefaliasだけど、似たようなコードを発見した。

Ron Garretユーティリティライブラリで、

(defmacro define-synonym (s1 s2)
  `(progn
     (defun ,s1 (&rest args) (declare (ignore args)))
     (setf (symbol-function ',s1) (function ,s2))))

という関数を定義してた。

何度か目を通してるはずなのに何故気付かなかったんだ、と一瞬後悔したけど、良く見たらs2を直接function特殊形式に渡してる。これだと、関数名lambda式以外を渡すことが許されないので、純粋に別名を付けるためだけを目的としたもののようだ。セーフ。こちらの主な目的は関数合成とかの結果に名前を付けることだから、上のコードは使えない。

安心した所で、無駄にならなかったdefaliasを、関数を扱うときに良く使われるユーティリティ関数とまとめてcl-fnというライブラリにした。ついでに、lambdaを書くのに疲れてきたので、前述のRon Garretのユーティリティからfnというマクロも貰ってきた。

;; &restを使わずに引数全体を束縛できる
(funcall (fn args args) 0 1 2)
;=> (0 1 2)

;; _で引数を無視できる(警告が出ないように宣言も付く)
(funcall (fn (x _) x) 0 1)
;=> 0

なんてことができるちょっと賢いやつ。ただし、リーダには手を入れないので、

((fn (x) x) 0)

みたいなことはできない。直接lambda式を呼びたいことなんてあんまりないから問題ないとは思うけど。

ちなみに、使いたい機能だけ楽にインポートできるように、パッケージを細かく分けておいた。例えば、curryとrcurryだけ使いたい場合は、cl-fn.paパッケージだけ使えば大丈夫。全部入りが欲しいならcl-fnを使う。余分なものまでインポートしなくて良いので綺麗好きな人でも安心。

2011-08-04

defalias

Emacs Lispには、関数に別名を付けるdefaliasという関数があるんだけど、これが欲しくなったので書いてみた。

(defmacro defalias (name function-designator)
  (with-gensyms (function designator)
    `(let* ((,designator ,function-designator)
            (,function (if (functionp ,designator)
                           ,designator
                           (symbol-function ,designator))))
       (setf (symbol-function ',name) ,function)
       ',name)))

マクロにしたのはクォートを付けるのが面倒だから。第二引数はfunction designatorなので、シンボルでも関数でも大丈夫。

普通に別名を付けることもできるけど、考えている主な使い所は、合成したり部分適用した関数に名前を付けたりするとき。

;; これを
(setf (symbol-function '2*)
      (curry #'* 2))

;; こう書ける
(defalias 2* (curry #'* 2))

(2* 3)  ;=> 6

他にも誰かが似たようなものを作ってそうだったから探してみたんだけど、見付けられなかった。