(FILECREATED "25-JUN-83 10:49:39" {PHYLUM}<LISPCORE>SOURCES>POSTFUGUE.;2
 3092   

      changes to:  (VARS POSTFUGUECOMS)
		   (FNS BQUOTIFY)
		   (USERMACROS BQUOTE)
		   (MACROS RESETVARS)

      previous date: "25-JUN-83 10:35:31" {PHYLUM}<LISPCORE>SOURCES>POSTFUGUE.;1)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT POSTFUGUECOMS)

(RPAQQ POSTFUGUECOMS
 ((MACROS RESETVARS)
		      (FNS BQUOTIFY)
		      (USERMACROS BQUOTE)))
(DECLARE: EVAL@COMPILE 

(PUTPROPS RESETVARS DMACRO
 [X
	    (PROG
	      [(VARS (MAPCAR (CAR X)
			     (FUNCTION (LAMBDA (Z)
					       (SETQ Z (MKLIST Z))
					       [AND EMFLAG (NOT (GLOBALVARP (CAR Z)))
						    (COMPERRM (CONS (CAR Z)
								    (QUOTE (- not GLOBALVAR in 
									      RESETVARS]
					       Z]
	      (RETURN
		(BQUOTE
		  (PROG
		    ([MACROX (SETQ RESETVARSLST ,
				   (PROG ((Z (QUOTE RESETVARSLST)))
					 [MAPC (REVERSE VARS)
					       (FUNCTION
						 (LAMBDA (V)
							 (SETQ
							   Z
							   (BQUOTE (CONS (CONS (QUOTE , (CAR V))
									       ,
									       (CAR V))
									 , Z]
					 (RETURN Z]
		     MACROY)
		    (SETQ MACROY RESETVARSLST)
		    (RETURN
		      (CAR (OR [PROG1 (XNLSETQ (PROG NIL [PROGN ,. (MAPCAR VARS
									   (FUNCTION
									     (LAMBDA
									       (V)
									       (CONS (QUOTE SETQ)
										     V]
						     ,.
						     (CDR X))
					       INTERNAL)
				      ,.
				      (MAPCON VARS
					      (FUNCTION
						(LAMBDA
						  (V)
						  (LIST (LIST (QUOTE SETQ)
							      (CAAR V)
							      (QUOTE (CDAR MACROX)))
							(COND [(CDR V)
							       (QUOTE (SETQ MACROX (CDR MACROX]
							      (T (QUOTE (COND ((EQ MACROY 
										   RESETVARSLST)
									       (SETQ RESETVARSLST
										     (CDR MACROX)))
									      ((TAILP MACROY 
										     RESETVARSLST)
									       (RPLACD (NLEFT 
										     RESETVARSLST 1 
											   MACROY)
										       (CDR MACROX]
			       (ERROR!])
)
(DEFINEQ

(BQUOTIFY

  [LAMBDA (FORM)                                             (* lmm "25-JUN-83 10:32")

                                                             (* return either list of BQUOTE expression or NIL)

    (COND
      ((LISTP FORM)
	(SELECTQ (CAR FORM)
		 (QUOTE (LIST (CADR FORM)))
		 [LIST (LIST (for
 X in
 (CDR FORM) bind
 BQ join
 (COND
								 ((BQUOTIFY
 X))
								 (T (LIST (QUOTE ,)
									  X]
		 [CONS (LIST (NCONC (OR (BQUOTIFY
 (CADR FORM))
					(LIST (QUOTE ,)
					      (CADR FORM)))
				    (PROG [(BQ (BQUOTIFY
 (CADDR FORM]
				          (RETURN (COND
						    (BQ (CAR BQ))
						    (T (LIST (QUOTE ,.)
							     (CADDR FORM]
		 NIL))
      ((OR (NUMBERP FORM)
	   (STRINGP FORM)
	   (EQ FORM T)
	   (NULL FORM))
	(LIST FORM])
)

(ADDTOVAR EDITMACROS
 (BQUOTE NIL UP [ORR [(I 1 (OR (CONS (QUOTE BQUOTE)
							 (OR (BQUOTIFY (## 1))
							     (ERROR!)))
						   (ERROR!]
					 ((E (QUOTE BQUOTE?]
			     1))

(ADDTOVAR EDITCOMSA
 BQUOTE)
(PUTPROPS POSTFUGUE COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1986 2793 (BQUOTIFY 1996 . 2791)))))
STOP