From 5f3fba52fd7c9984a7f797c4720ec93799d6d786 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 24 Jun 2004 15:12:02 +0000 Subject: [PATCH] r9687: new routines --- debian/changelog | 6 ++++++ macros.lisp | 9 +++++++++ package.lisp | 4 +++- strings.lisp | 31 ++++++++++++++++++++++++++++++- 4 files changed, 48 insertions(+), 2 deletions(-) diff --git a/debian/changelog b/debian/changelog index 96d7fad..3429a8d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-kmrcl (1.75-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 24 Jun 2004 01:19:04 -0600 + cl-kmrcl (1.74-1) unstable; urgency=low * New upstream diff --git a/macros.lisp b/macros.lisp index 1239eb4..c83b3b6 100644 --- a/macros.lisp +++ b/macros.lisp @@ -147,6 +147,15 @@ ,@body)) +(defmacro time-seconds (&body body) + (let ((t1 (gensym))) + `(let ((,t1 (get-internal-real-time))) + (values + (progn ,@body) + (coerce (/ (- (get-internal-real-time) ,t1) + internal-time-units-per-second) + 'double-float))))) + (defmacro time-iterations (n &body body) (let ((i (gensym)) (count (gensym))) diff --git a/package.lisp b/package.lisp index 042fc11..8bb206b 100644 --- a/package.lisp +++ b/package.lisp @@ -71,7 +71,8 @@ #:shrink-vector #:collapse-whitespace #:string->list - + #:trim-non-alphanumeric + ;; io.lisp #:indent-spaces #:indent-html-spaces @@ -121,6 +122,7 @@ ;; macros.lisp #:time-iterations + #:time-seconds #:in #:mean #:with-gensyms diff --git a/strings.lisp b/strings.lisp index 4ef18f0..533bf01 100644 --- a/strings.lisp +++ b/strings.lisp @@ -604,7 +604,12 @@ for characters in a string" (defun split-alphanumeric-string (string) "Separates a string at any non-alphanumeric chararacter" - (flet ((is-sep (char) (non-alphanumericp char))) + (declare (simple-string string) + (optimize (speed 3) (safety 0))) + (flet ((is-sep (char) + (declare (character char)) + (and (non-alphanumericp char) + (not (char= #\_ char))))) (let ((tokens nil)) (do* ((token-start (position-if-not #'is-sep string) @@ -619,6 +624,30 @@ for characters in a string" (push (subseq string token-start token-end) tokens))))) +(defun trim-non-alphanumeric (word) + "Strip non-alphanumeric characters from beginning and end of a word." + (declare (simple-string word) + (optimize (speed 3) (safety 0) (size 0))) + (let* ((start 0) + (len (length word)) + (end len)) + (declare (fixnum start end len)) + (do ((done nil)) + ((or done (= start end))) + (if (alphanumericp (schar word start)) + (setq done t) + (incf start))) + (when (> end start) + (do ((done nil)) + ((or done (= start end))) + (if (alphanumericp (schar word (1- end))) + (setq done t) + (decf end)))) + (if (or (plusp start) (/= len end)) + (subseq word start end) + word))) + + (defun collapse-whitespace (s) "Convert multiple whitespace characters to a single space character." -- 2.34.1