マクロを書く練習

LET OVER LAMBDA 邦訳版を読んだため，マクロをうまく書けるようになりたい気持ちが沸いてきた．
ということで，練習がてらに書いてみる．

;;;引数の個数によって動作を変えるlambda
(defmacro olambda (&body body)
(let ((args (gensym "olambda-args")))
`(lambda (&rest ,args)
   (case (length ,args)
     ,@(mapcar
   #'(lambda (clause)
       `(,(if (listp (car clause))
       (length (car clause))
       t)
   (destructuring-bind ,(car clause)
       ,args
     ,@(cdr clause))))
   body)))))

LOLに載っていたdlambdaのパクリっぽい．
dlambdaとの違いはキーワード引数ではなくて引数の数で動作を変えること．
lambdaに一文字足した名前にしようと思い，overloadのoを選んでみた．
以下，動作結果．

;;;引数すべての平均値を求める
>(defparameter avg
  (olambda
    (() 0)  ;引数がなければ0を返す
    ((x) x) ;引数が1つならばそのまま返す
    ;;2つ以上引数があれば計算して返す
    (args (/ (apply #'+ args) (length args)))))

>(funcall avg)
0

>(funcall avg 5)
5

>(funcall avg 1 2 3 4 5)
3

>(macroexpand-1
  '(olambda
    (() 0)
    ((x) x)
    (args (/ (apply #'+ args) (length args)))))
(LAMBDA (&REST #:|olambda-args1425|)
(CASE (LENGTH #:|olambda-args1425|)
  (0 (DESTRUCTURING-BIND () #:|olambda-args1425| 0))
  (1 (DESTRUCTURING-BIND (X) #:|olambda-args1425| X))
  (T
    (DESTRUCTURING-BIND ARGS
      #:|olambda-args1425|
    (/ (APPLY #'+ ARGS) (LENGTH ARGS))))))

一応考えているとおりに動いてそうだ．

波うさぎ

本日の酒はこちら．

• 冷酒仕立て　本醸造　波うさぎ(長陵醸造元 高橋酒造株式会社/新潟)

五百万石使用,日本酒度+3,酸度1.2とのこと．
ラベルに「白魚が　冷酒グラスの　紅を拭き」とある．
白魚は春の季語らしいが，目の前にあるので夏場だろうと気にせずにぐいっと．

リーダマクロでドット区切りなメソッド呼び出し風な何か

酔った勢いでリーダマクロを書いた．
(foo bar piyo)をbar.foo(piyo)と書けるようにしてみた．
次の朝にはコードを理解できない可能性が高い．

(defun dot-reader (stream ch1 ch2)
  (declare (ignore ch1 ch2))
  (cons
   'progn
   (merge-method-invokation-sexp
    (convert-to-method-invokation   
     (mapcar
      #'convert-to-dot-exp
      (read-delimited-list #\] stream))))))
    

(defun convert-to-dot-exp (sexp)
  (cond
    ((listp sexp)
     (mapcar #'convert-to-dot-exp sexp))
    ((symbolp sexp)
     (convert-symbol-to-dot-exp sexp))
    (t sexp)))

(defun merge-method-invokation-sexp (sexp &optional prev)
  (if (null sexp)
      ;;終端
      (if prev (list prev) nil)
      (let ((fst (car sexp)))
 (if (listp fst)
     (case (car fst)
       (:method-invoke
        (append
  (if prev (list prev) nil)
  (merge-method-invokation-sexp
   (cdr sexp)
   `(,(third fst)
      ,(second fst)
      ,@(nthcdr 3 fst)))))
       (:dot
        (merge-method-invokation-sexp
  (cdr sexp)
  `(,(second fst)
     ,prev
     ,@(nthcdr 2 fst)) ))
       (t
        (append
  (if prev (list prev) nil)  
  (merge-method-invokation-sexp
   (cdr sexp)
   fst))))
     (append
      (if prev (list prev) nil)  
      (merge-method-invokation-sexp
       (cdr sexp)
       fst))))))

(defun convert-to-method-invokation (sexp)
  (if (not (listp sexp)) sexp
      (loop
  :for rest = sexp then (if (and (listp o)
     (or (eq (car o) :dot)
         (eq (car o) :method-invoke)))
       (cddr rest)
       (cdr rest))
  :for o = (car rest)
  :while rest
  :collect
  (if (and (listp o)
    (or (eq (car o) :dot)
        (eq (car o) :method-invoke)))
      (append o (second rest))
      o))))

(defun convert-symbol-to-dot-exp (sym)
  (let ((str (symbol-name sym)))
    (let ((pos (position #\. str)))
      (if (not pos)
   sym
   (if (= pos 0)
       (list :dot
      (convert-symbol-to-dot-exp
       (intern (subseq str 1))))
       (list
        :method-invoke
        (read-from-string (subseq str 0 pos))
        (convert-symbol-to-dot-exp
  (intern (subseq str (1+ pos))))))))))
   
(set-macro-character #\] (get-macro-character #\)))
(set-dispatch-macro-character #\# #\[ 'dot-reader)

なんとなく動くひどいコード．
酔ってなくてもこのくらいしか書けないレベルですが．
目が覚めて気になったら書きなおそう．

以下実行結果．

>#[(loop :for i from 0 to 10 :collect i).elt(1)]
1
>#[(defparameter a #\0) a.char-code().+(9).code-char()]
#\9

黒龍

今日は刺身をつまみに日本酒を飲んだ．

• 黒龍　大吟醸　龍(黒龍酒造株式会社/福井)

飲みやすいので調子に乗って飲みすぎそうだ．次の日が怖い．

closure-xml

Common LispのXML,HTMLパーサライブラリに，Closure XML Parserとその仲間たち(stp,chtml等)がある．
asdf-installでインストールできるので楽ちん．
htmlをパースするならこのようにしてパースできるようだ．

;;リストにして返す
(chtml:parse #p"./hoge.html" (chtml:make-lhtml-builder))

;;DOMっぽいもの(CXML-STP)に利用できるオブジェクトを返す
(chtml:parse #p"./hoge.html" (stp:make-builder))

ドキュメントがしっかり書かれているようなので，英語で挫けなければ便利に使えそう．

Ironclad

目に付いたCommonLispのライブラリを挙げてみる．
１回目のネタは最近出会った暗号ライブラリのIronclad．CLikiからホームページに飛べるし，ASDF-INSTALLでいれられる．
ホームページのドメインがmethod-combination.netってのがまた括弧良い．
様々な暗号化やダイジェスト関数（ハッシュ関数）を扱うことのできるライブラリで，暗号化はmake-cipherとencrypt,decryptを使い，ダイジェスト関数には'High-level convenience function'としてdigest-sequenceなどの関数があるので，単純にハッシュ値を求めたいときはこいつを使えばよさそう．