src/base/sequence.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Sequence utils
   4 ;;;
   5
   6 (in-package :iolib/base)
   7
   8 (defmacro check-bounds (sequence start end)
   9   (with-gensyms (length)
  10     `(let ((,length (length ,sequence)))
  11        (check-type ,start unsigned-byte "a non-negative integer")
  12        (when ,end (check-type ,end unsigned-byte "a non-negative integer or NIL"))
  13        (unless ,end
  14          (setf ,end ,length))
  15        (unless (<= ,start ,end ,length)
  16          (error "Wrong sequence bounds. start: ~S end: ~S" ,start ,end)))))
  17
  18 (declaim (inline %join))
  19 (defun %join (connector strings)
  20   (concatenate 'string (car strings)
  21                (reduce (lambda (str1 str2)
  22                          (concatenate 'string str1 connector str2))
  23                        (cdr strings)
  24                        :initial-value "")))
  25
  26 (declaim (inline join))
  27 (defun join (connector &rest strings)
  28   (%join (string connector) strings))
  29
  30 (declaim (inline join*))
  31 (defun join* (connector strings)
  32   (%join (string connector) strings))
  33
  34 (defmacro shrink-vector (str size)
  35   #+allegro `(excl::.primcall 'sys::shrink-svector ,str ,size)
  36   #+cmu `(lisp::shrink-vector ,str ,size)
  37   #+lispworks `(system::shrink-vector$vector ,str ,size)
  38   #+sbcl `(sb-kernel:shrink-vector ,str ,size)
  39   #+scl `(common-lisp::shrink-vector ,str ,size)
  40   #-(or allegro cmu lispworks sbcl scl) `(subseq ,str 0 ,size))
  41
  42 (declaim (inline full-string))
  43 (defun full-string (string)
  44   (etypecase string
  45     (string
  46      (if (zerop (length string))
  47          nil
  48          string))))