slot-push!/slot-pop! (Gauche-devel-jp) - Gauche

もっともです。追加しました。
slotの値がペアでなかった時も、defaultが与えられてればそれを
返すようにしました。*-push!/pop! は便利ルーチンなので
あまり厳密なことは言わないのがいいかなと。

--shiro

From: Masatake YAMATO <yamat****@redha*****>
Subject: [Gauche-devel-jp] slot-push!/slot-pop!
Date: Sat, 06 Feb 2010 15:17:57 +0900 (JST)

> こんにちは
> 
> hash-table-push!に対してhash-table-pop!があるように
> slot-push!に対してslot-pop!があると便利だと思います。
> 追加を検討してもらえないでしょうか？
> 
> 大和
> 
> 
> (define (slot-pop! obj slot . default)
>   (if (and (not (null? default))
> 	   (or (not (slot-bound? obj slot))
> 	       (null? (slot-ref obj slot))))
>       (car default)
>       (let ((r (slot-ref obj slot)))
> 	(slot-set! obj slot (cdr r))
> 	(car r))))
> 
> (use gauche.test)
> (test-start "slot-pop!")
> 
> (test-section "no default value")
> (define-class <x> () ((a :init-value '())))
> (define-class <y> () (a))
> 
> (test* "() push pop" 1
>        (let1  x (make <x>)
> 	 (slot-push! x 'a 1)
> 	 (slot-pop! x 'a)))
> (test* "() push push pop pop" 1
>        (let1  x (make <x>)
> 	 (slot-push! x 'a 1)
> 	 (slot-push! x 'a 2)
> 	 (slot-pop! x 'a)
> 	 (slot-pop! x 'a)))
> 
> (test-section "with default value")
> (test* "()" 1
>        (let1  x (make <x>)
> 	 (slot-pop! x 'a 1)))
> 
> (test* "<unbound>" 1
>        (let1  x (make <y>)
> 	 (slot-pop! x 'a 1)))
> 
> (test* "<broken value>" <y>
>        (let1  x (make <y>)
> 	 (guard (e (else (class-of x)))
> 	   (slot-set! x 'a 1)
> 	   (slot-pop! x 'a 2))))
> 
> (test-end)
> 
> _______________________________________________
> Gauche-devel-jp mailing list
> Gauch****@lists*****
> http://lists.sourceforge.jp/mailman/listinfo/gauche-devel-jp