From efc7413d282c34802b71d2642a1654815b397ffc Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sat, 10 Dec 2011 19:00:30 +0100
Subject: [PATCH] Load-form for hash tables is now based on EXT:HASH-TABLE-FILL

---
 src/CHANGELOG      |  4 ++++
 src/clos/print.lsp | 25 ++++++++++++++++---------
 2 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 2b7cba292..f9a0cda54 100755
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -143,6 +143,10 @@ ECL 11.7.1:
    invocations of the C compiler. This can be modfied by changing the type
    specifier in c:*suppress-compiler-messages*.
 
+ - Hash tables can now be printed readably when *READ-EVAL* is true. This is
+   done using two new functions, EXT:HASH-TABLE-CONTENT and
+   EXT:HASH-TABLE-FILL.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***
diff --git a/src/clos/print.lsp b/src/clos/print.lsp
index f3d25e030..c8f386afc 100644
--- a/src/clos/print.lsp
+++ b/src/clos/print.lsp
@@ -115,15 +115,22 @@ printer and we should rather use MAKE-LOAD-FORM."
        (values `(cons ,(maybe-quote (car object)) nil)
 	       (and (rest object) `(rplacd ,(maybe-quote object) ,(maybe-quote (cdr object))))))
       (hash-table
-       (values
-	`(make-hash-table :size ,(hash-table-size object)
-	  :rehash-size ,(hash-table-rehash-size object)
-	  :rehash-threshold ,(hash-table-rehash-threshold object)
-	  :test ',(hash-table-test object))
-	`(dolist (i ',(loop for key being each hash-key in object
-			 using (hash-value obj)
-			 collect (cons key obj)))
-	  (setf (gethash (car i) ,object) (cdr i)))))
+       (let* ((content (ext:hash-table-content object))
+	      (make-form `(make-hash-table
+			   :size ,(hash-table-size object)
+			   :rehash-size ,(hash-table-rehash-size object)
+			   :rehash-threshold ,(hash-table-rehash-threshold object)
+			   :test ',(hash-table-test object))))
+	 (if (need-to-make-load-form-p content)
+	     (values
+	      make-form
+	      `(dolist (i ',(loop for key being each hash-key in object
+			       using (hash-value obj)
+			       collect (cons key obj)))
+		 (setf (gethash (car i) ,object) (cdr i))))
+	     (values
+	      `(ext:hash-table-fill ,make-form ',content)
+	      nil))))
       (t
        (error "Cannot externalize object ~a" object)))))