[CM] c?r?

[Bill Schottstaedt]

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)))))))