cmucl-cvs November 2014

cmucl-cvs@common-lisp.net

1 participants
33 discussions

Start a nNew thread

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-8-g224406c
by Raymond Toy 12 Nov '14

12 Nov '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-7-g96b342a
by Raymond Toy 08 Nov '14

08 Nov '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-6-g4d6ff8e
by Raymond Toy 08 Nov '14

08 Nov '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-5-g1769b2a
by Raymond Toy 08 Nov '14

08 Nov '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-4-gd44beaa
by Raymond Toy 07 Nov '14

07 Nov '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-3-g2b1925b
by Raymond Toy 06 Nov '14

06 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 2b1925b64fac2d5bd5b46826a2f2678b52c1683c (commit) from 4c0e29679bad7b315f9da448280b3a7061549ac3 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 2b1925b64fac2d5bd5b46826a2f2678b52c1683c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Nov 5 19:52:57 2014 -0800 Add iterators and loop paths for codepoints and glyphs * src/code/string.lisp: * Add WITH-STRING-CODEPOINT-ITERATOR to allow iterating over the codepoints in a string. * Add WITH-STRING-GLYPO-ITERATOR to allow iterating over the glpyhs in a string. * src/code/exports.lisp: * Export WITH-STRING-CODEPOINT-ITERATOR and WITH-STRING-GLYPH-ITERATOR. * src/code/loop.lisp: * Support (loop for cp being the codepoint of string ...) which extracts the consecutive codepoints from the string. Allow codepoints, code-point, and code-points as aliases of codepoint. * Support (loop for g-string being the glyph of string ...) which extracts each glyph (as a string) from the string. Allow glpyhs as an alias. * tests/extended-loop.lisp: * New file of tests for the new loop paths. * src/i18n/locale/cmucl.pot: * Update. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index 455894c..e75e5d7 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -919,7 +919,9 @@ "+UNICODE-CATEGORY-UPPER+" "+UNICODE-CATEGORY-TITLE+" "LOAD-ALL-UNICODE-DATA" - "SURROGATES")) + "SURROGATES" + "WITH-STRING-CODEPOINT-ITERATOR" + "WITH-STRING-GLYPH-ITERATOR")) (defpackage "EVAL" (:export "*EVAL-STACK-TRACE*" "*INTERNAL-APPLY-NODE-TRACE*" diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 0ca34c2..29b9c23 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -45,6 +45,9 @@ ;;;> United States of America ;;;> +1-617-221-1000 +;;;> See page 391 of http://bitsavers.trailing-edge.com/pdf/symbolics/software/genera_8/Symbolic… +;;;> for more information on how to extend loop. + ;; $aclHeader: loop.cl,v 1.5 91/12/04 01:13:48 cox acl4_1 $ #+cmu @@ -2153,6 +2156,77 @@ collected result will be returned as the value of the LOOP." ,variable) (,next-fn))) ()))) + + +;; Supports +;; +;; (loop for cp being the codepoint of string ...) +;; +;; where cp is the codepoint of charactor (or surrogate pair) in the +;; string. +(defun loop-string-codepoint-iteration-path (variable data-type prep-phrases) + (cond ((or (cdr prep-phrases) (not (member (caar prep-phrases) '(:in :of)))) + (loop-error _N"Too many prepositions!")) + ((null prep-phrases) (loop-error _N"Missing OF or IN in ~S iteration path."))) + (let ((string-var (loop-gentemp 'loop-codepoint-string-)) + (next-fn (loop-gentemp 'loop-codepoint-next-)) + (post-steps nil)) + (let* ((val-var nil) + (temp-val-var (loop-gentemp 'loop-codepoint-val-temp-)) + (temp-predicate-var (loop-gentemp 'loop-codepoint-predicate-var-)) + (variable (or variable (loop-gentemp))) + (bindings `((,variable nil ,data-type) + (,string-var ,(cadar prep-phrases))))) + (push `(lisp::with-string-codepoint-iterator (,next-fn ,string-var)) *loop-wrappers*) + (setq val-var variable) + `(,bindings ;bindings + () ;prologue + () ;pre-test + () ;parallel steps + (not + (multiple-value-bind (,temp-predicate-var ,temp-val-var) + (,next-fn) + (when ,temp-predicate-var + (setq ,val-var ,temp-val-var)) + ,temp-predicate-var + )) ;post-test + ,post-steps)))) + +;; Supports +;; (loop for g-string being the glyph of string ...) +;; +;; where g-string is a string consisting of a character and all +;; trailing combining characters. +(defun loop-string-glyph-string-iteration-path (variable data-type prep-phrases) + (cond ((or (cdr prep-phrases) (not (member (caar prep-phrases) '(:in :of)))) + (loop-error _N"Too many prepositions!")) + ((null prep-phrases) (loop-error _N"Missing OF or IN in ~S iteration path."))) + (let ((string-var (loop-gentemp 'loop-glyph-string-)) + (next-fn (loop-gentemp 'loop-glyph-next-)) + (post-steps nil)) + (let* ((val-var nil) + (temp-index-var (loop-gentemp 'loop-glyph-index-temp-)) + (temp-len-var (loop-gentemp 'loop-glyph-len-temp-)) + (temp-predicate-var (loop-gentemp 'loop-glyph-predicate-var-)) + (variable (or variable (loop-gentemp))) + (bindings `((,variable nil ,data-type) + (,string-var ,(cadar prep-phrases))))) + (push `(lisp::with-string-glyph-iterator (,next-fn ,string-var)) *loop-wrappers*) + (setq val-var variable) + `(,bindings ;bindings + () ;prologue + () ;pre-test + () ;parallel steps + (not + (multiple-value-bind (,temp-predicate-var ,temp-index-var ,temp-len-var) + (,next-fn) + (when ,temp-predicate-var + (setq ,val-var (subseq ,string-var ,temp-index-var ,temp-len-var))) + ,temp-predicate-var + )) ;post-test + ,post-steps)))) + + ;;;; ANSI Loop @@ -2235,12 +2309,22 @@ collected result will be returned as the value of the LOOP." :preposition-groups '((:of :in)) :inclusive-permitted nil :user-data '(:symbol-types (:internal :external))) + (when extended-p + (add-loop-path '(code-point code-points codepoint codepoints) + 'loop-string-codepoint-iteration-path + w + :preposition-groups '((:of :in)) + :inclusive-permitted nil) + (add-loop-path '(glyph glyphs) + 'loop-string-glyph-string-iteration-path + w + :preposition-groups '((:of :in)) + :inclusive-permitted nil)) w)) (defparameter *loop-ansi-universe* - (make-ansi-loop-universe nil)) - + (make-ansi-loop-universe t)) (defun loop-standard-expansion (keywords-and-forms environment universe) (if (and keywords-and-forms (symbolp (car keywords-and-forms))) diff --git a/src/code/string.lisp b/src/code/string.lisp index 8005cda..bfaffb4 100644 --- a/src/code/string.lisp +++ b/src/code/string.lisp @@ -87,6 +87,30 @@ (values (truly-the codepoint code) nil)))) (t (values (truly-the codepoint code) nil))))) +(defmacro with-string-codepoint-iterator ((next string) &body body) + _N"WITH-STRING-CODEPOINT-ITERATOR ((next string) &body body) + provides a method of looping through a string from the beginning to + the end of the string prodcucing successive codepoints from the + string. NEXT is bound to a generator macro that, within the scope + of the invocation, returns one or two values. The first value tells + whether any objects remain in the string. When the first value is + non-NIL, the second value is the codepoint of the next object." + (let ((n-next (gensym "WITH-STRING-CODEPOINT-ITERATOR-"))) + `(let ((,n-next + (let* ((s ,string) + (len (length s)) + (index 0)) + (labels + ((,next () + (when (< index len) + (multiple-value-bind (cp surrogatep) + (codepoint s index) + (incf index (if surrogatep 2 1)) + (values t cp))))) + #',next)))) + (macrolet ((,next () '(funcall ,n-next))) + ,@body)))) + (defun surrogates (codepoint) "Return the high and low surrogate characters for Codepoint. If Codepoint is in the BMP, the first return value is the corresponding @@ -1013,6 +1037,31 @@ (values (subseq string n index) (and (> n 0) n)) (values (subseq string index n) (and (< n (length string)) n))))) +(defmacro with-string-glyph-iterator ((next string) &body body) + _N"WITH-STRING-GLYPH-ITERATOR ((next string) &body body) + provides a method of looping through a string from the beginning to + the end of the string prodcucing successive glyphs from the string. + NEXT is bound to a generator macro that, within the scope of the + invocation, returns one or three values. The first value tells + whether any objects remain in the string. When the first value is + non-NIL, the second value is the index into the string of the glyph + and the third value is index of the next glyph." + (let ((n-next (gensym "WITH-STRING-GLYPH-ITERATOR-"))) + `(let ((,n-next + (let* ((s ,string) + (len (length s)) + (index 0)) + (labels + ((,next () + (when (< index len) + (let ((glyph-end (%glyph-f s index))) + (multiple-value-prog1 + (values t index glyph-end) + (setf index glyph-end)))))) + #',next)))) + (macrolet ((,next () '(funcall ,n-next))) + ,@body)))) + #+unicode (defun string-reverse* (sequence) (declare (optimize (speed 3) (space 0) (safety 0)) diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index a885634..608de17 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -3703,6 +3703,17 @@ msgstr "" #: src/code/string.lisp msgid "" +"WITH-STRING-CODEPOINT-ITERATOR ((next string) &body body)\n" +" provides a method of looping through a string from the beginning to\n" +" the end of the string prodcucing successive codepoints from the\n" +" string. NEXT is bound to a generator macro that, within the scope\n" +" of the invocation, returns one or two values. The first value tells\n" +" whether any objects remain in the string. When the first value is\n" +" non-NIL, the second value is the codepoint of the next object." +msgstr "" + +#: src/code/string.lisp +msgid "" "Return the high and low surrogate characters for Codepoint. If\n" " Codepoint is in the BMP, the first return value is the corresponding\n" " character and the second is NIL." @@ -3961,6 +3972,18 @@ msgstr "" #: src/code/string.lisp msgid "" +"WITH-STRING-GLYPH-ITERATOR ((next string) &body body)\n" +" provides a method of looping through a string from the beginning to\n" +" the end of the string prodcucing successive glyphs from the string.\n" +" NEXT is bound to a generator macro that, within the scope of the\n" +" invocation, returns one or three values. The first value tells\n" +" whether any objects remain in the string. When the first value is\n" +" non-NIL, the second value is the index into the string of the glyph\n" +" and the third value is index of the next glyph." +msgstr "" + +#: src/code/string.lisp +msgid "" "Convert String to Unicode Normalization Form D (NFD) using the\n" " canonical decomposition. The NFD string is returned" msgstr "" diff --git a/tests/extended-loop.lisp b/tests/extended-loop.lisp new file mode 100644 index 0000000..c184540 --- /dev/null +++ b/tests/extended-loop.lisp @@ -0,0 +1,30 @@ +(defpackage :extended-loop-tests + (:use :cl :lisp-unit)) + +(in-package "EXTENDED-LOOP-TESTS") + +(define-test loop-codepoint + (:tag :extended-loop) + (let ((codepoints (mapcar #'(lambda (c) + (if (characterp c) + (char-code c) + c)) + '(#\a #\b #\greek_capital_letter_gamma + ;; This is a random code point that + ;; requires a surrogate pair in our + ;; UTF-16 string represntation. + 65536 + #\c)))) + (assert-equal codepoints + (loop for c being the codepoints of (lisp::codepoints-string codepoints) + collect c)))) + +(define-test loop-glyph-string + (:tag :extended-loop) + (let* ((s (string #\Latin_Small_Letter_A_With_Diaeresis_and_macron)) + (d (lisp::string-to-nfkd s))) + (assert-equal (list s) + (loop for g being the glyphs of s collect g)) + (assert-equal (list d) + (loop for g being the glyphs of d collect g)))) + ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 4 ++- src/code/loop.lisp | 88 +++++++++++++++++++++++++++++++++++++++++++++-- src/code/string.lisp | 49 ++++++++++++++++++++++++++ src/i18n/locale/cmucl.pot | 23 +++++++++++++ tests/extended-loop.lisp | 30 ++++++++++++++++ 5 files changed, 191 insertions(+), 3 deletions(-) create mode 100644 tests/extended-loop.lisp hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-2-g4c0e296
by Raymond Toy 06 Nov '14

06 Nov '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-1-g6e5af74
by Raymond Toy 06 Nov '14

06 Nov '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp annotated tag snapshot-2014-11 created. snapshot-2014-11
by Raymond Toy 04 Nov '14

04 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The annotated tag, snapshot-2014-11 has been created at 6dbcf27e86d29cb65960eee05b15dc45ac76b70d (tag) tagging c0c49604d436b83f8afac4e60d342d63e2ea4eb2 (commit) replaces 20f tagged by Raymond Toy on Mon Nov 3 18:40:21 2014 -0800 - Log ----------------------------------------------------------------- Snapshot 2014-11 -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.13 (Darwin) iEYEABECAAYFAlRYPJUACgkQBs44GQhsdQvE+ACdFieXw9kYYuH+BUERv50dHDDt RIAAoIXVvh0oGb82gqvrm3hCHmI6nZfD =wZqU -----END PGP SIGNATURE----- Raymond Toy (61): Remove the NetBSD setexception changes on the master branch. This is Fix error in type derivation for the sign in DECODE-FLOAT. Make (log (scale-float 1d0 k) 2) = k Import e_log10.c from netlib as is. Update to use a union. Use fdlibm_setexception to signal appropriate exceptions. Add fdlibm's log10. Add deftransform to convert (log x 2) and (log x 10) to log2 and Make the LOG function match what the deftransform for LOG does. Add tests for compiled log2 and log10. Fix type derivation of the exponent for DECODE-FLOAT. Oops. Remove debugging print left in from commit [c0052f55] Regenerate. Fix incorrect value from INTEGER-DECODE-FLOAT for denormals. Correct a comment for %ieee754-rem-pi/2. Import scalbn directly from fdlibm. Rename scalbn to fdlibm_scalbn, and use a union. Compile in scalbn. Fix a couple of issues in the code. Add alien interface to scalbn. Add tests for kernel:%scalbn. Move fdlibm tests from trig.lisp to fdlibm.lisp. Fix regression in %ENUMERATE-DIRECTORIES. Add FAST-ASH-C/FIXNUM=>SIGNED vop. Micro-optimize SCALE-FLOAT to use multiplication when possible. Merge branch '20f-branch' Update with latest changes. Update ppc cross-compile script. Update sparc cross-compile script. Fix issue with negative value for lisp::cycles-per-tick. First cut at removing ppc-darwin-dlshim.c. Not needed anymore because Unify extern-alien-name for darwin x86 and ppc. Prepend underscore in extern-alien-name for darwin/ppc. On sparc, use EXTERN_ALIEN_NAME too when printing out the error message. For x86, define FEATURE_ELF if needed. For sparc, define FEATURE_ELF because Solaris uses elf. Add boot file for the darwin/x86 cross-compile that is used to fix the Add :elf to *features* for sparc/solaris. Fix compiler warning for skipped_break_addr Update to asdf 3.1.4. Update from commit logs. Remove definition of LD. Remove darwin-lispadjuster.c and ppc-darwin-dlshim.c Remove OS_LINK_FLAGS that were creating a CMUCLRO section. Fix compiler warning on ppc about &context->uc_mcontext->__es.__dar Close the file descriptor when done. Don't leak the string created by strdup. Clarify a few things. Fix #84: motifd is 64-bit app. Fix motifd text callback. Support 64-bit time-t on NetBSD. Fix issue in sending a boolean created from a pointer in Minor tweaks for solaris. Support 64-bit time-t on NetBSD. Change check for id to be 1 <= id <= 3, and print error message if The external format :utf is no longer an alias for :utf-8. Update notes from logs. Remove the LOOP package. There are no symbols in it anyway. Remove src/code/old-loop.lisp. Update notes from logs. Replace :utf with :utf-8 since :utf is no longer an alias. Richard M Kreuter (5): Add an "oid" layer to motifd. Fix bugs around XmTextField's callbacks. Remove some printf debugging in write_text_callback. XEvents need to be trafficked as oids, too. Rename "oblist.*" to "oid.*" (since the data structure is incidental). ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. 20f-66-gc0c4960
by Raymond Toy 03 Nov '14

03 Nov '14

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs November 2014