3rdparties/software/split-sequence-v2.0.0/api.lisp (3854 bytes)
1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 3 (in-package :split-sequence) 4 5 (defun list-long-enough-p (list length) 6 (or (zerop length) 7 (not (null (nthcdr (1- length) list))))) 8 9 (defun check-bounds (sequence start end) 10 (progn 11 (check-type start unsigned-byte "a non-negative integer") 12 (check-type end (or null unsigned-byte) "a non-negative integer or NIL") 13 (typecase sequence 14 (list 15 (when end 16 (unless (list-long-enough-p sequence end) 17 (error "The list is too short: END was ~S but the list is ~S elements long." 18 end (length sequence))))) 19 (t 20 (let ((length (length sequence))) 21 (unless end (setf end length)) 22 (unless (<= start end length) 23 (error "Wrong sequence bounds. START: ~S END: ~S" start end))))))) 24 25 (define-condition simple-program-error (program-error simple-condition) ()) 26 27 (defmacro check-tests (test test-p test-not test-not-p) 28 `(progn 29 (when (and ,test-p ,test-not-p) 30 (error (make-condition 'simple-program-error 31 :format-control "Cannot specify both TEST and TEST-NOT."))) 32 (when (and ,test-not-p (not ,test-p)) 33 (check-type ,test-not (or function (and symbol (not null))))) 34 (when (and ,test-p (not ,test-not-p)) 35 (check-type ,test (or function (and symbol (not null))))))) 36 37 (declaim (ftype (function (&rest t) (values list unsigned-byte)) 38 split-sequence split-sequence-if split-sequence-if-not)) 39 40 (defun split-sequence (delimiter sequence &key (start 0) (end nil) (from-end nil) 41 (count nil) (remove-empty-subseqs nil) 42 (test #'eql test-p) (test-not nil test-not-p) 43 (key #'identity)) 44 (check-bounds sequence start end) 45 (check-tests test test-p test-not test-not-p) 46 (etypecase sequence 47 (list (split-list delimiter sequence start end from-end count 48 remove-empty-subseqs test test-not key)) 49 (vector (split-vector delimiter sequence start end from-end count 50 remove-empty-subseqs test test-not key)) 51 #+(or abcl sbcl) 52 (extended-sequence (split-extended-sequence delimiter sequence start end from-end count 53 remove-empty-subseqs test test-not key)))) 54 55 (defun split-sequence-if (predicate sequence &key (start 0) (end nil) (from-end nil) 56 (count nil) (remove-empty-subseqs nil) (key #'identity)) 57 (check-bounds sequence start end) 58 (etypecase sequence 59 (list (split-list-if predicate sequence start end from-end count 60 remove-empty-subseqs key)) 61 (vector (split-vector-if predicate sequence start end from-end count 62 remove-empty-subseqs key)) 63 #+(or abcl sbcl) 64 (extended-sequence (split-extended-sequence-if predicate sequence start end from-end count 65 remove-empty-subseqs key)))) 66 67 (defun split-sequence-if-not (predicate sequence &key (start 0) (end nil) (from-end nil) 68 (count nil) (remove-empty-subseqs nil) (key #'identity)) 69 (check-bounds sequence start end) 70 (etypecase sequence 71 (list (split-list-if-not predicate sequence start end from-end count 72 remove-empty-subseqs key)) 73 (vector (split-vector-if-not predicate sequence start end from-end count 74 remove-empty-subseqs key)) 75 #+(or abcl sbcl) 76 (extended-sequence (split-extended-sequence-if-not predicate sequence start end from-end count 77 remove-empty-subseqs key)))) 78 79 (pushnew :split-sequence *features*)