

DEFINE((
(PROGITER(LAMBDA(NAME EXP)(PROG(G1 G2 VS GS X)
((AND(EQ(CAADDR EXP )COND)(PI1(CDADDR EXP)))(GO AA))(RETURN
EXP)
AA(SETQ G1(GENSYM))
(SETQ G2(GENSYM))
(SETQ VS(CADR EXP))
(SETQ GS(MAPLIST(CADR EXP)GENSYM))
(SETQ X (LIST(LIST GO G1)))
(SETQ X(PAIRMAP VS GS X))
(SETQ X (PI3(CDADDR EXP)NIL(CONS G2 X)))
(SETQ X(CONS PROG(CONS GS(CONS G1 X))))
(RETURN(LIST LAMBDA VS X )))))
(PI1(LAMBDA(L)(PROG NIL 
A((NULL L)(RETURN T))((ATOM(CADAR L))(GO B))
((EQ(CAADAR L)NAME)(RETURN T))
B(SETQ L(CDR L))(GO A) )))
 (PAIRMAP(LAMBDA(L M Z)(PROG(A B)((NULL L)(RETURN Z))
  (SETQ A(SETQ B(CONS(LIST(QUOTE SETQ)(CAR L)(CAR M) ) Z)))
 A (SETQ L(CDR L))(SETQ M(CDR M))((NULL L)(RETURN A))
   (SETQ B(CDR(RPLACD B(CONS(LIST(QUOTE SETQ)(CAR L)(CAR M) )Z))))
   (GO A) )))
 (PI3(LAMBDA(L C S)(PROG NIL 
A((NULL L)(RETURN(CONS(CONS(QUOTE COND)C)
 S)))((ATOM(CADAR L))(GO B))((EQ(CAADAR L)NAME)(RETURN
((LAMBDA(G3)(PI3(CDR L)(NCONC C(LIST
 (LIST(CAAR L)(LIST(QUOTE GO)G3) )))(CONS G3(PAIRMAP GS(CDADAR L)
     (CONS(LIST(QUOTE GO)G2)S) )) ))(GENSYM) )))
 B(SETQ C(NCONC C(LIST(LIST(CAAR L)(LIST(QUOTE RETURN)(CADAR L)) )) ))
 (SETQ L(CDR L))(GO A) )))
 (NCONC(LAMBDA(X Y)(PROG(M)((NULL X)(RETURN Y))(SETQ M X)
 A((NULL(CDR M))(GO B))(SETQ M(CDR M))(GO A)B(RPLACD M Y)(RETURN X) )))
))

DEFINE((
(AND(LAMBDA(X Y)(COND(X Y)(T F))))
(MAPLIST(LAMBDA(X FN)(COND((NULL X)NIL)
(T(CONS(FN)(MAPLIST(CDR X)FN))) )))
))
DEFLIS((
(MEMBER(LAMBDA(X Y)(COND((NULL Y)NIL)((EQ X(CAR Y))T)
  (T(MEMBER X(CDR Y))))))
(LAST(LAMBDA(L)(COND((NULL L)NIL)((NULL(CDR L))(CAR L))
  (T(LAST(CDR L))))))
(COMPOSE(LAMBDA(FC X N)(COND ((EQ 0 N)X)((NULL X)NIL)
  (T(COMPOSE FC(FC X)(MINUS N 1))))))
(NTHEM(LAMBDA(A X)(COND((NULL X)NIL)((EQ A O)(CAR X))
  (T(NTHEM(MINUS A 1)(CDR X))))))
(P1(LAMBDA(X)(COND((NULL(CDDR X))(EQUAL(CAR X)(CADR X)))
  ((EQUAL(CAR X)(CADR X))(P1(CDR X)))(T F))))
(ND(LAMBDA(N X)(COND((NULL X)NIL)((EQ N O)X)
  (T(ND(MINUS N 1)(D X))))))
)APVAL)
ICLOSE NIL
