;; hilsdale
;; c311, Spring 1996
;; Solutions to assignment eight, more CPS

(define f-cps
  (lambda (l k)
    (if (null? l)
	(k 0)
	(g l
	  (lambda (test)
	    (if test
		(f-cps (car l)
		  (lambda (v)
		    (k (+ 1 v))))
		(f-cps (car l)
		  (lambda (v)
		    (f-cps (cdr l)
		      (lambda (w)
			(k (+ v w))))))))))))

(define mystery-cps
  (lambda (n k)
    (letrec
      ((mystery-helper
         (lambda (n s k)
           (cond
             ((zero? n) (k (list s)))
             (else
	       (mystery-helper (sub1 n) (cons 0 s)
		 (lambda (v)
		   (mystery-helper (sub1 n) (cons 1 s)
		     (lambda (w)
		       (k (append v w)))))))))))
      (mystery-helper n '() k))))

(define deep-recur-cps
  (lambda (seed item-proc list-proc k)
    (letrec
      ((helper
         (lambda (ls k)
           (if (null? ls)
               (k seed)
               (let ((a (car ls)))
                 (if (or (pair? a) (null? a))
		     (helper a
		       (lambda (v)
			 (helper (cdr ls)
			   (lambda (w)
			     (list-proc v w k)))))
		     (helper (cdr ls)
		       (lambda (v)
			 (item-proc a v k)))))))))
      (k helper))))

(define map-cps
  (lambda (f ls k)
    (if (null? ls)
	(k '())
	(f (car ls)
	  (lambda (v)
	    (map-cps f (cdr ls)
	      (lambda (w)
		(k (cons v w)))))))))

(define add>n
  (lambda (ls n)
    (cond
      ((null? ls) 0)
      ((> (car ls) n)
       (+ (car ls) (add>n (cdr ls) n)))
      (else
	(add>n (cdr ls) n)))))

(define add>n-cps
  (lambda (ls n k)
    (cond
      ((null? ls) (k 0))
      ((> (car ls) n)
       (add>n-cps (cdr ls) n
	 (lambda (v)
	   (k (+ (car ls) v)))))
      (else
	(add>n-cps (cdr ls) n k)))))

(define what-happens-cps
  (lambda (x1 x2 f k)
    (cond
      [(null? x1) (k x2)]
      [(symbol? (car x1)) (k (cons x1 x2))]
      [else
	(let ((tmp (car x1)))
	  (let ((f2 (lambda (x k) (k (cons x 'a)))))
	    (what-happens-cps (car x1) x2 f2
	      (lambda (head)
		(what-happens-cps (cdr x1) x2 f2
		  (lambda (tail)
		    (f (cons tmp (cons head tail)) k)))))))])))