[plt-scheme] "useless" abstraction

On Saturday Horace asked me in a private email whether I'd ever
abstract along the lines of HtDP 27.2.2 an exercise that combines
two functions: one that drops n items from a list and one that
picks up the first n.

As it happens, I was working on a core library when I ran into
a somewhat unusual programming trick that encoded an invariant.
It took me a while to decipher it and then I discovered that it
had been documented -- somewhere else and in a less than obvious
way. Since the trick was used three times in this library alone,
I decided to abstract the three occurrences. Also, since this
abstraction is very much like the one in HtDP in terms of source,
I thought I'd post it here.

;; I am using syntactic abstraction instead of value abstraction
;; so that I get no performance loss at run-time. If I didn't,
;; I'd pay for accumulator consing (part VI in HtDP) and recursive
;; combinations -- even when the function doesn't use it. With
;; syntax, the combine part and the accumulator part simply disappear
;; and I pay nothing after expansion.

(define-syntax-rule
   (define/lead (name x n) base combine pfx ...)
   ;; MF: lead is (- (depth x) n) items, ergo traversing lead leaves
   ;;     (- (depth x) (- (depth x) n)) = n items to be dealt with
   ;;     either via a combine ~ cons or an accumulator
   (let loop ([lead (drop x n)] [x x][pfx '()] ...)
     (if (pair? lead)
         (combine (car x) (loop (cdr lead) (cdr x) (cons (car x)  
pfx) ...))
         (base x pfx ...))))

(define-syntax-rule (K- a b) b)

;; ... and here are the three instances, with contracts:

;; (->d ([x (compose (>=/c n) depth)][n natural-number/c]) ()
;;       (_ (compose (=/c n) depth)))
(define/lead (take-right x n)
   values K-) ;; I 8! values as identity

;; (->d ([x (compose (>=/c n) depth)][n natural-number/c]) ()
;;       (_ (and/c LoA (compose (=/c (- (depth x) n)) length))))
(define/lead (drop-right x n)
   (lambda (x) '()) cons)

;; (->d ([l (compose (>=/c n) depth)][n natural-number/c]) ()
;;       (values (_ (and/c LoA (compose (=/c (- (depth l) n)) length)))
;;               (_ (compose (=/c n) depth))))
(define/lead (split-at-right x n)
   (lambda (x pfx) (values (reverse pfx) x)) K- pfx)

I consider the names self-documenting so there are no
purpose statements.

-- Matthias