;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 121.15
;;; Reason:
;;;  Teach Luke Codewalker about the Force of macros:
;;;   * The expansion functions of local macros are always defined in the
;;;     top level environment.
;;;   * There was never a conflict between the codewalker's macro/function
;;;     environment and that of the macroexpander, so it was a big mistake
;;;     to bind the former to NIL when walking the result of a macroexpansion.
;;;  The latter change fixes ZL:MACROEXPAND-ALL when given things like
;;;   (macrolet ((x () 'x) (y (thing) `(car ,thing))) (y (x)))
;;; Written 28-Jan-87 15:01:13 by RpK (Robert P. Krajewski) at site LMI Cambridge
;;; while running on Cthulhu from band 3
;;; with Experimental System 121.13, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, Experimental Site Data Editor 4.0, Experimental K Bridge Support 1.0, microcode 1730, SDU Boot Tape 3.12, SDU ROM 102, the old ones.



; From modified file DJ: L.SYS; QCLUKE.LISP#34 at 28-Jan-87 15:01:14
#10R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCLUKE  "

(defun cw-expression (exp &aux tem)
  (when (and (consp exp)
	     (memq (car exp) *all-functions-to-check-for*))
    (pushnew (car exp) *all-functions* :test 'eq))
  (cond ((symbolp exp)
	 (when (or (eq *all-variables-to-check-for* t)
		   (memq exp *all-variables-to-check-for*))
	   (pushnew exp *all-variables* :test 'eq))
	 exp)
	((atom exp) exp)
	((consp (car exp))
	 ;; Explicit lambda-expression
	 (if *cw-return-expansion-flag*
	     `(,(cw-lambda-expression (car exp)) . ,(mapcar #'cw-expression (cdr exp)))
	   (cw-lambda-expression (car exp))
	   (mapc #'cw-expression (cdr exp))))
	((nsymbolp (car exp))
	 (cw-eval-args exp))
	((setq tem (fsymeval-in-function-environment (car exp) *cw-function-environment*))
	 (if (eq (car-safe tem) 'macro)
	     ;; Local definition is a macro.  Call its expander.
	     (with-stack-list (si:*macroexpand-environment* *cw-function-environment*)
	       ;; Was binding *CW-FUNCTION-ENVIRONMENT* to NIL, forcing walk in top level
	       ;; environment, trying to avoid a non-existent environment clash.
	       ;; -- RpK 28-Jan-87 15:00:32
	       (cw-expression (funcall (cdr tem) exp si:*macroexpand-environment*)))
	   ;; Local definition is not a macro.  Assume it evals its args.
	   (cw-eval-args exp)))
	((setq tem (get (car exp) 'cw-handler))
	 ;; special form with its own way of doing this.
	 (funcall tem exp))
	;; Hack &QUOTE.
	((SI:INTERPRETER-SPECIAL-FORM (CAR EXP))
	 (SETQ TEM (ARGLIST (CAR EXP)))
	 (let ((quoted))
	   (flet ((frob (arg) (do ((x (pop tem) (pop tem)))
				  ((not (memq x lambda-list-keywords))
				   (if quoted arg (cw-expression arg)))
				(cond ((eq x '&quote) (setq quoted t))
				      ((eq x '&eval) (setq quoted nil))))))
	     (if *cw-return-expansion-flag*
		 `(,(car exp) . ,(mapcar #'frob (cdr exp)))
	         (mapc #'frob (cdr exp))))))
	((multiple-value-bind (v1 v2)
	     (with-stack-list (env *cw-function-environment*)
	       (macroexpand-1 exp env))
	   (setq tem v1)
	   v2)
	 ;; Macro call.
	 (cw-expression tem))
	(t
	 (cw-eval-args exp))))

))

; From modified file DJ: L.SYS; QCLUKE.LISP#34 at 28-Jan-87 15:02:10
#10R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCLUKE  "

(defun (:property macrolet cw-handler) (exp)
  (let ((*all-functions-to-check-for*
	  ;; References to these locally bound functions
	  ;; should not be reported as refs to the external functions to check for.
	  (remove-if #'(lambda (elt) (assq elt (cadr exp)))
		     *all-functions-to-check-for*)))
    (with-stack-list* (*cw-function-environment*
			(loop for elt in (and (consp (cadr exp)) (cadr exp))
			      nconc (list* (locf (symbol-function (car elt)))
					   ;; Local macros are defined in the top level
					   ;; environment.  -- RpK 28-Jan-87 15:01:57
					   `(macro . ,(si:expand-defmacro elt nil))
					   nil))	;for cdr-next for nconc
			*cw-function-environment*)
      (let ((body (cw-clause (cddr exp))))
	(when *cw-return-expansion-flag*
	  ;; No need to have a MACROLET in the result
	  ;; since there cannot be any uses of the local macros remaining after expansion.
	  (if (= (length body) 1)
	      (car body)
	      `(progn . ,body)))))))

))