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 |

2008-03-22

read-lineが多値を返すのを有効利用したい

| 13:36 | read-lineが多値を返すのを有効利用したい - わだばLisperになる を含むブックマーク はてなブックマーク - read-lineが多値を返すのを有効利用したい - わだばLisperになる

何気なくLispマシン(LMI Lambda)のソースコードを眺めていたのですが、

(DEFUN SXHASH-FILE (FILENAME &OPTIONAL &KEY (CHUNK-SIZE 1024))
  (LET ((BUFFER (MAKE-STRING CHUNK-SIZE)))
    (WITH-OPEN-FILE (INPUT FILENAME)
      (DO ((END)
           (EOFP)
           (HASHSUM 0 (PROGN (MULTIPLE-VALUE-SETQ (END EOFP) (SEND INPUT :STRING-IN NIL BUFFER))
                             (COMPILER::%SXHASH-SUBSTRING BUFFER #o377 0 END))))
          (EOFP
           HASHSUM)))))

というコードに遭遇しました。

DOで入出力のループを回すと、read系の関数を2回書くことになったりするのが、DO派の悩みですが、この方法だと1回で済み、また、ループから抜ける判定も同時にこなしてるのが、何だか素敵なので真似して他に応用できないか考えてみることにしました。

とはいえ、

(SEND INPUT :STRING-IN NIL BUFFER)

がFlavors(CLOS以前にメジャーだったオブジェクトシステム)なのが問題で、憶測ですが、bufferに値をセットして、返り値は、ファイルポジションと、EOFに遭遇したか否かを多値で返すとか、そんな感じじゃないでしょうか。

(DEFUN SXHASH-FILE (FILENAME &OPTIONAL &KEY (CHUNK-SIZE 1024))
  (with-output-to-string (BUFFER)
    (WITH-OPEN-FILE (INPUT FILENAME)
      (DO ((END)
           (EOFP)
           (HASHSUM 0 (PROGN (MULTIPLE-VALUE-SETQ (END EOFP) (read-line input nil))
                             (COMPILER::%SXHASH-SUBSTRING BUFFER #o377 0 END))))
          (EOFP
           HASHSUM)))))

みたいな。

そんなこんな考えるうちに、DOが多値に対応すれば、何か素敵なことができるんじゃないかと思ったので、multiple-value-doを作ってみることにしました。

;; ファイルの読み込み
(with-open-file (in "/tmp/foo.txt")
  (multiple-value-do (((line eofp) (values) (read-line in nil)))
      (eofp 'done)
    (and line (write-line line))))

;=> abcdef ....... EOF

;; 他になんかできないか…。
(defun my-gcd (n m)
  (multiple-value-do (((n m) (values n m) (values m (rem n m))))
      ((zerop m) n)))

しかし、read系は、read-lineのようにEOFの検出を2値目で知らせてくれるのかと思ったら、read-lineだけでした。そう言われてみればそうだったんですが、行単位で扱うから多値を返すんでしょうか…。

そうすると、実質 MULTIPLE-VALUE-DO を書いた意味がない…

他にも色々試してみましたが、「残念ながら、MULTIPLE-VALUE-DOはあまり役に立ちそうもない」というのは議論の余地のない given な事実として淀みなく会話は流れる、というのが一般的になりそうです。

(defpackage :mv 
  (:use :cl)
  (:export :multiple-value-psetq
           :multiple-value-do))

(in-package :mv)

(defmacro MULTIPLE-VALUE-DO ((&rest varlist) (test &rest finally) &body body)
  (let ((vars (mappend #'car varlist))
        (inits (mappend #'cadr varlist))
        (tag (gensym)))
    `(BLOCK NIL
       (MULTIPLE-VALUE-BIND ,vars ,inits
         (TAGBODY
            (MULTIPLE-VALUE-PSETQ ,@(mappend (fn ((x y z)) `(,x ,y))
                                             varlist))
       ,tag (WHEN ,test
              (RETURN-FROM NIL (PROGN ,@finally)))
            ,@body
            (MULTIPLE-VALUE-PSETQ ,@(mappend (fn ((x y z)) `(,x ,z))
                                             varlist))
            (GO ,tag))))))

;; --

(defmacro FN ((&rest args) &body body) ;; Arcから拝借
  (let ((g (gensym)))
    `(LAMBDA (&rest ,g)
       (DESTRUCTURING-BIND ,args ,g
         (DECLARE (IGNORABLE ,@(metatilities:flatten args)))
         ,@body))))

(defun MAPPEND (fn &rest lists)
  (reduce #'append (apply #'mapcar fn lists)))

(defmacro MULTIPLE-VALUE-PSETQ (&rest pairs)
  (cond ((cddr pairs) `(SETF (VALUES ,@(car pairs))
                             (MULTIPLE-VALUE-PROG1 ,(cadr pairs)
                               (MULTIPLE-VALUE-PSETQ ,@(cddr pairs)))))
        ((cdr pairs) `(SETF (VALUES ,@(car pairs)) ,@(cdr pairs)))
        ('T (error "Odd number of args."))))

ArcでL-99 (P41a ゴールドバッハ予想をリスト表示)

| 01:10 | ArcでL-99 (P41a ゴールドバッハ予想をリスト表示) - わだばLisperになる を含むブックマーク はてなブックマーク - ArcでL-99 (P41a ゴールドバッハ予想をリスト表示) - わだばLisperになる

今回のお題は、ある数値の範囲を与え、その範囲のゴールドバッハ予想をリスト表示するというものです。

前回定義したgoldbachを使用します。

おまけの質問があるのですが、それは、P41bということで次回に解答することにしました。

(goldbach-list 9 20)
;=> 10 = 3 + 7
;   12 = 5 + 7
;   14 = 3 + 11
;   16 = 3 + 13
;   18 = 5 + 13
;   20 = 3 + 17

(def goldbach-list (start end)
  (each a (range start end)
    (whenlet (x y) (goldbach a)
      (prf "#a = #x + #y\n"))))