;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.10
;;; Reason:
;;;  Make ALTERNATE-MACRO-DEFINITIONS of PROG and PROG*
;;;  conform to Common LISP.
;;; Written 22-Jan-87 18:01:20 by jrm (Joe Marshall) at site LMI Cambridge
;;; while running on Laurie Anderson from band 2
;;; with Experimental System 121.7, Experimental Lambda-Diag 15.0, Experimental ZMail 70.1, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, Experimental IMicro 19.0, microcode 1729, SDU Boot Tape 3.14, SDU ROM 102.



; From modified file DJ: L.SYS2; CLMAC.LISP#8 at 22-Jan-87 18:01:46
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; CLMAC  "

(defun make-prog-macroexpander (prog-type let-type)
  #'(lambda (prog-form macroenvironment)
      (when (not (>= (length prog-form) 2))
	(ferror nil "Too few arguments to ~S in ~S." prog-type prog-form))
      (let ((binding-list (second prog-form))
	    (body         (rest (rest prog-form))))
	;; Macroexpand body to get declarations.
	(let ((macroexpanded-body
		(mapcar #'(lambda (form) (macroexpand form macroenvironment)) body)))
	  ;; Scan out declarations.
	  (do ((forms macroexpanded-body (rest forms))
	       (decls '() (cons (first forms) decls)))
	      ((or (not (consp (first forms)))
		   (not (eq (car (first forms)) 'LISP::DECLARE)))
	       `(BLOCK NIL
		  (,let-type ,binding-list
		   ,@(reverse decls)
		   (TAGBODY ,@forms)))))))))

))

; From modified file DJ: L.SYS2; CLMAC.LISP#8 at 22-Jan-87 18:01:52
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; CLMAC  "

(deff prog-macro-expander  (make-prog-macroexpander 'PROG  'LET))
(deff prog*-macro-expander (make-prog-macroexpander 'PROG* 'LET*))

(defprop prog  (macro . prog-macro-expander)  alternate-macro-definition)
(defprop prog* (macro . prog*-macro-expander) alternate-macro-definition)

))