commit/XEmacs: kehoea: Transform #'princ to #'write-sequence at compile time if appropriate.

1 new commit in XEmacs:

https://bitbucket.org/xemacs/xemacs/commits/4004c3266c09/
Changeset:   4004c3266c09
User:        kehoea
Date:        2013-12-22 11:36:33
Summary:     Transform #'princ to #'write-sequence at compile time if appropriate.

lisp/ChangeLog addition:

2013-12-22  Aidan Kehoe  <[email protected]>

	* cl-macs.el:
	* cl-macs.el (princ): New compiler macro.
	Transform #'princ to #'write-sequence if we can determine at
	compile time that it is being passed a string. Initialising the
	printer is expensive enough, but much of our code took this
	approach because #'write-sequence wasn't available.
Affected #:  2 files

diff -r 7a538e1a4676a2229b4f1806dfa26725226f0ba7 -r 4004c3266c09888a9935242a462beb3fb28e02a3 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2013-12-22  Aidan Kehoe  <[email protected]>
+
+	* cl-macs.el:
+	* cl-macs.el (princ): New compiler macro.
+	Transform #'princ to #'write-sequence if we can determine at
+	compile time that it is being passed a string. Initialising the
+	printer is expensive enough, but much of our code took this
+	approach because #'write-sequence wasn't available.
+
 2013-12-17  Aidan Kehoe  <[email protected]>
 
 	* simple.el (blink-matching-open):

diff -r 7a538e1a4676a2229b4f1806dfa26725226f0ba7 -r 4004c3266c09888a9935242a462beb3fb28e02a3 lisp/cl-macs.el
--- a/lisp/cl-macs.el
+++ b/lisp/cl-macs.el
@@ -3911,6 +3911,28 @@
       (list* 'intersection (pop cl-keys) (pop cl-keys) :stable t cl-keys)
     form))
 
+(define-compiler-macro princ (&whole form object &optional stream)
+  "When passing `princ' a string, call `write-sequence' instead.
+
+This avoids the resource- and time-intensive initialization of the printer,
+and functions equivalently. Such code will not run on 21.4, but 21.4 will
+not normally encounter it, and the error message will be clear enough (that
+`write-sequence' has a void function definition) in the odd event that it
+does."
+  (cond ((not (<= 2 (length form) 3))
+	 form)
+	((or (stringp object)
+	     (member (car-safe object)
+		     '(buffer-string buffer-substring concat format gettext
+		       key-description make-string mapconcat
+		       substitute-command-keys substring-no-properties
+		       symbol-name text-char-description string)))
+	 (cons 'write-sequence (cdr form)))
+	((member (car-safe object) '(substring subseq))
+	 `(write-sequence ,(nth 1 object) ,stream :start ,(nth 2 object)
+	                  ,@(if (nth 3 object) `((:end ,(nth 3 object))))))
+	(t form)))
+
 (map nil
      #'(lambda (function)
          ;; There are byte codes for the two-argument versions of these

Repository URL: https://bitbucket.org/xemacs/xemacs/

--

This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.