(module combinators mzscheme

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

  (provide curry
           yrruc
           constant
           compose/apply
           map2
           map/values
           fold/values
           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))

  ;; fold/values : (A ... B ... -> (values B ...)) (list B ...) (Listof A) ... -> (values B ...)
  (define (fold/values f inits . ls)
    (recur loop ([ls ls]
                 [results inits])
      (if (ormap null? ls)
          (apply values results)
          (loop (map cdr ls)
                (call-with-values (lambda ()
                                    (apply f (append (map car ls) results)))
                  list)))))

  ;; map/values : n:Nat (A ... -> B ...n) (Listof A) ... -> (Listof B) ...n
  ;; Like map, for functions returning n values.
  (define (map/values n 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
                (format
                 "map/values: all lists must be of same length, got lengths ~v"
                 lengths)
                (current-continuation-marks))))
      (recur loop ([ls ls])
        (cond
         [(ormap null? ls) (apply values (build-list n (constant null)))]
         [else
          (call-with-values (lambda () (apply f (map car ls)))
            (lambda heads
              (call-with-values (lambda () (loop (map cdr ls)))
                (lambda tails
                  (apply values (map cons heads tails))))))]))))

  ;; 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)
    (apply map/values 2 f l-first l-rest))

  ;; 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)))

  )