ジェネレータっぽいものを使ったループ

ジェネレータを使ったループっぽいものをcommon lispで実装してみた。
実装は適当で制限も多いけど、処理効率は(通常のループと同程度に)良い。

まず動作例。

;; 1: ".profile"の各行を出力する
(for (x (each-line ".profile"))
  (print x))
"# ~/.profile: executed by the command interpreter for login shells." 
"# This file is not read by bash(1), if ~/.bash_profile or ~/.bash_login" 
"# exists." 
"# see /usr/share/doc/bash/examples/startup-files for examples." 
"# the files are located in the bash-doc package." 
"" 
"# the default umask is set in /etc/profile; for setting the umask" 
"# for ssh logins, install and configure the libpam-umask package." 
"#umask 022" 
"" 
"# if running bash" 
"if [ -n \"$BASH_VERSION\" ]; then" 
"    # include .bashrc if it exists" 
"    if [ -f \"$HOME/.bashrc\" ]; then" 
"	. \"$HOME/.bashrc\"" 
"    fi" 
"fi" 
"" 
"# set PATH so it includes user's private bin if it exists" 
"if [ -d \"$HOME/bin\" ] ; then" 
"    PATH=\"$HOME/bin:$PATH\"" 
"fi" 
--> NIL


;; 2: 空行とコメント行を除いて出力する
(for (x (remove-empty-line (each-line ".profile")))
  (print x))
"if [ -n \"$BASH_VERSION\" ]; then" 
"    # include .bashrc if it exists" 
"    if [ -f \"$HOME/.bashrc\" ]; then" 
"	. \"$HOME/.bashrc\"" 
"    fi" 
"fi" 
"if [ -d \"$HOME/bin\" ] ; then" 
"    PATH=\"$HOME/bin:$PATH\"" 
"fi" 
--> NIL


;; 3: 行の文字数を付与
(for (x (add-length (remove-empty-line (each-line ".profile"))))
  (print x))
(31 "if [ -n \"$BASH_VERSION\" ]; then") 
(34 "    # include .bashrc if it exists") 
(35 "    if [ -f \"$HOME/.bashrc\" ]; then") 
(18 "	. \"$HOME/.bashrc\"") 
(6 "    fi") 
(2 "fi") 
(28 "if [ -d \"$HOME/bin\" ] ; then") 
(26 "    PATH=\"$HOME/bin:$PATH\"") 
(2 "fi") 
NIL

ジェネレータ(もどき)を使った場合は、通常のcommon lispのループと違って、処理を重ねてもネストが深くなることがないので、可動性が向上する。
気がする。

以降はforおよびジェネレータの定義マクロの定義。
例を除けば20行弱。

;; 補助関数: body内の現れるvarsをvalsに置換する
(defun eval-bindings (vars vals body)  
  (loop FOR var IN vars
        FOR val IN vals
    DO
    (setf body (subst val var body))
    FINALLY
    (return body)))
