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