;; lists.lq

(define (list args...)
  args...)

(define (pair* a b args...)
  ;; (pair* ..args.. rest)
  ;; (pair a (pair b (pair rest))) == (pair* a b rest)
  ;; useful with apply.
  (if (empty? args...)
      (pair a b)
      (pair a (apply pair* (pair b args...)))))

(define (length lst)
  (define (length-aux lst acc)
    (if (empty? lst)
        acc
        (length-aux (tail lst) (+ acc 1))))
  (length-aux lst 0))

(define (reverse lst)
  (define (reverse-aux lst acc)
    (if (empty? lst)
        acc
        (reverse-aux (tail lst) (pair (head lst) acc))))
  (reverse-aux lst ()))

(define (map f lst)
  (define (map-aux f lst acc)
    (if (empty? lst)
        (reverse acc)
        (map-aux f (tail lst)
                 (pair (f (head lst)) acc))))
  (map-aux f lst ()))

(define (filter pred lst)
  (define (filter-aux pred lst acc)
    (if (empty? lst)
        (reverse acc)
        (if (pred (head lst))
            (filter-aux pred (tail lst) (pair (head lst) acc))
            (filter-aux pred (tail lst) acc))))
  (filter-aux pred lst ()))

(define (for-each f lst)
  (if (empty? lst)
      #t ;; value doesn't matter
      (begin
        (f (head lst))
        (for-each f (tail lst)))))

(define (list-ref lst n)
  (if (<= n 0) ;; later: support negative indices?
      (head lst)
      (list-ref (tail lst) (- n 1))))

(define first head)
(define (second lst) (head (tail lst)))
(define (third lst) (head (tail (tail lst))))
(define (fourth lst) (list-ref lst 3))
(define (fifth lst) (list-ref lst 4))

;; untested
(define (fold-left f lst default)
  (define (fold-left-aux lst acc)
    (if (empty? lst)
        acc
        (fold-left-aux (tail lst) (f acc (head lst)))))
  (fold-left-aux lst default))

;; untested
(define (fold-right f lst default)
  (define (fold-right-aux lst acc)
    (if (empty? lst)
        acc
        (fold-right-aux (tail lst) (f (head lst) acc))))
  (fold-right-aux (reverse lst) default))

(define reduce fold-left)

;; is probably dog slow!
;; try more efficient version
;(define (append xs ys)
;  (fold-right pair xs ys))

;; FIXME: not tail recursive
;; alternatively, make this a builtin?
(define (append xs ys)
  (if (empty? xs)
      ys
      (pair (head xs)
            (append (tail xs) ys))))

;; this version of member takes a comparison function that returns #t if the
;; two elements compared are considered equal.  since "equal" can mean
;; different things depending on context, the comparison function must be
;; specified for clarity, rather than assuming a default.
(define (member? x lst same?)
  (if (empty? lst)
      #f
      (if (same? (head lst) x)
          #t
          (member? x (tail lst) same?))))

(define (unique lst same?)
  (define (unique-aux items acc)
    (if (empty? items)
        (reverse acc)  ;; should we sort this?
        (if (member? (head items) acc same?)
            (unique-aux (tail items) acc)
            (unique-aux (tail items) (pair (head items) acc)))))
  (unique-aux lst ()))

(define (drop n lst)
  (if (or (empty? lst) (<= n 0))
      lst
      (drop (- n 1) (tail lst))))

(define (take n lst)
  (define (take-aux lst n acc)
    (if (or (<= n 0) (empty? lst))
        (reverse acc)
        (take-aux (tail lst) (- n 1) (pair (head lst) acc))))
  (take-aux lst n ()))

(define (take-and-drop n lst)
  (define (take-and-drop-aux lst n acc)
    (if (or (<= n 0) (empty? lst))
        (list (reverse acc) lst)
        (take-and-drop-aux (tail lst) (- n 1) (pair (head lst) acc))))
  (take-and-drop-aux lst n ()))

(define (take-while pred lst)
  (define (take-while-aux lst acc)
    (if (or (empty? lst)
            (not (pred (head lst))))
        (reverse acc)
        (take-while-aux (tail lst) (pair (head lst) acc))))
  (take-while-aux lst ()))

(define (drop-while pred lst)
  (if (or (empty? lst)
          (not (pred (head lst))))
      lst
      (drop-while pred (tail lst))))

;; take two lists and return a new list of their items transposed, e.g.
;; (transpose '(a b c) '(1 2 3)) => ((a 1) (b 2) (c 3)).
;; this version stops as soon as one of the lists is empty.
(define (transpose xs ys)
  (define (transpose-aux xs ys acc)
    (if (or (empty? xs) (empty? ys))
        (reverse acc)
        (transpose-aux (tail xs) (tail ys)
                       (pair (list (head xs) (head ys)) acc))))
  (transpose-aux xs ys ()))

(define (range n)
  (define (range-aux n acc)
    (if (<= n 0)
        acc
        (range-aux (- n 1) (pair (- n 1) acc))))
  (range-aux n ()))