Page:AITR-474.djvu/133

;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* '|?|)