#lang zuo/private/base

;; See note in "pair.zuo" about language choice

(require "base/and-or.zuo")

(provide list*
         list-tail
         map
         for-each
         foldl
         andmap
         ormap
         filter)

(define list*
  (lambda (val . vals)
    (if (null? vals)
        val
        (cons val (apply list* vals)))))

(define list-tail
  (lambda (l n)
    (unless (and (integer? n) (>= n 0)) (arg-error 'list-tail "index" n))
    (letrec ([list-tail (lambda (n l)
                          (cond
                            [(= n 0) l]
                            [(pair? l) (list-tail (- n 1) (cdr l))]
                            [else (error "list-tail: encountered a non-pair" l)]))])
      (list-tail n l))))

(define foldl
  (lambda (f init lst)
    (unless (procedure? f) (arg-error 'foldl "procedure" f))
    (unless (list? lst) (arg-error 'foldl "list" lst))
    (letrec ([foldl (lambda (accum lst)
                      (if (null? lst)
                          accum
                          (foldl (f (car lst) accum) (cdr lst))))])
      (foldl init lst))))

;; Other functions could be written with `foldl`, but we write them
;; directly so that a more helpful name shows up stack traces

(define map
  (lambda (f lst . lsts)
    (unless (procedure? f) (arg-error 'map "procedure" f))
    (unless (list? lst) (arg-error 'map "list" lst))
    (cond
      [(null? lsts)
       (letrec ([map (lambda (lst)
                       (if (null? lst)
                           '()
                           (cons (f (car lst)) (map (cdr lst)))))])
         (map lst))]
      [else
       (letrec ([check (lambda (lsts)
                         (unless (null? lsts)
                           (unless (list? (car lsts))
                             (arg-error 'map "list" (car lsts)))
                           (unless (= (length lst) (length (car lsts)))
                             (error "map: lists have different lengths" (cons lst lsts)))
                           (check (cdr lsts))))])
         (check lsts))
       (let ([map1 map])
         (letrec ([map (lambda (lsts)
                         (if (null? (car lsts))
                             '()
                             (cons (apply f (map1 car lsts))
                                   (map (map1 cdr lsts)))))])
           (map (cons lst lsts))))])))

(define for-each
  (lambda (f lst)
    (unless (procedure? f) (arg-error 'for-each "procedure" f))
    (unless (list? lst) (arg-error 'for-each "list" lst))
    (letrec ([for-each (lambda (lst)
                         (unless (null? lst)
                           (f (car lst))
                           (for-each (cdr lst))))])
      (for-each lst))))

(define andmap
  (lambda (f lst)
    (unless (procedure? f) (arg-error 'andmap "procedure" f))
    (unless (list? lst) (arg-error 'andmap "list" lst))
    (letrec ([andmap (lambda (lst)
                       (cond
                         [(null? lst) #t]
                         [(null? (cdr lst)) (f (car lst))]
                         [else (and (f (car lst)) (andmap (cdr lst)))]))])
      (andmap lst))))

(define ormap
  (lambda (f lst)
    (unless (procedure? f) (arg-error 'ormap "procedure" f))
    (unless (list? lst) (arg-error 'ormap "list" lst))
    (letrec ([ormap (lambda (lst)
                      (cond
                        [(null? lst) #f]
                        [(null? (cdr lst)) (f (car lst))]
                        [else (or (f (car lst)) (ormap (cdr lst)))]))])
      (ormap lst))))

(define filter
  (lambda (f lst)
    (unless (procedure? f) (arg-error 'filter "procedure" f))
    (unless (list? lst) (arg-error 'filter "list" lst))
    (letrec ([filter (lambda (lst)
                       (if (null? lst)
                           '()
                           (if (f (car lst))
                               (cons (car lst) (filter (cdr lst)))
                               (filter (cdr lst)))))])
      (filter lst))))
