bknr-cvs

bknr-cvs@common-lisp.net

1964 discussions

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation.lisp
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3610 Author: ksprotte URL: http://bknr.net/trac/changeset/3610 small correction for the fact that search-adjacent now returns m2 objects U trunk/projects/bos/m2/allocation.lisp Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-24 10:11:59 UTC (rev 3609) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-24 10:59:03 UTC (rev 3610) @@ -350,7 +350,7 @@ (assert (alexandria:setp result :test #'equal)) (assert (= n (length result))) (decf (allocation-area-free-m2s area) n) - (return (mapcar (alexandria:curry #'apply #'ensure-m2) result))) + (return result)) (when (> (get-internal-real-time) deadline) (return nil)))))))

1 0

[bknr-cvs] hans changed trunk/projects/bos/m2/allocation.lisp
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3609 Author: hans URL: http://bknr.net/trac/changeset/3609 Use apply, not funcall now. U trunk/projects/bos/m2/allocation.lisp Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-24 10:01:26 UTC (rev 3608) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-24 10:11:59 UTC (rev 3609) @@ -306,7 +306,7 @@ (try-get (x y) (let ((m2 (ensure-m2 x y))) (when (and (not (gethash m2 allocated)) - (apply pred m2)) + (funcall pred m2)) m2))) (get-next-neighbor (m2) (let ((x (m2-x m2))

1 0

