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 |

2007-10-03

DOMAP-AND,DOMAP-OR (Maclisp/LET.LSP)

| 15:02 | DOMAP-AND,DOMAP-OR (Maclisp/LET.LSP) - わだばLisperになる を含むブックマーク はてなブックマーク - DOMAP-AND,DOMAP-OR (Maclisp/LET.LSP) - わだばLisperになる

今回も前回と同じMaclispのLET.LSPからDOMAP-AND、DOMAP-ORに挑戦してみることにしました。

お題:

;;; DOMAP-AND evaluates a form, on successive tails of a list, returning ()
;;;  if any of the evaluations if (), and returning the last one if not.
;;; DOMAP-OR returns the first non-() one, or () if all are ().
;;; Syntax is (DOMAP-and/or (VAR1 <first-form>) ... (VARn <last-form>) <pred>)
;;;   Items in angle-brackets are evaluated, and the names "VARi" are used
;;;   as the stepping variables to use;  <pred> is a "predicate" form.
;;;   Typical use -  (DOMAP-AND (TEMP DATA-LIST) (NOT (LOSEP (CAR TEMP))))
(macro DOMAP-AND (x) 
  (bind-let ((forms (cdr x)) pred (g (gensym)))
	    (setq pred (car (setq forms (reverse forms)))
		  forms (nreverse (cdr forms)))
	    `(DO ((,g)
		  ,.(mapcar #'(lambda (x) `(,(car x) ,(cadr x) (CDR ,(car x))))
			    forms))
		 ((NOT (AND ,.(mapcar #'CAR forms))) ,g)
	       (OR (setq ,g ,pred) (RETURN () )))))

(macro DOMAP-OR (x) 
  (bind-let ((forms (cdr x)) pred (g (gensym)))
	    (setq pred (car (setq forms (reverse forms)))
		  forms (nreverse (cdr forms)))
	    `(DO ((,g)
		  ,.(mapcar #'(lambda (x) `(,(car x) ,(cadr x) (CDR ,(car x))))
			    forms))
		 ((NOT (AND ,.(mapcar #'CAR forms))) () )
	       (AND (setq ,g ,pred) (RETURN ,g)))))

初見時の感想:

  • どういう時に便利なマクロなのかいまいち想像がつかない…。
  • コードの内容はdomap-and/orの違いはちょっとの違いしかない。

暗記で再現:

(defmacro DOMAP-AND (&body forms)
  (let (pred (g (gensym)))
    (setq pred (car (setq forms (reverse forms)))
	  forms (nreverse (cdr forms)))
    `(DO (,g
	  ,.(mapcar (lambda (x) `(,(car x) ,(cadr x) (CDR ,(car x)))) forms))
	 ((NOT (and ,.(mapcar #'car forms))) ,g)
       (OR (setq ,g ,pred) (RETURN () )))))

(defmacro DOMAP-OR (&body forms)
  (let (pred (g (gensym)))
    (setq pred (car (setq forms (reverse forms)))
	  forms (nreverse (cdr forms)))
    `(DO (,g
	  ,.(mapcar (lambda (x) `(,(car x) ,(cadr x) (CDR ,(car x)))) forms))
	 ((and ,.(mapcar #'car forms)) () )
       (AND (setq ,g ,pred) (RETURN ,g )))))

また、これもdefmacroに翻訳してみました。細かいところはちょっと違うけど、なんとかできました。

使い方:

(domap-and (tem '(1 2 3 4 5))
	   (tem2 '(10 20 30 40 50))
	   (print (* (car tem) (car tem2))))
=>
10 
40 
90 
160 
250 

みたいになるのだろうか。やっぱり「これは便利だ!」という使用法が思い付かない…。

技法的なこと:

(setq pred (car (setq forms (reverse forms)))
      forms (nreverse (cdr forms)))

妙に巧妙で妙に感心してしまう。自分なら、

(setq pred (car (last forms))
      forms (butlast forms))

と書いてしまいそう。