(FILECREATED " 8-Feb-86 15:08:30" {DSK}<LISPFILES2>IMPROVEDDCOMS>BASIC.;1
 3176   

      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 COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (381 2505 (def.const 391 . 521) (def.global 523 . 689) (def.init 691 . 907) (def.macro 
909 . 1296) (def.nlambda 1298 . 1602) (def.open 1604 . 1758) (def.props 1760 . 1995) (def.struct 1997
 . 2135) (def.subr 2137 . 2267) (def.var 2269 . 2503)))))
STOP