.. COMPILER EXPR PSEUDO-FUNCTION .. CONTENTS 1 DEFINE DEFINE (( (LENGTH(LAMBDA (M) (PROG (N) (SETQ N 0) A (COND ((NULL M) (RETURN N)) ) (SETQ N (ADD1 N)) (SETQ M (CDR M)) (GO A) ))) (REVERSE (LAMBDA (X) (PROG (Y) A (COND ((NULL X) (RETURN Y))) (SETQ Y (C ONS (CAR X) Y)) (SETQ X (CDR X)) (GO A)))) (MEMBER (LAMBDA (U V) (COND ((NULL V) NIL) ((EQUAL (CAR V) U) T) (T (MEMBER U (CDR V))) ))) (COMVAL (LAMBDA (EXP STOMAP NAME) (PROG NIL (COND ((OR (ATOM EXP) (MEMBER (CAR EXP) (QUOTE (QUOTE SPECIAL)))) (LAC EXP)) ((EQ (CAR EXP) (QUOTE SETQ)) (PROG NIL (COMVAL (CADDR EXP) STOMAP NAME) (ATTACH (LIST (CONS (QUOTE STO) (LOCATE (CADR EXP))))) )) ((EQ (CAR EXP) (QUOTE COND)) (COMCOND (CDR EXP) T)) ((EQ (CAR EXP) (QUOTE PROG)) (COMPROG (CDDR EXP) (CADR EXP) NAME)) ((EQ (CAR EXP) (QUOTE OR)) (COMBOOL F F (CDR EXP) NIL)) ((EQ (CAR EXP) (QUOTE AND)) (COMBOOL T F (CDR EXP) NIL)) ((ATOM (CAR EXP)) (CALL (CAR EXP) (COMLIS (CDR EXP)))) (T (PROG NIL (COMPLY (CAR EXP) (CDR EXP)) (COMVAL (CADDAR EXP) STOMAP NAME))) ) (SETQ AC NAME) (RETURN NAME) ))) (COMPLY (LAMBDA (FN ARGS) (MAP (PAIR (CADR FN) ARGS) (FUNCTION (LAMBDA (J) (PROG NIL (COMVAL (CDAR J) STOMAP (GENSYM)) (STORE (CAAR J) T))))) )) (COMLIS (LAMBDA (EXP) (PROG (X) (RETURN (MAPLIST EXP (FUNCTION (LAMBDA ( J) (COND ((OR (EQ (CAAR J) (QUOTE QUOTE)) (ATOM (CAR J))) (CAR J)) (X (P ROG2 (STORE AC T) (COMVAL (CAR J) STOMAP (GENSYM)))) (T (PROG2 (SETQ X T ) (COMVAL (CAR J) STOMAP (GENSYM)))))))))))) (LAC (LAMBDA (X) (COND ((EQUAL AC X) NIL) (T (ATTACH (LIST (CONS (QUOTE CLA) (LOCATE X)))))))) (STORE (LAMBDA (X Y) (PROG NIL (COND ((OR (NULL X) (EQ (CAR X) (QUOTE QU OTE))) (RETURN NIL))) (SETQ STOMAP (CONS (CONS X (LIST (LIST (ADD1 (CAAD AR STOMAP)) (QUOTE *N)) 1)) STOMAP)) (COND (Y (ATTACH (LIST (CONS (QUOTE STO) (LOCATE X)))))) (SETQ LENGTH (MAX LENGTH (CAADAR STOMAP)))))) (PHASE2 (LAMBDA (EXP NAME) (PROG (AC LISTING STOMAP LENGTH) (COND (((LAM BDA (J) (AND (EQ (CAADR EXP) (CADAR J)) (EQ (CAAR J) (QUOTE NULL)) (EQUA L (CADR J) (QUOTE (QUOTE NIL))))) (CADAR (CDDR EXP))) (PROG2 (ATTACH (QU OTE ((TZE 1 4)))) (SETQ EXP (LIST (CAR EXP) (CADR EXP) (CONS (QUOTE COND ) (CDDAR (CDDR EXP)))))))) (ATTACH (LIST (LIST (QUOTE TNX) (LIST (QUOTE E) NAME) 1 (QUOTE *MN)) (APPEND (QUOTE (TSX *MOVE 1)) ((LAMBDA (J) (LIST (COND ((LESSP J 3) C) (T (DIFFERENCE (TIMES J 2) 4))))) (LENGTH (CADR E XP)))))) (SETQ LENGTH 0) (SETQ STOMAP (QUOTE ((NIL (0 *N) 1)))) (MAP (CA DR EXP) (FUNCTION (LAMBDA (J) (STORE (CAR J) F)))) (SETQ AC NIL) (COMVAL (CADDR EXP) STOMAP NIL) (COND ((NOT (MEMBER (CAADDR EXP) (QUOTE (COND P ROG)))) (ATTACH (QUOTE ((TXI *RETURN 1 *MN)))))) (SETQ EXP (REVERSE LIST ING)) (RETURN (LIST EXP (LIST (CONS (QUOTE *MN) (PLUS LENGTH 2)) (CONS ( QUOTE *N) (DIFFERENCE -2 LENGTH)))))))) (COMPROG (LAMBDA (EXP PROGLIS RETN) (PROG (GOLIST HOLD NAME SETS S) (SET Q HOLD EXP) A (COND ((NULL HOLD) (GO B)) ((ATOM (CAR HOLD)) (SETQ GOLIST (CONS (CONS (CAR HOLD) (GENSYM)) GOLIST))) ((NOT SETS) (COND ((EQ (CAAR HOLD) (QUOTE SPECBIND)) (SETQ S (CADADR HOLD))) (T (SETQ SETS T))))) (S ETQ HOLD (CDR HOLD)) (GO A) B (SETQ HOLD PROGLIS) C (CO ND ((NULL HOLD) (GO G))) (STORE (CAR HOLD) NIL) (COND ((NOT (EQ (CAR HOL D) S)) (ATTACH (LIST (CONS (QUOTE STZ) (LOCATE (CAR HOLD))))))) (SETQ HO LD (CDR HOLD)) (GO C) G (SETQ HOLD EXP) D (SETQ AC NIL) (SETQ NAME (GENS YM)) (COND ((NULL HOLD) (GO E)) ((ATOM (CAR HOLD)) (ATTACH (LIST (CDR (SASSOC (CAR HOLD) GOLIST NIL)))) ) ((EQ (CAAR HOLD) (QUOTE GO)) (ATTACH (LIST (LIST (QUOTE TRA) (CDR (SASSOC (CADAR HOLD) GO LIST (FUNCTION (LAMBDA NIL (ERROR (QUOTE GO)))))))))) ((EQ (CAAR HOLD) ( QUOTE COND)) (COMCOND (CDAR HOLD) F)) (T (COMVAL (CAR HOLD) STOMAP NAME) )) (SETQ HOLD (CDR HOLD)) (GO D) E (COND (RETN (ATTACH (LIST RETN))))))) (COMPACT (LAMBDA (EXP NAME) (COND ((EQ (CAR EXP) (QUOTE NULL)) (PROG2 (SETQ SWITCH (NOT SWITCH)) (COMPACT (CADR EXP) NAME))) ((EQUAL EXP (QUOTE (QUOTE *T* ))) (COND (SWITCH (ATTACH (LIST (LIST (QUOTE TRA) NAME)))) (T (SETQ FLAG F)))) ((EQ (CAR EXP) (QUOTE OR)) (COMBOOL F T (CDR EXP) SWITCH)) ((EQ (CAR EXP) (QUOTE AND)) (COMBOOL T T (CDR EXP) SWITCH)) (T (PROG2 (COND ((EQ (CAR EXP) (QUOTE EQ)) (CEQ EXP STOMAP)) (T (COMVAL EXP STOMAP (GENSYM)))) (ATTACH (LIST (LIST (COND (SWITCH (QUOTE TNZ)) (T(QUOTE TZE))) NAME))) )) ))) (COMBOOL (LAMBDA (FN MODE EXP A) (PROG (GEN SWITCH) (SETQ GEN (GENSYM)) A (SETQ SWITCH NIL) (COND ((NULL EXP) (GO C)) ((AND MODE (NULL (CDR EXP)) (EQ A FN) ) (GO B))) (COMPACT (COND (FN (CAR EXP)) (T (LIST (QUOTE NULL) (CAR EXP)))) (COND ((AND MODE (NOT A )) (COND (FN NAME) (T GEN))) (T (COND ((NOT MODE) GEN) (FN GEN) (T NAME))) )) (SETQ AC (COND ((EQ (CAAR LISTING) (QUOTE TNZ)) (QUOTE (QUOTE NIL)) ) (T (QUOTE (QUOTE *T* ))))) (SETQ EXP (CDR EXP)) (GO A) B (COMPACT (COND (FN (LIST (QUOTE NULL) (CAR EXP))) (T (CAR EXP)) ) NAME) C (COND ((NOT MODE) (ATTACH (LIST (QUOTE (TRA (* 2))) (LIST (QUOTE CLA) (LIST (QUOTE QUOTE) FN)) )))) (ATTACH (LIST GEN)) (COND ((NOT MODE) (ATTACH (LIST (LIST (QUOTE CLA) (LIST (QUOTE QUOTE) (NOT FN))))))) ))) (COMCOND (LAMBDA (EXP MODE) (PROG (FLAG SWITCH GEN) (SETQ FLAG T) A (COND ((NULL EXP) (GO B))) (SETQ GEN (GENSYM)) (SETQ SWITCH NIL) (COND((AND (NOT MODE) (EQ (CAADAR EXP) (QUOTE GO))) (GO C))) (COMPACT (CAAR EXP) GEN) (SETQ AC (COND (SWITCH (QUOTE (QUOTE NIL))) (T NIL))) (COMVAL (CADAR EXP) STOMAP NAME) (COND ((OR (AND NAME (NULL (CDR EXP))) (MEMBER (CAADAR EXP) (QUOTE (RETURN GO)))) (GO L))) (ATTACH (LIST (COND (NAME (LIST (QUOTE TRA) NAME)) (T (QUOTE (TXI *RETURN 1 *MN))) ))) L (ATTACH (LIST GEN)) D (SETQ EXP (CDR EXP)) (SETQ AC (COND (SWITCH (QUOTE NIL)) (T (QUOTE (QUOTE NIL))))) (GO A) B (COND (NAME (ATTACH (LIST NAME)))) (RETURN NIL) C (COMPACT (LIST (QUOTE NULL) (CAAR EXP)) (CDR (SASSOC (CADR (CADAR EXP)) GOLIST (FUNCTION (LAMBDA (V) (ERROR (QUOTE GO))))))) (GO D) ))) (CEQ (LAMBDA (EXP STOMAP) (PROG (A) (SETQ A (COMLIS (CDR EXP))) (COND (( EQUAL(CAR A)AC)(ATTACH (LIST (CONS (QUOTE SUB) (LOCATE (CADR A)))))) (T (PROG2 (LAC (CADR A)) (ATTACH (LIST (CONS (QUOTE SUB) (LOCATE (CAR A)))) )))) (SETQ SWITCH (NOT SWITCH))))) (CALL (LAMBDA (FN ARGS) (PROG (HOLD ITEM NUM) (COND ((MEMBER FN (QUOTE(SPECBIND SPECSTR LIST RETURN GO))) (GO E)) ((NULL ARGS) (GO D)) ((NULL (CDR ARGS)) (GO C))) (SETQ HOLD (REVERSE (CDDR ARGS))) (SETQ NUM (LENGTH ARGS)) (COND ((GREATERP NUM 20) (ERROR (QUOTE ARGS)))) A (COND ((NULL HOLD) (GO B))) (SETQ ITEM (CAR HOLD)) (COND ((EQUAL ITEM (QUOTE (QUOTE NIL))) (ATTACH (LIST (LIST (QUOTE STZ) (LIST (QUOTE $ALIST) NUM))))) ((EQUAL ITEM AC) (ATTACH (LIST (LIST (QUOTE STO) (LIST (QUOTE $ALIST) NUM))))) (T (ATTACH (LIST (LIST (QUOTE STQ) (LIST (QUOTE $ALIST) NUM)) (CONS (QUOTE LDQ) (LOCATE ITEM)) )))) (SETQ HOLD (CDR HOLD)) (SETQ NUM (SUB1 NUM)) (GO A) B (COND ((EQUAL AC (CADR ARGS)) (COND ((EQUAL AC (CAR ARGS)) (ATTACH (QUOTE ((LDQ($ALIST 2)) (STO ($ALIST 2)))))) (T (ATTACH (QUOTE ((XCA))))))) (T (ATTACH (LIST (CONS (QUOTE LDQ) (LOCATE (CADR ARGS))))))) C (LAC (CAR ARGS)) D (ATTACH (LIST (LIST (QUOTE STR) (LIST (QUOTE E) FN) 7 (LENGTH ARGS)))) (RETURN NIL) E (COND ((EQ FN (QUOTE GO)) (ERROR (QUOTE GO))) ((EQ FN (QUOTE RETURN)) (PROG NIL (LAC (CAR ARGS)) (ATTACH (LIST (COND (RETN (LIST (QUOTE TRA) RETN)) (T (QUOTE (TXI *RETURN 1 *MN)))))))) ((EQ FN (QUOTE LIST)) (PROG (X) (COND ((NULL ARGS) (RETURN (ATTACH (QUOTE ((CLA (QUOTE NIL)))) )))) (COND (AC (LOCATE AC))) (ATTACH (QUOTE ((TSX *LIST 4)))) (ATTACH (LIST (CONS (TIMES (LENGTH ARGS) 1Q6) (LOCATE (CAR ARGS))))) (SETQ X (CDR ARGS)) A (COND ((NULL X) (RETURN NIL))) (ATTACH (LIST (CONS 0 (LOCATE (CAR X))))) (SETQ X (CDR X)) (GO A) )) ((MEMBER FN (QUOTE (SPECBIND SPECRSTR))) (PROG NIL (ATTACH (LIST (LIST (QUOTE TSX) FN 4))) (MAPLIST (CADAR ARGS) (FUNCTION (LAMBDA (J) (ATTACH (LIST (LIST (COND ((CDR J) 0)(T (QUOTE STR))) (CAR (LOCATE (CAR J)))1 (LIST (QUOTE SPECIAL) (CAR J)))))))))) )))) (ATTACH (LAMBDA (A) (COND ((AND (EQUAL (CAR A) (QUOTE (TXI *RETURN 1 *MN))) (MEMBER (CAAR LISTING) (QUOTE (TXI TRA)))) NIL) (T (SETQ LISTING (APPEND A LISTING))) ))) (LOCATE (LAMBDA (X) (COND ((OR (EQ (CAR X) (QUOTE QUOTE)) (EQ (CAR X) (Q UOTE SPECIAL)) (EQ X (QUOTE $ALIST))) (LIST X)) (T (CDR (SASSOC X STOMAP (FUNCTION (LAMBDA NIL (COND ((EQ X AC) (PROG NIL (STORE AC T) (RETURN (SASSOC X STOMAP (FUNCTION NIL))))) (T (ERROR (LIST X (QUOTE UNDECLARED)))) ))) ))) ))) (DELETEL (LAMBDA (L M) (MAPCON M (FUNCTION (LAMBDA (J) (COND ((MEMBER (C AR J) L) NIL) (T (LIST (CAR J))))))))) (PASSONE (LAMBDA (NAME FN) (PALAM (PROGITER NAME FN) NIL))) (PA1 (LAMBDA (L) (MAPLIST L (FUNCTION (LAMBDA (J) (PAFORM (CAR J) B))))) ) (PA4 (LAMBDA (COMS SPECS G) (COND ((AND (NULL COMS) (NULL SPECS)) (LIST (QUOTE LAMBDA) (CADR FN) (PAFORM (CADDR FN) (APPEND (CADR FN) B)))) (T ( LIST (QUOTE LAMBDA) (CADR FN) (CONC (LIST (QUOTE PROG) (LIST G)) (PA11 C OMS (QUOTE COMBIND)) (PA9 SPECS (QUOTE SPECBIND)) (LIST (LIST (QUOTE SET Q) G (PAFORM (CADDR FN) (APPEND (CADR FN) B)))) (PA9 SPECS (QUOTE SPECRS TR)) (PA14 COMS) (PA12 G))))))) (PA3 (LAMBDA (L) (COND ((NULL (CDR L)) (LIST (LIST (QUOTE (QUOTE *T* ) ) (PAFORM (CAR L) B)))) (T (CONS (LIST (LIST (QUOTE EQ) G (PAFORM (CAAR L) B)) (PAFORM (CADAR L) B)) (PA3 (CDR L))))))) (PA5 (LAMBDA (VARS PROP) (COND ((NULL VARS) NIL) ((GET (CAR VARS) PROP) (CONS (CAR VARS) (PA5 (CDR VARS) PROP))) (T (PA5 (CDR VARS) PROP))))) (PA6 (LAMBDA (KIND VAR) (LIST (LIST KIND (LIST (QUOTE QUOTE) VAR) (CONS (QUOTE LIST) VAR))))) (PA7 (LAMBDA (L B) (COND ((NULL L) (QUOTE ((RETURN (QUOTE NIL))))) ((AND (NULL (CDR L)) (EQ (CAAR L) (QUOTE GO))) L) ((ATOM (CAR L)) (CONS (CAR L) (PA7 (CDR L) B))) (T (CONS (PAFORM (CAR L) B) (PA7 (CDR L) B)))))) (PA11 (LAMBDA (VARS FUNC) (COND (VARS (PA6 FUNC VARS)) (T NIL)))) (PA14 (LAMBDA (COMS) (COND (COMS (LIST (LIST (QUOTE COMRSTR) (LIST (QUOT E QUOTE) (LENGTH COMS))))) (T NIL)))) (PA12 (LAMBDA (G) (LIST (LIST (QUOTE RETURN) G)))) (COMPILE (LAMBDA (L) (MAPLIST L (FUNCTION (LAMBDA (J) (COM1 (CAR J) (GET (CAR J) (QUOTE EXPR)) (GET (CAR J) (QUOTE FEXPR)))))))) (COM1 (LAMBDA (N A B) (PROG2 (COND (A (COM2 (QUOTE SUBR) (LENGTH (CADR A )) A N)) (B (COM2 (QUOTE FSUBR) (LENGTH (CADR B)) B N)) (T (PRINT (LIST N (QUOTE UNDEFINED))))) N))) (COM2 (LAMBDA (TYPE LENGTH EXP NAME) (PROG (LISTING) (SETQ LISTING (PHAS E2 (PASSONE NAME EXP) NAME)) (TERPRI) (TERPRI) (TERPRI) (PRINT (LIST NAM E TYPE LENGTH)) (MAP (CAR LISTING) (FUNCTION (LAMBDA (J) (PRINT (CAR J)) ))) (TERPRI) (LAP (CONS (LIST NAME TYPE LENGTH) ( CAR LISTING)) (CADR LISTING)) (REMPROP NAME (QUOTE EXPR)) (REMPROP NAME (QUOTE FEXPR)) (RETURN NAME)))) (COMMON (LAMBDA (L) (FLAG L (QUOTE COMMON)))) (UNCOMMON (LAMBDA (L) (REMFLAG L (QUOTE COMMON)))) (SPECIAL (LAMBDA (X) (MAPLIST X (FUNCTION (LAMBDA (J) (DEFLIST (LIST (LIST (CAR J) (LIST NIL))) (QUOTE SPECIAL))))))) (UNSPECIAL (LAMBDA (L) (MAP L (FUNCTION (LAMBDA (J) (REMPROP (CAR J) (QUOTE SPECIAL))))))) (PROGITER (LAMBDA (NAME EXP) (COND ((AND (EQ (CAADDR EXP) (QUOTE COND)) (PI1 (CDADDR EXP))) ((LAMBDA (G1 G2 VS GS) (LIST (QUOTE LAMBDA) VS (CONS (QUOTE PROG) (CONS GS (CONS G1 (PI3 (CDADDR EXP) NIL (CONS G2 (PAIRMAP VS GS (FUNCTION PI2) (LIST (LIST (QUOTE GO) G1))))))))))(GENSYM) (GENSYM) (CADR EXP) (MAPLIST (CADR EXP) (FUNCTION GENSYM)))) (T EXP) ))) (PI1 (LAMBDA (L) (COND ((NULL L) F) ((EQ (CAADAR L) NAME) T) (T (PI1 (CDR L))) ))) (PI2 (LAMBDA (J K) (LIST (QUOTE SETQ) J K))) (PI3 (LAMBDA (L C S) (COND ((NULL L) (CONS (CONS (QUOTE COND) C) S)) ((EQ (CAADAR L) NAME) ((LAMBDA (G3) (PI3 (CDR L) (NCONC C (LIST (LIST (CAAR L) (LIST (QUOTE GO) G3)))) (CONS G3 (PAIRMAP GS (CDADAR L) (FUNCTION PI2) (CONS (LIST (QUOTE GO) G2) S))))) (GENSYM))) (T (PI3 (CDR L) (NCONC C (LIST (LIST (CAAR L) (LIST (QUOTE RETURN) (CADAR L))))) S)) ))) (PALAM (LAMBDA (FN B) (COND ((ATOM FN) FN) ((EQ (CAR FN) (QUOTE LAMBDA)) (PA4 (PA5 (CADR FN) (QUOTE COMMON)) (PA5 (CADR FN) (QUOTE SPECIAL)) (GE NSYM))) ((EQ (CAR FN) (QUOTE LABEL)) (COMP (CADR FN) (CADDR FN))) (T (ER ROR (CONS FN (QUOTE (NOT FUNCTION)))))))) (PAFORM (LAMBDA (FORM B) (COND ((ATOM FORM) (COND ((OR (NUMBERP FORM) (M EMBER FORM (QUOTE (NIL *T* )))) (LIST (QUOTE QUOTE) FORM)) ((EQ FORM ( QUOTE T)) (QUOTE (QUOTE *T* ))) ((EQ FORM (QUOTE F)) (QUOTE (QUOTE NIL ))) ((GET FORM (QUOTE COMMON)) (LIST (QUOTE EVAL) (LIST (QUOTE QUOTE) FORM) (QUOTE $ALIST))) ((GET FORM (QUOTE SPECIAL)) (LIST (QUOTE SPECIAL) FORM)) ((MEMBER FORM B) FORM) (T (PROG NIL (PRINT (CONS FORM (QUOTE ( UNDECLARED )))) (RETURN (LIST (QUOTE EVAL)(LIST (QUOTE QUOTE) FORM) (QUOTE $ALIST))))) )) ((ATOM (CAR FORM)) (COND (( OR (GET (CAR FORM) (QUOTE FSUBR)) (GET (CAR FORM) (QUOTE FEXPR))) (COND ((MEMBER (CAR FORM) (QUOTE (AND OR))) (CONS (CAR FORM) (PA1 (CDR FORM))) ) ((MEMBER (CAR FORM) (QUOTE (MAX MIN PLUS TIMES LOGOR LOGAND LOGXOR))) (LIST (CAR FORM) (CONS (QUOTE LIST) (PA1 (CDR FORM))) (QUOTE $ALIST))) ( T (SELECT (CAR FORM) ((QUOTE COND) (CONS (QUOTE COND) (MAPLIST (CDR FORM ) (FUNCTION (LAMBDA (J) (LIST (PAFORM (CAAR J) B) (PAFORM (CADAR J) B))) )))) ((QUOTE LIST) (CONS (QUOTE LIST) (PA1 (CDR FORM)))) ((QUOTE QUOTE) FORM) ((QUOTE PROG) (PA8 (PA5 (CADR FORM) (QUOTE COMMON)) (PA5 (CADR FOR M) (QUOTE SPECIAL)) (GENSYM))) ((QUOTE FUNCTION) (LIST (QUOTE FUNC) (LIS T (QUOTE QUOTE) (COMP (GENSYM) (CADR FORM))) (QUOTE $ALIST))) ((QUOTE SE TQ) (COND ((GET (CADR FORM) (QUOTE COMMON)) (LIST (QUOTE SETQ) (LIST (QU OTE QUOTE) (CADR FORM)) (PAFORM (CADDR FORM) B) )) (T (LIS T (QUOTE SETQ) (PAFORM (CADR FORM) B) (PAFORM (CADDR FORM) B))))) ((QUOT E GO) FORM) ((QUOTE CSETQ) (LIST (QUOTE CSET) (LIST (QUOTE QUOTE) (CADR FORM)) (PAFORM (CADDR FORM) B))) ((QUOTE SELECT) ((LAMBDA (G) (LIST (LIS T (QUOTE LAMBDA) (LIST G) (CONS (QUOTE COND) (PA3 (CDDR FORM)))) (PAFORM (CADR FORM) B))) (GENSYM))) ((QUOTE CONC) (PA2 (CDR FORM))) (LIST (CAR FORM) (LIST (QUOTE QUOTE) (CDR FORM)) (QUOTE $ALIST)))))) ((EQ (CAR FORM ) (QUOTE NOT)) (LIST (QUOTE NULL) (PAFORM (CADR FORM) B))) ((EQ (CAR FOR M) (QUOTE SET)) (LIST (QUOTE SETQ) (PAFORM (CADR FORM) B) (PAFORM (CADDR FORM) B) )) (T (CONS (CAR FORM) (PA1 (CDR FORM)))))) ((OR (EQ (CAAR FORM) (QUOTE LAMBDA)) (EQ (CAAR FORM) (QUOTE LABEL))) (CONS ( PALAM (CAR FORM) B) (PA1 (CDR FORM)))) (T (LIST (QUOTE APPLY) (PAFORM (C AR FORM) B) (CONS (QUOTE LIST) (PA1 (CDR FORM))) (QUOTE $ALIST)))))) (PAIRMAP (LAMBDA (L M FARG Z) (PROG (A B) (COND ((NULL L) (RETURN Z))) (SETQ A (SETQ B (CONS (FARG (CAR L) (CAR M)) Z))) A (SETQ L (CDR L)) (SETQ M (CDR M)) (COND ((NULL L) (RETURN A))) (SETQ B (CDR (RPLACD B (CONS (FARG (CAR L) (CAR M)) Z)))) (GO A) ))) (PA8 (LAMBDA (COMS SPECS G) (COND ((AND (NULL COMS) (NULL SPECS)) (CONS (QUOTE PROG) (CONS (CADR FORM) (PA7 (CDDR FORM) (APPEND (CADR FORM) B))) )) (T (CONC (LIST (QUOTE PROG) (CONS G (APPEND COMS SPECS))) (PA11 COMS( QUOTE COMBIND)) (PA9 SPECS (QUOTE SPECBIND)) (LIST (LIST (QUOTE SETQ) G (CONS (QUOTE PROG) (CONS (DELETEL (APPEND COMS SPECS) (CADR FORM)) (PA7 (CDDR FORM) (APPEND (CADR FORM) B)))))) (PA9 SPECS (QUOTE SPECRSTR)) (PA 14 COMS) (PA12 G)))))) (COMP (LAMBDA (N E) (COND ((ATOM E) E) (T (COM2 (QUOTE SUBR) (LENGTH (CADR E)) E N)) ))) (PA9 (LAMBDA (V K) (COND (V (LIST (LIST K (LIST (QUOTE QUOTE) V)))) (T NIL)))) (PA2 (LAMBDA (L) (COND ((NULL L) (QUOTE (QUOTE NIL))) (T (LIST (QUOTE APPEND) (PAFORM (CAR L) B) (PA2 (CDR L))))))) ))