foo.scm

(import (rnrs)
        (for (only (srfi :1) break) expand))

(define-syntax foo
  (lambda (stx)
    (define (no-vals f befores)
      (let ((temps (generate-temporaries befores)))
        #`(lambda #,temps
            (#,f #,@(map list befores temps)))))
    (define (yes-vals f befores afters)
      (let ((temps-before (generate-temporaries befores))
            (temps-after  (generate-temporaries afters)))
        #`(lambda #,temps-before
            (let-values ((#,temps-after
                          (#,f #,@(map list befores temps-before))))
              (values #,@(map list afters temps-after))))))
    (syntax-case stx ()
      [(_ function converter ...)
       (let-values (((before after)
                     (break (lambda (x) (free-identifier=? x #'::))
                            #'(converter ...))))
         (if (null? after)
             (no-vals #'function before)
             (yes-vals #'function before (cdr after))))])))

;; (foo cons 1+ 1+)
;; -> (lambda (x y) (cons (1+ x) (1+ y)))

;; (foo break identity cdr :: car car)
;; -> (lambda (f l)
;;      (let-values (((a b) (break (identity f) (cdr l))))
;;        (values (car a) (car b))))