Moved mapconcat from cesarum.string to cesarum.sequence.

Pascal J. Bourguignon [2019-02-23 15:03]
Moved mapconcat from cesarum.string to cesarum.sequence.
Filename
common-lisp/cesarum/sequence.lisp
common-lisp/cesarum/string.lisp
diff --git a/common-lisp/cesarum/sequence.lisp b/common-lisp/cesarum/sequence.lisp
index 20b405e..792ab6a 100644
--- a/common-lisp/cesarum/sequence.lisp
+++ b/common-lisp/cesarum/sequence.lisp
@@ -45,7 +45,8 @@
            "PARSE-SEQUENCE-TYPE"
            "CONCATENATE-SEQUENCES"
            "PREFIXP"
-           "SUFFIXP")
+           "SUFFIXP"
+           "MAPCONCAT")
   (:documentation
    "

@@ -432,5 +433,52 @@ RETURN:  Whether SUFFIX is a suffix of the (subseq SEQUENCE START END).
              0)) )


+(defun mapconcat (function sequence separator)
+  (etypecase sequence
+    (list
+     (if sequence
+         (let* ((items (mapcar (lambda (item)
+                                 (let ((sitem (funcall function item)))
+                                   (if (stringp sitem)
+                                       sitem
+                                       (princ-to-string sitem))))
+                               sequence))
+                (ssepa (if (stringp separator)
+                           separator
+                           (princ-to-string separator)))
+                (size (+ (reduce (function +) items :key (function length))
+                         (* (length ssepa) (1- (length items)))))
+                (result (make-array size :element-type 'character))
+                (start  0))
+           (replace result  (first items) :start1 start)
+           (incf start (length (first items)))
+           (dolist (item (rest items))
+             (replace result ssepa :start1 start) (incf start (length ssepa))
+             (replace result item  :start1 start) (incf start (length item)))
+           result)
+         ""))
+    (vector
+     (if (plusp (length sequence))
+         (let* ((items (map 'vector (lambda (item)
+                                      (let ((sitem (funcall function item)))
+                                        (if (stringp sitem)
+                                            sitem
+                                            (princ-to-string sitem))))
+                            sequence))
+                (ssepa (if (stringp separator)
+                           separator
+                           (princ-to-string separator)))
+                (size (+ (reduce (function +) items :key (function length))
+                         (* (length ssepa) (1- (length items)))))
+                (result (make-array size :element-type 'character))
+                (start  0))
+           (replace result (aref items 0) :start1 start) (incf start (length (aref items 0)))
+           (loop
+              :for i :from 1 :below (length items)
+              :do (replace result ssepa :start1 start) (incf start (length ssepa))
+              (replace result (aref items i) :start1 start) (incf start (length (aref items i))))
+           result)
+         ""))))
+

 ;;;; THE END ;;;;
diff --git a/common-lisp/cesarum/string.lisp b/common-lisp/cesarum/string.lisp
index a583889..80c8de4 100644
--- a/common-lisp/cesarum/string.lisp
+++ b/common-lisp/cesarum/string.lisp
@@ -66,8 +66,7 @@
    "SPLIT-NAME-VALUE" "STRING-REPLACE" "UNSPLIT-STRING" "SPLIT-STRING"
    "SPLIT-ESCAPED-STRING" "IMPLODE-STRING" "EXPLODE-STRING"
    "IMPLODE" "EXPLODE"
-   "CONCATENATE-STRINGS"
-   "MAPCONCAT")
+   "CONCATENATE-STRINGS")
   (:documentation
    "

@@ -157,44 +156,6 @@ CHARACTER-DESIGNATOR is the type of character or designators of
 (defun character-designator-p (object)  (typep object 'character-designator))


-(defun mapconcat (function sequence separator)
-  "
-
-FUNCTION:   This function is applied on each element of sequence and
-            shall return a string designator.
-
-SEQUENCE:   A sequence.
-
-SEPARATOR:  A string designator.
-
-RETURN:     A string containing the concatenation of the strings
-            designated by the results of FUNCTION applied on each
-            element of SEQUENCE, with SEPARATOR inserted between each
-            of them.
-
-"
-  (let* ((strings   (map (if (vectorp sequence)
-                             'vector
-                             'list)
-                      (lambda (item) (string (funcall function item)))
-                      sequence))
-         (separator (string separator))
-         (seplen (length separator))
-         (totlen (if (zerop (length strings))
-                     0
-                     (+ (reduce (function +) strings :key (function length) :initial-value 0)
-                        (* seplen (1- (length strings))))))
-         (result (make-string totlen)))
-    (let ((start 0))
-      (map nil (lambda (string)
-                 (replace result string :start1 start)
-                 (incf start (length string))
-                 (unless (<= totlen start)
-                   (replace result separator :start1 start)
-                   (incf start seplen)))
-        strings))
-    result))
-
 (defun concatenate-strings (list-of-string-designators)
   "
 LIST-OF-STRING-DESIGNATORS:
ViewGit