p2.lisp

(DEFINE COMMENT SECTOR-LISP SOLUTION TO EVEN-FIBONACCI-NUMBERS)

(DEFINE T . T)

(DEFINE ZERO . (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))
(DEFINE ONE . (T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))
(DEFINE TWO . (NIL T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))
(DEFINE TEN . (NIL T NIL T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))

(DEFINE NOT . (LAMBDA (P) (COND (P NIL) (T T))))

(DEFINE REVERSE_ . (LAMBDA (A RESULT)
		     (COND (A (REVERSE_ (CDR A) (CONS (CAR A) RESULT)))
			   (T RESULT))))

(DEFINE REVERSE . (LAMBDA (A) (REVERSE_ A NIL)))

(DEFINE ADD-BINARY . (LAMBDA (A B CARRY)
		       (COND (A (COND (B (COND (CARRY (CONS T T))
					       (T (CONS NIL T))))
				      (T (COND (CARRY (CONS NIL T))
					       (T (CONS T NIL))))))
			     (T (COND (B (COND (CARRY (CONS NIL T))
					       (T (CONS T NIL))))
				      (T (COND (CARRY (CONS T NIL))
					       (T (CONS NIL NIL)))))))))

(DEFINE ADD_ . (LAMBDA (RESULT A B CARRY)
		 (COND (A ((LAMBDA (ADD-RESULT)
			     (ADD_ (CONS (CAR ADD-RESULT) RESULT)
				   (CDR A)
				   (CDR B)
				   (CDR ADD-RESULT)))
			   (ADD-BINARY (CAR A) (CAR B) CARRY)))
		       (T RESULT))))

(DEFINE ADD . (LAMBDA (A B) (REVERSE (ADD_ NIL A B NIL))))

(DEFINE INVERT . (LAMBDA (A)
		   (COND (A (CONS (NOT (CAR A))
				  (INVERT (CDR A))))
			 (T NIL))))

(DEFINE COMPLEMENT . (LAMBDA (A) (ADD (INVERT A) ONE)))

(DEFINE SUBTRACT . (LAMBDA (A B) (ADD A (COMPLEMENT B))))

(DEFINE LESS_ . (LAMBDA (A B RESULT)
		  (COND (A (LESS_ (CDR A)
				  (CDR B)
				  (COND ((EQ (CAR A) (CAR B)) RESULT)
					((CAR B) T)
					(T NIL))))
			(T RESULT))))

(DEFINE LESS . (LAMBDA (A B) (LESS_ A B NIL)))

(DEFINE TRUNCATE . (LAMBDA (TEMPLATE LIST)
		     (COND (TEMPLATE (CONS (CAR LIST)
					   (TRUNCATE (CDR TEMPLATE) (CDR LIST))))
			   (T NIL))))

(DEFINE REPLACE-NTH . (LAMBDA (I ITEM LIST)
			(COND (LIST (COND (I (CONS (CAR LIST) (REPLACE-NTH (CDR I)
									   ITEM
									   (CDR LIST))))
					  (T (CONS ITEM (CDR LIST))))))))

(DEFINE DIV-UPDATE-R . (LAMBDA (R A)
			 (TRUNCATE ZERO (CONS (CAR A) R))))

(DEFINE DIV-UPDATE-Q . (LAMBDA (Q I)
			 (REPLACE-NTH (CDR I) T Q)))

(DEFINE DIV-LOOP . (LAMBDA (I A B Q R)
		     (COND (I ((LAMBDA (R2)
				 (COND ((LESS R2 B) (DIV-LOOP (CDR I) (CDR A) B Q R2))
				       (T (DIV-LOOP (CDR I)
						    (CDR A)
						    B
						    (DIV-UPDATE-Q Q I)
						    (SUBTRACT R2 B)))))
			       (DIV-UPDATE-R R A)))
			   (T (CONS Q R)))))

(DEFINE DIVIDE . (LAMBDA (A B) (DIV-LOOP ZERO (REVERSE A) B ZERO ZERO)))

(DEFINE NUMBER->DIGIT . (LAMBDA (N)
			  (COND ((CAR N) (COND ((CAR (CDR N)) (COND ((CAR (CDR (CDR N))) (QUOTE 7))
								    (T (QUOTE 3))))
					       (T (COND ((CAR (CDR (CDR N))) (QUOTE 5))
							(T (COND ((CAR (CDR (CDR (CDR N)))) (QUOTE 9))
								 (T (QUOTE 1))))))))
				(T (COND ((CAR (CDR N)) (COND ((CAR (CDR (CDR N))) (QUOTE 6))
							      (T (QUOTE 2))))
					 (T (COND ((CAR (CDR (CDR N))) (QUOTE 4))
						  (T (COND ((CAR (CDR (CDR (CDR N)))) (QUOTE 8))
							   (T (QUOTE 0)))))))))))

(DEFINE PRINT-NUMBER_ . (LAMBDA (A)
			  (COND ((LESS A ONE) NIL)
				(T ((LAMBDA (DIVIDE-RESULT)
				      (CONS (NUMBER->DIGIT (CDR DIVIDE-RESULT))
					    (PRINT-NUMBER_ (CAR DIVIDE-RESULT))))
				    (DIVIDE A TEN))))))

(DEFINE PRINT-NUMBER . (LAMBDA (A) (REVERSE (PRINT-NUMBER_ A))))

(DEFINE FOUR-MILLION . (NIL NIL NIL NIL NIL NIL NIL NIL T NIL NIL T NIL NIL NIL NIL T NIL T T T T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))

(DEFINE EVENP . (LAMBDA (A) (NOT (CAR A))))

(DEFINE FIB_ . (LAMBDA (LIMIT SEQUENCE)
		 ((LAMBDA (NEXT)
		    (COND ((LESS NEXT LIMIT) (FIB_ LIMIT (CONS NEXT SEQUENCE)))
			  (T SEQUENCE)))
		  (ADD (CAR SEQUENCE) (CAR (CDR SEQUENCE))))))

(DEFINE FIB . (LAMBDA (LIMIT) (FIB_ LIMIT (CONS TWO (CONS ONE NIL)))))

(DEFINE EVEN-FIB_ . (LAMBDA (A SUM)
		      (COND (A (EVEN-FIB_ (CDR A)
					  (COND ((EVENP (CAR A)) (ADD SUM (CAR A)))
						(T SUM))))
			    (T SUM))))

(DEFINE EVEN-FIB . (LAMBDA (LIMIT) (EVEN-FIB_ (FIB LIMIT) ZERO)))

(PRINT-NUMBER (EVEN-FIB FOUR-MILLION))