(FILECREATED "14-FEB-83 23:01:54" <LISPUSERS>PERFORMTRAN.;9
    4965

      changes to:  (FNS PERFORMTRAN)

      previous date: " 4-SEP-81 21:44:36" <LISPUSERS>PERFORMTRAN.;8)


(PRETTYCOMPRINT PERFORMTRANCOMS)

(RPAQQ PERFORMTRANCOMS
 ((LOCALVARS . T)
			(FNS PERFORMOPSTRAN PERFORMTRAN PT.RECREDECLARE1)
			(P (MOVD? (QUOTE RECREDECLARE1)
				  (QUOTE PT.OLDRECREDECLARE1))
			   (MOVD (QUOTE PT.RECREDECLARE1)
				 (QUOTE RECREDECLARE1)))
			(PROP CLISPWORD PERFORM perform)
			(ADDVARS (CLISPRECORDTYPES PERFORMOPS)
				 (PERFORMOPS))
			(P (MOVD (QUOTE RECORD)
				 (QUOTE PERFORMOPS))
			   [SETTEMPLATE (QUOTE PERFORM)
					(QUOTE (MACRO ARGS (PERFORMTRAN ARGS T]
			   (SETTEMPLATE (QUOTE perform)
					(GETTEMPLATE (QUOTE PERFORM)))
			   (SETSYNONYM (QUOTE PERFORM)
				       (QUOTE FETCH)
				       T)
			   (SETSYNONYM (QUOTE PERFORMS)
				       (QUOTE FETCHES)
				       T)
			   (SETSYNONYM (QUOTE PERFORMING)
				       (QUOTE FETCHING)
				       T)
			   (SETSYNONYM (QUOTE PERFORMED)
				       (QUOTE FETCHED)
				       T))
			(PROP USERRECORDTYPE PERFORMOPS)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DEFINEQ

(PERFORMOPSTRAN

  [LAMBDA (DECL)                                            (* DECLARATIONS:)

                                                            (* rmk: "24-AUG-81 13:33")

    (NCONC [CONS (QUOTE ACCESSFNS)
		 (COND
		   ((LITATOM (CADR DECL))
		     (LIST (CAR (SETQ DECL (CDR DECL]
	   (LIST (LIST (QUOTE PERFORMOPS)
		       (QUOTE DATUM))
		 (LIST (QUOTE ACCESSFNS)
		       (QUOTE PERFORMOPS)
		       (for
 OP in
 (CDR DECL) collect
 (LIST (CAR OP)
							   (KWOTE (CDR OP])

(PERFORMTRAN

  [LAMBDA (FORM MASTERSCOPEFLAG)
    (CLISP:(RECORD FORM (perform
 PATH . ARGS)))        (* rmk: "14-FEB-83 23:01")


          (* Translates PERFORM expressions, where the record FOO has a PERFORMOPS access field, e.g. (PERFORMOPS (MAP (FN) 

	  (MAPC X FN)) (PRINT (X FILE) (PPV X FILE))) The CDR of the PERFORMOPS specification is an ALIST indexed by the operation name 

	  (e.g. MAP) The element after the operation name (FN) is a list of dummy arguments, and the 3rd element is a form into which the true 

	  args will be substituted.)




          (* If MASTERSCOPEFLAG, then we are being called from a Masterscope template. FORM is CDR of the perform expression.

	  We return an appropriate FETCH form, so that the user can ask about the operation as a field name.)



    (DECLARE
 (GLOBALVARS DWIMESSGAG))
    (if
 MASTERSCOPEFLAG
	then
 (FORM← <'perform ! FORM>))
    (RESETVARS ((DWIMESSGAG (OR MASTERSCOPEFLAG DWIMESSGAG)))
	       (RETURN (PROG (OP TEMP OPDEF (PATH (FORM:PATH)))
			     [PATH←(if
 (LISTP PATH)
				       then
 < ! PATH>
				     else
 (bind
 I←0 while
 I
					     collect
 (I←I+1)
						     (SUBATOM PATH I (AND I←(STRPOS "." PATH I)
									  I-1]
			     (OP←(TEMP←PATH::-1):1)
			     (ATTACH 'PERFORMOPS TEMP)
			     (if
 OPDEF←(CAR (NLSETQ (RECORDACCESS PATH)))
			       elseif
 OPDEF←(CDR (ASSOC OP PERFORMOPS))
				 then
 (AND DWIMESSGAG
					   (LISPXPRIN1 (CONCAT "{in " FAULTFN 
							    "}  Using global perform definition
")
						       T)))
			     (if
 (AND ~DWIMESSGAG (NLISTP OPDEF))
				 then
 (LISPXPRIN1 (CONCAT " {in " FAULTFN 
							"}  Undefined PERFORM operator in form
	")
						  T)
				      (LISPXPRINT FORM T)
				      (ERROR!))
			     (if
 ~MASTERSCOPEFLAG
				 then
 (DWIMIFY0? FORM:ARGS FORM NIL NIL NIL FAULTFN))
			     (OPDEF←(SUBPAIR OPDEF:1 FORM:ARGS (MKPROGN OPDEF::1)))
			     (RETURN (if
 MASTERSCOPEFLAG
					 then
 (<'fetch PATH 'of (OR (LISTP OPDEF)
								    <'ppe >)
						>)
				       else
 (if
 LCASEFLG
						then
 (FORM:perform←'perform))
					    (CLISPTRAN FORM OPDEF])

(PT.RECREDECLARE1

  [LAMBDA (TRAN ORIG)
    (CLISP:)                                           (* rmk: " 4-SEP-81 21:42")

    (DECLARE
 (GLOBALVARS CLISPARRAY))
    (SELECTQ ORIG:1
	     ((perform
 PERFORM
)
	       (/PUTHASH ORIG NIL CLISPARRAY))
	     (PT.OLDRECREDECLARE1 TRAN ORIG])
)
(MOVD? (QUOTE RECREDECLARE1)
       (QUOTE PT.OLDRECREDECLARE1))
(MOVD (QUOTE PT.RECREDECLARE1)
      (QUOTE RECREDECLARE1))

(PUTPROPS PERFORM CLISPWORD
 (PERFORMTRAN . perform))

(PUTPROPS perform CLISPWORD
 (PERFORMTRAN . perform))

(ADDTOVAR CLISPRECORDTYPES
 PERFORMOPS)

(ADDTOVAR PERFORMOPS
 )
(MOVD (QUOTE RECORD)
      (QUOTE PERFORMOPS))
[SETTEMPLATE (QUOTE PERFORM)
	     (QUOTE (MACRO ARGS (PERFORMTRAN ARGS T]
(SETTEMPLATE (QUOTE perform)
	     (GETTEMPLATE (QUOTE PERFORM)))
(SETSYNONYM (QUOTE PERFORM)
	    (QUOTE FETCH)
	    T)
(SETSYNONYM (QUOTE PERFORMS)
	    (QUOTE FETCHES)
	    T)
(SETSYNONYM (QUOTE PERFORMING)
	    (QUOTE FETCHING)
	    T)
(SETSYNONYM (QUOTE PERFORMED)
	    (QUOTE FETCHED)
	    T)

(PUTPROPS PERFORMOPS USERRECORDTYPE
 PERFORMOPSTRAN)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1148 4152 (PERFORMOPSTRAN 1158 . 1669) (PERFORMTRAN 1671 . 3845) (PT.RECREDECLARE1 3847
 . 4150)))))
STOP