;; ex:
;; (eval-bindings '(a b c) '(1 2 3) '(+ a b c))
;; --> (+ 1 2 3)

;; ジェネレータの定義マクロ
;; - ジェネレータの定義は通常の関数とほぼ同様。
;; - 本体に(yield val)式があった場合は、その箇所でループの本体に処理が移譲される。
(defmacro define-generator (name args body) 
  `(defun ,name ,args 
     (eval-bindings ',args (list ,@args) ',body))) 

;; ジェネレータが生成した値のフィルタの定義マクロ  ※ 実際にはフィルタ + マッピング
;; - 定義は、引数が一つ(ジェネレータが生成した値)に限定されること以外は、ジェネレータと同様
(defmacro define-filter (name (arg) body)
  `(defun ,name (,arg)
     (subst '(lambda (,arg) ,body)
            'yield
            ,arg)))

;; forマクロ
(defmacro for ((var generator) &body body)
  (subst `(lambda (,var) ,@body)
         'yield
         (eval generator)))

最初の例で使用したジェネレータの定義。

;; ファイルの各行を読み込むためのジェネレータ
(define-generator each-line (pathname)
  (with-open-file (in pathname)
    (loop FOR line = (read-line in nil nil)
          WHILE line
      DO
      (yield line))))
;; ex:
;; (each-line ".profile")
;; --> (WITH-OPEN-FILE (IN ".profile")
;;         (LOOP FOR LINE = (READ-LINE IN NIL NIL)
;;               WHILE LINE
;;               DO (YIELD LINE)))  ; <- forマクロは、このyieldの部分をsubst関数でループ本体に置換することでジェネレータ的な動作を模倣している

;; 空行 + コメント行を除外するフィルタ
(define-filter remove-empty-line (line)
  (when (and (plusp (length line))
             (not (char= #\# (char line 0))))
    (yield line)))
;; ex:
;; (remove-empty-line (each-line ".profile"))
;; --> (WITH-OPEN-FILE (IN ".profile")
;;       (LOOP FOR LINE = (READ-LINE IN NIL NIL)
;;             WHILE LINE
;;          DO ((LAMBDA (LINE)  ; <- (each-line ".profile")でyieldだった部分が、remove-empty-lineの本体で置換されている
;;                 (WHEN (AND (PLUSP (LENGTH LINE)) (NOT (CHAR= #\# (CHAR LINE 0))))
;;                    (YIELD LINE)))  ; <- 代わりにyieldはここに移動 (remove-empty-lineのyield)
;;               LINE)))


;; 行の文字列追加用
(define-filter add-length (line)
  (yield (list (length line) line)))


;;;;
;; マクロ展開例
(macroexpand-1 
  '(for (x (add-length 
             (remove-empty-line 
               (each-line ".profile"))))
     (print x)))

-->
(WITH-OPEN-FILE (IN ".profile")    
  (LOOP FOR LINE = (READ-LINE IN NIL NIL)
        WHILE LINE
        DO ((LAMBDA (LINE)
              (WHEN (AND (PLUSP (LENGTH LINE)) (NOT (CHAR= #\# (CHAR LINE 0))))
                ((LAMBDA (LINE)
                   ((LAMBDA (X) (PRINT X)) (LIST (LENGTH LINE) LINE)))
                 LINE)))
            LINE)))


;; 同じ処理を普通のループ等を使って書いた場合
(with-open-file (in ".profile") ; (each-line ".profile")
  (loop FOR line = (read-line in nil nil)  
        WHILE line
    DO
    (when (and (plusp (length line))  ; (remove-empty-line ...)
               (not (char= #\# (char line 0))))
      (let ((x (list (length line) line)))  ; (add-length ...)
        (print x)))))

追記(2011/04/19): もう少し安全に

最初の版ではyield部分をsubst関数を使って処理本体のS式に置換していた。
この方法だとyieldシンボルが現れる文脈を考慮しないので、ループとは無関係な箇所まで変換してしまう危険性がある。
そのため、以下のように明示的な変数の束縛を使う方法に変更。

(defmacro define-generator (name args body) 
  `(defun ,name ,args 
     `(let ,(mapcar #'list ',args (list ,@args))
        ,',body)))

(defmacro define-filter (name (arg) body)
  `(defun ,name (,arg)
     `(flet ((yield (,',arg) ,',body))
        (declare (inline yield))
        ,,arg)))

(defmacro for ((var generator) &body body)
  `(flet ((yield (,var) ,@body))
     (declare (inline yield))
     ,(eval generator)))

マクロ展開後の可読性は下がるが、こちらの方がずっと安全。

;; ジェネレータの定義は変わらず
(define-generator each-line (pathname)
  (with-open-file (in pathname)
    (loop FOR line = (read-line in nil nil)
          WHILE line
      DO
      (yield line))))

(define-filter remove-empty-line (line)
  (when (and (plusp (length line))
             (not (char= #\# (char line 0))))
    (yield line)))

(define-filter add-length (line)
  (yield (list (length line) line)))

;;;;;
;; 使用例
(for (x (add-length 
             (remove-empty-line 
               (each-line ".profile"))))
     (print x))
(31 "if [ -n \"$BASH_VERSION\" ]; then") 
(34 "    # include .bashrc if it exists") 
(35 "    if [ -f \"$HOME/.bashrc\" ]; then") 
(18 "	. \"$HOME/.bashrc\"") 
(6 "    fi") 
(2 "fi") 
(28 "if [ -d \"$HOME/bin\" ] ; then") 
(26 "    PATH=\"$HOME/bin:$PATH\"") 
(2 "fi") 
--> NIL

;;;;;
;; 展開例
(macroexpand-1 
  '(for (x (add-length 
             (remove-empty-line 
               (each-line ".profile"))))
     (print x)))
--> (FLET ((YIELD (X)
             (PRINT X)))
      (DECLARE (INLINE YIELD))
      (FLET ((YIELD (LINE)
               (YIELD (LIST (LENGTH LINE) LINE))))
        (DECLARE (INLINE YIELD))
        (FLET ((YIELD (LINE)
                 (WHEN (AND (PLUSP (LENGTH LINE)) (NOT (CHAR= #\# (CHAR LINE 0))))
                   (YIELD LINE))))
          (DECLARE (INLINE YIELD))
          (LET ((PATHNAME ".profile"))
                (WITH-OPEN-FILE (IN PATHNAME)
              (LOOP FOR LINE = (READ-LINE IN NIL NIL)
                    WHILE LINE
                    DO (YIELD LINE)))))))