[movitz-cvs] CVS update: movitz/image.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv12267

Modified Files:
	image.lisp 
Log Message:
Improved, hopefully, interaction between image-read-intern-constant
and movitz-read.

Date: Mon Feb  2 08:27:26 2004
Author: ffjeld

Index: movitz/image.lisp
diff -u movitz/image.lisp:1.4 movitz/image.lisp:1.5
--- movitz/image.lisp:1.4	Mon Feb  2 08:04:49 2004
+++ movitz/image.lisp	Mon Feb  2 08:27:26 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Sun Oct 22 00:22:43 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: image.lisp,v 1.4 2004/02/02 13:04:49 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.5 2004/02/02 13:27:26 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1238,19 +1238,11 @@
     (string
      (or (gethash expr (image-string-constants *image*))
 	 (setf (gethash expr (image-string-constants *image*))
-	   (make-movitz-string expr))))
+	   (movitz-read expr))))
     (cons
      (or (gethash expr (image-cons-constants *image*))
 	 (setf (gethash expr (image-cons-constants *image*))
-	    (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#)))
-		(multiple-value-bind (unfolded-expr cdr-index)
-		    (unfold-circular-list expr)
-		  (let ((result (movitz-read unfolded-expr)))
-		    (setf (movitz-last-cdr result)
-		      (movitz-nthcdr cdr-index result))
-		    result))
-	      (make-movitz-cons (movitz-read (car expr))
-			     (movitz-read (cdr expr)))))))
+	   (movitz-read expr))))
     (t (movitz-read expr))))
 
 ;;; "Reader"
@@ -1291,22 +1283,25 @@
 	 (null *movitz-nil*)
 	 ((member t) (movitz-read 'muerte.cl:t))
 	 (symbol (intern-movitz-symbol expr))
-	 (string (image-read-intern-constant *image* expr))
 	 (integer (make-movitz-fixnum expr))
 	 (character (make-movitz-character expr))
+	 (string (or (gethash expr (image-string-constants *image*))
+		     (setf (gethash expr (image-string-constants *image*))
+		       (make-movitz-string expr))))
 	 (vector (make-movitz-vector (length expr)
 				     :initial-contents (map 'vector #'movitz-read expr)))
 	 (cons
-	  (image-read-intern-constant *image* expr)
-	  #+ignore (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#)))
-		       (multiple-value-bind (unfolded-expr cdr-index)
-			   (unfold-circular-list expr)
-			 (let ((result (movitz-read unfolded-expr)))
-			   (setf (movitz-last-cdr result)
-			     (movitz-nthcdr cdr-index result))
-			   result))
-		     (make-movitz-cons (movitz-read (car expr))
-				    (movitz-read (cdr expr)))))
+	  (or (gethash expr (image-cons-constants *image*))
+	      (setf (gethash expr (image-cons-constants *image*))
+		(if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#)))
+		    (multiple-value-bind (unfolded-expr cdr-index)
+			(unfold-circular-list expr)
+		      (let ((result (movitz-read unfolded-expr)))
+			(setf (movitz-last-cdr result)
+			  (movitz-nthcdr cdr-index result))
+			result))
+		  (make-movitz-cons (movitz-read (car expr))
+				    (movitz-read (cdr expr)))))))
 	 (hash-table
 	  (make-movitz-hash-table expr))
 	 (structure-object