Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-01-03

Clojure 1.1のdo-templateをCLで

| 03:22 | Clojure 1.1のdo-templateをCLで - わだばLisperになる を含むブックマーク はてなブックマーク - Clojure 1.1のdo-templateをCLで - わだばLisperになる

no titleを観てみると、Clojure 1.1には色々と機能が追加されたみたいようです。

4つ位機能が紹介されていますが、do-templateはCommon Lispですぐ真似できそうだったので早速マクロを書いてみました。

(USE-PACKAGE :SHIBUYA.LISP)

(DEFUN SUBST* (NEWS OLDS TREE &KEY (TEST #'EQL TESTP) 
                                   (TEST-NOT #'EQL NOTP))
  (WHEN (AND TESTP NOTP)
    (ERROR ":TEST and :TEST-NOT were both supplied."))
  (IF (OR (ENDP NEWS) (ENDP OLDS))
      TREE
      (SUBST* (CDR NEWS) (CDR OLDS)
              (APPLY #'SUBST (CAR NEWS) (CAR OLDS) 
                     TREE (IF NOTP 
                              (LIST :TEST-NOT TEST-NOT)
                              (LIST :TEST TEST))))))

(DEFMACRO DO-TEMPLATE ((&REST VARS) EXPR &REST VALS)
  `(PROGN ,@(MAPCAR (CUT SUBST* <> VARS EXPR)
                    (GROUP VALS (LENGTH VARS)))))

使い方は、

(DO-TEMPLATE (NAME INC)

  (DEFUN NAME (N)
    (+ N INC))
  
  FOO 2
  BAR 3
  BAZ 4)

とテンプレートの定義を書くと、

(PROGN
  (DEFUN FOO (N) (+ N 2))
  (DEFUN BAR (N) (+ N 3))
  (DEFUN BAZ (N) (+ N 4)))

と展開されます。

マクロがあるのに、なんでわざわざという気もしますが、マクロのデザイン・パターンの一つとして考えれば、こういうのも悪くないかなと思いました。

Common Lispでは、do-templateは、

(MACROLET ((DE (NAME INC)
             `(DEFUN ,NAME (N)
                (+ N ,INC))))
  (DE FOO 2)
  (DE BAR 3)
  (DE BAZ 4))

とでも書けるかなと思います。

KMRCLを眺める (57) PRINT-FILE-CONTENTS

| 00:03 | KMRCLを眺める (57) PRINT-FILE-CONTENTS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (57) PRINT-FILE-CONTENTS - わだばLisperになる

lists.lispも読み終わったので次は何にしようと思いましたが、とりあえず手頃なところで入出力関係のio.lispを眺めて行くことにしました。

ということで、今回はKMRCLのio.lisp中からPRINT-FILE-CONTENTSです。

名前の通り、ファイルの中身をPRINTするというもので定義は、

(defun print-file-contents (file &optional (strm *standard-output*))
  "Opens a reads a file. Returns the contents as a single string"
  (when (probe-file file)
    (let ((eof (cons 'eof nil)))
      (with-open-file (in file :direction :input)
        (do ((line (read-line in nil eof)
                   (read-line in nil eof)))
            ((eq line eof))
          (write-string line strm)
          (write-char #\newline strm))))))

です。

動作は想像どおり、

(WITH-OUTPUT-TO-STRING (OUT)
  (PRINT-FILE-CONTENTS "/etc/motd" OUT))
;⇒ "Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64
;
;To access official Ubuntu documentation, please visit:
;http://help.ubuntu.com/
;
;"

です。

定義中の

((eof (cons 'eof nil)))

が何か妙な気がしますが、READ-LINEがEOFになった時に返すオブジェクト((EOF)というリスト)を作成しています。

呼ばれる度にconsされるので一意になる筈、ということなんだと思います(ということでeqで比較)が、たまにこういうスタイルを見かける気がします。

NILや:EOF、'eofでも特に問題に遭遇したことはないのですが、何かあったりするんでしょうか。(READなら色々あると思いますが…)

他のパターンでは、ストリームオブジェクトそのものを判定に使うというのがあるようです。

(with-open-file (in file :direction :input)
  (do ((line (read-line in nil in)
             (read-line in nil in)))
      ((eq line in))
    (write-string line strm)
    (write-char #\newline strm)))))

最初にこのやり方を聞いたときに、ナイスなアイデアだと思うと同時に、本当にそんなひねくれたことをする人がいるのか、と思いましたが、Common Lispプログラミング/Rodney-Brooksでも紹介されていた手法なので割と古くからあるスタイルなのかもしれません。