From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 12 May 2009 09:58:45 +0000 (+0000)
Subject: 1.0.28.42: pretty-printing LOOP forms
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=69f3ae0736d7a4a61af87cf727794e88359710a3;p=sbcl.git

1.0.28.42: pretty-printing LOOP forms

 Thanks to Tobias Ritterweiler.

 Update NEWS a bit while at it.
---

diff --git a/NEWS b/NEWS
index 505e518..7ce94b9 100644
--- a/NEWS
+++ b/NEWS
@@ -8,15 +8,21 @@
     the symbol, prohibits both lexical and dynamic binding. This is mainly an
     efficiency measure for threaded platforms, but also valueable in
     expressing intent.
-  * improvement: SBCL now emits a compiler note where stack allocation was
-    requested but could not be provided.
   * optimization: compiler now generates faster array typechecking code.
   * optimization: ARRAY-DIMENSION is now faster for multidimensional and
     non-simple arrays.
   * optimization: multidimensional array accesses in the absence of type
     information regarding array rank are approximately 10% faster due to
     open coding of ARRAY-RANK.
+  * improvement: SBCL now emits a compiler note where stack allocation was
+    requested but could not be provided.
+  * improvement: pretty-printing loop has been implemented properly. (thanks
+    to Tobias Rittweiler)
   * documentation: CLOS slot typechecing policy has been documented.
+  * bug fix: MAKE-ARRAY for non-zero :INITIAL-ELEMENT always used the
+    same implementation of FILL to initialize the array, even if a more
+    efficient one was available (reported by Stas Boukarev, thanks to
+    Paul Khuong)
   * bug fix: potential miscompilation of array stack allocation on x86 and
     x86-64. (reported by Time Tossavainen)
   * bug fix: some forms of AND, OR, and COND resulted in expansions that could
diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 74c368c..9dd92d9 100644
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -1300,6 +1300,43 @@ line break."
     (pprint-fill stream (pprint-pop))
     (pprint-tagbody-guts stream)))
 
+;;; Each clause in this list will get its own line.
+(defvar *loop-seperating-clauses*
+  '(:and
+    :where :for
+    :initially :finally
+    :do :doing
+    :collect :collecting
+    :append :appending
+    :nconc :nconcing
+    :count :counting
+    :sum :summing
+    :maximize :maximizing
+    :minimize :minimizing
+    :if :when :unless :end
+    :for :while :until :repeat :always :never :thereis
+    ))
+
+(defun pprint-loop (stream list &rest noise)
+  (declare (ignore noise))
+  (destructuring-bind (loop-symbol . clauses) list
+    (write-char #\( stream)
+    (output-object loop-symbol stream)
+    (when clauses
+      (write-char #\space stream)
+      (pprint-logical-block (stream clauses :prefix "" :suffix "")
+        (output-object (pprint-pop) stream)
+        (pprint-exit-if-list-exhausted)
+        (write-char #\space stream)
+        (loop for thing = (pprint-pop)
+              when (and (symbolp thing)
+                        (member thing  *loop-seperating-clauses* :test #'string=))
+                do (pprint-newline :mandatory stream)
+              do (output-object thing stream)
+              do (pprint-exit-if-list-exhausted)
+              do (write-char #\space stream))))
+    (write-char #\) stream)))
+
 (defun pprint-fun-call (stream list &rest noise)
   (declare (ignore noise))
   (funcall (formatter "~:<~^~W~^ ~:_~:I~@{~W~^ ~:_~}~:>")
@@ -1391,7 +1428,7 @@ line break."
                           (etypecase pprint-typecase)
                           #+nil (handler-bind ...)
                           #+nil (handler-case ...)
-                          #+nil (loop ...)
+                          (loop pprint-loop)
                           (multiple-value-bind pprint-progv)
                           (multiple-value-setq pprint-block)
                           (pprint-logical-block pprint-block)
diff --git a/version.lisp-expr b/version.lisp-expr
index 0eec54d..401b27b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.28.41"
+"1.0.28.42"