;;; Continuation examples

;;; EOPL1 examples

;;; Length

(define (lengthx ls)
  (if (null? ls) 
      0
      (+ (lengthx (cdr ls)) 1)))

;;; Continuation-passing style

(define (length-cps ls k) ;;; k is the continuation
  (if (null? ls)
      (k 0)
      (length-cps (cdr ls)
                  (lambda (v) (k (+ v 1))))))

;;; Initial call

(length-cps '(1 2 3 4 5 6) (lambda (v) v)) ;;; ==> 6

;;; Substitution

(define (substx new old exp)
  (cond ((null? exp) '())
        ((not (pair? (car exp)))
         (if (eq? (car exp) old)
             (cons new (substx new old (cdr exp)))
             (cons (car exp) (substx new old (cdr exp)))))
        (else (cons (substx new old (car exp))
                    (substx new old (cdr exp))))))

(substx 10 'x '(+ x (* x y z))) ;;; ==> (+ 10 (* 10 y z))

;;; Continuation-passing style

(define (subst-cps new old exp k)
  (cond ((null? exp) (k '()))
        ((not (pair? (car exp)))
         (if (eq? (car exp) old)
             (subst-cps new old (cdr exp)
                (lambda (v) (k (cons new v))))
             (subst-cps new old (cdr exp)
                (lambda (v) (k (cons (car exp) v))))))
        (else (subst-cps new old (car exp)
                (lambda (v)
                  (subst-cps new old (cdr exp)
                    (lambda (v1) (k (cons v v1)))))))))
            
(subst-cps 10 'x '(+ x (* x y z)) (lambda (v) v)) ;;; ==> (+ 10 (* 10 y z))

;;; Data structure representation of continuations
;;; (to avoid introduction of new procedures)

(define (subst-final new old exp)
  (subst-rep new old exp (make-final-val)))

(define (subst-rep new old exp k)
  (cond ((null? exp) (apply-cont k '()))
        ((not (pair? (car exp)))
         (if (eq? (car exp) old)
             (subst-rep new old (cdr exp)
                        (make-subst1 new k))
             (subst-rep new old (cdr exp)
                        (make-subst2 exp k))))
        (else (subst-rep new old (car exp)
                         (make-subst3 new old exp k)))))

(define (make-final-val) (list 'final-val))
(define (make-subst1 new k) (list 'subst1 new k))
(define (make-subst2 exp k) (list 'subst2 exp k))
(define (make-subst3 new old exp k) 
  (list 'subst3 new old exp k))

(define (apply-cont k v)
  (case (car k)
    ((final-val) v)
    ((subst1) (apply-cont (caddr k) (cons (cadr k) v)))
    ((subst2) (apply-cont (caddr k) (cons (car (cadr k)) v)))
    ((subst3) 
     (subst-rep (cadr k) (caddr k) (cdr (cadddr k)) 
                (make-subst1 v (caddddr k))))
    (else (error "Invalid continuation:" k))))

(define (caddddr x) (cadr (cdddr x)))

(subst-final 10 'x '(+ x (* x y z))) ;;; ==> (+ 10 (* 10 y z))

;;; Note that subst-final is a tail-recursive function.

;;; Completely iterative (first-order imperative-form)
;;; version of this definitition.

;;; To be completed.  See EOPL1, Fig. 10.1.1.