merged.

Pascal J. Bourguignon [2015-06-23 01:29]
merged.
Filename
common-lisp/cesarum/string.lisp
common-lisp/cesarum/utility.lisp
diff --git a/common-lisp/cesarum/string.lisp b/common-lisp/cesarum/string.lisp
index ca74517..48841dc 100644
--- a/common-lisp/cesarum/string.lisp
+++ b/common-lisp/cesarum/string.lisp
@@ -57,7 +57,8 @@
    "SPLIT-NAME-VALUE" "STRING-REPLACE" "UNSPLIT-STRING" "SPLIT-STRING"
    "SPLIT-ESCAPED-STRING" "IMPLODE-STRING" "EXPLODE-STRING"
    "IMPLODE" "EXPLODE"
-   "CONCATENATE-STRINGS")
+   "CONCATENATE-STRINGS"
+   "MAPCONCAT")
   (:documentation
    "

@@ -147,6 +148,41 @@ CHARACTER-DESIGNATOR is the type of character or designators of



+(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 (+ (reduce (function +) strings :key (function length) :initial-value 0)
+                    (* seplen (1- (length strings)))))
+         (result (make-string totlen)))
+    (loop
+      :for string :in strings
+      :with start = 0
+      :do (replace result string :start1 start)
+          (incf start (length string))
+          (unless (<= totlen start)
+            (replace result separator :start1 start)
+            (incf start seplen)))
+    result))

 (defun concatenate-strings (list-of-string-designators)
   "
diff --git a/common-lisp/cesarum/utility.lisp b/common-lisp/cesarum/utility.lisp
index d969243..fdbbe05 100644
--- a/common-lisp/cesarum/utility.lisp
+++ b/common-lisp/cesarum/utility.lisp
@@ -9,6 +9,7 @@
 ;;;;AUTHORS
 ;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
 ;;;;MODIFICATIONS
+;;;;    2015-06-13 <PJB> Added CHRONO.
 ;;;;    2014-10-22 <PJB> Added hash-table-to-sexp and sexp-to-hash-table.
 ;;;;    2013-06-30 <PJB> Added FLOAT-{,C,E}TYPECASE; exported [-+]EPSILON.
 ;;;;    2008-06-24 <PJB> Added INCF-MOD and DECF-MOD.
@@ -48,6 +49,7 @@
 ;;;;    You should have received a copy of the GNU Affero General Public License
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>
 ;;;;****************************************************************************
+
 (in-package "COMMON-LISP-USER")
 (defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
   (:use "COMMON-LISP"
@@ -122,6 +124,8 @@
    ;;
    "XOR" "EQUIV" "IMPLY"
    ;; "SET-EQUAL"
+   ;; Miscellaneous
+   "CHRONO"
    )
   (:documentation
    "
@@ -160,7 +164,19 @@ License:
 ;; 3 - EVALUATION AND COMPILATION
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-
+(defun chrono* (thunk)
+  "
+Call the THUNK and return the run-time spent on it.
+The results of THUNK are ignored.
+"
+  (let ((start (get-internal-run-time)))
+    (funcall thunk)
+    (let ((end (get-internal-run-time)))
+      (float (/ (- end start) internal-time-units-per-second)
+             1.0d0))))
+
+(defmacro chrono (&body body)
+  `(chrono* (lambda () ,@body)))

 #-:with-debug-gensym
 (defmacro with-gensyms (syms &body body)
ViewGit