vector.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       vector.lisp (4514B)
       ---
            1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
            2 
            3 (in-package :split-sequence)
            4 
            5 (declaim (inline
            6           split-vector split-vector-if split-vector-if-not
            7           split-vector-from-end split-vector-from-start))
            8 
            9 (deftype array-index (&optional (length array-dimension-limit))
           10   `(integer 0 (,length)))
           11 
           12 (declaim (ftype (function (&rest t) (values list unsigned-byte))
           13                 split-vector split-vector-if split-vector-if-not))
           14 
           15 (declaim (ftype (function (function vector array-index
           16                                     (or null array-index) (or null array-index) boolean)
           17                           (values list unsigned-byte))
           18                 split-vector-from-start split-vector-from-end))
           19 
           20 (defun split-vector
           21     (delimiter vector start end from-end count remove-empty-subseqs test test-not key)
           22   (cond
           23     ((and (not from-end) (null test-not))
           24      (split-vector-from-start (lambda (vector start)
           25                                 (position delimiter vector :start start :key key :test test))
           26                               vector start end count remove-empty-subseqs))
           27     ((and (not from-end) test-not)
           28      (split-vector-from-start (lambda (vector start)
           29                                 (position delimiter vector :start start :key key :test-not test-not))
           30                               vector start end count remove-empty-subseqs))
           31     ((and from-end (null test-not))
           32      (split-vector-from-end (lambda (vector end)
           33                               (position delimiter vector :end end :from-end t :key key :test test))
           34                             vector start end count remove-empty-subseqs))
           35     (t
           36      (split-vector-from-end (lambda (vector end)
           37                               (position delimiter vector :end end :from-end t :key key :test-not test-not))
           38                             vector start end count remove-empty-subseqs))))
           39 
           40 (defun split-vector-if
           41     (predicate vector start end from-end count remove-empty-subseqs key)
           42   (if from-end
           43       (split-vector-from-end (lambda (vector end)
           44                                (position-if predicate vector :end end :from-end t :key key))
           45                              vector start end count remove-empty-subseqs)
           46       (split-vector-from-start (lambda (vector start)
           47                                  (position-if predicate vector :start start :key key))
           48                                vector start end count remove-empty-subseqs)))
           49 
           50 (defun split-vector-if-not
           51     (predicate vector start end from-end count remove-empty-subseqs key)
           52   (if from-end
           53       (split-vector-from-end (lambda (vector end)
           54                                (position-if-not predicate vector :end end :from-end t :key key))
           55                              vector start end count remove-empty-subseqs)
           56       (split-vector-from-start (lambda (vector start)
           57                                  (position-if-not predicate vector :start start :key key))
           58                                vector start end count remove-empty-subseqs)))
           59 
           60 (defun split-vector-from-end (position-fn vector start end count remove-empty-subseqs)
           61   (declare (optimize (speed 3) (debug 0))
           62            (type (function (vector fixnum) (or null fixnum)) position-fn))
           63   (loop
           64     :with end = (or end (length vector))
           65     :for right := end :then left
           66     :for left := (max (or (funcall position-fn vector right) -1)
           67                       (1- start))
           68     :unless (and (= right (1+ left)) remove-empty-subseqs)
           69       :if (and count (>= nr-elts count))
           70         :return (values (nreverse subseqs) right)
           71       :else
           72         :collect (subseq vector (1+ left) right) into subseqs
           73         :and :sum 1 :into nr-elts :of-type fixnum
           74     :until (< left start)
           75     :finally (return (values (nreverse subseqs) (1+ left)))))
           76 
           77 (defun split-vector-from-start (position-fn vector start end count remove-empty-subseqs)
           78   (declare (optimize (speed 3) (debug 0))
           79            (type vector vector)
           80            (type (function (vector fixnum) (or null fixnum)) position-fn))
           81   (let ((length (length vector)))
           82     (loop
           83       :with end = (or end (length vector))
           84       :for left := start :then (1+ right)
           85       :for right := (min (or (funcall position-fn vector left) length)
           86                          end)
           87       :unless (and (= right left) remove-empty-subseqs)
           88         :if (and count (>= nr-elts count))
           89           :return (values subseqs left)
           90         :else
           91           :collect (subseq vector left right) :into subseqs
           92           :and :sum 1 :into nr-elts :of-type fixnum
           93       :until (>= right end)
           94       :finally (return (values subseqs right)))))