[movitz-cvs] CVS movitz
ffjeld
ffjeld at common-lisp.net
Mon Apr 10 11:49:41 UTC 2006
Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv4760
Modified Files:
compiler.lisp
Log Message:
minor tweaks.
--- /project/movitz/cvsroot/movitz/compiler.lisp 2005/10/31 09:22:54 1.166
+++ /project/movitz/cvsroot/movitz/compiler.lisp 2006/04/10 11:49:41 1.167
@@ -8,7 +8,7 @@
;;;; Created at: Wed Oct 25 12:30:49 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: compiler.lisp,v 1.166 2005/10/31 09:22:54 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.167 2006/04/10 11:49:41 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -1400,8 +1400,7 @@
(pathname-directory path))
(path)
"Refusing to delete file not in /tmp.")
- (delete-file path))))
- (values))
+ (delete-file path)))))
(defun movitz-compile-file-internal (path
&optional (*default-load-priority*
@@ -1440,9 +1439,9 @@
(when *compiler-verbose-p*
(format *query-io* "~&Movitz Compiling ~S..~%"
(cond
- ((symbolp form) form)
- ((symbolp (car form))
- (xsubseq form 0 2)))))
+ ((symbolp form) form)
+ ((symbolp (car form))
+ (xsubseq form 0 2)))))
(compiler-call #'compile-form
:form form
:funobj funobj
@@ -1452,13 +1451,16 @@
(cond
((null file-code)
(setf (image-load-time-funobjs *image*)
- (delete funobj (image-load-time-funobjs *image*) :key #'first)))
+ (delete funobj (image-load-time-funobjs *image*) :key #'first))
+ 'muerte::constantly-true)
(t (setf (extended-code function-env) file-code
(need-normalized-ecx-p function-env) nil
(function-envs funobj) (list (cons 'muerte.cl::t function-env))
(funobj-env funobj) funobj-env)
- (make-compiled-funobj-pass2 funobj)))
- t))))
+ (make-compiled-funobj-pass2 funobj)
+ (let ((name (funobj-name funobj)))
+ (setf (movitz-env-named-function name) funobj)
+ name)))))))
;;;;
More information about the Movitz-cvs
mailing list