Changeset 12132


Ignore:
Timestamp:
May 26, 2009, 6:51:03 PM (10 years ago)
Author:
gb
Message:

Provide a CONCAT-TO-STRING (to handle (CONCATENATE 'STRING ...)), mostly
so that I don't forget to check it in.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/sequences.lisp

    r11876 r12132  
    447447       (setq total-length (+ total-length length)))))
    448448
     449(defun concat-to-string (&rest sequences)
     450  (declare (dynamic-extent sequences))
     451  (let* ((size 0))
     452    (declare (fixnum size))
     453    (dolist (seq sequences)
     454      (setq size (+ size (the fixnum (length seq)))))
     455    (let* ((result (make-string size))
     456           (out 0))
     457      (declare (simple-string result) (fixnum out))
     458      (dolist (seq sequences result)
     459        (etypecase seq
     460          (simple-string
     461           (let* ((n (length seq)))
     462             (declare (fixnum n))
     463             (%copy-ivector-to-ivector seq
     464                                       0
     465                                       result
     466                                       (the fixnum (ash out 2))
     467                                       (the fixnum (ash n 2)))
     468             (incf out n)))
     469          (string
     470           (let* ((n (length seq)))
     471             (declare (fixnum n))
     472             (multiple-value-bind (data offset) (array-data-and-offset seq)
     473               (declare (fixnum offset))
     474               (%copy-ivector-to-ivector data
     475                                         (the fixnum (ash offset 2))
     476                                         result
     477                                         (the fixnum (ash out 2))
     478                                         (the fixnum (ash n 2)))
     479               (incf out n))))
     480          (vector
     481           (dotimes (i (length seq))
     482             (setf (schar result out) (aref seq i))
     483             (incf out)))
     484          (list
     485           (dolist (elt seq)
     486             (setf (schar result out) elt))))))))
    449487
    450488;This one doesn't choke on circular lists, doesn't cons as much, and is
Note: See TracChangeset for help on using the changeset viewer.