From 9c201c7e6f9180880cd14583431c51d323105874 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 9 Nov 1991 01:21:34 +0000
Subject: [PATCH] Redid part of the symbol-macrolet support in order to keep
 some totally undocumented properties.  Piece of shit.

---
 pcl/walk.lisp | 60 +++++++++++++++++++++++++--------------------------
 1 file changed, 29 insertions(+), 31 deletions(-)

diff --git a/pcl/walk.lisp b/pcl/walk.lisp
index 529b2a89c..6766a9628 100644
--- a/pcl/walk.lisp
+++ b/pcl/walk.lisp
@@ -946,16 +946,14 @@
 (defun walker-environment-bind-1 (env &key (walk-function nil wfnp)
 					   (walk-form nil wfop)
 					   (declarations nil decp)
-					   (lexical-variables nil lexp)
-					   (symbol-macros nil symmacp))
+					   (lexical-variables nil lexp))
   (let ((lock (environment-macro env *key-to-walker-environment*)))
     (list
       (list *key-to-walker-environment*
 	    (list (if wfnp walk-function     (car lock))
 		  (if wfop walk-form         (cadr lock))
 		  (if decp declarations      (caddr lock))
-		  (if lexp lexical-variables (cadddr lock))
-		  (if symmacp symbol-macros  (fifth lock)))))))
+		  (if lexp lexical-variables (cadddr lock)))))))
 		  
 (defun env-walk-function (env)
   (car (env-lock env)))
@@ -969,30 +967,31 @@
 (defun env-lexical-variables (env)
   (cadddr (env-lock env)))
 
-(defun env-symbol-macros (env)
-  (fifth (env-lock env)))
-
 
 (defun note-declaration (declaration env)
-  (let ((lock (env-lock env)))
-    (setf (caddr lock)
-	  (cons declaration (caddr lock)))))
+  (push declaration (caddr (env-lock env))))
 
 (defun note-lexical-binding (thing env)
-  (let ((lock (env-lock env)))
-    (push thing (cadddr lock))
-    (setf (fifth lock) (remove thing (fifth lock) :key #'car))))
+  (push (list thing :lexical-var) (cadddr (env-lock env))))
 
 
 (defun VARIABLE-LEXICAL-P (var env)
-  (member var (env-lexical-variables env)))
+  (let ((entry (member var (env-lexical-variables env) :key #'car)))
+    (when (eq (cadar entry) :lexical-var)
+      entry)))
+
+(defun variable-symbol-macro-p (var env)
+  (let ((entry (member var (env-lexical-variables env) :key #'car)))
+    (when (eq (cadar entry) :macro)
+      entry)))
+
 
 (defvar *VARIABLE-DECLARATIONS* '(special))
 
 (defun VARIABLE-DECLARATION (declaration var env)
   (if (not (member declaration *variable-declarations*))
       (error "~S is not a reckognized variable declaration." declaration)
-      (let ((id (or (member var (env-lexical-variables env)) var)))
+      (let ((id (or (variable-lexical-p var env) var)))
 	(dolist (decl (env-declarations env))
 	  (when (and (eq (car decl) declaration)
 		     (eq (cadr decl) id))
@@ -1309,11 +1308,11 @@
 	 ((not (eq form newform))
 	  (walk-form-internal newform context env))
 	 ((not (consp newform))
-	  (let ((symmac (assoc newform (env-symbol-macros env))))
+	  (let ((symmac (car (variable-symbol-macro-p newform env))))
 	    (if symmac
-		(let ((newnewform (walk-form-internal (cadr symmac)
+		(let ((newnewform (walk-form-internal (cddr symmac)
 						      context env)))
-		  (if (eq newnewform (cadr symmac))
+		  (if (eq newnewform (cddr symmac))
 		      newform
 		      newnewform))
 		newform)))
@@ -1648,11 +1647,10 @@
       env)))
 
 (defun walk-multiple-value-setq (form context env)
-  (let ((symmacs (env-symbol-macros env))
-	(vars (cadr form)))
-    (if (dolist (var vars)
-	  (when (member var symmacs :key #'car)
-	    (return t)))
+  (let ((vars (cadr form)))
+    (if (some #'(lambda (var)
+		  (variable-symbol-macro-p var env))
+	      vars)
 	(let* ((expanded
 		(loop
 		  for var in vars
@@ -1771,9 +1769,9 @@
 	    `(progn ,@walked)))
       (let* ((var (cadr form))
 	     (val (caddr form))
-	     (symmac (assoc var (env-symbol-macros env))))
+	     (symmac (car (variable-symbol-macro-p var env))))
 	(if symmac
-	    (let* ((expanded `(setf ,(cadr symmac) ,val))
+	    (let* ((expanded `(setf ,(cddr symmac) ,val))
 		   (walked (walk-form-internal expanded context env)))
 	      (if (eq expanded walked)
 		  form
@@ -1787,12 +1785,12 @@
   (let* ((bindings (cadr form)))
     (walker-environment-bind
 	(new-env old-env
-		 :lexical-variables (remove-if #'(lambda (x)
-						   (member x bindings
-							   :key #'car))
-					       (env-lexical-variables old-env))
-		 :symbol-macros (append bindings
-					(env-symbol-macros old-env)))
+		 :lexical-variables
+		 (append (mapcar #'(lambda (binding)
+				     `(,(car binding)
+				       :macro . ,(cadr binding)))
+				 bindings)
+			 (env-lexical-variables old-env)))
       (relist* form 'symbol-macrolet bindings
 	       (walk-repeat-eval (cddr form) new-env)))))
 
-- 
GitLab