(define apply-continuation
  (lambda (k . list-of-values)
    (apply k list-of-values)))

(define fact-acc
  (lambda (n acc)
    (if (zero? n)
	acc
	(fact-acc (- n 1) (* acc n)))))

(define fact-cps
  (trace-lambda fact-cps (n k)
    (if (zero? n)
	(apply-continuation k 1)
	(fact-cps (- n 1)
		  (lambda (v)
		    (apply-continuation k (* n v)))))))

(define list-copy-cps
  (lambda (L k)
    (if (null? L)
	(apply-continuation k '())
	(list-copy-cps (cdr L)
		       (lambda (v)
			 (apply-continuation k (cons (car L) v))))))) 


(define memq-cps
  (lambda (sym ls k)
    (cond [(null? ls) (apply-continuation k #f)]
	  [(eq? sym (car ls))
	   (apply-continuation k #t)]
	  [else
	   (memq-cps sym (cdr ls) k)])))
		     

(define intersection  ; convert this to CPS
  (lambda (los1 los2)
    (cond
     [(null? los1) '()]
     [(memq (car los1) los2)
      (cons (car los1)
            (intersection (cdr los1) los2))]
     [else (intersection (cdr los1) los2)])))


(define intersection-cps
  (lambda (los1 los2 k)
    (if (null? los1) 
	(apply-continuation k '())
	(intersection-cps (cdr los1) los2
	       (lambda (intersection-with-cdr)
		 (memq-cps (car los1) los2
			   (lambda (car-in-los2)
			     (apply-continuation k
						 (if car-in-los2
						     (cons (car los1) intersection-with-cdr)
						     intersection-with-cdr)))))))))
(intersection-cps
 '(a d e g h) '(s f c h b r a) list)
    



(define free-vars ; convert to CPS
  (lambda (exp)
    (cond [(symbol? exp) (list exp)]
	  [(eq? (1st exp) 'lambda)       
	   (remove (car (2nd exp)) 
		   (free-vars (3rd exp)))]      
	  [else (union (free-vars (1st exp))
		       (free-vars (2nd exp)))])))

(define free-vars-cps ; convert to CPS
  (lambda (exp k)
    (cond [(symbol? exp) (apply-continuation k (list exp))]
	  [(eq? (1st exp) 'lambda)       
	   (free-vars-cps (3rd exp)
		      (lambda (free-vars-from-body)
			(remove-cps (car (2nd exp)) free-vars-from-body k)))]
	  [else (free-vars-cps (1st exp)
		    (lambda (free-vars-from-proc)
		      (free-vars-cps (2nd exp)
			    (lambda (free-vars-from-rand)
			      (union-cps free-vars-from-proc free-vars-from-rand k)))))])))


;(union (free-vars (1st exp))
;		       (free-vars (2nd exp)))])))





(define substitute-leftmost
  (lambda (new old slist)
    (subst-left-cps
      new
      old
      slist
      (lambda (v) v)     ; succeed continuation
      (lambda () slist)  ; fail continuation
     )))

(define subst-left-cps
  (lambda (new old slist changed unchanged)
    (let loop ([slist slist] 
               [changed changed] 
               [unchanged unchanged])
      (cond
       [(null? slist) (apply-continuation unchanged)]
       [(symbol? (car slist)) 
	(if (eq? (car slist) old)
	    (apply-continuation changed (cons new (cdr slist)))
	    (loop (cdr slist) 
		  (lambda (substituted-cdr)
		    (apply-continuation changed (cons (car slist) substituted-cdr)))
		  unchanged))]
       [else
	(loop (car slist)
	      (lambda (substituted-car)
		(apply-continuation changed (cons substituted-car (cdr slist))))
	      (lambda ()
		(loop (cdr slist) 
		      (lambda (substituted-cdr)
			(apply-continuation changed (cons (car slist) substituted-cdr)))
		      unchanged)))]))))
.