(define (residualize v)
  (set! count 0)
  (set! registered '())
  (resid v))


(define (resid v)
  (cond
   ((number? v) v)
   ((boolean? v) v)
   ((char? v) v)
   ((string? v) v)
   ((vector? v) v)
   ((symbol? v) (list 'quote v))
   ((null? v) v)
   ((pair? v) (list 'cons (resid (car v)) (resid (cdr v))))
   ((procedure? v)
    (if (memq v registered)
	(v special)
	(let ((x (gensym)))
	  (arity_raise x (resid (apply v (uparrow_list x 10)))))))))


(define (uparrow e)
  (let ((f (lambda v
	     (if (eq? (car v) special)
		 e
		 (uparrow (cons e (map resid v)))))))
    (set! registered (cons f registered))
    f))

(define (uparrow_list x n)
  (if (= n 0) (list (uparrow (list 'car x)))
      (cons (uparrow (list 'car x)) (uparrow_list (list 'cdr x) (- n 1)))))

(define (arity_raise x e)
  (let* ((mcdr (max_cdr x e))
	 (alist (append (map (lambda (x) (gensym)) (m_list mcdr)) (gensym)))
	 (newe (replace_cdr x e alist)))
    (list 'lambda alist newe)))

(define (m_list n)
  (if (= n 0) ()
      (cons () (m_list (- n 1)))))

(define (max_cdr x e)
  (cond
   ((number? e) 0)
   ((boolean? e) 0)
   ((char? e) 0)
   ((string? e) 0)
   ((vector? e) 0)
   ((symbol? e) 0)
   ((null? e) 0)
   ((pair? e)
    (if (equal? (car e) 'car)
	(count_cdr x (car (cdr e)) 1)
	(max (max_cdr x (car e)) (max_cdr x (cdr e)))))))

(define (count_cdr x e n)
  (cond
   ((eq? x e) n)
   ((and (pair? e) (equal? (car e) 'cdr))
    (count_cdr x (car (cdr e)) (+ 1 n)))
   (else 0)))

(define (replace_cdr x e alist)
  (cond
   ((number? e) e)
   ((boolean? e) e)
   ((char? e) e)
   ((string? e) e)
   ((vector? e) e)
   ((symbol? e) e)
   ((null? e) e)
   ((pair? e)
    (if (equal? (car e) 'car)
	(replace_cdr1 x (car (cdr e)) alist (lambda (e) (list 'car e)))
	(cons (replace_cdr x (car e) alist) (replace_cdr x (cdr e) alist))))))

(define (replace_cdr1 x e alist builder)
  (cond
   ((eq? x e) (car alist))
   ((and (pair? e) (equal? (car e) 'cdr))
    (replace_cdr1 x (car (cdr e)) (cdr alist)
		  (lambda (e) (list 'cdr (builder e)))))
   (else (builder e))))

(define registered '())

(define count 0)

(define special '(special))

(define (gensym)
  (set! count (+ 1 count))
  (string->symbol (string-append "x" (number->string count))))