[movitz-cvs] CVS update: movitz/image.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Feb 2 13:04:49 UTC 2004
Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv12269
Modified Files:
image.lisp
Log Message:
Improved movitz-print so it's more symmetric with movitz-read.
Date: Mon Feb 2 08:04:49 2004
Author: ffjeld
Index: movitz/image.lisp
diff -u movitz/image.lisp:1.3 movitz/image.lisp:1.4
--- movitz/image.lisp:1.3 Mon Jan 19 06:23:41 2004
+++ movitz/image.lisp Mon Feb 2 08:04:49 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.3 2004/01/19 11:23:41 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.4 2004/02/02 13:04:49 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -1262,6 +1262,9 @@
(setf (gethash movitz-object (image-inverse-read-map-hash image)) lisp-object
(gethash lisp-object (image-read-map-hash image)) movitz-object))
+(defmethod image-movitz-to-lisp-object ((image symbolic-image) movitz-object)
+ (gethash movitz-object (image-inverse-read-map-hash image)))
+
(defmacro with-movitz-read-context (options &body body)
(declare (ignore options))
`(let ((*movitz-reader-clean-map* (if (boundp '*movitz-reader-clean-map*)
@@ -1292,7 +1295,7 @@
(integer (make-movitz-fixnum expr))
(character (make-movitz-character expr))
(vector (make-movitz-vector (length expr)
- :initial-contents (map 'vector #'movitz-read 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#)))
@@ -1387,25 +1390,17 @@
;;; "Printer"
(defun movitz-print (expr)
+ "Find the host lisp object equivalent to the Movitz object expr."
(etypecase expr
(integer expr)
(symbol expr)
(cons (mapcar #'movitz-print expr))
((or movitz-nil movitz-constant-block) nil)
- (movitz-symbol
- (intern (movitz-print (movitz-symbol-name expr))))
- (movitz-string
- (map 'string #'identity
- (movitz-vector-symbolic-data expr)))
(movitz-fixnum
(movitz-fixnum-value expr))
- (movitz-vector
- (map 'vector #'movitz-print (movitz-vector-symbolic-data expr)))
- (movitz-cons
- (cons (movitz-print (movitz-car expr))
- (movitz-print (movitz-cdr expr))))))
-
-;;;
+ (movitz-heap-object
+ (or (image-movitz-to-lisp-object *image* expr)
+ (error "Unknown Movitz object: ~S" expr)))))
(defmethod make-toplevel-funobj ((*image* symbolic-image))
(let ((toplevel-code (loop for (funobj) in (image-load-time-funobjs *image*)
More information about the Movitz-cvs
mailing list