[bknr-cvs] hans changed trunk/projects/bos/m2/allocation.lisp
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3608 Author: hans URL: http://bknr.net/trac/changeset/3608 Refactored... U trunk/projects/bos/m2/allocation.lisp Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-24 09:19:16 UTC (rev 3607) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-24 10:01:26 UTC (rev 3608) @@ -7,7 +7,7 @@ (width :update) (height :update) (vertices :update) - (y :update) + (y :update) (total-m2s :read) (free-m2s :update) (bounding-box :update :transient t)) @@ -45,7 +45,7 @@ (defmethod notify-tiles ((allocation-area allocation-area)) (mapc #'(lambda (tile) (image-tile-changed tile)) (allocation-area-tiles allocation-area))) -(defmethod destroy-object :before ((allocation-area allocation-area)) +(defmethod destroy-object :before ((allocation-area allocation-area)) (notify-tiles allocation-area)) (defmethod initialize-transient-instance :after ((allocation-area allocation-area)) @@ -119,7 +119,7 @@ (when (point-in-polygon-p x y (allocation-area-vertices allocation-area)) (error "new allocation area must not intersect with existing allocation area ~A" allocation-area)))))) - + (make-allocation-area/unchecked vertices)) (deftransaction make-allocation-area/unchecked (vertices) @@ -132,8 +132,8 @@ :width width :height height :y top - :active-p nil - :vertices vertices))) + :active-p nil + :vertices vertices))) result))) (defmethod allocation-area-bounding-box ((allocation-area allocation-area)) @@ -161,7 +161,7 @@ (defun allocation-areas-plus-contracts-bounding-box () "Returns the bounding-box as with ALLOCATION-AREAS-BOUNDING-BOX, but possibly augmented by any contracts that dont have an allocation-area -anymore." +anymore." (geometry:with-bounding-box-collect (collect) (awhen (allocation-areas-bounding-box) (geometry:with-rectangle (it) @@ -290,77 +290,69 @@ (setf consistent-p nil)) consistent-p)) -;;; allocation -(defun try-allocation (n start-x start-y pred) +(defun search-adjacent (n m2 pred) "Try to find N free square meters that are adjacent and that begin -at X and Y. PRED is a predicate function of two arguments that +at square meter M2. PRED is a predicate function of two arguments that returns a true value if the arguments specify the coordinates of an allocatable square meter." - (unless (funcall pred start-x start-y) - (error "sqm ~A/~A not allocatable" start-x start-y)) - (let* ((allocated (make-hash-table :test #'equal)) - (border-queue (make-queue)) - connected) - (labels - ((enqueue* (x y) - (let ((key (list x y))) - (setf (gethash key allocated) t) - (enqueue key border-queue))) - (try-get (&rest key) - (and (not (gethash key allocated)) - (apply pred key) - key)) - (get-next-neighbor (x y) - (or (try-get (1+ x) y) - (try-get x (1+ y)) - (try-get (1- x) y) - (try-get x (1- y))))) - (enqueue* start-x start-y) - (dotimes (i (1- n) - (append connected (queue-elements border-queue))) - (tagbody - retry - (if (queue-empty-p border-queue) - (return nil) - (destructuring-bind (x y) (peek-queue border-queue) - (let ((next (get-next-neighbor x y))) + (when (funcall pred m2) + (let* ((allocated (make-hash-table :test #'eq)) + (border-queue (make-queue)) + completely-checked) + (labels + ((to-border-queue (m2) + (setf (gethash m2 allocated) t) + (enqueue m2 border-queue)) + (try-get (x y) + (let ((m2 (ensure-m2 x y))) + (when (and (not (gethash m2 allocated)) + (apply pred m2)) + m2))) + (get-next-neighbor (m2) + (let ((x (m2-x m2)) + (y (m2-y m2))) + (or (try-get (1+ x) y) + (try-get x (1+ y)) + (try-get (1- x) y) + (try-get x (1- y)))))) + (to-border-queue m2) + (dotimes (i (1- n) + (nconc completely-checked (queue-elements border-queue))) + (tagbody + check-next + (if (queue-empty-p border-queue) + (return nil) + (let ((next (get-next-neighbor (peek-queue border-queue)))) (cond (next - (apply #'enqueue* next)) + (to-border-queue next)) (t - (push (dequeue border-queue) connected) - (go retry))))))))))) + (push (dequeue border-queue) completely-checked) + (go check-next))))))))))) (defun allocate-in-area (area n) (let* ((area-left (allocation-area-left area)) (area-top (allocation-area-top area)) (area-width (allocation-area-width area)) (area-height (allocation-area-height area)) - ;; (area-right (+ area-left area-width)) - ;; (area-bottom (+ area-top area-height)) - ) - (labels ((allocatable-p (x y) - (and (in-polygon-p x y (allocation-area-vertices area)) - (not (m2-contract (ensure-m2 x y)))))) - (loop with deadline = (+ (get-internal-real-time) - ;; give up after 10 ms - (* (/ 10 1000) internal-time-units-per-second)) - do (let ((x (+ area-left (random area-width))) - (y (+ area-top (random area-height)))) - (when (allocatable-p x y) - (let ((result (try-allocation n x y #'allocatable-p))) - (when result - (assert (alexandria:setp result :test #'equal)) - (assert (= n (length result))) - (decf (allocation-area-free-m2s area) n) - (return-from allocate-in-area - (mapcar (lambda (x-y) - (destructuring-bind (x y) - x-y - (ensure-m2 x y))) - result)))))) - when (> (get-internal-real-time) deadline) - return nil)))) + (deadline (+ (get-internal-real-time) + ;; give up after 10 ms + (* (/ 10 1000) internal-time-units-per-second)))) + (labels ((allocatable-p (m2) + (and (in-polygon-p (m2-x m2) (m2-y m2) (allocation-area-vertices area)) + (not (m2-contract m2))))) + (loop + (let* ((x (+ area-left (random area-width))) + (y (+ area-top (random area-height))) + (m2 (ensure-m2 x y)) + (result (search-adjacent n m2 #'allocatable-p))) + (when result + (assert (alexandria:setp result :test #'equal)) + (assert (= n (length result))) + (decf (allocation-area-free-m2s area) n) + (return (mapcar (alexandria:curry #'apply #'ensure-m2) result))) + (when (> (get-internal-real-time) deadline) + (return nil))))))) (defun allocate-m2s-for-sale (n) "The main entry point to the allocation machinery. Will return a @@ -369,7 +361,7 @@ (dolist (area (active-allocation-areas)) (when (<= n (allocation-area-free-m2s area)) (let ((m2s (allocate-in-area area n))) - (when m2s + (when m2s (return-from allocate-m2s-for-sale m2s))))) (dolist (area (inactive-nonempty-allocation-areas)) (when (<= n (allocation-area-free-m2s area)) @@ -382,7 +374,7 @@ (:documentation "Mark the given square meters as free, so that they can be re-allocated.")) -(defmethod return-contract-m2s (m2s) +(defmethod return-contract-m2s (m2s) (loop for m2 in m2s for allocation-area = (m2-allocation-area m2) when allocation-area

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation.lisp
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3607 Author: ksprotte URL: http://bknr.net/trac/changeset/3607 allocation-area more readable using DEADLINE timestamp U trunk/projects/bos/m2/allocation.lisp Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-24 09:11:18 UTC (rev 3606) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-24 09:19:16 UTC (rev 3607) @@ -342,7 +342,9 @@ (labels ((allocatable-p (x y) (and (in-polygon-p x y (allocation-area-vertices area)) (not (m2-contract (ensure-m2 x y)))))) - (loop with start-time = (get-internal-real-time) + (loop with deadline = (+ (get-internal-real-time) + ;; give up after 10 ms + (* (/ 10 1000) internal-time-units-per-second)) do (let ((x (+ area-left (random area-width))) (y (+ area-top (random area-height)))) (when (allocatable-p x y) @@ -357,9 +359,7 @@ x-y (ensure-m2 x y))) result)))))) - when (> (- (get-internal-real-time) start-time) - ;; give up after 10 ms - (* (/ 10 1000) internal-time-units-per-second)) + when (> (get-internal-real-time) deadline) return nil)))) (defun allocate-m2s-for-sale (n)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation.lisp
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3606 Author: ksprotte URL: http://bknr.net/trac/changeset/3606 allocate-in-area now gives up after 10ms U trunk/projects/bos/m2/allocation.lisp Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-23 23:45:26 UTC (rev 3605) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-24 09:11:18 UTC (rev 3606) @@ -342,21 +342,25 @@ (labels ((allocatable-p (x y) (and (in-polygon-p x y (allocation-area-vertices area)) (not (m2-contract (ensure-m2 x y)))))) - (dotimes (i 10) - (let ((x (+ area-left (random area-width))) - (y (+ area-top (random area-height)))) - (when (allocatable-p x y) - (let ((result (try-allocation n x y #'allocatable-p))) - (when result - (assert (alexandria:setp result :test #'equal)) - (assert (= n (length result))) - (decf (allocation-area-free-m2s area) n) - (return-from allocate-in-area - (mapcar (lambda (x-y) - (destructuring-bind (x y) - x-y - (ensure-m2 x y))) - result)))))))))) + (loop with start-time = (get-internal-real-time) + do (let ((x (+ area-left (random area-width))) + (y (+ area-top (random area-height)))) + (when (allocatable-p x y) + (let ((result (try-allocation n x y #'allocatable-p))) + (when result + (assert (alexandria:setp result :test #'equal)) + (assert (= n (length result))) + (decf (allocation-area-free-m2s area) n) + (return-from allocate-in-area + (mapcar (lambda (x-y) + (destructuring-bind (x y) + x-y + (ensure-m2 x y))) + result)))))) + when (> (- (get-internal-real-time) start-time) + ;; give up after 10 ms + (* (/ 10 1000) internal-time-units-per-second)) + return nil)))) (defun allocate-m2s-for-sale (n) "The main entry point to the allocation machinery. Will return a

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-ppcre/doc/index.html
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3605 Author: edi URL: http://bknr.net/trac/changeset/3605 Fix two typos U trunk/thirdparty/cl-ppcre/doc/index.html Modified: trunk/thirdparty/cl-ppcre/doc/index.html =================================================================== --- trunk/thirdparty/cl-ppcre/doc/index.html 2008-07-23 23:03:10 UTC (rev 3604) +++ trunk/thirdparty/cl-ppcre/doc/index.html 2008-07-23 23:45:26 UTC (rev 3605) @@ -2123,7 +2123,7 @@ in <code>"[a-ge-kf]"</code>) or to otherwise optimize these tests for speed. However, you can play with <a href="#*optimize-char-classes*"><code>*OPTIMIZE-CHAR-CLASSES*</code></a> - if you've identified character classes as bottleneck and want to + if you've identified character classes as a bottleneck and want to make sure that you have O(1) test functions. <li>If you know that the expression you're looking for is anchored, @@ -2131,7 +2131,7 @@ your scanners more efficient. <li>In addition to anchors, constant strings at the start or end of a - regular expression can help the engine to quickly scan a strang. + regular expression can help the engine to quickly scan a string. Note that for example <code>"(a-d|aebf)"</code> and <code>"ab(cd|ef)"</code> are equivalent, but only the second form has a constant start the regex engine can recognize. @@ -2208,7 +2208,7 @@ OpenMCL. -$Header: /usr/local/cvsrep/cl-ppcre/doc/index.html,v 1.195 2008/07/23 22:24:52 edi Exp $ +$Header: /usr/local/cvsrep/cl-ppcre/doc/index.html,v 1.197 2008/07/23 23:45:18 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body>

