Recursive Condition

This little trick hit me when I was perusing PCL . Specifically, the when selector.

( defun rec-cond ( key )
( cond
( ( eq key :before ) ( format nil "executing before" ) )
( ( eq key :during ) ( format nil "executing during" ) )
( ( eq key :after ) ( format nil "executing after" ) )
( ( eq key :set-up ) ( rec-cond :before ) )
( ( eq key :init ) ( rec-cond :before ) )
( ( eq key :teardown ) ( rec-cond :after ) )
( t ( error ( format nil "unknown command: ~A" key) ) ) )
This overloads keyword symbols so that you more than one keyword can execute the same code.Syntactic Sugar

( defun num ( key )
( cond
( ( eq key :zero ) 0 )
( ( eq key :one ) 1 )
( ( eq key :two ) ( 1+ ( num :one ) ) )
( ( eq key :three ) ( 1+ ( num :two ) ) )
( ( eq key :four ) ( 1+ ( num :three ) ) )
( ( eq key :five ) ( 1+ ( num :four ) ) )
( ( eq key :six ) ( 1+ ( num :five ) ) )
( ( eq key :seven ) ( 1+ ( num :six ) ) )
( ( eq key :eight ) ( 1+ ( num :seven ) ) )
( ( eq key :nine ) ( 1+ ( num :eight ) ) )
( t ( error ( format nil "unknown number keyword: ~A" key) ) ) ) )
( test-fixture
:num
( :tests
( should-do-my-key-numbers
( assert-equal 0 ( num :zero ) )
( assert-equal 1 ( num :one ) )
( assert-equal 2 ( num :two ) )
( assert-equal 3 ( num :three ) )
( assert-equal 4 ( num :four ) )
( assert-equal 5 ( num :five ) )
( assert-equal 6 ( num :six ) )
( assert-equal 7 ( num :seven ) )
( assert-equal 8 ( num :eight ) )
( assert-equal 9 ( num :nine ) )
( assert-error 'simple-error ( num :haha ) ) )
( should-do-basic-math
( assert-equal 5 ( + ( num :two ) ( num :three ) ) )
( assert-equal 5 ( - ( num :eight ) ( num :three ) ) )
( assert-equal 6 ( * ( num :two ) ( num :three ) ) )
( assert-equal 2 ( / ( num :six ) ( num :three ) ) ) ) ) )
But who the hell wants to write num function and then keyword.

This might me a little better.

( defmacro with-numbers ( &rest rest)
`( let ( ( zero 0 )
( one 1 )
( two 2 )
( three 3 )
( four 4 )
( five 5 )
( six 6 )
( seven 7 )
( eight 8 )
( nine 9 ) )
,@rest ) )
( test-fixture
:num-with-sugar
( :tests
( should-use-sugar-number
( with-numbers
( assert-equal 0 zero)
( assert-equal 1 one)
( assert-equal 2 two)
( assert-equal 3 three)
( assert-equal 4 four)
( assert-equal 5 five)
( assert-equal 6 six)
( assert-equal 7 seven)
( assert-equal 8 eight)
( assert-equal 9 nine) ) )
( should-sugar-do-basic-math
( with-numbers
( assert-equal 5 ( + two three) )
( assert-equal 5 ( - eight three) )
( assert-equal 6 ( * two three) )
( assert-equal 2 ( / six three) ) ) ) )
I believe that if you use format you can also get something similar. Just intern string to symbol.

( intern ( string-upcase ( format nil "~r" 0 ) )
I think I’m going to start using different titles for these type of posts.

What do you think?

Like this: Like Loading...

Related
This entry was posted on Monday, December 22nd, 2008 at 04:54 and is filed under Domain Specific Language , Lisp Programming . You can follow any responses to this entry through the RSS 2.0 feed.
You can leave a response , or trackback from your own site.

Post navigation
« Previous Post
Next Post »
ECASE would be more appropriate.

A bare SETQ with no special declaration has undefined consequences.

That’s the problem with trying to find a binding for the numbers that also shows off something that you think is cool. I’ve redone the example and got rid of the SETQs. Thanks for you feedback

How about that ECASE update now too?

Also ERROR by default can handle formatting its message.

I’d probably make NUM like this:

(or (position num

#(:zero :one :two :three :four :five :six :seven :eight :nine))

(error “~A is not a number keyword” num))

More likely: (error “~S is not a number keyword” num)