(load "record.ss")

(define depth-cps
  (lambda (ls k)
    (cond
      ((null? ls) (k 1))
      ((list? (car ls))
       (depth-cps (car ls)
	 (lambda (v)
	   (depth-cps (cdr ls)
	     (lambda (w)
	       (k (max (add1 v) w)))))))
      (else (depth-cps (cdr ls) k)))))

(define substq-cps
  (lambda (new old ls k)
    (cond
      ((null? ls) (k '()))
      ((eq? (car ls) old)
       (substq-cps new old (cdr ls)
	 (lambda (v)
	   (k (cons new v)))))
      (else
	(substq-cps new old (cdr ls)
	  (lambda (v)
	    (k (cons (car ls) v))))))))

(define ack-cps
  (lambda (x y k)
    (cond
      ((= y 0) (k 0))
      ((= x 0) (k (* 2 y)))
      ((= y 1) (k 2))
      (else
	(ack-cps x (sub1 y)
	  (lambda (v)
	    (ack-cps (sub1 x) v k)))))))

;; ----

(define-record head-depth-k (ls k))
(define-record tail-depth-k (head-depth k))
(define-record init-depth-k ())

(define depth-cps-ri
  (lambda (ls k)
    (cond
      ((null? ls) (apply-depth-k k 1))
      ((list? (car ls))
       (depth-cps-ri (car ls)
	 (make-head-depth-k ls k)))
      (else (depth-cps-ri (cdr ls) k)))))

(define apply-depth-k
  (lambda (k v)
    (variant-case k
      (init-depth-k () v)
      (head-depth-k (ls k)
	(depth-cps-ri (cdr ls)
	  (make-tail-depth-k v k)))
      (tail-depth-k (head-depth k)
	(apply-depth-k k (max (add1 head-depth) v)))
      (else
	(error 'apply-depth-k "Bad k: ~s" k)))))

;; ----

(define-record in-substq-k (new k))
(define-record out-substq-k (ls k))
(define-record init-substq-k ())

(define substq-cps-ri
  (lambda (new old ls k)
    (cond
      ((null? ls) (apply-substq-k k '()))
      ((eq? (car ls) old)
       (substq-cps-ri new old (cdr ls)
	 (make-in-substq-k new k)))
      (else
	(substq-cps-ri new old (cdr ls)
	  (make-out-substq-k ls k))))))

(define apply-substq-k
  (lambda (k v)
    (variant-case k
      (init-substq-k () v)
      (in-substq-k (new k)
	(apply-substq-k k (cons new v)))
      (out-substq-k (ls k)
	(apply-substq-k k (cons (car ls) v)))
      (else
	(error 'apply-substq-k "Bad k: ~s" k)))))

;; ----

(define-record ack-k (x k))
(define-record init-ack-k ())

(define ack-cps-ri
  (lambda (x y k)
    (cond
      ((= y 0) (apply-ack-k k 0))
      ((= x 0) (apply-ack-k k (* 2 y)))
      ((= y 1) (apply-ack-k k 2))
      (else
	(ack-cps-ri x (sub1 y)
	  (make-ack-k x k))))))

(define apply-ack-k
  (lambda (k v)
    (variant-case k
      (init-ack-k () v)
      (ack-k (x k)
	(ack-cps-ri (sub1 x) v k))
      (else
	(error 'apply-ack-k "Bad k: ~s" k)))))