base/split-sequence.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- SPLIT-SEQUENCE
   4 ;;;
   5 ;;; This code was based on Arthur Lemmens' in
   6 ;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>;
   7 ;;;
   8
   9 (in-package :iolib.base)
  10
  11 (defun split-sequence (delimiter sequence &key (start 0) (end nil) (from-end nil)
  12                        (count nil) (remove-empty-subseqs nil)
  13                        (test #'eql) (test-not nil) (key #'identity))
  14   "Return a list of subsequences in seq delimited by delimiter.
  15
  16 If :remove-empty-subseqs is NIL, empty subsequences will be included
  17 in the result; otherwise they will be discarded.  All other keywords
  18 work analogously to those for CL:SUBSTITUTE.  In particular, the
  19 behaviour of :from-end is possibly different from other versions of
  20 this function; :from-end values of NIL and T are equivalent unless
  21 :count is supplied. The second return value is an index suitable as an
  22 argument to CL:SUBSEQ into the sequence indicating where processing
  23 stopped."
  24   (check-bounds sequence start end)
  25   (cond
  26     ((and (not from-end) (null test-not))
  27      (split-from-start (lambda (sequence start)
  28                          (position delimiter sequence :start start :key key :test test))
  29                        sequence start end count remove-empty-subseqs))
  30     ((and (not from-end) test-not)
  31      (split-from-start (lambda (sequence start)
  32                          (position delimiter sequence :start start :key key :test-not test-not))
  33                        sequence start end count remove-empty-subseqs))
  34     ((and from-end (null test-not))
  35      (split-from-end (lambda (sequence end)
  36                        (position delimiter sequence :end end :from-end t :key key :test test))
  37                      sequence start end count remove-empty-subseqs))
  38     ((and from-end test-not)
  39      (split-from-end (lambda (sequence end)
  40                        (position delimiter sequence :end end :from-end t :key key :test-not test-not))
  41                      sequence start end count remove-empty-subseqs))))
  42
  43 (defun split-sequence-if (predicate sequence &key (start 0) (end nil) (from-end nil)
  44                           (count nil) (remove-empty-subseqs nil) (key #'identity))
  45   "Return a list of subsequences in seq delimited by items satisfying
  46 predicate.
  47
  48 If :remove-empty-subseqs is NIL, empty subsequences will be included
  49 in the result; otherwise they will be discarded.  All other keywords
  50 work analogously to those for CL:SUBSTITUTE-IF.  In particular, the
  51 behaviour of :from-end is possibly different from other versions of
  52 this function; :from-end values of NIL and T are equivalent unless
  53 :count is supplied. The second return value is an index suitable as an
  54 argument to CL:SUBSEQ into the sequence indicating where processing
  55 stopped."
  56   (check-bounds sequence start end)
  57   (if from-end
  58       (split-from-end (lambda (sequence end)
  59                         (position-if predicate sequence :end end :from-end t :key key))
  60                       sequence start end count remove-empty-subseqs)
  61       (split-from-start (lambda (sequence start)
  62                           (position-if predicate sequence :start start :key key))
  63                         sequence start end count remove-empty-subseqs)))
  64
  65 (defun split-sequence-if-not (predicate sequence &key (count nil) (remove-empty-subseqs nil)
  66                               (from-end nil) (start 0) (end nil) (key #'identity))
  67   "Return a list of subsequences in seq delimited by items satisfying
  68 \(CL:COMPLEMENT predicate).
  69
  70 If :remove-empty-subseqs is NIL, empty subsequences will be included
  71 in the result; otherwise they will be discarded.  All other keywords
  72 work analogously to those for CL:SUBSTITUTE-IF-NOT.  In particular,
  73 the behaviour of :from-end is possibly different from other versions
  74 of this function; :from-end values of NIL and T are equivalent unless
  75 :count is supplied. The second return value is an index suitable as an
  76 argument to CL:SUBSEQ into the sequence indicating where processing
  77 stopped."
  78   (check-bounds sequence start end)
  79   (if from-end
  80       (split-from-end (lambda (sequence end)
  81                         (position-if-not predicate sequence :end end :from-end t :key key))
  82                       sequence start end count remove-empty-subseqs)
  83       (split-from-start (lambda (sequence start)
  84                           (position-if-not predicate sequence :start start :key key))
  85                         sequence start end count remove-empty-subseqs)))
  86
  87 (defun split-from-end (position-fn sequence start end count remove-empty-subseqs)
  88   (loop
  89      :for right := end :then left
  90      :for left := (max (or (funcall position-fn sequence right) -1)
  91                        (1- start))
  92      :unless (and (= right (1+ left))
  93                   remove-empty-subseqs) ; empty subseq we don't want
  94      :if (and count (>= nr-elts count))
  95      ;; We can't take any more. Return now.
  96        :return (values (nreverse subseqs) right)
  97      :else
  98        :collect (subseq sequence (1+ left) right) into subseqs
  99        :and :sum 1 :into nr-elts
 100      :until (< left start)
 101    :finally (return (values (nreverse subseqs) (1+ left)))))
 102
 103 (defun split-from-start (position-fn sequence start end count remove-empty-subseqs)
 104   (let ((length (length sequence)))
 105     (loop
 106        :for left := start :then (+ right 1)
 107        :for right := (min (or (funcall position-fn sequence left) length)
 108                           end)
 109        :unless (and (= right left)
 110                     remove-empty-subseqs) ; empty subseq we don't want
 111        :if (and count (>= nr-elts count))
 112        ;; We can't take any more. Return now.
 113          :return (values subseqs left)
 114        :else
 115          :collect (subseq sequence left right) :into subseqs
 116          :and :sum 1 :into nr-elts
 117        :until (>= right end)
 118      :finally (return (values subseqs right)))))