A sequence library for Common Lisp

seq.lisp

(defclass seq () ())

(defmethod s-first ((s seq))
  "The first element, if exists"
  (error "Implement in child class"))

(defmethod s-rest ((s seq))
  "The rest of the sequence, if exists"
  (error "Implement in child class"))

(defmethod s-append ((s seq) e)
  "Append an element to the seq in the right place"
  (error "Implement in child class"))

(defmethod s-count ((s seq))
  "Get the count of elements in the sequence"
  0)

(defmethod s-reverse ((s seq))
  "Returns a reversed sequence from s"
  (error "Implement in child class"))

;; concrete types

(defclass sq-list (seq)
  ((val :reader val
        :initarg :of
        :initform nil)))

(defun s-make-list (&rest args)
  (make-instance 'sq-list :of args))

(defclass sq-vector (seq)
  ((val :reader val
        :initarg :of
        :initform #())))

(defun s-make-vector (&rest args)
  (make-instance 'sq-vector
		 :of (apply #'vector args)))

;; methods

;; list

(defmethod s-first ((l sq-list))
  (first (val l)))

(defmethod s-rest ((l sq-list))
  (apply #'s-make-list
	 (rest (val l))))

(defmethod s-append ((l sq-list) e)
  (apply #'s-make-list
	 (cons e (val l))))

(defmethod s-count ((l sq-list))
  (length (val l)))

(defmethod s-reverse ((l sq-list))
  (apply #'s-make-list
         (reverse (val l))))

;; vector

(defmethod s-first ((v sq-vector))
  (let* ((v (val v))
	 (vl (length v)))
    (if (> vl 0)
	(elt v 0)
	nil)))

(defmethod s-rest ((v sq-vector))
  (let* ((v (val v))
	 (vl (length v)))
    (if (<= vl 1)
	(s-make-vector)
	(apply #'s-make-vector
	       (loop for i from 1 to (- vl 1)
		     collect (elt v i))))))

(defmethod s-append ((v sq-vector) e)
  (apply #'s-make-vector
	 (coerce (concatenate 'vector
                              (val v)
                              (vector e))
		 'list)))

(defmethod s-count ((v sq-vector))
  (length (val v)))

(defmethod s-reverse ((v sq-vector))
  (apply #'s-make-vector
         (reverse (val v))))

;; util function

(defmethod s-emptyp ((s seq))
  (= (s-count s) 0))

(defmethod s-list ((s sq-list))
  s)

(defmethod s-list ((s sq-vector))
  (apply #'s-make-list
         (coerce (val s) 'list)))

(defmethod s-vector ((s sq-list))
  (apply #'s-make-vector (val s)))

(defmethod s-vector ((s sq-vector))
  s)

(defmethod s-p-atref (stream char)
  (declare (ignore char))
  (list (quote val) (read stream t nil t)))

(set-macro-character #\@ #'s-p-atref)

;; generic algorithms
;; the default return type sequence of algorithms
;; is a list sequence.

;; map
(defmethod s-map-for (f (s seq) accm)
  (cond
    ((s-emptyp s) (s-reverse accm))
    (t (s-map-for f
                  (s-rest s)
                  (s-append
                   accm
                   (funcall f (s-first s)))))))

(defmethod s-map (f (s seq))
  (s-map-for f s (s-make-list)))

;; reduce
(defmethod s-foldl (f init (s seq))
  (if (s-emptyp s)
      init
      (s-foldl f
               (funcall f init (s-first s))
               (s-rest s))))

(defmethod s-reduce (f (s seq) &optional (init nil))
  (cond
    ((null init) (s-foldl f (s-first s) (s-rest s)))
    (t (s-foldl f init s))))

;; filter
(defmethod s-filter (f (s seq)
                     &optional (accm (s-make-list)))
  (cond
    ((s-emptyp s) (s-reverse accm))
    (t (s-filter f
                 (s-rest s)
                 (if (funcall f (s-first s))
                     (s-append accm (s-first s))
                     accm)))))

;; range
(defun s-range (start end
                &optional (by 1))
  (apply #'s-make-list
         (loop for i from start to end by by
               collect i)))