This page needs to be proofread.
;RABBIT 568 05/15/78 Page 2
(COND ((NOT (BOUNDP '*EMPTY*))
(SET' *EMPTY* (LIST '*EMPTY*))))
(DEFINE EMPTY
(LAMBDA (x) (EQ X *EMPTY*)))
(DEFINE TRIVFN
(LAMBDA (SYM)
(GETL SYM ‘(EXPR SUBR LSUBR *EXPR *LEXPR))))
(DEFMAC INCREMENT (X) "(ASET' ,X (+ ,X 1)))
(DEFMAC CATENATE ARGS
"(IMPLODE (APPEND @(MAPCAR '(LAMBDA (X)
(COND ((OR (ATOM X) (NOT (EQ (CAR X) 'QUOTE)))
*(EXPLODEN ,X))
(T "(QUOTE ,(EXPLODEN (CADR X))))))
ARGS))))
(COND ((NOT (BOUNDP '*GENTEMPNUM*))
(SET' *GETNTEMPNUM* 0)))
(COND ((NOT (BOUNDP '*GENTEMPLIST*))
(SET' *GENTEMPLIST* NIL)))
(DEFINE GENTEMP
(LAMBDA (X)
(BLOCK (INCREMENT *GENTEMPNUM*)
(LET ((SYM (CATENATE X '|-| *GENTEMPNUM*)))
(ASET' *GENTEMPLIST* (CONS SYM *GENTEMPLIST*)) SYM))))
(DEFINE GENFLUSH
(LAMBDA ()
(BLOCK (AMAPC REMOB *GENTEMPLIST*)
(ASET' *GENTEMPLIST* NIL))))
(DEFINE GEN-GLOBAL-NAME
(LAMBDA () (GENTEMP *GLOBAL-GEN-PREFIX*)))
(SET' *GLOBAL-GEN-PREFIX* '|?|)