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

Modified Files: environment.lisp Log Message: Use hash-tables for macros in environments.

--- /project/movitz/cvsroot/movitz/environment.lisp 2007/03/21 19:57:54 1.22 +++ /project/movitz/cvsroot/movitz/environment.lisp 2008/03/15 20:44:53 1.23 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 3 11:40:15 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: environment.lisp,v 1.22 2007/03/21 19:57:54 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.23 2008/03/15 20:44:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -54,7 +54,10 @@ (setf (movitz-environment-extent-uplink instance) (movitz-environment-uplink instance))))

-(defmethod movitz-environment-compiler-macros ((env movitz-environment)) nil) +(defmethod movitz-environment-macros ((env movitz-environment)) + (load-time-value (make-hash-table :test #'eq))) +(defmethod movitz-environment-compiler-macros ((env movitz-environment)) + (load-time-value (make-hash-table :test #'eq))) (defmethod movitz-environment-function-cells ((env movitz-environment)) (load-time-value (make-hash-table :test #'eq))) (defmethod movitz-environment-modifies-stack ((env movitz-environment)) @@ -87,8 +90,11 @@ (bindings :initform nil :accessor movitz-environment-bindings) + (macros + :initform (make-hash-table :test #'eq :size 400) + :accessor movitz-environment-macros) (compiler-macros - :initform nil + :initform (make-hash-table :test #'eq :size 400) :accessor movitz-environment-compiler-macros)))

(defclass with-things-on-stack-env (movitz-environment) @@ -305,7 +311,7 @@

(defparameter *movitz-macroexpand-hook* #'(lambda (macro-function form environment) -;;; (warn "Expanding form ~W" form) +;; (break "Expanding form ~W" form) ;;; (warn "..with body ~W" macro-function) (let ((expansion (funcall macro-function form environment))) (cond @@ -489,13 +495,13 @@ (environment nil) (recurse-p t)) (loop for env = (or environment *movitz-global-environment*) - then (when recurse-p (movitz-environment-uplink env)) - for plist = (and env (getf (movitz-environment-plists env) symbol)) - while env - do (let ((val (getf plist indicator '#0=#:not-found))) - (unless (eq val '#0#) - (return (values val env)))) - finally (return default))) + then (when recurse-p (movitz-environment-uplink env)) + for plist = (and env (getf (movitz-environment-plists env) symbol)) + while env + do (let ((val (getf plist indicator '#0=#:not-found))) + (unless (eq val '#0#) + (return (values val env)))) + finally (return default)))

(defun (setf movitz-env-get) (val symbol indicator &optional default environment) @@ -551,41 +557,40 @@ (and (typep binding 'macro-binding) (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 - when val - do (return (and (typep val 'movitz-macro) - (movitz-macro-expander-function val)))))) + then (movitz-environment-uplink env) + for val = (when env + (gethash symbol (movitz-environment-macros env))) + while env + when val + do (return (movitz-macro-expander-function val)))))

(defun (setf movitz-macro-function) (fun symbol &optional environment) - (let ((obj (or (gethash symbol (movitz-environment-function-cells (or environment - *movitz-global-environment*))) - (make-instance 'movitz-macro)))) - (setf (slot-value obj 'expander-function) fun) - (setf (gethash symbol (movitz-environment-function-cells (or environment - *movitz-global-environment*))) - obj)) - fun) + (let* ((env (or environment *movitz-global-environment*)) + (obj (or (gethash symbol (movitz-environment-macros env)) + (setf (gethash symbol (movitz-environment-macros env)) + (make-instance 'movitz-macro))))) + (setf (slot-value obj 'expander-function) fun)))

;;; Accessor: COMPILER-MACRO-FUNCTION

(defun movitz-compiler-macro-function (name &optional environment) + (gethash name (movitz-environment-compiler-macros *movitz-global-environment*)) + #+ignore (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 - when val do (return val))) + then (movitz-environment-uplink env) + for val = (when env + (gethash name (movitz-environment-compiler-macros env))) + while env + when val do (return val)))

(defun (setf movitz-compiler-macro-function) (fun name &optional environment) - (setf (getf (movitz-environment-compiler-macros (or environment - *movitz-global-environment*)) - name) - fun)) + (setf (gethash name (movitz-environment-compiler-macros (or environment + *movitz-global-environment*))) + fun))

;;; Special operators

-(defparameter *persistent-movitz-environment* (make-global-movitz-environment)) +(defvar *persistent-movitz-environment* (make-global-movitz-environment))

(defun movitz-special-operator-p (symbol) (let ((val (gethash symbol (movitz-environment-function-cells *persistent-movitz-environment*))))