cut-macro.scm

(define-syntax cut
  (ir-macro-transformer
   (lambda (form inject compare?)
     `(cut% () () ,@(cdr form)))))

;; ir-macro-transformer version
(define-syntax cut%
  (ir-macro-transformer
   (lambda (form inject compare?)
     (let ((slots (cadr form))
	   (combi (caddr form))
	   (se (cdddr form)))
       (cond ((null? se)
	      (let ((slots (reverse slots))
		    (combi (reverse combi)))
		`(lambda ,slots ((begin ,(car combi)) ,@(cdr combi)))))
	     ((compare? (car se) '<...>)
	      (let ((slots (fold-right cons 'rest-slot (reverse slots)))
		    (combi (reverse (cons 'rest-slot combi))))
		`(lambda ,slots (apply ,@combi))))
	     ((compare? (car se) '<>)
	      `(cut% ,(cons 'x slots) ,(cons 'x combi) ,@(cdr se)))
	     (else `(cut% ,slots ,(cons (car se) combi) ,@(cdr se))))))))

;; syntax-rules version
(define-syntax cut%
  (syntax-rules (<> <...>)
    ((_ (slot-name ...) (proc arg ...))
     (lambda (slot-name ...) ((begin proc) arg ...)))
    ((_ (slot-name ...) (proc arg ...) <...>)
     (lambda (slot-name ... . rest-slot) (apply proc arg ... rest-slot)))
    ((_ (slot-name ...) (position ...) <> . se)
     (cut% (slot-name ... x) (position ... x) . se))
    ((_ (slot-name ...) (position ...) nse . se)
     (cut% (slot-name ...) (position ... nse) . se))))