1 0

[bknr-cvs] edi changed tags/thirdparty/cl-unicode-0.1.0/
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3604 Author: edi URL: http://bknr.net/trac/changeset/3604 Tag cl-unicode 0.1.0 A tags/thirdparty/cl-unicode-0.1.0/ Copied: tags/thirdparty/cl-unicode-0.1.0 (from rev 3603, trunk/thirdparty/cl-unicode)

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-unicode/
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3603 Author: edi URL: http://bknr.net/trac/changeset/3603 Update cl-unicode to release version U trunk/thirdparty/cl-unicode/CHANGELOG.txt U trunk/thirdparty/cl-unicode/doc/index.html U trunk/thirdparty/cl-unicode/test/simple U trunk/thirdparty/cl-unicode/util.lisp Modified: trunk/thirdparty/cl-unicode/CHANGELOG.txt =================================================================== --- trunk/thirdparty/cl-unicode/CHANGELOG.txt 2008-07-23 23:01:07 UTC (rev 3602) +++ trunk/thirdparty/cl-unicode/CHANGELOG.txt 2008-07-23 23:02:44 UTC (rev 3603) @@ -1,3 +1,3 @@ Version 0.1.0 -2008-07-23 +2008-07-24 Initial release Modified: trunk/thirdparty/cl-unicode/doc/index.html =================================================================== --- trunk/thirdparty/cl-unicode/doc/index.html 2008-07-23 23:01:07 UTC (rev 3602) +++ trunk/thirdparty/cl-unicode/doc/index.html 2008-07-23 23:02:44 UTC (rev 3603) @@ -867,8 +867,8 @@ look-ups by removing all whitespace, hyphens, and underline characters. -Tries not to remove hyphens preceded by spaces if this could lead to -ambiguities as described in +Tries not to remove hyphens preceded by spaces or underlines if this +could lead to ambiguities as described in <a href="http://unicode.org/unicode/reports/tr18/#Name_Properties">http://unicode.org/unicode/reports/tr18/#Name_Properties</a>. All CL-UNICODE functions which accept string names for characters @@ -895,8 +895,11 @@ CL-USER 7 > (canonicalize-name (canonicalize-name "TIBETAN LETTER -A")) "TIBETANLETTER -A" + +CL-USER 8 > (canonicalize-name "Tibetan_Letter_-A") +"TibetanLetter -A" </pre> -Note that the preceding space is relevant in the ambiguous cases (but +Note that the preceding chracter is relevant in the ambiguous cases (but there are only three of them): <pre> CL-USER 8 > (char= (<a href="#character-named" class=none>character-named</a> "TibetanLetter A") (<a href="#character-named" class=none>character-named</a> "TibetanLetter -A")) @@ -1160,6 +1163,9 @@ set <a href="#*try-lisp-syntax-p*"><code>*TRY-LISP-SYNTAX-P*</code></a> to a true value when enabling the alternative syntax, so that you can still use the short syntax (like <code>#\a</code>) for characters.) + +For an alternative syntax for strings +see <a href="http://weitz.de/cl-interpol/">CL-INTERPOL</a>. </blockquote>  @@ -1264,7 +1270,7 @@ This documentation was prepared with <a href="http://weitz.de/documentation-template/">DOCUMENTATION-TEMPLATE</a>. -$Header: /usr/local/cvsrep/cl-unicode/doc/index.html,v 1.10 2008/07/23 02:22:20 edi Exp $ +$Header: /usr/local/cvsrep/cl-unicode/doc/index.html,v 1.12 2008/07/23 14:55:26 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: trunk/thirdparty/cl-unicode/test/simple =================================================================== --- trunk/thirdparty/cl-unicode/test/simple 2008-07-23 23:01:07 UTC (rev 3602) +++ trunk/thirdparty/cl-unicode/test/simple 2008-07-23 23:02:44 UTC (rev 3603) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/test/simple,v 1.13 2008/07/21 23:12:56 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/test/simple,v 1.14 2008/07/23 14:11:42 edi Exp $ ;;; some simple tests for CL-UNICODE - entered manually and to be read ;;; in the CL-UNICODE-TEST package; all forms are expected to return a @@ -390,8 +390,10 @@ ;; ambiguous names (see NORMALIZE-NAME) (= #xf68 (character-named "TIBETAN LETTER A" :want-code-point-p t)) +(= #xf68 (character-named "Tibetan_Letter_A" :want-code-point-p t)) (= #xf68 (character-named "TIBETANLETTERA" :want-code-point-p t)) (= #xf60 (character-named "TIBETAN LETTER -A" :want-code-point-p t)) +(= #xf60 (character-named "Tibetan_Letter_-A" :want-code-point-p t)) (= #xfb8 (character-named "TIBETAN SUBJOINED LETTER A" :want-code-point-p t)) (= #xfb8 (character-named "TIBETANSUBJOINEDLETTERA" :want-code-point-p t)) (= #xfb0 (character-named "TIBETAN SUBJOINED LETTER -A" :want-code-point-p t)) Modified: trunk/thirdparty/cl-unicode/util.lisp =================================================================== --- trunk/thirdparty/cl-unicode/util.lisp 2008-07-23 23:01:07 UTC (rev 3602) +++ trunk/thirdparty/cl-unicode/util.lisp 2008-07-23 23:02:44 UTC (rev 3603) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/util.lisp,v 1.26 2008/07/22 12:20:14 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/util.lisp,v 1.27 2008/07/23 14:11:40 edi Exp $ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. @@ -45,10 +45,11 @@ All CL-UNICODE functions which accept string \"names\" for characters or properties will canonicalize the name first using this function and will then look up the name case-insensitively." - (values (ppcre:regex-replace-all "( -A| O-E)$|[-_\\s]" name + (values (ppcre:regex-replace-all "[ _](-A|O-E)$|[-_\\s]" name (lambda (match register) (declare (ignore match)) - (or register "")) + (cond (register (format nil " ~A" register)) + (t ""))) :simple-calls t))) (defun property-symbol (name)

