(FILECREATED " 4-SEP-81 21:44:36" <LISPUSERS>PERFORMTRAN.;8
 5085   

     changes to:  PERFORMTRANCOMS PERFORMTRAN PT.RECREDECLARE1

     previous date: "30-AUG-81 22:20:11" <LISPUSERS>PERFORMTRAN.;7)


(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: " 4-SEP-81 21:39")


          (* 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.)



    (if
 MASTERSCOPEFLAG
	then
 (FORM_ <'perform ! FORM>))
    (PROG (OP TEMP OPDEF (DWIMESSGAG (OR MASTERSCOPEFLAG DWIMESSGAG))
	      (PATH (FORM:PATH)))
          (DECLARE
 (SPECVARS DWIMESSGAG))
          [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 (1214 4238 (PERFORMOPSTRAN 1226 . 1749) (PERFORMTRAN 1753 . 3921) (PT.RECREDECLARE1 3925
 . 4235)))))
STOP