(FILECREATED " 2-Feb-86 19:02:37" {DSK}<LISPFILES2>UTIL.LSP;2
 7105   

      changes to:  (VARS UTILCOMS)
		   (FNS CANONICAL.REST DEFFILES DEFMACROC.ARGLIST DEFMACROC.BODY))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT UTILCOMS)

(RPAQQ UTILCOMS
 ((FNS CANONICAL.REST DEFCMD DEFFILES DEFMACROC DEFMACROC.ARGLIST DEFMACROC.BODY 
			EMACS.READIN KILLLINE QP.ADDTOFILE)
		   (MACROS DEFRECORD DEFUNC EVAL.ON.LOAD INCF INCR MAKE.SURE.COMPILED PUTPROPC)
		   (P (PROGN (SETSYNTAX (QUOTE %;)
					(QUOTE (SPLICE FIRST ESCQUOTE NONIMMEDIATE KILLLINE))
					T)
			     (SETSYNTAX (QUOTE %;)
					(QUOTE (SPLICE FIRST ESCQUOTE NONIMMEDIATE KILLLINE))
					FILERDTBL)))))
(DEFINEQ

(CANONICAL.REST

  (CL:LAMBDA (ARGS)
    (
COND

      ((
NOT
 (
NULL
 (
CDR
 (
LAST
 ARGS))))
	(LET ((
LASTN
 (
LASTN
 ARGS 1)))
	     (
CONS
 (
CDR
 LASTN)
		     (
CAR
 LASTN))))
      (T (LET ((
LASTN
 (
LASTN
 ARGS 2)))
	      (
COND

		((
MEMB
 (
CADR
 LASTN)
			 (
QUOTE
 (&REST &rest)))
		  (
CONS
 (
CADDR
 LASTN)
			  (
CAR
 LASTN)))
		(T (
CONS
 NIL ARGS))))))))

(DEFCMD

  (NLAMBDA (CMD)
    (QP.ADDTOFILE
 CMD (
QUOTE
 P))
    (
EVAL
 CMD)))

(DEFFILES

  (NLAMBDA FILES
    (for
 FILE in
 (
REVERSE
 FILES) do
 (QP.ADDTOFILE
 FILE (
QUOTE
 FILES)))
    (
APPLY
 (
FUNCTION
 FILESLOAD)
	     FILES)))

(DEFMACROC

  (NLAMBDA ARGLIST
    (LET* ((NAME (
CAR
 ARGLIST))
	   (ARGS (CANONICAL.REST
 (
CADR
 ARGLIST)))
	   (REST.ARG (
CAR
 ARGS))
	   (REG.ARGS (
CDR
 ARGS))
	   (BODY (
CDDR
 ARGLIST)))
          (
PUTPROP
 NAME (
QUOTE
 MACRO)
		     (
LIST
 (
QUOTE
 **MACROARG**)
			     (
BQUOTE
 (LET (\, (DEFMACROC.ARGLIST
 REG.ARGS REST.ARG))
					    (\,@ BODY)))))
          (QP.ADDTOFILE
 NAME (
QUOTE
 MACROS))
      NAME)))

(DEFMACROC.ARGLIST

  (CL:LAMBDA (REG.ARGS REST.ARG)
    (LET* ((
LENGTH
 (
LENGTH
 REG.ARGS))
	   (REG.ARG.PART (
COND

			   ((
NULL
 REG.ARGS)
			     NIL)
			   (T (for
 I from
 1 to
 LENGTH
				 collect
 (
BQUOTE
 ((\, (
CAR
 (
NTH
 REG.ARGS I)))
						      (
CAR
 (
NTH
 **MACROARG** (\, I)))))))))
	   (REST.ARG.PART (
COND

			    ((
NULL
 REST.ARG)
			      NIL)
			    (T (
BQUOTE
 (((\, REST.ARG)
					   (
NTH
 **MACROARG** (\, (
ADD1
 LENGTH))))))))))
          (
NCONC
 REG.ARG.PART REST.ARG.PART))))

(DEFMACROC.BODY

  (CL:LAMBDA (ARGBODY)
    (
COND

      ((
EQP
 (
LENGTH
 ARGBODY)
	      1)
	(
CAR
 ARGBODY))
      (T (
CONS
 (
QUOTE
 LIST)
		 ARGBODY)))))

(EMACS.READIN

  (LAMBDA NIL
    (LET ((FILEPKGFLG NIL)
	  (QP.SOURCE.FILE (
QUOTE
 .XFER.LSP)))
         (
PRIN1
 (
QUOTE
 Emacs% read% started...))
         (
LOADWELL
 {GOEDEL}/usr2/xerox/descartes/.xfer T T)
         (
BKSYSBUF
 (
QUOTE
 %
))
         (
PRIN1
 (
QUOTE
 Emacs% read% completed)))))

(KILLLINE

  (LAMBDA (F R)
    (
PROG
 (C)
	L   (
SETQ
 C (
READC
 F R))
	    (
COND

	      ((
NEQ
 C (
QUOTE
 %
))
		(
GO
 L)))
	    (
RETURN
 NIL))))

(QP.ADDTOFILE

  (LAMBDA (NAME TYPE)
    (
COND

      ((
AND
 (
BOUNDP
 (
QUOTE
 QP.SOURCE.FILE))
	      QP.SOURCE.FILE)
	(
ADDTOFILE
 NAME TYPE QP.SOURCE.FILE)))))
)
(DECLARE: EVAL@COMPILE 
(PUTPROPS DEFRECORD MACRO
	  (**MACROARG**
	    (LET ((NAME (CAR (NTH **MACROARG** 1)))
		  (TYPE (CAR (NTH **MACROARG** 2)))
		  (FIELDS (NTH **MACROARG** 3)))
		 (LET* ((SLOTS (MAPCAR FIELDS (QUOTE (LAMBDA (FIELD)
							     (COND ((ATOM FIELD)
								    FIELD)
								   (T (CAR FIELD)))))))
			(ACCESSORS (MAPCAR SLOTS (QUOTE (LAMBDA
							  (SLOT)
							  (BQUOTE (DEFMACROC
								    (\, SLOT)
								    (X)
								    (LIST (QUOTE FETCH)
									  (QUOTE (\, SLOT))
									  (QUOTE OF)
									  X)))))))
			(SETFFORMS (MAPCAR SLOTS (QUOTE (LAMBDA
							  (SLOT)
							  (BQUOTE (PUTPROP
								    (QUOTE (\, SLOT))
								    (QUOTE SETFDEF)
								    (QUOTE (REPLACE (\, SLOT)
										    OF DATUM WITH 
										    NEWVALUE)))))))))
		       (QP.ADDTOFILE NAME (QUOTE RECORDS))
		       (for SLOT in SLOTS do (QP.ADDTOFILE (LIST SLOT (QUOTE SETFDEF))
							   (QUOTE PROPS)))
		       (BQUOTE (PROGN ((\, TYPE)
				       (\, NAME)
				       (\, SLOTS))
				      (\,@ ACCESSORS)
				      (\,@ SETFFORMS)
				      (QUOTE (\, NAME))))))))
(PUTPROPS DEFUNC MACRO (**MACROARG** (LET ((NAME (CAR (NTH **MACROARG** 1)))
					   (ARGS (CAR (NTH **MACROARG** 2)))
					   (BODY (NTH **MACROARG** 3)))
					  (QP.ADDTOFILE NAME (QUOTE FNS))
					  (LIST (QUOTE PUTDQ)
						NAME
						(COND ((EQ ARGS (QUOTE FEXPR))
						       (CONS (QUOTE NLAMBDA)
							     BODY))
						      ((EQ ARGS (QUOTE EXPR))
						       (CONS (QUOTE LAMBDA)
							     BODY))
						      (T (CONS (QUOTE LAMBDA)
							       (CONS ARGS BODY))))))))
(PUTPROPS EVAL.ON.LOAD MACRO (**MACROARG** (LET ((FORM (CAR (NTH **MACROARG** 1))))
						(QP.ADDTOFILE FORM (QUOTE P))
						FORM)))
(PUTPROPS INCF MACRO (**MACROARG** (LET ((NAME (CAR (NTH **MACROARG** 1)))
					 (COUNT (CAR (NTH **MACROARG** 2))))
					(BQUOTE (SETF (\, NAME)
						      (PLUS (\, NAME)
							    (\, (OR COUNT 1))))))))
(PUTPROPS INCR MACRO (**MACROARG** (LET ((NAME (CAR (NTH **MACROARG** 1)))
					 (COUNT (CAR (NTH **MACROARG** 2))))
					(BQUOTE (SETQ (\, NAME)
						      (PLUS (\, NAME)
							    (\, (OR COUNT 1))))))))
(PUTPROPS MAKE.SURE.COMPILED MACRO
	  (**MACROARG** (LET ((FUNCTION (CAR (NTH **MACROARG** 1))))
			     (BQUOTE (COND ((NOT (EQ (TYPENAME (GETD (QUOTE (\, FUNCTION))))
						     (QUOTE CCODEP)))
					    (COMPILE! (QUOTE (\, FUNCTION)))))))))
(PUTPROPS PUTPROPC MACRO (**MACROARG** (LET ((ATOM (CAR (NTH **MACROARG** 1)))
					     (PROPERTY (CAR (NTH **MACROARG** 2)))
					     (VALUE (CAR (NTH **MACROARG** 3))))
					    (QP.ADDTOFILE (LIST (EVAL ATOM)
								(EVAL PROPERTY))
							  (QUOTE PROPS))
					    (BQUOTE (PUTPROP (\, ATOM)
							     (\, PROPERTY)
							     (\, VALUE))))))
)
(PROGN (SETSYNTAX (QUOTE %;)
		  (QUOTE (SPLICE FIRST ESCQUOTE NONIMMEDIATE KILLLINE))
		  T)
       (SETSYNTAX (QUOTE %;)
		  (QUOTE (SPLICE FIRST ESCQUOTE NONIMMEDIATE KILLLINE))
		  FILERDTBL))
