(FILECREATED "23-Jun-86 11:19:34" {ERIS}<LISPCORE>SOURCES>MISC.;14 44396
changes to: (FNS APPENDTOVAR ADDTOVAR)
previous date: "20-Jan-86 20:47:45" {ERIS}<LISPCORE>SOURCES>MISC.;13)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MISCCOMS)
(RPAQQ MISCCOMS
[(FNS ADD1VAR ADDTOVAR APPENDTOVAR APPEND \APPEND2 ASSOC ATTACH CHANGEPROP CONCATLIST
CONSTANTS CONSTANTEXPRESSIONP COPY DEFINEQ DEFLIST DREMOVE DREVERSE DSUBST EQLENGTH
ERSETQ EVERY GENSYM GENSYM? \GS.INITBUF GETLIS INTERSECTION KWOTE LAST LASTN LCONC LDIFF
LDIFFERENCE LENGTH LISTGET LISTGET1 LISTPUT LISTPUT1 LSUBST MAP MAP2C MAP2CAR MAPC
MAPCAR MAPCON MAPCONC MAPLIST MEMBER NLEFT NLSETQ NOTANY NOTEVERY NTH PUTASSOC RATOMS
REMOVE REVERSE RPT RPTQ FRPTQ SASSOC SAVEDEF SAVEDEF1 SELECT SELECT1 SELECTC SETQQ SOME
STRMEMB SUB1VAR SUBSET SUBST TAILP TCONC TIME UNION)
(INITVARS (COMPVARMACROHASH NIL))
(ADDVARS (CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT
IMIN IMAX IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND))
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (\GS.BUFSIZE 100)))
(INITVARS (GENNUM 0)
(\GS.OGENNUM -1)
(\GS.NUMLEN 0)
(\GS.BUF NIL)
(\GS.STR (ALLOCSTRING 0)))
(ALISTS (PRETTYEQUIVLST SELECTC)
(DWIMEQUIVLST SELECTC))
(GLOBALVARS GENNUM \GS.OGENNUM \GS.NUMLEN \GS.BUF \GS.STR)
(LOCALVARS . T)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA SELECTC SELECT FRPTQ RPTQ DEFINEQ CONSTANTS APPENDTOVAR ADDTOVAR)
(NLAML TIME SUB1VAR SETQQ NLSETQ ERSETQ ADD1VAR)
(LAMA APPEND])
(DEFINEQ
(ADD1VAR
(NLAMBDA (ADD1X)
(SET ADD1X (ADD1 (EVAL ADD1X)))))
(ADDTOVAR
[NLAMBDA X (* lmm "19-Jun-86 12:36")
(* redefined to handle alists
specially)
(PROG ((VAR (CAR X))
[VAL (OR (AND (EQ DFNFLG (QUOTE ALLPROP))
(GETPROP (CAR X)
(QUOTE VALUE)))
(LISTP (GETTOPVAL (CAR X]
TYPE FLG)
[COND
[[AND (NEQ DFNFLG (QUOTE ALLPROP))
(SETQ TYPE (GETPROP VAR (QUOTE VARTYPE)))
(SETQ TYPE (OR (LISTGET1 (LISTP TYPE)
(QUOTE ALIST))
(EQ TYPE (QUOTE ALIST]
[MAPC
(CDR X)
(FUNCTION (LAMBDA (PAIR OLDENTRY)
(COND
((NLISTP PAIR)
(SETQ VAL (CONS PAIR VAL))
(SETQ FLG T))
((NOT
(EQUAL
(SETQ OLDENTRY
(SELECTQ TYPE
(USERMACROS [CAR (SOME VAL
(FUNCTION (LAMBDA (OP)
(AND
(EQ (CAR OP)
(CAR PAIR))
(EQ (NULL (CADR OP))
(NULL (CADR PAIR])
(FASSOC (CAR PAIR)
VAL)))
PAIR))
(OR (NULL OLDENTRY)
(EQ DFNFLG T)
(LISPXPRINT (LIST (QUOTE new)
VAR
(QUOTE entry)
(QUOTE for)
(CAR PAIR))
T T))
(MARKASCHANGED (LIST VAR (CAR PAIR))
(QUOTE ALISTS)
(NULL OLDENTRY))
(SETQ VAL (CONS PAIR (COND
(OLDENTRY (/DREMOVE OLDENTRY VAL))
(T VAL]
(COND
(FLG (SAVESET VAR VAL T (QUOTE NOPRINT)))
(T (/SETTOPVAL VAR VAL]
(T (* in shallow system, addtovar works
on current binding.)
(LET [(DFNFLG (COND
((EQ DFNFLG (QUOTE ALLPROP))
(QUOTE PROP))
(T DFNFLG]
(COND
((OR VAL (CDR X))
(SAVESET VAR (UNION (CDR X)
VAL)
T
(QUOTE NOPRINT)))
((EQ (QUOTE NOBIND)
(GETTOPVAL VAR)) (* The semantics of (ADDVARS
(FOO)) are to initiilize FOO to NIL if
it is NOBIND, otherwise leave it
alone.)
(/SETTOPVAL VAR NIL]
(RETURN VAR])
(APPENDTOVAR
[NLAMBDA X (* lmm "19-Jun-86 12:36")
(* redefined to handle alists
specially)
(PROG ((VAR (CAR X))
[VAL (OR (AND (EQ DFNFLG (QUOTE ALLPROP))
(GETPROP (CAR X)
(QUOTE VALUE)))
(LISTP (GETTOPVAL (CAR X]
TYPE FLG)
[COND
[[AND (NEQ DFNFLG (QUOTE ALLPROP))
(SETQ TYPE (GETPROP VAR (QUOTE VARTYPE)))
(SETQ TYPE (OR (LISTGET1 (LISTP TYPE)
(QUOTE ALIST))
(EQ TYPE (QUOTE ALIST]
[MAPC
(CDR X)
(FUNCTION (LAMBDA (PAIR OLDENTRY)
(COND
((NLISTP PAIR)
(SETQ VAL (CONS PAIR VAL))
(SETQ FLG T))
((NOT
(EQUAL
(SETQ OLDENTRY
(SELECTQ TYPE
(USERMACROS [CAR (SOME VAL
(FUNCTION (LAMBDA (OP)
(AND
(EQ (CAR OP)
(CAR PAIR))
(EQ (NULL (CADR OP))
(NULL (CADR PAIR])
(FASSOC (CAR PAIR)
VAL)))
PAIR))
(OR (NULL OLDENTRY)
(EQ DFNFLG T)
(LISPXPRINT (LIST (QUOTE new)
VAR
(QUOTE entry)
(QUOTE for)
(CAR PAIR))
T T))
(MARKASCHANGED (LIST VAR (CAR PAIR))
(QUOTE ALISTS)
(NULL OLDENTRY))
(SETQ VAL (APPEND (COND
(OLDENTRY (/DREMOVE OLDENTRY VAL))
(T VAL))
(LIST PAIR]
(COND
(FLG (SAVESET VAR VAL T (QUOTE NOPRINT)))
(T (/SETTOPVAL VAR VAL]
(T (* in shallow system, addtovar works
on current binding.)
(LET [(DFNFLG (COND
((EQ DFNFLG (QUOTE ALLPROP))
(QUOTE PROP))
(T DFNFLG]
(COND
((OR VAL (CDR X))
(SAVESET VAR (APPEND VAL (LDIFFERENCE (CDR X)
VAL))
T
(QUOTE NOPRINT)))
((EQ (QUOTE NOBIND)
(GETTOPVAL VAR)) (* The semantics of (ADDVARS
(FOO)) are to initiilize FOO to NIL if
it is NOBIND, otherwise leave it
alone.)
(/SETTOPVAL VAR NIL]
(RETURN VAR])
(APPEND
[LAMBDA L (* lmm "30-Jun-84 00:37")
(* fixed bug so that (APPEND
(QUOTE (A B . C))) was (QUOTE
(A B . C)))
(COND
((EQ L 0)
NIL)
((EQ L 1)
(\APPEND2 (ARG L 1)
NIL))
(T (bind (VAL ←(ARG L L))
(N ← L) while (IGREATERP (add N -1)
0)
do (SETQ VAL (\APPEND2 (ARG L N)
VAL))
finally (RETURN VAL])
(\APPEND2
[LAMBDA (L1 L2) (* lmm "30-Jun-84 00:30")
(COND
((LISTP L1)
(PROG ((VAL (CONS (CAR L1)
L2))
TAIL)
(SETQ TAIL VAL)
LP [FRPLACD TAIL (SETQ TAIL (LIST (CAR (OR (LISTP (SETQ L1 (CDR L1)))
(PROGN (FRPLACD TAIL (OR L2 L1))
(RETURN VAL]
(GO LP)))
((NLISTP L2)
L1)
(T L2])
(ASSOC
(LAMBDA (KEY ALST) (* bvm: "20-FEB-81 14:58")
(PROG NIL
LP (COND
((NLISTP ALST)
(RETURN))
((AND (LISTP (CAR ALST))
(EQ (CAAR ALST)
KEY))
(RETURN (CAR ALST))))
(SETQ ALST (CDR ALST))
(GO LP))))
(ATTACH
(LAMBDA (X L)
(COND
((LISTP L)
(FRPLACA (FRPLACD L (CONS (CAR L)
(CDR L)))
X))
((NULL L)
(CONS X))
(T (ERRORX (LIST 4 L))))))
(CHANGEPROP
(LAMBDA (X PROP1 PROP2) (* wt: "31-MAY-79 22:28")
(PROG ((Z (COND
((LITATOM X)
(GETPROPLIST X))
(T (ERRORX (LIST 14 X))))))
LP (RETURN (COND
((NLISTP Z)
NIL)
((EQ (CAR Z)
PROP1)
(FRPLACA Z PROP2)
X)
(T (SETQ Z (CDR (LISTP (CDR Z))))
(GO LP)))))))
(CONCATLIST
[LAMBDA (L) (* rmk: "27-Mar-85 17:23")
(PROG (STR FATP) (* Try to pre-determine FATP, at least for strings and
litatoms, where it is easy to tell.)
(SETQ STR (ALLOCSTRING (for X in L
sum (AND (EQ (SYSTEMTYPE)
(QUOTE D))
(OR FATP (SELECTC (NTYPX X)
(\STRINGP (SETQ FATP
(ffetch (STRINGP
FATSTRINGP)
of X)))
(\LITATOM (SETQ FATP
(ffetch (LITATOM FATPNAMEP)
of X)))
NIL)))
(NCHARS X))
NIL NIL FATP))
(for X in L as I from 1 by (NCHARS X) do (RPLSTRING STR I X))
(RETURN STR])
(CONSTANTS
[NLAMBDA VARS (* rmk: " 3-Jan-84 13:20")
(OR COMPVARMACROHASH (SETQ COMPVARMACROHASH (HASHARRAY 100)))
[for X in VARS do (COND
((LISTP X)
(PUTHASH (CAR X)
(LIST (QUOTE CONSTANT)
(CADR X))
COMPVARMACROHASH))
(T (PUTHASH X (LIST (QUOTE CONSTANT)
X)
COMPVARMACROHASH]
VARS])
(CONSTANTEXPRESSIONP
[LAMBDA (FORM) (* lmm "20-Jan-86 20:43")
(COND
[(LITATOM FORM)
(COND
((OR (NULL FORM)
(EQ FORM T))
(LIST FORM))
((AND COMPVARMACROHASH (SETQ FORM (GETHASH FORM COMPVARMACROHASH)))
(CONSTANTEXPRESSIONP FORM]
[(LISTP FORM)
(SELECTQ (CAR FORM)
(QUOTE (CDR FORM))
(FUNCTION (AND (LITATOM (CADR FORM))
(NULL (CDDR FORM))
(CDR FORM)))
[CONSTANT (LIST (EVAL (CADR FORM]
(COND
[(FMEMB (CAR FORM)
CONSTANTFOLDFNS)
(for X in (CDR FORM) collect (CAR (OR (CONSTANTEXPRESSIONP X)
(RETURN)))
finally (RETURN (LIST (APPLY (CAR FORM)
$$VAL]
((NOT (GETD (CAR FORM)))
(PROG ((MAC (GETMACROPROP (CAR FORM)
COMPILERMACROPROPS)))
(RETURN (AND MAC [NOT (EQUAL FORM (SETQ FORM (MACROEXPANSION FORM MAC]
(CONSTANTEXPRESSIONP FORM]
((NUMBERP FORM)
(LIST FORM])
(COPY
(LAMBDA (X) (* lmm "16-FEB-82 22:07")
(COND
((NLISTP X)
X)
(T (PROG (TAIL (VAL (LIST (COPY (CAR X)))))
(SETQ TAIL VAL)
LP (COND
((NLISTP (SETQ X (CDR X)))
(AND X (FRPLACD TAIL X))
(RETURN VAL)))
(FRPLACD TAIL (SETQ TAIL (CONS (COPY (CAR X)))))
(GO LP))))))
(DEFINEQ
(NLAMBDA X
(DEFINE X)))
(DEFLIST
(LAMBDA (L PROP)
(PROG NIL
LOOP(COND
((NLISTP L)
(RETURN)))
(PUTPROP (CAAR L)
PROP
(CADAR L)) (* NOTE: this call to PUTPROP is changed to /PUTPROP
later in the loadup.)
(SETQ L (CDR L))
(GO LOOP))))
(DREMOVE
(LAMBDA (X L)
(COND
((NLISTP L)
NIL)
((EQ X (CAR L))
(COND
((CDR L)
(FRPLACA L (CADR L))
(FRPLACD L (CDDR L))
(DREMOVE X L))))
(T (PROG (Z)
(DECLARE (LOCALVARS Z))
(SETQ Z L)
LP (COND
((NLISTP (CDR L))
(RETURN Z))
((EQ X (CADR L))
(FRPLACD L (CDDR L)))
(T (SETQ L (CDR L))))
(GO LP))))))
(DREVERSE
(LAMBDA (L)
(PROG (Y Z)
(DECLARE (LOCALVARS Y Z))
R1 (COND
((NLISTP (SETQ Y L))
(RETURN Z)))
(SETQ L (CDR L))
(SETQ Z (FRPLACD Y Z))
(GO R1))))
(DSUBST
(LAMBDA (NEW OLD EXPR) (* lmm "16-FEB-82 22:10")
(PROG (B)
(COND
((EQ OLD (SETQ B EXPR))
(RETURN (COPY NEW))))
LP (COND
((NLISTP EXPR)
(RETURN B))
((EQUAL OLD (CAR EXPR))
(FRPLACA EXPR (COPY NEW)))
(T (DSUBST NEW OLD (CAR EXPR))))
(COND
((AND OLD (EQ OLD (CDR EXPR)))
(FRPLACD EXPR (COPY NEW))
(RETURN B)))
(SETQ EXPR (CDR EXPR))
(GO LP))))
(EQLENGTH
[LAMBDA (X N) (* bvm: "14-Feb-85 00:34")
(* Generated by paatern match. INcluded so user can load code that has been dwimified and or compiled into a
nonclisp system and run it.)
(COND
((ILESSP N 0)
NIL)
((EQ N 0)
(NLISTP X))
(T (AND (LISTP (SETQ X (NTH X N)))
(NLISTP (CDR X])
(ERSETQ
(NLAMBDA (ERSETX)
(ERRORSET ERSETX T)))
(EVERY
(LAMBDA (EVERYX EVERYFN1 EVERYFN2) (* Note that EVERY does not compile open, although SOME
does.)
(PROG NIL
LOOP(COND
((NLISTP EVERYX)
(RETURN T))
((NULL (APPLY* EVERYFN1 (CAR EVERYX)
EVERYX))
(RETURN NIL)))
(SETQ EVERYX (COND
(EVERYFN2 (APPLY* EVERYFN2 EVERYX))
(T (CDR EVERYX))))
(GO LOOP))))
(GENSYM
[LAMBDA (PREFIX NUMSUFFIX OSTRBUFFER NEW? CHARCODE) (* lmm "14-Apr-85 20:39")
(OR (NULL PREFIX)
(STRINGP PREFIX)
(LITATOM PREFIX)
(ERRORX (LIST 27 PREFIX)))
(OR (NULL NUMSUFFIX)
(FIXP NUMSUFFIX)
(ERRORX (LIST 27 NUMSUFFIX)))
(OR (NULL OSTRBUFFER)
(STRINGP OSTRBUFFER)
(ERRORX (LIST 27 OSTRBUFFER)))
(OR (NULL CHARCODE)
(CHARCODEP CHARCODE)
(ERRORX (LIST 27 CHARCODE)))
(PROG ((BUFSIZE \GS.BUFSIZE)
(NUMLEN \GS.NUMLEN)
[BUF (OR (STRINGP \GS.BUF)
(SETQ \GS.BUF (ALLOCSTRING \GS.BUFSIZE]
(PREFIXLEN 0)
BEG.I ATOM)
(if (OR (NULL PREFIX)
(EQ (SETQ PREFIXLEN (NCHARS PREFIX))
0))
then (SETQ PREFIX)
(if (NULL CHARCODE)
then (* Here's the default case)
(SETQ CHARCODE (CHARCODE A)))
elseif (IGREATERP PREFIXLEN (IDIFFERENCE BUFSIZE 10))
then (ERROR PREFIX "Too long"))
(if (if OSTRBUFFER
then (if (NULL NUMSUFFIX)
then (HELP "OSTRBUFFER supplied without NUMSUFFIX")
elseif (ILESSP (SETQ BUFSIZE (NCHARS OSTRBUFFER))
(IPLUS 12 PREFIXLEN))
then (ERROR OSTRBUFFER "Too short"))
T
elseif NUMSUFFIX
then (* Insulate the normal \GS.BUF from random intrustions)
[SETQ OSTRBUFFER (ALLOCSTRING (SETQ BUFSIZE (IPLUS PREFIXLEN 12]
T)
then (SETQ BUF OSTRBUFFER))
A (UNINTERRUPTABLY
(if (if OSTRBUFFER
then (* Use the user-supplied buffer, or a freshly cons'd
one if he supplied NUMSUFFIX without OSTRBUFFER)
T
elseif (NOT (FIXP GENNUM))
then (* Disaster recovery)
(SETQ GENNUM 0)
T)
then (SETQ NUMLEN (\GS.INITBUF BUF BUFSIZE (OR NUMSUFFIX GENNUM)))
else
(* In this case, we have kept account of the contents of \GS.BUF so we don't have to call \GS.INITBUF afresh, but
rather merely "patch up" the effect of adding 1 to GENNUM)
(if (if (NOT (IEQP GENNUM \GS.OGENNUM))
then (* User perhaps has reset GENNUM)
(if (ILESSP GENNUM 0)
then (SETQ GENNUM 0))
T
elseif (IGEQ GENNUM MAX.FIXP)
then (* Sigh, two's complement wrap-around)
(SETQ GENNUM 0)
T)
then (SETQ NUMLEN (\GS.INITBUF BUF BUFSIZE GENNUM)))
(* Increment the GENNUM counter and the string buffer
buffer.)
(if (for CNT C to NUMLEN as I from BUFSIZE by -1
do (* Simulates a BCD type add in the gensym string)
(SETQ C (NTHCHARCODE \GS.BUF I))
(if (ILEQ (add C 1)
(CHARCODE 9))
then (* ha, carry stops here)
(RPLCHARCODE BUF I C)
(RETURN)
else (RPLCHARCODE BUF I (CHARCODE 0)))
finally (RETURN T))
then (* Sigh, we have to extend the numerical part)
(RPLCHARCODE BUF (IDIFFERENCE BUFSIZE NUMLEN)
(CHARCODE 1))
(SETQ NUMLEN (add \GS.NUMLEN 1)))
(SETQ \GS.OGENNUM (add GENNUM 1))) (* BEG.I will be the beginning index, in the buffer,
for the atom)
(SETQ BEG.I (ADD1 (IDIFFERENCE BUFSIZE NUMLEN)))
(if CHARCODE
then (RPLCHARCODE BUF (add BEG.I -1)
CHARCODE))
(if PREFIX
then (RPLSTRING BUF (SETQ BEG.I (IDIFFERENCE BEG.I PREFIXLEN))
PREFIX))
(SETQ \GS.STR (SUBSTRING BUF BEG.I BUFSIZE \GS.STR))
(SETQ ATOM (MKATOM \GS.STR)))
(if (NUMBERP ATOM)
then (ERRORX (LIST 27 PREFIX)))
(RETURN ATOM])
(GENSYM?
(LAMBDA (X) (* lmm " 1-JUN-81 08:30")
(AND (LITATOM X)
(EQ (NTHCHARCODE X -5)
(CHARCODE A))
(FIXP (NTHCHAR X -4))
(FIXP (NTHCHAR X -3))
(FIXP (NTHCHAR X -2))
(FIXP (NTHCHAR X -1))
T)))
(\GS.INITBUF
[LAMBDA (BUF BUFSIZE N) (* lmm "14-Apr-85 20:36")
(* Initializes BUF (which must be a stringp of length BUFSIZE) with the digits of N right-justified and left-0
padded up to a minimum of 4 digits. Returns the decimal length of N)
(PROG (NUMLEN)
(RPLSTRING BUF [IDIFFERENCE BUFSIZE (if (ILESSP N 10000)
then (* Trick to get leading zeros)
(SETQ N (IPLUS N 10000))
(SETQ NUMLEN 4)
else (SUB1 (SETQ NUMLEN (NCHARS N]
N)
(AND (EQ BUF \GS.BUF)
(SETQ \GS.NUMLEN NUMLEN))
(RETURN NUMLEN])
(GETLIS
(LAMBDA (X PROPS) (* wt: "31-MAY-79 22:25")
(PROG ((Z (COND
((LITATOM X)
(GETPROPLIST X))
(T X))))
LP (RETURN (COND
((NLISTP Z)
NIL)
((FMEMB (CAR Z)
PROPS)
Z)
(T (SETQ Z (CDR (LISTP (CDR Z))))
(GO LP)))))))
(INTERSECTION
(LAMBDA (X Y)
(PROG ((R (CONS))
S)
(DECLARE (LOCALVARS R S))
LP (COND
((NLISTP X)
(RETURN (CAR R)))
((COND
((LITATOM (SETQ S (CAR X)))
(AND (FMEMB S Y)
(NULL (FMEMB S (CAR R)))))
(T (AND (MEMBER S Y)
(NULL (MEMBER S (CAR R))))))
(TCONC R S)))
(SETQ X (CDR X))
(GO LP))))
(KWOTE
(LAMBDA (X) (* dcl: 15 SEP 75 15:25)
(COND
((OR (NULL X)
(EQ X T)
(NUMBERP X))
X)
(T (LIST (QUOTE QUOTE)
X)))))
(LAST
(LAMBDA (X)
(PROG (XX)
(DECLARE (LOCALVARS XX))
L (COND
((NLISTP X)
(RETURN XX)))
(SETQ XX X)
(SETQ X (CDR X))
(GO L))))
(LASTN
(LAMBDA (L N)
(PROG (X Y)
(DECLARE (LOCALVARS X Y))
(COND
((NLISTP L)
(RETURN NIL))
((NULL (SETQ X (FNTH L N)))
(RETURN)))
LP (COND
((NULL (SETQ X (CDR X)))
(RETURN (CONS Y L))))
(SETQ Y (NCONC1 Y (CAR L)))
(SETQ L (CDR L))
(GO LP))))
(LCONC
(LAMBDA (PTR X)
(PROG (XX)
(DECLARE (LOCALVARS XX))
(RETURN (COND
((NULL X)
PTR)
((OR (NLISTP X)
(CDR (SETQ XX (LAST X))))
(SETQ XX X)
(GO ERROR))
((NULL PTR)
(CONS X XX))
((NLISTP PTR)
(SETQ XX PTR)
(GO ERROR))
((NULL (CAR PTR))
(FRPLACA (FRPLACD PTR XX)
X))
(T (FRPLACD (CDR PTR)
X)
(FRPLACD PTR XX))))
ERROR
(ERROR (QUOTE "bad argument - LCONC")
XX))))
(LDIFF
(LAMBDA (X Y Z)
(COND
((EQ X Y)
Z)
((AND (NULL Y)
(NULL Z))
X)
(T (PROG (V)
(COND
(Z (SETQ V (CDR (FRPLACD (SETQ V (FLAST Z))
(FRPLACD (CONS (CAR X)
V))))))
(T (SETQ V (SETQ Z (CONS (CAR X))))))
LOOP(SETQ X (CDR X))
(COND
((EQ X Y)
(RETURN Z))
((NULL X)
(RETURN (ERROR (QUOTE "LDIFF: not a tail")
Y))))
(SETQ V (CDR (FRPLACD V (FRPLACD (CONS (CAR X)
V)))))
(GO LOOP))))))
(LDIFFERENCE
[LAMBDA (X Y) (* lmm "27-Mar-84 16:26")
(for Z in X when (NOT (MEMBER Z Y)) collect Z])
(LENGTH
(LAMBDA (X)
(PROG ((N 0))
(DECLARE (LOCALVARS N))
LP (COND
((NLISTP X)
(RETURN N))
(T (SETN N (ADD1 N))
(SETQ X (CDR X))
(GO LP))))))
(LISTGET
(LAMBDA (LST PROP) (* like getp but works on lists, searching them two cdrs
at a time.)
(PROG NIL
LP (COND
((NLISTP LST)
(RETURN))
((EQ (CAR LST)
PROP)
(RETURN (CADR LST))))
(SETQ LST (CDR (LISTP (CDR LST))))
(GO LP))))
(LISTGET1
(LAMBDA (LST PROP) (* Used to be called GET. Like LISTGET but only searches
one cdr at a time.)
(PROG NIL
LP (COND
((NLISTP LST)
(RETURN))
((EQ (CAR LST)
PROP)
(RETURN (CADR LST))))
(SETQ LST (CDR LST))
(GO LP))))
(LISTPUT
(LAMBDA (LST PROP VAL) (* Like PUT but works on lists.
Inverse of LISTGET)
(PROG ((X (OR (LISTP LST)
(ERRORX (LIST 4 LST))))
X0)
LOOP(COND
((NLISTP (CDR X)) (* Odd parity; either (A B C) or
(A B C . D) -
drop thru and add at beginning)
)
((EQ (CAR X)
PROP) (* found it)
(FRPLACA (CDR X)
VAL)
(RETURN VAL))
((LISTP (SETQ X (CDDR (SETQ X0 X))))
(GO LOOP))
((NULL X)
(* Ran out without finding PROP on even parity. add at end If X is not NIL, means ended in a non-list following
even parity, e.g. (A B . C) so drop through and add at front.)
(FRPLACD (CDR X0)
(LIST PROP VAL))
(RETURN VAL)))
ADDFRONT
(FRPLNODE LST PROP (CONS VAL (CONS (CAR LST)
(CDR LST))))
(RETURN VAL))))
(LISTPUT1
[LAMBDA (LST PROP VAL) (* lmm "22-Oct-85 16:44")
(* Used to be called PUTL. Like LISTPUT but only
searches one cdr at a time.
Inverse of LISTGET1)
(PROG ((X LST))
LP (COND
[(NLISTP X) (* Note no checks for lists ending in dotted pairs.)
(RETURN (NCONC LST (LIST PROP VAL]
((EQ (CAR X)
PROP)
[COND
((CDR X)
(FRPLACA (CDR X)
VAL))
(T (FRPLACD X (LIST VAL]
(RETURN LST)))
(SETQ X (CDR X))
(GO LP])
(LSUBST
(LAMBDA (NEW OLD EXPR) (* lmm "16-FEB-82 22:11")
(* Substitutes X as a segment for Y in Z. E.g. LSUBST ((A B) Y (X Y Z)) is (X A B Z) not meaningful for Y an atom
and CDR of a list. if X is NIL, operation effectively deletes Y, i.e. produces a copy without Y in it.)
(COND
((NULL EXPR)
NIL)
((NLISTP EXPR)
(COND
((EQ OLD EXPR)
NEW)
(T EXPR)))
((EQUAL OLD (CAR EXPR))
(NCONC (COPY NEW)
(LSUBST NEW OLD (CDR EXPR))))
(T (CONS (LSUBST NEW OLD (CAR EXPR))
(LSUBST NEW OLD (CDR EXPR)))))))
(MAP
(LAMBDA (MAPX MAPFN1 MAPFN2)
(PROG NIL
LP (COND
((NLISTP MAPX)
(RETURN)))
(APPLY* MAPFN1 MAPX)
(SETQ MAPX (COND
(MAPFN2 (APPLY* MAPFN2 MAPX))
(T (CDR MAPX))))
(GO LP))))
(MAP2C
(LAMBDA (MAPX MAPY MAPFN1 MAPFN2)
(PROG NIL
LP (COND
((OR (NLISTP MAPX)
(NLISTP MAPY))
(RETURN)))
(APPLY* MAPFN1 (CAR MAPX)
(CAR MAPY))
(COND
(MAPFN2 (SETQ MAPX (APPLY* MAPFN2 MAPX))
(SETQ MAPY (APPLY* MAPFN2 MAPY)))
(T (SETQ MAPX (CDR MAPX))
(SETQ MAPY (CDR MAPY))))
(GO LP))))
(MAP2CAR
(LAMBDA (MAPX MAPY MAPFN1 MAPFN2)
(PROG (MAPL MAPE)
LP (COND
((OR (NLISTP MAPX)
(NLISTP MAPY))
(RETURN MAPL)))
(SETQ MAPE (CONS (APPLY* MAPFN1 (CAR MAPX)
(CAR MAPY))
MAPE))
(COND
(MAPL (FRPLACD (CDR MAPE)
(FRPLACD MAPE)))
(T (SETQ MAPL MAPE)))
(COND
(MAPFN2 (SETQ MAPY (APPLY* MAPFN2 MAPY))
(SETQ MAPX (APPLY* MAPFN2 MAPX)))
(T (SETQ MAPY (CDR MAPY))
(SETQ MAPX (CDR MAPX))))
(GO LP))))
(MAPC
(LAMBDA (MAPX MAPFN1 MAPFN2)
(PROG NIL
LP (COND
((NLISTP MAPX)
(RETURN)))
(APPLY* MAPFN1 (CAR MAPX))
(SETQ MAPX (COND
(MAPFN2 (APPLY* MAPFN2 MAPX))
(T (CDR MAPX))))
(GO LP))))
(MAPCAR
(LAMBDA (MAPX MAPFN1 MAPFN2)
(PROG (MAPL MAPE)
LP (COND
((NLISTP MAPX)
(RETURN MAPL)))
(SETQ MAPE (CONS (APPLY* MAPFN1 (CAR MAPX))
MAPE))
(COND
(MAPL (FRPLACD (CDR MAPE)
(FRPLACD MAPE)))
(T (SETQ MAPL MAPE)))
(SETQ MAPX (COND
(MAPFN2 (APPLY* MAPFN2 MAPX))
(T (CDR MAPX))))
(GO LP))))
(MAPCON
(LAMBDA (MAPX MAPFN1 MAPFN2)
(PROG (MAPL MAPE MAPY)
LP (COND
((NLISTP MAPX)
(RETURN MAPL))
((LISTP (SETQ MAPY (APPLY* MAPFN1 MAPX)))
(COND
(MAPE (FRPLACD MAPE MAPY))
(T (SETQ MAPL (SETQ MAPE MAPY))))
(PROG NIL
LP (COND
((SETQ MAPY (CDR MAPE))
(SETQ MAPE MAPY)
(GO LP))))))
(SETQ MAPX (COND
(MAPFN2 (APPLY* MAPFN2 MAPX))
(T (CDR MAPX))))
(GO LP))))
(MAPCONC
(LAMBDA (MAPX MAPFN1 MAPFN2)
(PROG (MAPL MAPE MAPY)
LP (COND
((NLISTP MAPX)
(RETURN MAPL))
((LISTP (SETQ MAPY (APPLY* MAPFN1 (CAR MAPX))))
(COND
(MAPE (FRPLACD MAPE MAPY))
(T (SETQ MAPL (SETQ MAPE MAPY))))
(PROG NIL
LP (COND
((SETQ MAPY (CDR MAPE))
(SETQ MAPE MAPY)
(GO LP))))))
(SETQ MAPX (COND
(MAPFN2 (APPLY* MAPFN2 MAPX))
(T (CDR MAPX))))
(GO LP))))
(MAPLIST
(LAMBDA (MAPX MAPFN1 MAPFN2)
(PROG (MAPL MAPE)
LP (COND
((NLISTP MAPX)
(RETURN MAPL)))
(SETQ MAPE (CONS (APPLY* MAPFN1 MAPX)
MAPE))
(COND
(MAPL (FRPLACD (CDR MAPE)
(FRPLACD MAPE)))
(T (SETQ MAPL MAPE)))
(SETQ MAPX (COND
(MAPFN2 (APPLY* MAPFN2 MAPX))
(T (CDR MAPX))))
(GO LP))))
(MEMBER
(LAMBDA (X Y)
(PROG NIL
LP (RETURN (COND
((NLISTP Y)
NIL)
((COND
((LITATOM X)
(EQ X (CAR Y)))
(T (EQUAL X (CAR Y))))
Y)
(T (SETQ Y (CDR Y))
(GO LP)))))))
(NLEFT
[LAMBDA (L N TAIL) (* bvm: "14-Feb-85 00:35")
(* Returns TAIL of L containing N elements more than TAIL, e.g. if TAIL is NIL (the usual case) NLEFT
((A B C D E) 2) is (D E). If FOO is (A B C D E) and FIE is (CDDDR FOO), (NLEFT FOO 1 FIE) is
(C D E).)
(PROG ((X L)
(Y L))
LP (COND
((EQ N 0)
(GO LP1))
((OR (EQ X TAIL)
(NLISTP X))
(RETURN NIL)))
(SETQ X (CDR X))
(SUB1VAR N)
(GO LP)
LP1 (COND
((OR (EQ X TAIL)
(NLISTP X))
(RETURN Y)))
(SETQ X (CDR X))
(SETQ Y (CDR Y))
(GO LP1])
(NLSETQ
(NLAMBDA (NLSETX)
(ERRORSET NLSETX NIL)))
(NOTANY
(LAMBDA (SOMEX SOMEFN1 SOMEFN2)
(NULL (SOME SOMEX SOMEFN1 SOMEFN2))))
(NOTEVERY
(LAMBDA (EVERYX EVERYFN1 EVERYFN2)
(NULL (EVERY EVERYX EVERYFN1 EVERYFN2))))
(NTH
(LAMBDA (X N)
(COND
((IGREATERP 1 N)
(CONS NIL X))
(T (PROG NIL
LP (COND
((NOT (IGREATERP N 1))
(RETURN X))
((NLISTP X)
(RETURN NIL)))
(SETQ X (CDR X))
(SETQ N (SUB1 N))
(GO LP))))))
(PUTASSOC
(LAMBDA (KEY VAL ALST) (* lmm: 5 SEP 75 119)
(PROG ((X (OR (LISTP ALST)
(ERRORX (LIST 4 ALST)))))
(DECLARE (LOCALVARS X))
LP (COND
((EQ (CAR (OR (LISTP (CAR X))
(GO NEXT)))
KEY)
(FRPLACD (CAR X)
VAL)
(RETURN VAL)))
NEXT(SETQ X (OR (LISTP (CDR X))
(PROGN (FRPLACD X (LIST (CONS KEY VAL)))
(RETURN VAL))))
(GO LP))))
(RATOMS
(LAMBDA (A FILE RDTBL)
(PROG (L X)
B (COND
((EQ (SETQ X (RATOM FILE RDTBL))
A)
(RETURN (CAR L)))
((SETQ L (TCONC L X))
(GO B))))))
(REMOVE
(LAMBDA (X L)
(COND
((NLISTP L)
NIL)
((EQUAL X (CAR L))
(REMOVE X (CDR L)))
(T (CONS (CAR L)
(REMOVE X (CDR L)))))))
(REVERSE
(LAMBDA (L)
(PROG (U)
(DECLARE (LOCALVARS U))
LOOP(COND
((NLISTP L)
(RETURN U)))
(SETQ U (CONS (CAR L)
U))
(SETQ L (CDR L))
(GO LOOP))))
(RPT
(LAMBDA (RPTN RPTF)
(PROG (RPTV)
(DECLARE (LOCALVARS RPTV))
LP (COND
((IGREATERP RPTN 0)
(SETQ RPTV (EVAL RPTF (QUOTE INTERNAL)))
(SETQ RPTN (SUB1 RPTN))
(GO LP))
(T (RETURN RPTV))))))
(RPTQ
(NLAMBDA RPTZ
(PROG ((RPTN (EVAL (CAR RPTZ)
(QUOTE INTERNAL)))
RPTV)
(DECLARE (SPECVARS RPTN))
RPTQLOOP
(COND
((IGREATERP RPTN 0)
(SETQ RPTV (APPLY (FUNCTION PROGN)
(CDR RPTZ)
(QUOTE INTERNAL)))
(SETQ RPTN (SUB1 RPTN))
(GO RPTQLOOP)))
(RETURN RPTV))))
(FRPTQ
(NLAMBDA RPTZ
(DECLARE (LOCALVARS . T))
(PROG ((RPTN (EVAL (CAR RPTZ)
(QUOTE INTERNAL)))
RPTV)
RPTQLOOP
(COND
((IGREATERP RPTN 0)
(SETQ RPTV (APPLY (FUNCTION PROGN)
(CDR RPTZ)
(QUOTE INTERNAL)))
(SETQ RPTN (SUB1 RPTN))
(GO RPTQLOOP)))
(RETURN RPTV))))
(SASSOC
(LAMBDA (KEY ALST)
(PROG NIL
LP (COND
((NLISTP ALST)
(RETURN NIL))
((EQUAL (CAAR ALST)
KEY)
(RETURN (CAR ALST))))
(SETQ ALST (CDR ALST))
(GO LP))))
(SAVEDEF
(LAMBDA (X)
(COND
((ATOM X)
(SAVEDEF1 X))
(T (MAPCAR X (FUNCTION SAVEDEF1))))))
(SAVEDEF1
(LAMBDA (X)
(PROG ((DF (GETD X)))
(RETURN (COND
(DF (PUTPROP X (SETQ X (SELECTQ (FNTYP X)
((SUBR SUBR* FSUBR FSUBR*)
(QUOTE SUBR))
((EXPR EXPR* FEXPR FEXPR*)
(QUOTE EXPR))
((CEXPR CEXPR* CFEXPR CFEXPR*)
(QUOTE CODE))
(COND
((EXPRP X)
(QUOTE EXPR))
(T (QUOTE LIST)))))
DF) (* NOTE: this call to PUTPROP is changed to /PUTPROP
later in the loadup.)
X))))))
(SELECT
(NLAMBDA .SELEC.
(DECLARE (LOCALVARS . T)) (* dcl: 12 Dec 78 09:08)
(APPLY (QUOTE PROGN)
(SELECT1 (EVAL (CAR .SELEC.)
(QUOTE SELECTQ))
(CDR .SELEC.))
(QUOTE SELECTQ))))
(SELECT1
(LAMBDA (M L)
(DECLARE (LOCALVARS . T)) (* edited: 8 Dec 78 13:53)
(PROG (C A)
LP (SETQ C L)
(COND
((NULL (SETQ L (CDR L)))
(RETURN C))
((NLISTP (CAR (SETQ C (CAR C))))
(AND (EQ M (EVAL (CAR C)
(QUOTE INTERNAL)))
(RETURN (CDR C)))
(GO LP)))
(SETQ A (CAR C))
L2 (COND
((EQ M (EVAL (CAR A)
(QUOTE INTERNAL)))
(RETURN (CDR C)))
((LISTP (SETQ A (CDR A)))
(GO L2))
(T (GO LP))))))
(SELECTC
(NLAMBDA SELCQ (* lmm "28-FEB-82 16:07")
(DECLARE (LOCALVARS . T))
(APPLY (QUOTE PROGN)
((LAMBDA (M L)
(PROG (C TL)
LP (SETQ C L)
(COND
((NULL (SETQ L (CDR L)))
(RETURN C))
((OR (EQ (SETQ TL (EVAL (CAR (SETQ C (CAR C)))
(QUOTE INTERNAL)))
M)
(AND (LISTP TL)
(FMEMB M TL)))
(RETURN (CDR C))))
(GO LP)))
(EVAL (CAR SELCQ)
(QUOTE SELECTQ))
(CDR SELCQ))
(QUOTE SELECTQ))))
(SETQQ
(NLAMBDA (X Y)
(SET X Y)))
(SOME
(LAMBDA (SOMEX SOMEFN1 SOMEFN2) (* SOME compiles open.)
(PROG NIL
LOOP(COND
((NLISTP SOMEX)
(RETURN NIL))
((APPLY* SOMEFN1 (CAR SOMEX)
SOMEX)
(RETURN SOMEX)))
(SETQ SOMEX (COND
(SOMEFN2 (APPLY* SOMEFN2 SOMEX))
(T (CDR SOMEX))))
(GO LOOP))))
(STRMEMB
(LAMBDA (X Y) (* rmk: " 6-JUN-82 15:08")
(PROG (C N)
(DECLARE (LOCALVARS C N))
(SETQ Y (SUBSTRING Y 1))
B (SETQ N 1)
A (COND
((NULL (SETQ C (NTHCHARCODE X N)))
(RETURN Y)))
(COND
((EQ C (NTHCHARCODE Y N))
(SETQ N (ADD1 N))
(GO A)))
(COND
((NULL (GNC Y))
(RETURN))
(T (GO B))))))
(SUB1VAR
(NLAMBDA (SUB1X)
(SET SUB1X (SUB1 (EVAL SUB1X)))))
(SUBSET
(LAMBDA (MAPX MAPFN1 MAPFN2)
(PROG (MAPL MAPE)
LP (COND
((NLISTP MAPX)
(RETURN MAPL))
((APPLY* MAPFN1 (CAR MAPX))
(COND
((NULL MAPL)
(SETQ MAPL (SETQ MAPE (CONS (CAR MAPX)))))
(T (SETQ MAPE (CDR (FRPLACD MAPE (FRPLACD (CONS (CAR MAPX)
MAPE)))))
(* Eseentially an open TCONC.)
))))
(SETQ MAPX (COND
(MAPFN2 (APPLY* MAPFN2 MAPX))
(T (CDR MAPX))))
(GO LP))))
(SUBST
(LAMBDA (NEW OLD EXPR) (* lmm "16-FEB-82 22:11")
(COND
((NULL EXPR)
NIL)
((NLISTP EXPR)
(COND
((EQ OLD EXPR)
(COPY NEW))
(T EXPR)))
(T (CONS (COND
((EQUAL OLD (CAR EXPR))
(COPY NEW))
(T (SUBST NEW OLD (CAR EXPR))))
(SUBST NEW OLD (CDR EXPR)))))))
(TAILP
(LAMBDA (X Y) (* True if X is A tail of Y X and Y non-null.)
(* Included with editor for block compilation purposes.)
(AND X (PROG NIL
LP (COND
((NLISTP Y)
(RETURN NIL))
((EQ X Y)
(RETURN X)))
(SETQ Y (CDR Y))
(GO LP)))))
(TCONC
(LAMBDA (PTR X)
(PROG (XX)
(DECLARE (LOCALVARS XX))
(RETURN (COND
((NULL PTR)
(CONS (SETQ XX (CONS X NIL))
XX))
((NLISTP PTR)
(ERROR (QUOTE "bad argument - TCONC")
PTR))
((NULL (CDR PTR))
(FRPLACA PTR (CONS X NIL))
(FRPLACD PTR (CAR PTR)))
(T (FRPLACD PTR (CDR (FRPLACD (CDR PTR)
(FRPLACD (CONS X (CDR PTR))))))))))))
(TIME
(NLAMBDA (TIMEX TIMEN TIMETYP)
(* If TIMETYP is 0, also prints real time, i.e. (CLOCK 0) if timetype is 3, does garbage collection time.
If timetype is T does PAGEFAULTS.)
(* Calls to prin1, terpri, print, and spaces changed to
correspoding lispx printing functions later in loadup.)
(PROG (TIMEY TIMECNS TIMEM TIMECLK1 TIMECLK2 TIMEZ)
(COND
((NULL TIMEN)
(SETQ TIMEN 1))
((MINUSP TIMEN)
(RETURN (CONS TIMEN (QUOTE (- ?)))))
((NOT (SMALLP TIMEN))
(RETURN (CONS TIMEN (QUOTE (is too large))))))
(SETQ TIMEM TIMEN)
(SETQ TIMECNS (CONSCOUNT))
(SETQ TIMEZ (SELECTQ TIMETYP
(0 (CLOCK 0))
(3 (CLOCK 3))
(T (PAGEFAULTS))
NIL))
(SETQ TIMECLK1 (CLOCK 2))
T1 (COND
((NEQ TIMEM 0)
(SETQ TIMEY (EVAL TIMEX))
(SUB1VAR TIMEM)
(GO T1)))
(SETQ TIMECLK2 (CLOCK 2))
(AND TIMEZ (SETQ TIMEZ (IDIFFERENCE (SELECTQ TIMETYP
(0 (CLOCK 0))
(3 (CLOCK 3))
(T (PAGEFAULTS))
(ERROR TIMETYP))
TIMEZ)))
(SETQ TIMECNS (IDIFFERENCE (CONSCOUNT)
TIMECNS))
(COND
((NEQ TIMEN 1)
(PRIN1 TIMECNS T)
(PRIN1 (QUOTE /)
T)
(PRIN1 TIMEN T)
(PRIN1 (QUOTE " = ")
T)))
(PRIN1 (IQUOTIENT TIMECNS TIMEN)
T)
(SPACES 1 T)
(PRINT (QUOTE conses)
T)
(SETQ TIMEM (FQUOTIENT (IPLUS TIMECLK2 (IMINUS TIMECLK1))
1000))
(COND
((NEQ TIMEN 1)
(PRIN1 TIMEM T)
(PRIN1 (QUOTE /)
T)
(PRIN1 TIMEN T)
(PRIN1 (QUOTE " = ")
T)))
(PRIN1 (FQUOTIENT TIMEM TIMEN)
T)
(SPACES 1 T)
(PRINT (QUOTE seconds)
T)
(SELECTQ TIMETYP
(0 (PRIN1 (FQUOTIENT TIMEZ 1000)
T)
(PRIN1 (QUOTE " seconds, real time
")
T))
(3 (PRIN1 (FQUOTIENT TIMEZ 1000)
T)
(PRIN1 (QUOTE " seconds, garbage collection time
")
T))
(T (PRIN1 TIMEZ T)
(PRIN1 (QUOTE " page faults
")
T))
NIL)
(RETURN TIMEY))))
(UNION
(LAMBDA (X Y)
(DECLARE (LOCALVARS . T)) (* lmm "31-DEC-78 14:47")
(PROG (VAL)
LP (COND
((NLISTP X)
(RETURN (ENDCOLLECT VAL Y)))
((COND
((LITATOM (CAR X))
(NOT (FMEMB (CAR X)
Y)))
(T (NOT (MEMBER (CAR X)
Y))))
(SETQ VAL (DOCOLLECT (CAR X)
VAL))))
(SETQ X (CDR X))
(GO LP))))
)
(RPAQ? COMPVARMACROHASH NIL)
(ADDTOVAR CONSTANTFOLDFNS
PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT IMIN IMAX IABS LLSH LRSH
LOGOR LOGXOR LOGAND OR AND)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ \GS.BUFSIZE 100)
(DECLARE: EVAL@COMPILE
(CONSTANTS (\GS.BUFSIZE 100))
)
)
(RPAQ? GENNUM 0)
(RPAQ? \GS.OGENNUM -1)
(RPAQ? \GS.NUMLEN 0)
(RPAQ? \GS.BUF NIL)
(RPAQ? \GS.STR (ALLOCSTRING 0))
(ADDTOVAR PRETTYEQUIVLST (SELECTC . SELECTQ))
(ADDTOVAR DWIMEQUIVLST (SELECTC . SELECTQ))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS GENNUM \GS.OGENNUM \GS.NUMLEN \GS.BUF \GS.STR)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA SELECTC SELECT FRPTQ RPTQ DEFINEQ CONSTANTS APPENDTOVAR ADDTOVAR)
(ADDTOVAR NLAML TIME SUB1VAR SETQQ NLSETQ ERSETQ ADD1VAR)
(ADDTOVAR LAMA APPEND)
)
(PUTPROPS MISC COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1959 43258 (ADD1VAR 1969 . 2038) (ADDTOVAR 2040 . 6149) (APPENDTOVAR 6151 . 10354) (
APPEND 10356 . 10897) (\APPEND2 10899 . 11305) (ASSOC 11307 . 11623) (ATTACH 11625 . 11797) (
CHANGEPROP 11799 . 12176) (CONCATLIST 12178 . 13087) (CONSTANTS 13089 . 13498) (CONSTANTEXPRESSIONP
13500 . 14695) (COPY 14697 . 15083) (DEFINEQ 15085 . 15127) (DEFLIST 15129 . 15456) (DREMOVE 15458 .
15858) (DREVERSE 15860 . 16086) (DSUBST 16088 . 16609) (EQLENGTH 16611 . 17049) (ERSETQ 17051 . 17108)
(EVERY 17110 . 17536) (GENSYM 17538 . 21943) (GENSYM? 21945 . 22217) (\GS.INITBUF 22219 . 22950) (
GETLIS 22952 . 23286) (INTERSECTION 23288 . 23683) (KWOTE 23685 . 23893) (LAST 23895 . 24095) (LASTN
24097 . 24445) (LCONC 24447 . 24985) (LDIFF 24987 . 25491) (LDIFFERENCE 25493 . 25672) (LENGTH 25674
. 25879) (LISTGET 25881 . 26233) (LISTGET1 26235 . 26582) (LISTPUT 26584 . 27598) (LISTPUT1 27600 .
28324) (LSUBST 28326 . 28963) (MAP 28965 . 29212) (MAP2C 29214 . 29589) (MAP2CAR 29591 . 30111) (MAPC
30113 . 30367) (MAPCAR 30369 . 30765) (MAPCON 30767 . 31225) (MAPCONC 31227 . 31692) (MAPLIST 31694 .
32085) (MEMBER 32087 . 32319) (NLEFT 32321 . 33098) (NLSETQ 33100 . 33159) (NOTANY 33161 . 33252) (
NOTEVERY 33254 . 33354) (NTH 33356 . 33611) (PUTASSOC 33613 . 34080) (RATOMS 34082 . 34269) (REMOVE
34271 . 34441) (REVERSE 34443 . 34663) (RPT 34665 . 34916) (RPTQ 34918 . 35272) (FRPTQ 35274 . 35623)
(SASSOC 35625 . 35847) (SAVEDEF 35849 . 35968) (SAVEDEF1 35970 . 36520) (SELECT 36522 . 36774) (
SELECT1 36776 . 37326) (SELECTC 37328 . 37876) (SETQQ 37878 . 37921) (SOME 37923 . 38281) (STRMEMB
38283 . 38737) (SUB1VAR 38739 . 38808) (SUBSET 38810 . 39334) (SUBST 39336 . 39705) (TAILP 39707 .
40110) (TCONC 40112 . 40549) (TIME 40551 . 42838) (UNION 42840 . 43256)))))
STOP