(in-package :com.sandersn.util)
(declaim (inline foldl foldr filter))
;; foldl, foldr and filter appear to preserve my sanity while in Scheme exile
(defun foldl (f x l)
  (reduce f l :initial-value x))
(defun foldr (f x l)
  (reduce f l :initial-value x :from-end t))
(defun filter (f l)
  (remove-if-not f l))
(defgeneric len (x))
(defmethod len ((h hash-table))
  (hash-table-count h))
(defmethod len ((l sequence))
  (length l))
(defgeneric gmap (f l &rest ls)
  (:documentation "A generic map function. Should act like mapcar does for lists"))
(defmethod gmap (f (l list) &rest ls)
  (apply #'mapcar f l ls))
(defmethod gmap (f (s string) &rest ls)
  (apply #'map 'string f s ls))
(defmethod gmap (f (v vector) &rest ls)
  (apply #'map 'vector f v ls))
(defmethod gmap (f (s sequence) &rest ls)
  (apply #'map 'list f s ls))
(defun maptree (f tree)
  "maybe make this generic if I make also a tree *class*"
  (cond
    ((null tree) ())
    ((listp tree) (mapcar #'(lambda (ch) (maptree f ch)) tree))
    (t (funcall f tree))))
(defun iota (count &optional (start 0) (step 1))
  "Iota definition courtesy of Olin Shivers"
  (let ((last-val (+ start (* (- count 1) step))))
    (do ((count count (- count 1))
         (val last-val (- val step))
         (ans '() (cons val ans)))
        ((<= count 0)  ans))))
(defun window (l n &key (inc 1))
  (loop for i upto (- (length l) n) by inc
     collect (subseq l i (+ i n))))
(defgeneric group (l n))
(defmethod group ((l list) n)
  "Efficient for lists. Courtesy of Paul Graham."
  (when (zerop n)
    (error "return value is infinite for n=0"))
  (labels ((rec (l acc)
             (let ((rest (nthcdr n l)))
               (if (consp rest)
                   (rec rest (cons (subseq l 0 n) acc))
                   (nreverse (cons l acc))))))
    (when l
      (rec l nil))))
(defmethod group (l n) ; not (l sequence) because I want to use this code
  ; in macros. Apparently the things macros pass around are not sequences.
  ; But they respond to length, loop, subseq...
  (when (zerop n)
    (error "return value is infinite for n=0"))
  (loop for x below (- (length l) (mod (length l) n)) by n
     collect (subseq l x (+ x n))))
(defun zip (&rest ls)
  "Still probably not the best in the world."
  (labels ((rec (acc ls)
             (if (some #'null ls)
                 acc
                 (rec (cons (mapcar #'car ls) acc) (mapcar #'cdr ls)))))
    (nreverse (rec () ls))))
(defun cross (&rest ls)
  "Produces all choices from ls, retaining order. Slow, inefficient, yadayada."
  (if (null ls)
      '(())
      (loop for x in (car ls) append
        (loop for y in (apply #'cross (cdr ls)) collect
          (cons x y)))))
(defun shuffle! (l)
  (loop for i below (length l)
     do (let* ((j (random (length l)))
               (tmp (elt l j)))
          (setf (elt l j) (elt l i))
          (setf (elt l i) tmp))))
(defun shuffle (l)
  (alet copied (copy-seq l)
    (shuffle! copied)
    copied))
(defun take (n l)
  (let ((n (if (> n (len l)) (len l) n)))
    (subseq l 0 n)))
(defun drop (n l)
  (let ((n (if (> n (len l)) (len l) n)))
    (subseq l n)))
(defun split-at (n l)
  (list (subseq l 0 n) (subseq l n)))
(defgeneric drop-while (f l))
(defgeneric take-while (f l))
(defmethod drop-while (f (l list))
  (cond
    ((null l) ())
    ((funcall f (car l)) (drop-while f (cdr l)))
    (t l)))
(defmethod drop-while (f (l sequence))
  (labels ((rec (i)
             (if (or (= i (len l)) (not (funcall f (elt l i))))
                 (subseq l i)
                 (rec (1+ i)))))
    (rec 0)))
(defmethod take-while (f (l list))
  (labels ((rec (l acc)
             (cond ((or (null l) (not (funcall f (car l)))) acc)
                   (t (rec (cdr l) (cons (car l) acc))))))
    (nreverse (rec l ()))))
(defmethod take-while (f (l sequence))
  (labels ((rec (i)
             (if (or (= i (len l)) (not (funcall f (elt l i))))
                 (subseq l 0 i)
                 (rec (1+ i)))))
    (rec 0)))
(defun split (x l &key (test #'eql) (from-end nil))
  "a*(list a)->(list (list a))--split a l by item x inside it
uses position, not search, so it's not [a]*[a]->[[a]]
another possibiility would be (gmap #[position _ l] xs) in order to ape Python"
  (aif (and l (position x l :test test :from-end from-end))
       (bind (first rest) (split-at _ l)
         (cons first (split x (drop 1 rest) :test test :from-end from-end)))
       (list l)))
(defun join (ss &optional (sep " "))
  "(list str)*str->str"
  (apply #'concatenate 'string (intersperse sep ss)))
(defun intersperse (sep l)
  "a*(list b)->(list a|b)"
  (cdr (mapcan #[ list sep _] l)))
(defun filter-white (l)
  (remove #\Space l :test #'char=))
(defun same? (l) ; or (def all-equal? #[all #'equal])
  (every (uncurry #'equal) (window l 2)))
(defun all (binary-test l)
  (every (uncurry binary-test) (window l 2)))
(defun times (x n)
  (loop for i from 1 to n collect x))