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 (labels
  19     ((%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   (declare (inline %join))
  26   (declaim (inline join join*))
  27   (defun join (connector &rest strings)
  28     (%join (string connector) strings))
  29   (defun join* (connector strings)
  30     (%join (string connector) strings)))
  31
  32 (defmacro shrink-vector (str size)
  33   #+allegro `(excl::.primcall 'sys::shrink-svector ,str ,size)
  34   #+cmu `(lisp::shrink-vector ,str ,size)
  35   #+lispworks `(system::shrink-vector$vector ,str ,size)
  36   #+sbcl `(sb-kernel:shrink-vector ,str ,size)
  37   #+scl `(common-lisp::shrink-vector ,str ,size)
  38   #-(or allegro cmu lispworks sbcl scl) `(subseq ,str 0 ,size))
  39
  40 (declaim (inline full-string))
  41 (defun full-string (string)
  42   (etypecase string
  43     (string
  44      (if (zerop (length string))
  45          nil
  46          string))))