;; #%kernel implements `map', `for-each', `andmap', and `ormap',
;;  but the JIT generates faster code, especially for the common cases.

(module map '#%kernel
  (#%require '#%utils ; built into mzscheme
             "more-scheme.ss" "small-scheme.ss" "define.ss")

  (#%provide (rename map2 map)
             (rename for-each2 for-each)
             (rename andmap2 andmap))
  
  ;; -------------------------------------------------------------------------

  (define map2
    (let ([map
           (case-lambda
            [(f l)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 1)
                      (list? l))
                 (let loop ([l l])
                   (cond
                    [(null? l) null]
                    [else (cons (f (car l)) (loop (cdr l)))]))
                 (map f l))]
            [(f l1 l2)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 2)
                      (list? l1)
                      (list? l2)
                      (= (length l1) (length l2)))
                 (let loop ([l1 l1][l2 l2])
                   (cond
                    [(null? l1) null]
                    [else (cons (f (car l1) (car l2)) 
                                (loop (cdr l1) (cdr l2)))]))
                 (map f l1 l2))]
            [(f . args) (apply map f args)])])
      map))
  
  (define for-each2
    (let ([for-each
           (case-lambda
            [(f l)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 1)
                      (list? l))
                 (let loop ([l l])
                   (cond
                    [(null? l) (void)]
                    [else (begin (f (car l)) (loop (cdr l)))]))
                 (for-each f l))]
            [(f l1 l2)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 2)
                      (list? l1)
                      (list? l2)
                      (= (length l1) (length l2)))
                 (let loop ([l1 l1][l2 l2])
                   (cond
                    [(null? l1) (void)]
                    [else (begin (f (car l1) (car l2)) 
                                 (loop (cdr l1) (cdr l2)))]))
                 (for-each f l1 l2))]
            [(f . args) (apply for-each f args)])])
      for-each))

  (define andmap2
    (let ([andmap
           (case-lambda
            [(f l)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 1)
                      (list? l))
                 (if (null? l)
                     #t
                     (let loop ([l l])
                       (cond
                        [(null? (cdr l)) (f (car l))]
                        [else (and (f (car l)) (loop (cdr l)))])))
                 (andmap f l))]
            [(f l1 l2)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 2)
                      (list? l1)
                      (list? l2)
                      (= (length l1) (length l2)))
                 (if (null? l1)
                     #t
                     (let loop ([l1 l1][l2 l2])
                       (cond
                        [(null? (cdr l1)) (f (car l1) (car l2))]
                        [else (and (f (car l1) (car l2)) 
                                   (loop (cdr l1) (cdr l2)))])))
                 (andmap f l1 l2))]
            [(f . args) (apply andmap f args)])])
      andmap))

  (define ormap2
    (let ([ormap
           (case-lambda
            [(f l)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 1)
                      (list? l))
                 (if (null? l)
                     #f
                     (let loop ([l l])
                       (cond
                        [(null? (cdr l)) (f (car l))]
                        [else (or (f (car l)) (loop (cdr l)))])))
                 (ormap f l))]
            [(f l1 l2)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 2)
                      (list? l1)
                      (list? l2)
                      (= (length l1) (length l2)))
                 (if (null? l1)
                     #f
                     (let loop ([l1 l1][l2 l2])
                       (cond
                        [(null? (cdr l1)) (f (car l1) (car l2))]
                        [else (or (f (car l1) (car l2)) 
                                  (loop (cdr l1) (cdr l2)))])))
                 (ormap f l1 l2))]
            [(f . args) (apply ormap f args)])])
      ormap)))