(chapter-start 'list-manipulation)

;; each call to the name 'accfn-name with an arg will append the arg to the end of a list.
;; This form returns the resulting list.
;; Example (collect first names from a list of people)
;;
;;   (accum a (each person people (a person.firstname)))
;;
;; will return (Alice Bob Carol Declan Eliza Fionn)
;;
(mac accum (accfn-name . body)
  (w/uniq (things last-cons)
    `(with (,last-cons  (cons)
             ,things     ,last-cons
             ,accfn-name (fn (a)
                           (= ,last-cons (cdr-set ,last-cons (cons a)))
                           a)
             accum-end   (fn (a)
                           (= ,last-cons (cdr-set ,last-cons a))
                           a))
       ,@body
       (cdr ,things))))

(def list-length (things)
  (let cc 0
    (loop (pair? things)
      (do
        (++ cc)
        (= things (cdr things))))
    (if things (+ cc 1) cc)))

;; slice 'things into a list of lists each with maximum 'slice-size items
(def list-slices (things slice-size)
  (chapter pagination)
  (if things
    (if (> slice-size (len things))
      (list things)
      (cons (firstn slice-size things)
        (list-slices (nthcdr slice-size things)
          slice-size)))
    nil))

;; return a new list with 'inbetween in between every element of 'things
(def intersperse (inbetween things)
  (accum i
         (while (pair? things)
           (i (car things))
           (if (cdr things)
               (i inbetween))
           (= things (cdr things)))
         (if things (accum-end things))))

;; expects 'things a list of lists, joins the lists
;; placing 'inbetween in between each list.
;; For example (intersperse-splicing 'X '((a b) (c d) (e f)))
;; returns (a b X c d X e f)
(def intersperse-splicing (inbetween things)
  (apply joinlists (intersperse (list inbetween) things)))

;; if 'things is a list, return all the items in the list for which 'f returns non-nil
;; otherwise, return 'things if (f things) is non-nil
;; otherwise, nil
;; note that this preserves improper lists and may return only the lastcdr if all else fails...
(def collect-helper (f things res)
  (loop (pair? things)
        (do
            (if (f (car things))
                (= res (cdr-set res (cons (car things)))))
            (= things (cdr things))))
  (if (and things (f things))
      (= res (cdr-set res things))))

(def collect (f things)
  (let res (cons)
    (collect-helper f things res)
    (cdr res)))

(assign select collect)

;; return a new list containing only 'present? items from the given list
(def compact (things) (collect present? things))

;; return the sum of all non-nil values (consider nil as zero)
(def +nz args
  (apply + (compact args)))

;; return all the items in 'things for which 'f returns nil
(def reject (f things)
  (collect !f things))

;; repeatedly assigns an element of 'things to 'var,
;; and executes 'body each time
(mac each (var things . body)
  (w/uniq xs
    `(let ,xs ,things
       (loop ,xs
         (let ,var (car ,xs)
           ,@body
           (= ,xs (cdr ,xs)))))))

;; repeatedly assigns an element of 'things to 'var, increments 'ivar,
;; and executes 'body each time
(mac each-with-index (ivar var things . body)
  (w/uniq xs
    `(with (,xs ,things ,ivar 0)
       (loop ,xs
         (let ,var (car ,xs)
           ,@body
           (++ ,ivar)
           (= ,xs (cdr ,xs)))))))


;; used internally by 'reduce
(def reduce-helper (f a things)
  (loop (pair? things)
        (= a      (f a (car things))
           things (cdr things)))
  (if things
      (= a (f a things)))
  a)

;; applies f to each element of 'things and the result of f, returning the result
;;
;; for example, (reduce + '(1 2 3)) returns 6
;;
(def reduce (f things)
  (if (pair? things)
      (reduce-helper f (car things) (cdr things))
      things
      (f things)))

;; t if this is a proper list (last cdr is nil)
;; nil otherwise (last cdr is neither cons nor nil)
(def proper? (list)
  (or (no list)
      (and (pair? list)
           (proper? (cdr list)))))

;; returns the first 'n items in the list 'things
(def firstn (n things)
  (if (eq? n 0)   nil
      things      (cons (car things)
                        (firstn (- n 1)
                                (cdr things)))))

;; return a new list which is the concatenation of all the given lists
;; 'things is a list
;; 'more-thingses is a list of lists
;; call like this: (joinlists '(a b c) '(x y z) '(1 2 3))
(def joinlists (things . more-thingses)
  (if things
      (cons (car things)
            (apply joinlists
                   (cdr things)
                   more-thingses))
      more-thingses
      (apply joinlists more-thingses)))

(def detect-helper (f things found)
  (loop (and (no found) (pair? things))
    (let it (car things)
      (= found (and (f it) (or it t))
        things (cdr things))))
  (if (and (no found) things)
    (= found (and (f things) things)))
  found)

;; if 'f is a function,
;;   if 'things is a list, return the first item in the list for which 'f returns non-nil
;;   otherwise, return 'things if (f things) is non-nil
;;   otherwise, nil
;; if 'f is not a function, self-invoke with a function checking for equality with f
;;
;; WARNING: if the detected thing is nil, returns t instead. A return value of nil
;; means the thing was not found ; non-nil means the thing was found, including when
;; the found thing is itself nil.
(def detect (f things)
  (if (isa 'fn f)
      (detect-helper f things nil)
      (detect-helper (fn (thing) (eq? f thing)) things nil)))

;; split things into a list of lists each n long
(def tuples (n things)
  (rfnwith _ (list things)
           (if (no list)
               nil
               (cons (firstn n list) (_ (nthcdr n list))))))

;; iterates through 'things pairwise (a,b then b,c then c,d etc), returns whichever is preferred by 'better-p
;; example (best > '(3 1 4 1 5 9 2)) returns 9
;; "better-p" -> takes two args a and b, return t if a is "better" than b, nil otherwise
(def best (better-p things)
  (reduce (fn (a b)
              (if (no b) a
                  (no a) b
                  (better-p a b) a b))
          things))

(def min things (best < things))
(def max things (best > things))

;; returns a function taking two args a and b, that compares attributes of two objects
;; 'map-f takes one arg a returning a1
;; 'compare-p takes two args a1 and b1, returns t if a1 is "better" than b1
;;
;; useful in conjunction with 'best : (best (map-compare-f > &size) (list { size 1 } { size 7 } { size 3 })) returns { size 7 }
(def map-compare-f (compare-p map-f)
  (fn (a b) (compare-p (map-f a) (map-f b))))

;; iterate over 'things, calling 'on-atom for each non-list element, and calling
;; 'on-list for each list element.
;; 'on-atom takes one parameter, the element in question;
;; 'on-list takes two parameters: a function to call for recursing, and the list in question.
;; 'on-list should be something like (fn (rec xs) (foo xs) (map rec xs)) to construct a new list,
;; or (fn (rec xs) (foo xs) (eachl rec xs)) to iterate without constructing a new list
;; see 'list-gsub for an example of constructing a new list using this.
(def map-recurse (on-atom on-list things)
  ((afn (xs)
    (if (pair? xs)
        (on-list self xs)
        xs
        (on-atom xs)))
   things))

;; like map-recurse, but doesn't depend on caller to initiate recursion
;; 'on-atom and 'on-list are functions each taking one parameter
;; return value is last returned item from on-atom or on-list
(def list/traverse (on-atom on-list things)
  (map-recurse
   (fn (s)
       (on-atom s))
   (fn (rec xs)
       (on-list xs)
       (eachl rec xs))
   things))

;; recursively replaces 'old with 'new inside 'list
(def list-gsub (list old new)
  (map-recurse (fn (s) (if (eq? s old) new s))
               (fn (m things)
                   (if (eq? things old)
                       new
                       (map m things)))
               list))

(def all? (f things)
  ; if 'things is a list, true when f(thing) is non-nil for each thing in things
  ; if 'things is an atom, true when f(things) is non-nil
  (if (pair? things)
      (and (f:car things)
           (or (no:cdr things)
               (all? f (cdr things))))
      (f things)))

(def any? (f things)
  ; if 'things is a list, true when f(thing) is non-nil for at least one thing in things
  ; if 'things is an atom, true when f(thing) is non-nil
  (if (pair? things)
      (or (f:car things)
          (and (cdr things)
               (any? f (cdr things))))
      (f things)))

(def none? (f things)
  ; if 'things is a list, true when f(thing) is nil for each thing in things
  ; if 'things is an atom, true when f(things) is nil
  (if (pair? things)
      (and (no:f:car things)
           (none? f (cdr things)))
      (no:f things)))

(def list-match? (matchers things)
  ; 'matchers is a list of functions
  ; 'things is a list of items to match
  ; true when each function in 'matchers returns non-nil for the corresponding value in 'things
  (if (pair? matchers)
      (and ((car matchers) (car things))
           (list-match? (cdr matchers) (cdr things)))
      matchers
      (matchers things)
      t))

;; given an arg 'f, invoke 'f with no args
(def self-invoke (f) (f))

;; returns a function @r@ that takes one argument, @f@
;; which when called, applies @f@ to the given @args@
;;
;; example: @(map (self-invoker 3) (list sqrt sqr ln inv exp fib fact))@
;; returns (1.732 9 1.098 0.333 20.085 4 6)
;; being respectively the sqrt, square, log, inverse, e**x, fibonacci, factorial of 3 (assuming such functions are previously defined)
;;
(def self-invoker args
  λf(apply f args))

;; returns the first element of 'things iff it is the only element of 'things
(def list-single-element (things)
  (if (no (cdr things)) (car things)))

;; like map, but function 'f takes two arguments: the thing and the 0-based index of the thing
(def map-with-index (f things)
  (let c (counter)
    (map (fn (thing) (f thing (c)))
         things)))

;; takes a list of lists, returns a list of lists
;; transforms ((1 2 3) (a b c) (+ - *)) into ((1 a +) (2 b -) (3 c *))
;; the number of lists returned will be the number of items in the first of the given lists
(def rotate-2d-array (list-of-lists)
  (with (size (len:car list-of-lists)
         maps (map (fn (i) (fn (things) (nth i things))) (range 0 size)))
    (map (fn (mapper) (map mapper list-of-lists)) maps)))