[cl-irc-cvs] r148 - trunk

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Wed May 3 21:12:43 UTC 2006


Author: ehuelsmann
Date: Wed May  3 17:12:42 2006
New Revision: 148

Modified:
   trunk/parse-message.lisp
   trunk/utility.lisp
Log:
Make message parsing more memory efficient by using displaced arrays.

Partially resolve issue #7.

Modified: trunk/parse-message.lisp
==============================================================================
--- trunk/parse-message.lisp	(original)
+++ trunk/parse-message.lisp	Wed May  3 17:12:42 2006
@@ -112,8 +112,8 @@
 
 (defun ctcp-type-p (string type)
   "Is the `string' actually a representation of the CTCP `type'?"
-  (if (string-equal (subseq string 1 (min (length string) 
-                                          (1+ (length (symbol-name type))))) 
+  (if (string-equal (substring string 1 (min (length string)
+                                             (1+ (length (symbol-name type)))))
                     type)
       type
       nil))

Modified: trunk/utility.lisp
==============================================================================
--- trunk/utility.lisp	(original)
+++ trunk/utility.lisp	Wed May  3 17:12:42 2006
@@ -106,6 +106,14 @@
   "Create a socket connected to `server':`port' and return stream for it."
   (trivial-sockets:open-stream server port))
 
+(defun substring (string start &optional end)
+  (let* ((end-index (if end end (length string)))
+         (seq-len (- end-index start)))
+    (make-array seq-len
+                :element-type (array-element-type string)
+                :displaced-to string
+                :displaced-index-offset start)))
+
 
 (defun cut-between (string start-char end-chars &key (start 0) (cut-extra t))
   "If `start-char' is not nil, cut string between `start-char' and any
@@ -127,11 +135,11 @@
     (if (and end-position start-char)
         (if (eql (char string start) start-char)
             (values end-position
-                    (subseq string cut-from end-position))
+                    (substring string cut-from end-position))
             (values start nil))
         (if end-position
             (values end-position
-                    (subseq string cut-from end-position))
+                    (substring string cut-from end-position))
             (values start nil)))))
 
 (defun cut-before (string substring end-chars &key (start 0) (cut-extra t))
@@ -146,7 +154,7 @@
   (let ((end-position (search substring string :start2 start)))
     (if end-position
         (values (+ end-position (1- (length substring)))
-                (subseq string (if (and cut-extra
+                (substring string (if (and cut-extra
                                         (< start end-position))
                                    (1+ start) start) end-position))
       (let ((end-position (position-if #'(lambda (x)
@@ -155,7 +163,7 @@
             (cut-from (if cut-extra (1+ start) start)))
         (if end-position
             (values end-position
-                    (subseq string cut-from end-position))
+                    (substring string cut-from end-position))
           (values start nil))))))
 
 



More information about the cl-irc-cvs mailing list