;; Version 0: apply concatenate
;; This version probably shouldn't be used due to apply limits.
(defun s0+ (&rest rest)
  "Return a string which is the arguments concatenated as if output by PRINC."
  (labels ((as-string (s) (if (stringp s) s (princ-to-string s))))
    (apply #'concatenate 'string (mapcar #'as-string rest))))

;; Version 1: string streams
(defun s1+ (&rest rest)
  "Return a string which is the arguments concatenated as if output by PRINC."
  (macrolet ((to-string (x)
	       `(if (stringp ,x) ,x (princ-to-string ,x))))
    (cond
      ((null rest) (make-string 0))
      (t
       (with-output-to-string (result)
	 (loop :for x :in rest :do (princ x result)))))))

;; Version 2: adjustable strings
(defun s2+ (&rest rest)
  "Return a string which is the arguments concatenated as if output by PRINC."
  (macrolet ((to-string (x)
	       `(if (stringp ,x) ,x (princ-to-string ,x))))
    (cond
      ((null rest) (make-string 0))
      (t
       (let ((result (make-array 0 :element-type 'character
				 :fill-pointer 0 :adjustable t
				 :initial-element (code-char 0)))
	     (new-size 0)
	     (old-len 0)
	     (str ""))
         (declare (type fixnum new-size)
		  (type string str))
         (loop :for s :in rest :do
	    (setf str (if (stringp s) s (princ-to-string s))
		  old-len (fill-pointer result)
		  new-size (+ old-len (length str)))
	    (when (>= new-size (array-total-size result))
	      (setf result (adjust-array result new-size)))
	    (incf (fill-pointer result) (length str))
	    (setf (subseq result old-len new-size) str))
         result)))))

;; Version 3: reduce by concatenate
(defun s3+ (&rest rest)
  "Return a string which is the arguments concatenated as if output by PRINC."
  (macrolet ((to-string (x)
	       `(if (stringp ,x) ,x (princ-to-string ,x))))
    (cond
      ((null rest) (make-string 0))
      (t
       (if (not (cdr rest))
	   ;; reduce only works for at least 2 elements
	   (to-string (car rest))
	   (reduce (lambda (a b)
		     (concatenate 'string
				  (if (stringp a) a (princ-to-string a))
				  (if (stringp b) b (princ-to-string b))))
		   rest))))))

;; Sum lengths and replace
(defun s4+ (&rest rest)
  (macrolet ((to-string (x)
	       `(if (stringp ,x) ,x (princ-to-string ,x))))
    (let* ((str-list (mapcar (_ (to-string _)) rest))
	   (len (loop :for i :in rest :sum (length str-list)))
	   (new-str (make-string len)))
      (loop :with i = 0
	 :for s :in str-list
	 :do
	 (replace new-str s :start1 i)
	 (incf i (length s)))
      new-str)))

;; format with pre-allocated fill pointer string
(defun s5+ (&rest rest)
  (macrolet ((to-string (x)
	       `(if (stringp ,x) ,x (princ-to-string ,x))))
    (let* ((str-list (mapcar (_ (to-string _)) rest))
	   (len (loop :for i :in rest :sum (length str-list)))
	   (new-str (make-array len :fill-pointer 0 :element-type 'character)))
      (format new-str "~{~a~}" str-list)
      new-str)))

;; format to a string
(defun s6+ (&rest rest)
  (format nil "~{~a~}" rest))

;; from dlowe on #lisp
(defun s7+ (&rest rest)
  (loop :with r = (make-string (reduce '+ rest :key 'length))
     :for o = 0 :then (+ o (length s))
     :for s :in rest
     :do (replace r s :start1 o)
     :finally (return r)))