api.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
       ---
       api.lisp (3854B)
       ---
            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*)