(FILECREATED " 2-Feb-86 17:08:05" {DSK}<LISPFILES2>BASIC.LSP;2 4341   

      changes to:  (VARS BASICCOMS)
		   (FNS def.props))


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

(PRETTYCOMPRINT BASICCOMS)

(RPAQQ BASICCOMS ((FNS def.const def.global def.init def.macro def.nlambda def.open def.props 
			 def.struct def.subr def.var)))
(DEFINEQ

(def.const
  (NLAMBDA (X Val)
    (SETTOPVAL X (EVAL Val))
    (EVAL (LIST (QUOTE CONSTANTS)
		    X))
    (QP.ADDTOFILE X (QUOTE CONSTANTS))
    X))

(def.global
  (NLAMBDA (X)
    (if (NOT (MEMB X GLOBALVARS))
	then (SETQ GLOBALVARS (CONS X GLOBALVARS))
	       (QP.ADDTOFILE (LIST (QUOTE GLOBALVARS)
				       X)
			       (QUOTE ADDVARS)))
    X))

(def.init
  (NLAMBDA FORMS
    (PROG (COMS)
	    (SETQ COMS (EVAL (FILECOMS QP.SOURCE.FILE)))
	    (for FORM in FORMS unless (MEMBER (LIST (QUOTE P)
							      FORM)
						      COMS)
	       do (PROGN (QP.ADDTOFILE FORM (QUOTE P))
			     (EVAL FORM))))
    (QUOTE P)))

(def.macro
  (NLAMBDA FORM
    (PROG (X A)
	    (SETQ X (CAR FORM))
	    (SETQ A (CADR FORM))
	    (SETQ FORM (CDDR FORM))
	    (PUTPROP X (QUOTE MACRO)
		       (COND
			 ((NULL A)
			   (BQUOTE (X (PROGN (\,@ FORM)))))
			 ((LITATOM A)
			   (BQUOTE ((\, A)
				      (PROGN (\,@ FORM)))))
			 ((LISTP A)
			   (BQUOTE (X (APPLY (FUNCTION (LAMBDA (\, A)
						     (\,@ FORM)))
						 X))))
			 (T (SHOULDNT (QUOTE def.macro)))))
	    (QP.ADDTOFILE X (QUOTE MACROS))
	    (RETURN X))))

(def.nlambda
  (NLAMBDA FORM
    (PROG (X A)
	    (SETQ X (CAR FORM))
	    (SETQ A (CADR FORM))
	    (PUTD X (CONS (QUOTE NLAMBDA)
			      (CDR FORM)))
	    (COND
	      ((OR (NULL A)
		     (LISTP A))
		(OR (MEMB X NLAML)
		      (SETQ NLAML (CONS X NLAML))))
	      (T (OR (MEMB X NLAMA)
		       (SETQ NLAMA (CONS X NLAMA)))))
	    (QP.ADDTOFILE X (QUOTE FNS))
	    (RETURN X))))

(def.open
  (NLAMBDA FORM
    (PUTPROP (CAR FORM)
	       (QUOTE MACRO)
	       (CONS (QUOTE OPENLAMBDA)
		       (CDR FORM)))
    (QP.ADDTOFILE (CAR FORM)
		    (QUOTE MACROS))
    (CAR FORM)))

(def.props
  (NLAMBDA FORM
    (PROG (X)
	    (SETQ X (CAR FORM))
	    (SETQ FORM (CDR FORM))
	    (while (LISTP (CDR FORM))
	       DO (PUTPROP X (CAR FORM)
			       (CADR FORM))
		    (QP.ADDTOFILE (LIST X (CAR FORM))
				    (QUOTE PROPS))
		    (SETQ FORM (CDDR FORM)))
	    (RETURN X))))

(def.struct
  (NLAMBDA FORM
    (EVAL (LIST (QUOTE DATATYPE)
		    (CAR FORM)
		    (CDR FORM)))
    (QP.ADDTOFILE (CAR FORM)
		    (QUOTE RECORDS))
    (CAR FORM)))

(def.subr
  (NLAMBDA FORM
    (PUTD (CAR FORM)
	    (CONS (QUOTE LAMBDA)
		    (CDR FORM)))
    (QP.ADDTOFILE (CAR FORM)
		    (QUOTE FNS))
    (CAR FORM)))

(def.var
  (NLAMBDA (X Val)
    (if (NOT (MEMB X GLOBALVARS))
	then (SETQ GLOBALVARS (CONS X GLOBALVARS))
	       (QP.ADDTOFILE (LIST X Val)
			       (QUOTE VARS))
	       (QP.ADDTOFILE (LIST (QUOTE GLOBALVARS)
				       X)
			       (QUOTE ADDVARS)))
    (SETTOPVAL X (EVAL Val))
    X))
)
(PRETTYCOMPRINT BASICCOMS)

(RPAQQ BASICCOMS ((FNS def.const def.global def.init def.macro def.nlambda def.open def.props 
			 def.struct def.subr def.var)
		    (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
			      (ADDVARS (NLAMA def.subr def.struct def.props def.open def.nlambda 
					      def.macro def.init)
				       (NLAML def.var def.global def.const)
				       (LAMA)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA def.subr def.struct def.props def.open def.nlambda def.macro def.init)

(ADDTOVAR NLAML def.var def.global def.const)

(ADDTOVAR LAMA )
)
(PUTPROPS BASIC.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (379 3615 (def.const 389 . 570) (def.global 572 . 817) (def.init 819 . 1159) (def.macro 
1161 . 1752) (def.nlambda 1754 . 2237) (def.open 2239 . 2477) (def.props 2479 . 2852) (def.struct 2854
 . 3059) (def.subr 3061 . 3257) (def.var 3259 . 3613)))))
STOP