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