(let ((zero ())
      (one (cons #t ()))
      (two (cons #f (cons #t ())))
      (three (cons #t (cons #t ())))
      (four (cons #f (cons #f (cons #t ()))))
      (five (cons #t (cons #f (cons #t ()))))
      (six (cons #f (cons #t (cons #t ()))))
      (seven (cons #t (cons #t (cons #t ()))))
      (eight (cons #f (cons #f (cons #f (cons #t ())))))
      (nine (cons #t (cons #f (cons #f (cons #t ())))))
      (ten (cons #f (cons #t (cons #f (cons #t ()))))))
  (letrec ((interpret-digit (lambda ()
			      (cond ((read-char=? #\0)
				     (cons #t zero))
				    ((read-char=? #\1)
				     (cons #t one))
				    ((read-char=? #\2)
				     (cons #t two))
				    ((read-char=? #\3)
				     (cons #t three))
				    ((read-char=? #\4)
				     (cons #t four))
				    ((read-char=? #\5)
				     (cons #t five))
				    ((read-char=? #\6)
				     (cons #t six))
				    ((read-char=? #\7)
				     (cons #t seven))
				    ((read-char=? #\8)
				     (cons #t eight))
				    ((read-char=? #\9)
				     (cons #t nine))
				    (else
				     (cons #f zero)))))
	   (whole-add (lambda (i1 i2)
			(let add ((i1 i1) (i2 i2) (c #f))
			     (cond ((and (null? i1) (null? i2))
				    (if c
					(cons c ())
					()))
				   ((null? i1)
				    (if c
					(add (cons c ()) i2 #f)
					i2))
				   ((null? i2)
				    (add i2 i1 c))
				   (else
				    (let ((d1 (car i1))
					  (r1 (cdr i1))
					  (d2 (car i2))
					  (r2 (cdr i2)))
				      (cond ((and (not d1) (not d2) (not c))
					     (cons #f (add r1 r2 #f)))
					    ((or (and d1 (not d2) (not c))
						 (and (not d1) d2 (not c))
						 (and (not d1) (not d2) c))
					     (cons #t (add r1 r2 #f)))
					    ((or (and d1 d2 (not c))
						 (and d1 (not d2) c)
						 (and (not d1) d2 c))
					     (cons #f (add r1 r2 #t)))
					    (else
					     (cons #t (add r1 r2 #t))))))))))
	   (whole-sub (lambda (i1 i2)
			(letrec ((sub (lambda (i1 i2 c)
					(cond ((null? i1)
					       ())
					      ((and (null? i2) (not c))
					       i1)
					      ((and (null? i2) c)
					       (if (car i1)
						   (cons #f (cdr i1))
						   (cons #t (sub (cdr i1) () #t))))
					      (else
					       (let ((d1 (car i1))
						     (r1 (cdr i1))
						     (d2 (car i2))
						     (r2 (cdr i2)))
						 (cond ((and d1 (not d2) (not c))
							(cons #t (sub r1 r2 #f)))
						       ((or (and d1 (or (and d2 (not c))
									(and (not d2) c)))
							    (and (not d1) (not d2) (not c)))
							(cons #f (sub r1 r2 #f)))
						       ((or (and d1 d2 c)
							    (and (not d1) (or (and d2 (not c))
									      (and (not d2) c))))
							(cons #t (sub r1 r2 #t)))
						       ((and (not d1) d2 c)
							(cons #f (sub r1 r2 #t))))))))))
				(whole-normalize (sub i1 i2 #f)))))
	   (whole-normalize (lambda (i)
			      (if (null? i)
				  ()
				  (let ((r (whole-normalize (cdr i))))
				    (if (and (not (car i)) (null? r))
					()
					(cons (car i) r))))))
	   (whole-mul (lambda (i1 i2)
			(letrec ((mul (lambda (i1)
					(cond ((null? i1)
					       ())
					      ((car i1)
					       (whole-add i2 (cons #f (mul (cdr i1)))))
					      (else
					       (cons #f (mul (cdr i1))))))))
				(whole-normalize (mul i1)))))
	   (whole-eq? (lambda (i1 i2)
			(cond ((and (null? i1) (null? i2))
			       #t)
			      ((and (not (null? i1)) (not (null? i2)))
			       (and (or (and (car i1) (car i2))
					(and (not (car i1)) (not (car i2))))
				    (whole-eq? (cdr i1) (cdr i2))))
			      (else
			       #f))))
	   (whole-less? (lambda (i1 i2)
			  (cond ((and (null? i1) (null? i2))
				 #f)
				((null? i1)
				 #t)
				((null? i2)
				 #f)
				((whole-less? (cdr i1) (cdr i2))
				 #t)
				((whole-eq? (cdr i1) (cdr i2))
				 (and (car i2) (not (car i1))))
				(else
				 #f))))
	   (whole-div-mod (lambda (i1 i2)
			    (letrec ((div (lambda (i1)
					    (cond ((null? i1)
						   (cons ()
							 ()))
						  ((whole-less? i1 i2)
						   (cons ()
							 i1))
						  ((whole-eq? i1 i2)
						   (cons (cons #t ())
							 ()))
						  (else
						   (let ((res (div (cdr i1))))
						     (let ((q (car res))
							   (r (whole-normalize (cons (car i1) (cdr res)))))
						       (if (not (whole-less? r i2))
							   (cons (cons #t q)
								 (whole-sub r i2))
							   (cons (cons #f q)
								 r)))))))))
				    (let ((res (div i1)))
				      (let ((q (car res))
					    (r (cdr res)))
					(cons (whole-normalize q)
					      r))))))
	   (whole-div (lambda (i1 i2)
			(car (whole-div-mod i1 i2))))
	   (print-number (lambda (i)
			   (let ((res (whole-div-mod i ten)))
			     (let ((q (car res))
				   (r (cdr res)))
			       (begin
				(if (not (whole-eq? q zero))
				    (print-number q)
				    #f)
				(cond ((whole-eq? r zero)
				       (write-char #\0))
				      ((whole-eq? r one)
				       (write-char #\1))
				      ((whole-eq? r two)
				       (write-char #\2))
				      ((whole-eq? r three)
				       (write-char #\3))
				      ((whole-eq? r four)
				       (write-char #\4))
				      ((whole-eq? r five)
				       (write-char #\5))
				      ((whole-eq? r six)
				       (write-char #\6))
				      ((whole-eq? r seven)
				       (write-char #\7))
				      ((whole-eq? r eight)
				       (write-char #\8))
				      ((whole-eq? r nine)
				       (write-char #\9))))))))
	   (read-number (lambda (so-far)
			  (if (read-char?)
			      (let ((digit (interpret-digit)))
				(if (car digit)
				    (read-number (whole-add (whole-mul ten so-far) (cdr digit)))
				    so-far))
			      so-far))))
	  (print-number (whole-add (read-number zero) (read-number zero)))))
