00100	(PUTPROP @DIFFERENCE (GET @*DIF @SUBR) @SUBR)
00200	
00300	(PUTPROP @SASSQ (GET @SASSOC @SUBR) @SUBR)
00400	
00500	(PUTPROP @MAPC# (GET @MAPC @SUBR) @SUBR)
00600	
00700	(PUTPROP @MAPCAR# (GET @MAPCAR @SUBR) @SUBR)
00800	
00900	(PUTPROP @ASSQ (GET @ASSOC @SUBR) @SUBR)
01000	
01100	(PUTPROP @PUTPROP1 (GET @PUTPROP @SUBR) @SUBR)
01200	
01300	(PUTPROP @APPLY# (GET @APPLY @LSUBR) @LSUBR)
01400	
01500	(PUTPROP (QUOTE THPUSH)
01600		 (QUOTE (LAMBDA (A) (LIST (QUOTE SETQ)
01700				   (CADR A)
01800				   (LIST (QUOTE CONS) (CADDR A) (CADR A)))))
01900		 (QUOTE MACRO))
02000	
02100	(PUTPROP (QUOTE THTRACE)
02200		(QUOTE (LAMBDA (L)
02300			(PROG NIL
02400			 (DSKIN (P RPO) (THTRAC./13))
02500			 (REMPROP (QUOTE THTRACE) (QUOTE MACRO))
02600			 (RETURN (LIST (QUOTE QUOTE)(EVAL L))))))
02700		(QUOTE MACRO))
02800	
02900	(PUTPROP (QUOTE THEOREM) T (QUOTE SWAPIT))
03000	
03100	(SETQ THTRACE NIL)
03200	
03300	
03400	(OR (GETL @THERT @(FSUBR FEXPR))(DF THERT (L) NIL)))
03500	
03600	(DF DECLARE (L)NIL))
03700	
03800	(DECLARE (*FEXPR LAMBDA# SSTATUS DEFUN DECLARE GENPREFIX ERT THERT))
03900	(DECLARE (*EXPR SPRINT))
04000	
04100	(SETQ PURE NIL)
04200	
04300	(SETQ ERRLIST NIL)
     

00100	(DEFPROP MAPCAR (LAMBDA L
00200	(COND	((GREATERP L 3)(PRINT @(MAPCAR OF 3 ARG LISTS))(ERR))
00300		((EQUAL L 2)(MAPCAR# (ARG 1)(ARG 2)))
00400	(T (COND ((OR (NULL (ARG 2))(NULL (ARG 3)))NIL)
00500	(T (CONS ((ARG 1)(CAR (ARG 2))(CAR (ARG 3)))
00600	(MAPCAR (ARG 1)(CDR (ARG 2))(CDR (ARG 3)))))))))EXPR)
00700	
00800	(DF ERT (L) (APPLY (QUOTE THERT) L)))
00900	
01000	(DE ASSOC (A L)
01100	(COND ((NULL L) NIL)
01200		((EQUAL A (CAAR L))(CAR L))
01300		(T (ASSOC A (CDR L)))))
01400	
01500	(DEFPROP PAGEBPORG (LAMBDA () NIL)EXPR)
01600	
01700	(DEFPROP GENPREFIX (LAMBDA (L) NIL) FEXPR)
01800	
01900	(DEFPROP  MIN (LAMBDA  N
02000	(PROG (V)
02100	(SETQ V (ARG N))
02200	A (SETQ N(SUB1 N))
02300	(COND ((ZEROP N)(RETURN V)) 
02400	      ((LESSP (ARG N) V) (SETQ V (ARG N))))
02500	(GO A)))EXPR)
02600	
02700	(DEFPROP  MAX (LAMBDA  N
02800	(PROG (V )
02900	(SETQ V (ARG N))
03000	A (SETQ N(SUB1 N))
03100	(COND ((ZEROP N)(RETURN V)) 
03200	      ((GREATERP (ARG N) V)(SETQ V (ARG N))))
03300	(GO A)))EXPR)
03400	
03500	(DEFPROP RANDOM (LAMBDA ()
03600	(QUOTIENT (TIMES  (EXAMINE 15)(EXAMINE 16) ) (MAX (EXAMINE 15)(EXAMINE 16)))
03700	)EXPR)
03800	
03900	(DEFPROP DEFUN
04000	(LAMBDA (L)
04100	(COND ((AND(ATOM (CADR L))(NOT(NULL (CADR L))))
04200		(PUTPROP (CAR L)
04300			 (APPEND @(LAMBDA)
04400				 (LIST (CADDR L))
04500			 (COND ((GREATERP (LENGTH (CDDDR L)) 1)
04600				 (LIST (APPEND @(PROG NIL)
04700					(COND (T (RPLACA (LAST(CDDDR L))
04800							 (LIST @RETURN (CAR(LAST(CDDDR L)))))
04900						 (CDDDR L))))))
05000			       (T (CDDDR L))))
05100			 (CADR L))
05200		(CAR L))
05300	      (T 
05400		(PUTPROP (CAR L)
05500			 (APPEND @(LAMBDA)
05600				  (LIST (CADR L))
05700				 (COND ((GREATERP (LENGTH (CDDR L)) 1)
05800					(LIST(APPEND @(PROG NIL)
05900						     (COND (T (RPLACA (LAST(CDDR L))
06000							 (LIST @RETURN (CAR(LAST(CDDR L)))))
06100						 (CDDR L))))))
06200				       (T (CDDR L))))
06300			 (QUOTE EXPR))
06400		(CAR L))))FEXPR)
06500	
06600	
06700	
06800	(DEFPROP SSTATUS (LAMBDA (L)(QUOTE SSTATUS))FEXPR)
06900	
07000	(DEFPROP AND (LAMBDA (L)
07100	(AND# (CDR L))) MACRO)
07200	
07300	(DEFPROP AND# (LAMBDA (L)
07400	(COND ((NULL (CDR L))(LIST (QUOTE COND)(LIST (CAR L))))
07500	(T (LIST (QUOTE COND)(LIST (CAR L)(AND# (CDR L)))))))EXPR)
07600	
07700	(DEFPROP OR  (LAMBDA (L)
07800	(OR# (CDR L)))
07900	MACRO)
08000	
08100	(DEFPROP OR# (LAMBDA (L)
08200	(APPEND (QUOTE (COND))(MAPCAR (FUNCTION LIST) L)))
08300	EXPR)
08400	
08500	
08600	
08700	
08800	(DEFPROP LAMBDA# (LAMBDA (L) (COND (T (PRINT @LAMBDA#CALLED)
08900				(LIST (QUOTE COND) (CONS (QUOTE T) (CDR L)))))) FEXPR)
09000	
09100	(DEFPROP MAPC (LAMBDA L
09200		(COND	((GREATERP L 4)(PRINT @(MAPC OF FOUR ARG LISTS))(ERR))
09300		((EQUAL L 2)(MAPC# (ARG 1)(ARG 2)) (ARG 2) )
09400		((EQUAL L 3)
09500			(PROG (A B) 
09600				(SETQ A (ARG 2))(SETQ B (ARG 3)) 
09700			L1 (AND (OR (NULL A)(NULL B))(RETURN (ARG 2)) )
09800				   ((ARG 1)(CAR A)(CAR B))
09900				     (SETQ A (CDR A))(SETQ B (CDR B))
10000					(GO L1 )))
10100		(T (PROG (A B C) (SETQ A (ARG 2))(SETQ B (ARG 3))(SETQ C(ARG 4)) 
10200			L1 (AND (OR (NULL A)(NULL B)(NULL C))(RETURN (ARG 2)))
10300			   ((ARG 1)(CAR A)(CAR B)(CAR C))
10400			   (SETQ A(CDR A))(SETQ B (CDR B))(SETQ C(CDR C))
10500			   (GO L1)))))EXPR)
10600	
10700	(DECLARE (SPECIAL R F L))
10800	
10900	(DEFPROP MAPCAN
11000	 (LAMBDA(F L)
11100	  (PROG (R)
11200	(MAPC(FUNCTION (LAMBDA(X)(SETQ R(NCONC R (F X)))))L)
11300	(RETURN R)))
11400	EXPR)
11500	
11600	(DECLARE (UNSPECIAL R F L))
11700	
11800	(DECLARE (SPECIAL ERRLIST))
11900	
12000	(DEFPROP RESTART 
12100	 (LAMBDA NIL (PROG NIL (MAPC (FUNCTION EVAL) ERRLIST) (RETURN @EXIT) )) 
12200	EXPR)
12300	
12400	(DECLARE (UNSPECIAL ERRLIST))
12500	
12600	(DEFPROP MEMQ (LAMBDA (E L)
12700	(COND ((NULL L) NIL)
12800		((NOT (ATOM (CAR L)))(MEMQ E (CDR L)))
12900		((EQ E (CAR L)) L)
13000		(T (MEMQ E (CDR L)))))EXPR)
13100	
13200	(DEFPROP MEMBER (LAMBDA (E L)
13300	(COND ((NULL L) NIL)
13400		((EQUAL E (CAR L)) L)
13500		(T (MEMBER E (CDR L)))))EXPR)
13600	
13700	
13800	(DEFPROP APPLY (LAMBDA L
13900	(PROG ()
14000		(RETURN
14100			(COND	((GETL (ARG 1) (QUOTE (EXPR SUBR %%TRACE)))
14200				 (APPLY# (ARG 1)(ARG 2)))
14300				((EVAL (CONS (ARG 1)(ARG 2))))))))EXPR)
14400	
14500	
14600	(PUTPROP @AND @(LAMBDA (L)
14700	(AND# (CDR L))) @MACRO)
14800	
14900	(PUTPROP @OR  @(LAMBDA (L)
15000	(OR# (CDR L)))
15100	@MACRO)
15200	
15300	(DF TH (L)(PROG ()
15400		(PRINC @THEOREM:/ / )
15500		(PRINC (CAR L))
15600		(TERPRI)
15700		(SPRINT (GET (CAR L) @THEOREM) 0 1) ))
15800	
15900	(QUOTE (END OF FILE))