(PRETTYCOMPRINT UTILCOMS)

(RPAQQ UTILCOMS
 ((FNS CANONICAL.REST DEFCMD DEFFILES DEFMACROC DEFMACROC.ARGLIST DEFMACROC.BODY 
			EMACS.READIN KILLLINE QP.ADDTOFILE)
		   (MACROS DEFRECORD DEFUNC EVAL.ON.LOAD INCF INCR MAKE.SURE.COMPILED PUTPROPC)
		   (P (PROGN (SETSYNTAX (QUOTE %;)
					(QUOTE (SPLICE FIRST ESCQUOTE NONIMMEDIATE KILLLINE))
					T)
			     (SETSYNTAX (QUOTE %;)
					(QUOTE (SPLICE FIRST ESCQUOTE NONIMMEDIATE KILLLINE))
					FILERDTBL)))
		   (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
			     (ADDVARS (NLAMA DEFMACROC DEFFILES)
				      (NLAML DEFCMD)
				      (LAMA)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 DEFMACROC DEFFILES)

(ADDTOVAR NLAML
 DEFCMD)

(ADDTOVAR LAMA
 )
)
(PUTPROPS UTIL.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (724 3304 (CANONICAL.REST 734 . 1150) (DEFCMD 1152 . 1242) (DEFFILES 1244 . 1424) (
DEFMACROC 1426 . 1888) (DEFMACROC.ARGLIST 1890 . 2450) (DEFMACROC.BODY 2452 . 2627) (EMACS.READIN 2629
 . 2949) (KILLLINE 2951 . 3122) (QP.ADDTOFILE 3124 . 3302)))))
STOP