(MAPCAN MAPCAN-AUX MAPCAR MAPCAR-AUX DELETE DELETE-AUX DEFUN GET REMPROP PUTPROP *PMEMBER)›(SETQ MAPCAN '2›)›(DEFINEQ MAPCAN '(LAMBDA (*X* *FN*) (MAPCAN-AUX *X*))›)›(DEFINEQ MAPCAN-AUX '(LAMBDA (*X*) (COND ((EQ *X*) NIL) (T (NCONC (APPLY* *FN* (CAR *X*)) (MAPCAN-AUX (CDR *X*))))))›)›(DEFINEQ MAPCAR '(LAMBDA (*X* *FN*) (MAPCAR-AUX *X*))›)›(DEFINEQ MAPCAR-AUX '(LAMBDA (*X*) (COND ((EQ *X*) NIL) (T (CONS (APPLY* *FN* (CAR *X*)) (MAPCAR-AUX (CDR *X*))))))›)›(DEFINEQ DELETE '(LAMBDA (S L) (DELETE-AUX L))›)›(DEFINEQ DELETE-AUX '(LAMBDA (L) (COND ((EQ L) NIL) ((EQ S (CAR L)) (DELETE-AUX (CDR L))) ((CONS (CAR L) (DELETE-AUX (CDR L))))))›)›(DEFINEQ DEFUN '(MACRO (X) (CONS (QUOTE DEFINEQ) (LIST (CADR X) (CONS (QUOTE LAMBDA) (CDDR X)))))›)›(DEFINEQ GET '(LAMBDA (ID PROP) (COND ((ATOM ID) (COND ((EQ PROP (QUOTE VALUE)) (EVAL ID)) ((EQ PROP (QUOTE EXPR))) ((EQ PROP (QUOTE MACRO))) ((EQ PROP (QUOTE NLAMBDA))) (T (CADR (*PMEMBER PROP (CDDR (*CDR ID))))))) (T (BREAK (QUOTE GET-ERROR)))))›)›(DEFINEQ REMPROP '(LAMBDA (ID PROP) (COND ((ATOM ID) ((LAMBDA (Z M) (COND ((SETQ M (*PMEMBER PROP (CDDR Z))) (RPLACD M (CONS NIL (CDDR M))) T) (T NIL))) (*CDR ID)))))›)›(DEFINEQ PUTPROP '(LAMBDA (ID VALUE PROP) (COND ((ATOM ID) (COND ((EQ PROP (QUOTE VALUE)) (SET ID VALUE)) (T ((LAMBDA (Z M) (PROGN (SETQ M (*PMEMBER PROP (CDDR Z))) (COND (M (RPLACD M (CONS VALUE (CDDR M)))) (T (COND ((EQ (CDR Z) NIL) (RPLACD Z (CONS NIL)))) (RPLACD (CDR Z) (CONS PROP (CONS VALUE (CDDR Z)))))))) (*CDR ID)))) VALUE)))›)›(DEFINEQ *PMEMBER '(LAMBDA (PROP PLIST) (PROG NIL LOOP (COND ((EQ PLIST NIL) (RETURN)) ((EQ PROP (CAR PLIST)) (RETURN PLIST)) (T (SETQ PLIST (CDDR PLIST)))) (GO LOOP)))›)›NIL›