1 0

[bknr-cvs] edi changed tags/thirdparty/cl-ppcre-2.0.0/
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3602 Author: edi URL: http://bknr.net/trac/changeset/3602 Tag cl-ppcre 2.0.0 A tags/thirdparty/cl-ppcre-2.0.0/ Copied: tags/thirdparty/cl-ppcre-2.0.0 (from rev 3601, trunk/thirdparty/cl-ppcre)

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-ppcre/
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3601 Author: edi URL: http://bknr.net/trac/changeset/3601 Update to release version U trunk/thirdparty/cl-ppcre/CHANGELOG U trunk/thirdparty/cl-ppcre/doc/index.html U trunk/thirdparty/cl-ppcre/scanner.lisp U trunk/thirdparty/cl-ppcre/specials.lisp Modified: trunk/thirdparty/cl-ppcre/CHANGELOG =================================================================== --- trunk/thirdparty/cl-ppcre/CHANGELOG 2008-07-23 22:58:59 UTC (rev 3600) +++ trunk/thirdparty/cl-ppcre/CHANGELOG 2008-07-23 23:00:43 UTC (rev 3601) @@ -1,12 +1,13 @@ Version 2.0.0 -2008-07-23 +2008-07-24 Added named properties (\p{foo}) Added Unicode support Introduced test functions for character classes Added optional test function optimization Cleaned up test suite, removed performance cruft Removed the various alternative system definitions (too much maintenance work) -Exported PARSE-STRING +Exported PARSE-STRING +Changed default value of *USE-BMH-MATCHERS* General cleanup Lots of documentation additions Modified: trunk/thirdparty/cl-ppcre/doc/index.html =================================================================== --- trunk/thirdparty/cl-ppcre/doc/index.html 2008-07-23 22:58:59 UTC (rev 3600) +++ trunk/thirdparty/cl-ppcre/doc/index.html 2008-07-23 23:00:43 UTC (rev 3601) @@ -143,6 +143,7 @@ <li><a href="#backslash">Backslashes may confuse you...</a> </ol> <li><a href="#allegro">AllegroCL compatibility mode</a> + <li><a href="#blabla">Hints, comments, performance considerations</a> <li><a href="#ack">Acknowledgements</a> </ol> @@ -223,8 +224,7 @@ <li><code>\N{name}</code> (named characters), <code>\x{263a}</code> (wide hex characters), <code>\l</code>, <code>\u</code>, <code>\L</code>, and <code>\U</code> -because they're actually not part of Perl's regex syntax and -(honestly) because I was too lazy - but see <a href="http://weitz.de/cl-interpol/">CL-INTERPOL</a>. +because they're actually not part of Perl's regex syntax - but see <a href="http://weitz.de/cl-interpol/">CL-INTERPOL</a>. <li><code>\X</code> (extended Unicode), and <code>\C</code> (single character). But you can of course use all characters @@ -1192,20 +1192,19 @@ [Special variable] <a class=none name="*use-bmh-matchers*">*use-bmh-matchers*</a> -<blockquote> Usually, the scanners created by <a -href="#create-scanner"><code>CREATE-SCANNER</code></a> (or -implicitly by other functions and macros) will use fast <a -href="http://www-igm.univ-mlv.fr/~lecroq/string/node18.html">Boyer-Moore-Horspool -matchers</a> to check for constant strings at the start or end of the -regular expression. If <code>*USE-BMH-MATCHERS*</code> is -<code>NIL</code> (the default is <code>T</code>), the standard -function <a -href="http://www.lispworks.com/documentation/HyperSpec/Body/f_search.htm"><code>SEARCH</code></a> -will be used instead. This will usually be a bit slower but can save -lots of space if you're storing many scanners. The <a -href="#test">test suite</a> will automatically set -<code>*USE-BMH-MATCHERS*</code> to <code>NIL</code> while you're running -the default test. +<blockquote> Usually, the scanners created +by <a href="#create-scanner"><code>CREATE-SCANNER</code></a> (or +implicitly by other functions and macros) will use the standard +function <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_search.htm"><code>SEARCH</code></a> +to check for constant strings at the start or end of the regular +expression. If <code>*USE-BMH-MATCHERS*</code> is true (the default +is <code>NIL</code>), +fast <a href="http://www-igm.univ-mlv.fr/~lecroq/string/node18.html">Boyer-Moore-Horspool +matchers</a> will be used instead. This will usually be faster but +can make the scanners considerably bigger. Per BMH matcher - there +can be up to two per scanner - a fixnum array of +size <a href="#*regex-char-code-limit*"><code>*REGEX-CHAR-CODE-LIMIT*</code></a> +is allocated and closed over. Note: Due to the nature of <a href="http://www.lispworks.com/documentation/HyperSpec/Body/s_ld_tim.htm"><code>LOAD-TIME-VALUE</code></a> and the <a href="#compiler-macro">compiler macro for <code>SCAN</code> and other functions</a>, some @@ -1638,7 +1637,7 @@   <h3><a name="unicode" class=none>Unicode properties</a></h3> You can add support for Unicode properties to CL-PPCRE by loading -the CL-PPCRE-UNICODE system: +the CL-PPCRE-UNICODE system (which depends on <a href="http://weitz.de/cl-unicode/">CL-UNICODE</a>): <pre> (asdf:oos 'asdf:load-op :cl-ppcre-unicode) </pre> @@ -2039,6 +2038,148 @@ </pre> before you compile CL-PPCRE. +   <h3><a class=none name="blabla">Hints, comments, performance considerations</a></h3> + +Here are, in no particular order, a couple of things about CL-PPCRE +and regular expressions in general that you might or might not want to +read. + +<ul> + <li>A lot of hackers (especially users of Perl and other scripting + languages) think that regular expressions are the greatest thing + since slice bread and use it for almost everything. That is just + plain wrong. Other hackers (especially Lispers) tend to think that + regular expressions are the work of the devil and try to avoid them + at all cost. That's also wrong. Regular expressions are a handy + and useful addition to your toolkit which you should use when + appropriate - you should just try to figure out first if + they're appropriate for the task at hand. + + <li>If you're concerned about the string syntax of regular + expressions which can look like line noise and is really hard to + read for long expressions, consider using + CL-PPCRE's <a href="#create-scanner2">S-expression syntax</a> + instead. It is less error-prone and you don't have to worry about + escaping characters. It is also easier to manipulate + programmatically. + + <li>For alternations, order is important. The general rule is that + the regex engine tries from left to right and tries to match as much + as possible. +<pre> +CL-USER 1 > (scan-to-strings "<=|<" "<=") +"<=" +#() + +CL-USER 2 > (scan-to-strings "<|<=" "<=") +"<" +#() +</pre> + + <li><a class=none name="compiler-macro">CL-PPCRE</a> + uses <a href="http://www.lispworks.com/documentation/HyperSpec/Body/03_bba.htm">compiler + macros</a> to pre-compile scanners + at <a href=="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_l.htm#load_time">load + time</a> if possible. This happens if the compiler can determine + that the regular expression (no matter if it's a string or an + S-expression) + is <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_consta.htm">constant</a> + at <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_c.htm#compile_…">compile + time</a> and is intended to save the time for creating scanners + at <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_e.htm#executio…">execution + time</a> (probably creating the same scanner over and over in a + loop). Make sure you don't prevent the compiler from helping you. + For example, a definition like this one is usually not a good idea: +<pre> +(defun regex-match (regex target) + ;; don't do that! + (scan regex target)) +</pre> + + <li>If you want to search for a substring in a large string or if + you search for the same string very + often, <a href="#scan"><code>SCAN</code></a> will usually be faster + than Common + Lisp's <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_search.htm"><code>SEARCH</code></a> + if you <a href="#*use-bmh-matchers*">use BMH matchers</a>. However, + this only makes sense if scanner creation time is not the + limiting factor, i.e. if the search target is very large or + if you're using the same scanner very often. + + <li>Complementary to the last hint, don't use regular + expressions for one-time searches for constant strings. That's a + terrible waste of resources. + + <li><a href="#*use-bmh-matchers*"><code>*USE-BMH-MATCHERS*</code></a> together with a large value for + <a href="#*regex-char-code-limit*"><code>*REGEX-CHAR-CODE-LIMIT*</code></a> + can lead to huge scanners. + + <li>A character class is by default translated into a sequence of + tests exactly as you might expect. For + example, <code>"[af-l\\d]"</code> means to test if the character is + equal to <code>#\a</code>, then to test if it's + between <code>#\f</code> and <code>#\l</code>, then if it's a digit. + There's by default no attempt to remove redundancy (as + in <code>"[a-ge-kf]"</code>) or to otherwise optimize these tests + for speed. However, you can play + with <a href="#*optimize-char-classes*"><code>*OPTIMIZE-CHAR-CLASSES*</code></a> + if you've identified character classes as bottleneck and want to + make sure that you have O(1) test functions. + + <li>If you know that the expression you're looking for is anchored, + use anchors in your regex. This can help the engine a lot to make + your scanners more efficient. + + <li>In addition to anchors, constant strings at the start or end of a + regular expression can help the engine to quickly scan a strang. + Note that for example <code>"(a-d|aebf)"</code> + and <code>"ab(cd|ef)"</code> are equivalent, but only the second + form has a constant start the regex engine can recognize. + + <li>Try to avoid alternations if possible or at least factor them + out as in the example above. + + <li>If neither anchors nor constant strings are in sight, maybe + "standalone" (sometimes also called "possessive") regular + expressions can be helpful. Try the following: +<pre> +(let ((target (make-string 10000 :initial-element #\a)) + (scanner-1 (create-scanner "a*\\d")) + (scanner-2 (create-scanner "(?>a*)\\d"))) + (time (scan scanner-1 target)) + (time (scan scanner-2 target))) +</pre> + + <li>Consider using <a href="#create-scanner">"single-line mode"</a> + if it makes sense for your task. By default (following Perl's + practice), a dot means to search for any character except + line breaks. In single-line mode a dot searches for any + character which in some cases means that large parts of the target + can actually be skipped. This can be vastly more efficient for + large targets. + + <li>Don't use capturing register groups where a non-capturing group + would do, i.e. only use registers if you need to refer to + them later. If you use a register, each scan process needs to + allocate space for it and update its contents (possibly many times) + until it's finished. (In Perl parlance - use <code>"(?:foo)"</code> instead of + <code>"(foo)"</code> whenever possible.) + + <li>In addition to what has been said in the last hint, note that + Perl semantics force the regex engine to report the last + match for each register. This implies for example + that <code>"([a-c])+"</code> and <code>"[a-c]*([a-c])"</code> have + exactly the same semantics but completely different performance + characteristics. (Actually, in some cases CL-PPCRE automatically + converts expressions from the first type into the second type. + That's not always possible, though, and you shouldn't rely on it.) + + <li>By default, repetitions are "greedy" in Perl (and thus in + CL-PPCRE). This has an impact on performance and also on the actual + outcome of a scan. Look at your repetitions and ponder if a greedy + repetition is really what you want. +</ul> +   <h3><a class=none name="ack">Acknowledgements</a></h3> Although I didn't use their code, I was heavily inspired by looking at @@ -2067,7 +2208,7 @@ OpenMCL. -$Header: /usr/local/cvsrep/cl-ppcre/doc/index.html,v 1.191 2008/07/23 02:14:09 edi Exp $ +$Header: /usr/local/cvsrep/cl-ppcre/doc/index.html,v 1.195 2008/07/23 22:24:52 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: trunk/thirdparty/cl-ppcre/scanner.lisp =================================================================== --- trunk/thirdparty/cl-ppcre/scanner.lisp 2008-07-23 22:58:59 UTC (rev 3600) +++ trunk/thirdparty/cl-ppcre/scanner.lisp 2008-07-23 23:00:43 UTC (rev 3601) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-ppcre/scanner.lisp,v 1.34 2008/07/06 18:12:05 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-ppcre/scanner.lisp,v 1.35 2008/07/23 22:25:15 edi Exp $ ;;; Here the scanner for the actual regex as well as utility scanners ;;; for the constant start and end strings are created. @@ -36,21 +36,21 @@ "Auxiliary macro used by CREATE-BMH-MATCHER." (let ((char-compare (if case-insensitive-p 'char-equal 'char=))) `(lambda (start-pos) - (declare (fixnum start-pos)) - (if (or (minusp start-pos) - (> (the fixnum (+ start-pos m)) *end-pos*)) - nil - (loop named bmh-matcher - for k of-type fixnum = (+ start-pos m -1) - then (+ k (max 1 (aref skip (char-code (schar *string* k))))) - while (< k *end-pos*) - do (loop for j of-type fixnum downfrom (1- m) - for i of-type fixnum downfrom k - while (and (>= j 0) - (,char-compare (schar *string* i) - (schar pattern j))) - finally (if (minusp j) - (return-from bmh-matcher (1+ i))))))))) + (declare (fixnum start-pos)) + (if (or (minusp start-pos) + (> (the fixnum (+ start-pos m)) *end-pos*)) + nil + (loop named bmh-matcher + for k of-type fixnum = (+ start-pos m -1) + then (+ k (max 1 (aref skip (char-code (schar *string* k))))) + while (< k *end-pos*) + do (loop for j of-type fixnum downfrom (1- m) + for i of-type fixnum downfrom k + while (and (>= j 0) + (,char-compare (schar *string* i) + (schar pattern j))) + finally (if (minusp j) + (return-from bmh-matcher (1+ i))))))))) (defun create-bmh-matcher (pattern case-insensitive-p) "Returns a Boyer-Moore-Horspool matcher which searches the (special) @@ -76,15 +76,15 @@ :test test)))))) (let* ((m (length pattern)) (skip (make-array *regex-char-code-limit* - :element-type 'fixnum - :initial-element m))) + :element-type 'fixnum + :initial-element m))) (declare (fixnum m)) (loop for k of-type fixnum below m if case-insensitive-p - do (setf (aref skip (char-code (char-upcase (schar pattern k)))) (- m k 1) - (aref skip (char-code (char-downcase (schar pattern k)))) (- m k 1)) + do (setf (aref skip (char-code (char-upcase (schar pattern k)))) (- m k 1) + (aref skip (char-code (char-downcase (schar pattern k)))) (- m k 1)) else - do (setf (aref skip (char-code (schar pattern k))) (- m k 1))) + do (setf (aref skip (char-code (schar pattern k))) (- m k 1))) (if case-insensitive-p (bmh-matcher-aux :case-insensitive-p t) (bmh-matcher-aux)))) Modified: trunk/thirdparty/cl-ppcre/specials.lisp =================================================================== --- trunk/thirdparty/cl-ppcre/specials.lisp 2008-07-23 22:58:59 UTC (rev 3600) +++ trunk/thirdparty/cl-ppcre/specials.lisp 2008-07-23 23:00:43 UTC (rev 3601) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-ppcre/specials.lisp,v 1.40 2008/07/23 02:14:06 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-ppcre/specials.lisp,v 1.41 2008/07/23 22:25:15 edi Exp $ ;;; globally declared special variables @@ -120,7 +120,7 @@ Only used for patterns which might have zero length.") (declaim (simple-vector *last-pos-stores*)) -(defvar *use-bmh-matchers* t +(defvar *use-bmh-matchers* nil "Whether the scanners created by CREATE-SCANNER should use the \(fast but large) Boyer-Moore-Horspool matchers.")

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs