[movitz-cvs] CVS movitz

ffjeld ffjeld at common-lisp.net
Thu Mar 1 17:48:11 UTC 2007


Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv21457

Modified Files:
	environment.lisp 
Log Message:
minor cleanups.


--- /project/movitz/cvsroot/movitz/environment.lisp	2007/02/19 20:24:42	1.19
+++ /project/movitz/cvsroot/movitz/environment.lisp	2007/03/01 17:48:11	1.20
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Nov  3 11:40:15 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: environment.lisp,v 1.19 2007/02/19 20:24:42 ffjeld Exp $
+;;;; $Id: environment.lisp,v 1.20 2007/03/01 17:48:11 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -518,31 +518,17 @@
   (or #0=(gethash name (movitz-environment-setf-function-names *movitz-global-environment*))
       (let ((setf-symbol (make-symbol
 			  (symbol-name name)
-			  #+ignore (with-standard-io-syntax
-				     (format nil "~A-~A" 'setf name)))))
 	(setf (symbol-plist setf-symbol) (list :setf-placeholder name)
 	      #0# setf-symbol))))
   
-;;;(defun (setf movitz-env-setf-function-name) (value name &optional env)
-;;;  (setf (gethash name (movitz-environment-setf-function-names (or env
-;;;							       *movitz-global-environment*)))
-;;;    value))
-
-
-
-;;;(defun movitz-env-setf-function-cons (name &optional env)
-;;;  (assert (setf-name name))
-;;;  (gethash (setf-name name)
-;;;	   (movitz-environment-setf-function-cells (or env *movitz-global-environment*))))
-
 (defun movitz-env-named-function (name &optional env)
   (cond
-   ((setf-name name)
-    (movitz-env-symbol-function (movitz-env-setf-operator-name
-			      (setf-name name) env)))
-   ((symbolp name)
-    (movitz-env-symbol-function name env))
-   (t (error "Not a function name: ~S" name))))
+    ((setf-name name)
+     (movitz-env-symbol-function (movitz-env-setf-operator-name
+                                  (setf-name name) env)))
+    ((symbolp name)
+     (movitz-env-symbol-function name env))
+    (t (error "Not a function name: ~S" name))))
 
 (defun (setf movitz-env-named-function) (value name &optional env)
   (check-type value movitz-funobj)
@@ -551,15 +537,12 @@
      ((setf-name name)
       (let* ((sn (setf-name name))
 	     (function-name (movitz-env-setf-operator-name sn env)))
-	;; (setf (movitz-env-setf-function-name sn env) function-name)
 	(setf (movitz-env-named-function function-name env) value)))
      ((symbolp name)
       (setf (gethash name (movitz-environment-function-cells effective-env))
 	value))
      (t (error "Not a function name: ~S" name)))))
 
-;;; accessor: MACRO-FUNCTION
-
 (defun movitz-macro-function (symbol &optional environment)
   (or (let ((binding (movitz-operator-binding symbol (or environment *movitz-global-environment*))))
 	(and (typep binding 'macro-binding)




More information about the Movitz-cvs mailing list