[CM] c?r?

[Kjetil S. Matheussen]

That's really beautiful. :-)


On Fri, 9 Apr 2010, Bill Schottstaedt wrote:

> I was grumbling to myself that no one should have to count
> cars and cdrs, then thought of this macro:
>
> (define-macro (c?r path)
>      ;; here "path" is a list and "X" marks the spot in it that we are trying to access
>      ;; (a (b ((c X)))) -- anything after the X is ignored, other symbols are just placeholders
>      ;; c?r returns a function that gets X
>
>      ;; (c?r (a b X)) -> caddr,
>      ;; (c?r (a (b X))) -> cadadr
>      ;; ((c?r (a a a X)) '(1 2 3 4 5 6)) -> 4
>      ;; ((c?r (a (b c X))) '(1 (2 3 4))) -> 4
>      ;; ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 6
>      ;; ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 4
>      ;; (procedure-source (c?r (((((a (b (c (X (e f))))))))))) -> (lambda (lst) (car (car (cdr (car (cdr (car (cdr
> (car (car (car (car lst))))))))))))
>
>      (define (X-marks-the-spot accessor tree)
> 	(if (pair? tree)
> 	    (or (X-marks-the-spot (cons 'car accessor) (car tree))
> 		(X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
> 	    (if (eq? tree 'X)
> 		accessor
> 		#f)))
>
>      (let ((accessor (X-marks-the-spot '() path)))
> 	(if (not accessor)
> 	    (error "can't find the spot! ~A" path)
> 	    (let ((len (length accessor)))
> 	      (if (< len 5)                   ; it's a built-in function
> 		  (let ((name (make-string (+ len 2))))
> 		    (set! (name 0) #\c)
> 		    (set! (name (+ len 1)) #\r)
> 		    (do ((i 0 (+ i 1))
> 			 (a accessor (cdr a)))
> 			((= i len))
> 		      (set! (name (+ i 1)) (if (eq? (car a) 'car) #\a #\d)))
> 		    (string->symbol name))
> 		  (let ((body 'lst))          ; make a new function to find the spot
> 		    (for-each
> 		     (lambda (f)
> 		       (set! body (list f body)))
> 		     (reverse accessor))
> 		    `(lambda (lst) ,body)))))))
>
>
> _______________________________________________
> Cmdist mailing list
> Cmdist at ccrma.stanford.edu
> http://ccrma-mail.stanford.edu/mailman/listinfo/cmdist
>