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-08-19

.21

| 13:12 | .21 - わだばLisperになる を含むブックマーク はてなブックマーク - .21 - わだばLisperになる

日課練習、日課練習、色々書いてみたりしているのです

が、現在TAOの関数をマニュアルを参照しつつ想像で実

装して遊んでいます。

結構、変った関数が転がってますが、その中でも、

progiは光ってると思います。

prognの中の式に^(TAOではトガと呼ぶらしい)で印をつ

けることができて、印がついた一番最後の式の値を返す

というもの。

(defmacro progi (&body body)
  "progi                                  関数[#!subr]

<説明>
  形式 : progi &rest progi-id form1 form2 ...
form1 form2 ... を順に評価し、最後の トーガ (^) を持つ式の値を返す。
トーガを持つ式がないときは最後の式の値を返す。
form1 form2 ... はリストかアトム。
progi-id は、関数 exit-progi による脱出のためのマーク。

<例>
        (progi 1 2 3 ^4 5 6 ^7 8 9) -> 7
        (progi 1 2 3 4 5 6 7 8 9) -> 9
        (progi ^(car x) (!x (cdr x))) = (pop x)"
  (let ((progi-id (and (symbolp (car body))
		       (not (boundp (car body)))
		       (pop body)))
	(cache (gensym "TOGA-CACHE-")))
    `(block ,progi-id
       (let (,cache)
	 ,@(mapcar (lambda (x) (if (togap x) `(setq ,cache ,x) x)) (butlast body))
	 (if (or (togap ',@(last body))
		 (null ,cache))
	     (setq ,cache ,@(last body)) 
	     ,@(last body))
	 ,cache))))

(defmacro exit-progi (&optional val progi-id)
  "exit-progi                             関数[#!subr]

<説明>
  形式 : exit-progi &opt val progi-id
progi-id を持つ progi 節から強制的に脱出させる。
val が指定されると val を返し、省略されると {undef}0 を返す。
progi-id が省略された時は、最も内側にある progi 節から脱出させる。

<例>
        (progi qwe 1 2 (exit-progi 3 qwe) 4 5) -> 3
        (progi 1 2  (exit-progi 3) 4 5) -> 3"
  `(return-from ,progi-id ,val))

(defmacro toga (obj)
  obj)

(defun togap (expr)
  (and (eq 'toga (and (consp expr) (car expr)))))

(set-macro-character #\^
		     #'(lambda (stream char)
			 (declare (ignore char))
			 (list 'toga (read stream t nil t))))

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20070819