Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv17889
Modified Files: environment.lisp Log Message: Rewrote some really poorly written loop forms, and removed some dead code.
Date: Fri Jan 16 14:45:36 2004 Author: ffjeld
Index: movitz/environment.lisp diff -u movitz/environment.lisp:1.1.1.1 movitz/environment.lisp:1.2 --- movitz/environment.lisp:1.1.1.1 Tue Jan 13 06:04:59 2004 +++ movitz/environment.lisp Fri Jan 16 14:45:36 2004 @@ -1,7 +1,7 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001,2000, 2002-2004 -;;;; Department of Computer Science, University of Tromsø, Norway +;;;; Copyright (C) 2000-2004 +;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: environment.lisp ;;;; Description: Compiler environment. @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 3 11:40:15 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: environment.lisp,v 1.1.1.1 2004/01/13 11:04:59 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.2 2004/01/16 19:45:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -230,22 +230,11 @@
(defmethod num-dynamic-slots ((x unwind-protect-env)) 1)
-(defclass simple-dynamic-env (with-things-on-stack-env) - () +(defclass simple-dynamic-env (with-things-on-stack-env) () (:documentation "An environment that installs one dynamic-env."))
(defmethod num-dynamic-slots ((x simple-dynamic-env)) 1)
- -;;;(defmethod print-object ((object movitz-environment) stream) -;;; (print-unreadable-object (object stream) -;;; (maphash #'(lambda (name binding) -;;; (format stream " [~A: ~A]" -;;; name -;;; (and (slot-boundp binding 'location) -;;; (slot-value binding 'location)))) -;;; (movitz-environment-bindings object)))) - (defparameter *movitz-macroexpand-hook* #'(lambda (macro-function form environment) ;;; (warn "Expanding form ~W" form) @@ -294,23 +283,6 @@ (define-symbol-macro *movitz-global-environment* (image-global-environment *image*))
-;;;(defun movitz-environment-add-binding (environment variable binding &key replace) -;;; (warn "deprecated movitz-environment-add-binding called for ~S => ~S." variable binding) -;;; (assert (or (not (slot-boundp binding 'env)) -;;; (eq (binding-env binding) environment)) -;;; (binding) -;;; "Can't move a binding between environments!") -;;; (let ((bindings (movitz-environment-bindings environment))) -;;; (cond -;;; ((assoc variable bindings) -;;; (assert replace () -;;; (error "Variable ~S is multiple bound." variable)) -;;; (setf (cdr (assoc variable bindings)) binding)) -;;; (t (push (cons variable binding) -;;; (movitz-environment-bindings environment))))) -;;; (setf (binding-env binding) environment) -;;; (values)) - (defun movitz-env-add-binding (env binding &optional (variable (binding-name binding))) (check-type binding binding) (check-type variable symbol "a variable name") @@ -443,9 +415,10 @@ (defun movitz-env-get (symbol indicator &optional (default nil) (environment nil) (recurse-p t)) - (loop for env = (or environment *movitz-global-environment*) then (and recurse-p (movitz-environment-uplink env)) + (loop for env = (or environment *movitz-global-environment*) + then (and recurse-p (movitz-environment-uplink env)) + for plist = (and env (getf (movitz-environment-plists env) symbol)) while env - for plist = (getf (movitz-environment-plists env) symbol) do (let ((val (getf plist indicator '#0=#:not-found))) (unless (eq val '#0#) (return (values val env)))) @@ -523,8 +496,8 @@ (macro-binding-expander binding))) (loop for env = (or environment *movitz-global-environment*) then (movitz-environment-uplink env) + for val = (and env (gethash symbol (movitz-environment-function-cells env))) while env - for val = (gethash symbol (movitz-environment-function-cells env)) when val do (return (and (typep val 'movitz-macro) (movitz-macro-expander-function val)))))) @@ -544,10 +517,9 @@ (defun movitz-compiler-macro-function (name &optional environment) (loop for env = (or environment *movitz-global-environment*) then (movitz-environment-uplink env) + for val = (and env (getf (movitz-environment-compiler-macros env) name)) while env - for val = (getf (movitz-environment-compiler-macros env) name) - when val - do (return val))) + when val do (return val)))
(defun (setf movitz-compiler-macro-function) (fun name &optional environment) (setf (getf (movitz-environment-compiler-macros (or environment