(FILECREATED "24-Jul-84 16:32:53" {ERIS}<LISPCORE>SOURCES>RENAMEFNS.;3
 5681   

      changes to:  (FNS RNSUBST)

      previous date: "19-Jul-84 15:54:11" {ERIS}<LISPCORE>SOURCES>RENAMEFNS.;2)


(* Copyright (c) 1982, 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT RENAMEFNSCOMS)

(RPAQQ RENAMEFNSCOMS
 [(FNS DORENAME DORENAME0 RENAMEFN RENAMEDVAL MAKECOMP RNSUBST)
		      (FILES (SOURCE)
			     FILESETS)
		      (BLOCKS (RNSUBST RNSUBST (NOLINKFNS . T])
(DEFINEQ

(DORENAME

  [LAMBDA (TYPE NOLOADFLG)                                   (* lmm " 5-APR-82 13:03")

    (DORENAME0
 (SETQ RENAMETYPE TYPE)
	       NOLOADFLG)
    (for
 X in
 RENAMEFNSPAIRS do
 (RENAMEFN
 (CAR X)
					  (CDR X)))
    (MAKECOMP
 RENAMEDFILE (APPEND (RENAMEDVAL
 NEWCOMS)
				  EXTRACOMS])

(DORENAME0

  [LAMBDA (TYPE NOLOAD)                                      (* rrb "13-DEC-82 10:43")

    (PROG (LISPXHIST)
          (DECLARE
 (SPECVARS . T))
          [MAPC (CDR (ASSOC (OR TYPE (QUOTE I))
			    RENAMETYPES))
		(FUNCTION (LAMBDA (X)
		    (SETATOMVAL (CAR X)
				(CDR X]
          (RESETVARS ((LOADDBFLG (QUOTE NO))
		      (NOSPELLFLG T)
		      (CROSSCOMPILING T))
		     (FILESLOAD (SYSLOAD)
				DTDECLARE)
		     (for
 X in
 FILES do
 (PRINT (LOADFROM X)
					       T T)))
          [SETQ ALLFNS (INFILECOMS? NIL (QUOTE FNS)
				    (SETQ NEWCOMS (GETATOMVAL COMSNAME]
          [RESETVARS ((NOSPELLFLG T))
		     (MAPC FILES (FUNCTION (LAMBDA (FILE)
			       (LOADFNS ALLFNS FILE (QUOTE PROP]
          [SETQ NEWCOMS (MAPCAR NEWCOMS (FUNCTION (LAMBDA (X)
				    (COND
				      [(EQ (CADR X)
					   (QUOTE *))
					(CONS (CAR X)
					      (EVAL (CADDR X]
				      (T X]
          [SETQ RENAMEFNSPAIRS (MAPCAR (INFILECOMS? NIL (QUOTE FNS)
						    NEWCOMS)
				       (FUNCTION (LAMBDA (FN)
					   (CONS FN (PACK* PREFIX FN]
          (SETATOMVAL SUBNAME
		      (UNION [APPEND RENAMEFNSPAIRS
				     [MAPCONC (APPEND (GETATOMVAL VALUES)
						      (GETATOMVAL PTRS))
					      (FUNCTION (LAMBDA (X)
						  (AND (NEQ (CAR X)
							    (QUOTE *))
						       (LIST (CONS (CAR X)
								   (PACK* PREFIX (SUBSTRING
									    (CAR X)
									    2 -1]
				     [for
 X in
 INITCONSTANTS when
 (AND (NEQ (CAR X)
									    (QUOTE *))
								       (LISTP (CADR X)))
					collect
 (CONS (CAR X)
						      (LIST VAG2FN (CAADR X)
							    (CADR (CADR X]
				     (for
 X in
 FILES join
 (for
 Y in
 (FILECOMSLST X (QUOTE CONSTANTS))
							     collect
 (CONS Y (EVAL Y]
			     (GETATOMVAL SUBNAME])

(RENAMEFN

  [LAMBDA (OFN NFN)                                          (* edited: "19-Jul-84 15:51")

    (SETQ RENAMEALIST (EVALV SUBNAME))
    (until
 [ERSETQ (RESETVARS ((NOSPELLFLG T)
			       (DWIMESSGAG T)
			       (DWIMUSERFORMS))
			      (/PUTD NFN (RNSUBST
 (OR (AND (EXPRP OFN)
							   (GETD OFN))
						      (GETDEF OFN)
						      (HELP OFN (QUOTE (no DEFINITION FOUND]
       do
 (HELP OFN (QUOTE (rename failed -- RETURN to try again])

(RENAMEDVAL

  [LAMBDA (VAL)                                              (* edited: "19-Jul-84 15:51")

    (SETQ RENAMEALIST (EVALV SUBNAME))
    (RESETVARS ((NOSPELLFLG T)
		(DWIMESSGAG T)
		(DWIMUSERFORMS))
	       (RETURN (RNSUBST
 VAL])

(MAKECOMP

  [LAMBDA (FILE COMS)                                        (* lmm " 5-APR-82 13:01")

    (PROG (FULL)
          (SETATOMVAL (FILECOMS FILE)
		      COMS)
          [RESETVARS (PRETTYFLG (COPYRIGHTFLG (QUOTE NEVER))
				USEMAPFLG BUILDMAPFLG MAKEFILEREMAKEFLG)
		     (SETQ FULL (MAKEFILE FILE (QUOTE (NEW]
          (LISPXUNREAD (QUOTE (F)))
          (RETURN (LIST FULL (RESETVARS (DONTCOMPILEFNS)
				        (RETURN (BRECOMPILE FULL NIL (QUOTE ALL])

(RNSUBST

  [LAMBDA (X)                                                (* edited: "24-Jul-84 16:26")

    (COND
      ((NLISTP X)
	(OR (CDR (FASSOC X RENAMEALIST))
	    X))
      (T (PROG ((A (CAR X)))
	       (COND
		 ((LISTP A)
		   (GO LST)))
	       [RETURN (SELECTQ A                            (* (QUOTE (*)))

				[LOCAL (COND
					 [(LISTP (CADR X))
					   (CONS (CAADR X)
						 (MAPCAR (CDADR X)
							 (FUNCTION RNSUBST]
					 (T (CADR X]
				[UNLESSRDSYS (SELECTQ RENAMETYPE
						      (R (RNSUBST
 (CADDR X)))
						      (RNSUBST
 (CADR X]
				(ALLOCAL (CADR X))
				[OPENLAMBDA (CONS (QUOTE LAMBDA)
						  (RNSUBST
 (CDR X]
				(COND
				  [(FMEMB [CAR (LISTP (GETPROP A (QUOTE CLISPWORD]
					  (QUOTE (RECORDTRAN CHANGETRAN)))
                                                             (* most CLISP forms don't need or want to substitute 

							     under, but do so for record expressions)

				    (RNSUBST
 (OR (GETHASH (DWIMIFY X T)
							  CLISPARRAY)
						 (PROGN (HELP X "DWIM failed")
							X]
				  [(SETQ A (CDR (FASSOC A RENAMEALIST)))
				    (RNSUBST
 (CONS A (CDR X]
				  ((FMEMB (CAR X)
					  EXPANDMACROFNS)
				    [RESETVARS [(COMPILERMACROPROPS (QUOTE (DMACRO ALTOMACRO 
										   BYTEMACRO MACRO]
					       (COND
						 ((EQUAL X (SETQ X (EXPANDMACRO X T)))
						   (HELP X (QUOTE "macro expansion failed"]
				    (RNSUBST
 X))
				  (T (SETQ A (DOCOLLECT (CAR X)))
				     (GO NXT]
	   LST (SETQ A)
	   DLP (SETQ A (DOCOLLECT (RNSUBST
 (CAR X))
				  A))
	   NXT (AND (LISTP (SETQ X (CDR X)))
		    (GO DLP))
	       (RETURN (ENDCOLLECT A (RNSUBST
 X])
)
(FILESLOAD (SOURCE)
	   FILESETS)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: RNSUBST RNSUBST (NOLINKFNS . T))
]
(PUTPROPS RENAMEFNS COPYRIGHT ("Xerox Corporation" 1982 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (485 5471 (DORENAME 495 . 824) (DORENAME0 826 . 2615) (RENAMEFN 2617 . 3089) (RENAMEDVAL
 3091 . 3342) (MAKECOMP 3344 . 3816) (RNSUBST 3818 . 5469)))))
STOP