combinators.ss
(module combinators mzscheme

  (require (lib "etc.ss")
           (lib "list.ss"))

  (provide curry
           yrruc
           constant
           compose/apply
           map2
           negate
           conjoin
           disjoin)

  ;; curry : (A ... B ... -> C) A ... -> B ... -> C
  ;; Partially applies its first argument, using the remaining arguments
  ;; as the function's initial parameters.
  (define (curry f . args)
    (lambda rest
      (apply f (append args rest))))

  ;; yrruc : (A ... B... -> C) B ... -> A ... -> C
  ;; Partially applies its first argument, using the remaining arguments
  ;; as the function's final parameters.
  (define (yrruc f . rest)
    (lambda args
      (apply f (append args rest))))

  ;; constant : V -> Any ... -> V
  ;; Produces a function with constant return value.
  (define (constant v)
    (lambda args v))

  ;; compose/apply :
  ;; (A ... -> (list B ...)) (B ... -> (list C ...)) ... ->
  ;; (A ... -> (list Z ...))
  ;; Composes functions by passing on argument lists.
  (define (compose/apply first . rest)
    (foldl
     (lambda (f accum)
       (lambda args (apply accum (apply f args))))
     first
     rest))

  ;; map2 : (A ... -> B C) (Listof A) ... -> (Listof B) (Listof C)
  ;; Like map, but for a function that returns 2 values.
  (define (map2 f l-first . l-rest)
    (let* ([ls (cons l-first l-rest)]
           [lengths (map length ls)])
      (unless (or (null? l-rest) (apply = lengths))
        (raise (make-exn:fail:contract
                (string->immutable-string
                 (format
                  "map2: all lists must be of same length, got lengths ~v"
                  lengths))
                (current-continuation-marks))))
      (recur loop ([ls ls])
        (cond
         [(andmap null? ls) (values null null)]
         [else (let-values ([(bs cs) (loop (map cdr ls))]
                            [(b c) (apply f (map car ls))])
                 (values (cons b bs) (cons c cs)))]))))

  ;; negate : (A ... -> Boolean) -> A ... -> Boolean
  ;; Negates a predicate.
  (define (negate pred)
    (lambda args (not (apply pred args))))

  ;; conjoin : (A ... -> Boolean) ... -> A ... -> Boolean
  ;; Produces the conjunction of several predicates.
  (define (conjoin . preds)
    (lambda args (andmap (lambda (pred) (apply pred args)) preds)))

  ;; disjoin : (A ... -> Boolean) ... -> A ... -> Boolean
  ;; Produces the disjunction of several predicates.
  (define (disjoin . preds)
    (lambda args (ormap (lambda (pred) (apply pred args)) preds)))

  )