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
[email protected]
http://ccrma-mail.stanford.edu/mailman/listinfo/cmdist
