C311 script9.txt -- 3/10/97

---

IMPERATIVE FORM AND STACK ARCHITECTURE

---

First, the CPS conversion of SUBST.

> (define subst
    (lambda (new old s)
      (subst-cps new old s (lambda (x) x))))

> (define subst-cps
    (lambda (new old s k)
      (if (pair? s)
        (subst-cps new old (car s)
          (lambda (v)
            (subst-cps new old (cdr s)
              (lambda (w)
                (k (cons v w))))))
        (if (eq? s old) (k new) (k s)))))

> (subst 'a 'b '(a b c b))
(a a c a)

---

Now continuations as data structures and REGISTER FORM.

> (define make-final-valcont (lambda () '(final-valcont)))
> (define make-subst1-cont (lambda (s k) (list 'subst1-cont s k)))
> (define make-subst2-cont (lambda (v k) (list 'subst2-cont v k)))

> (define new-reg '*)
> (define s-reg '*)
> (define old-reg '*)
> (define k-reg '*)
> (define v-reg '*)

> (define subst
    (lambda (new old s)
      (set! k-reg (make-final-valcont))
      (set! new-reg new)
      (set! old-reg old)
      (set! s-reg s)
      (subst-cps/reg)))

> (define subst-cps/reg
    (lambda ()
      (if (pair? s-reg)
        (begin (set! k-reg (make-subst1-cont s-reg k-reg))
	  (set! s-reg (car s-reg))
	  (subst-cps/reg))
        (if (eq? s-reg old-reg)
	  (begin (set! v-reg new-reg)
	    (apply-continuation/reg))
	  (begin (set! v-reg s-reg)
	    (apply-continuation/reg))))))

> (define apply-continuation/reg
    (lambda ()
      (record-case k-reg
	(final-valcont () v-reg)
	(subst1-cont (s k)
	  (set! k-reg (make-subst2-cont v-reg k))
	  (set! s-reg (cdr s))
	  (subst-cps/reg))
	(subst2-cont (v k)
	  (set! k-reg k)
	  (set! v-reg (cons v v-reg))
	  (apply-continuation/reg)))))

> (subst 'a 'b '(a b c b))
(a a c a)

---

FRAMED CONTINUATION form.

> (define make-final-valframe (lambda () '(final-valframe)))
> (define make-subst1-frame (lambda (s) (list 'subst1-frame s)))
> (define make-subst2-frame (lambda (v) (list 'subst2-frame v)))

> (define make-final-valcont
    (lambda ()
      (cons (make-final-valframe) '())))

> (define make-subst1-cont
    (lambda (s k)
      (cons (make-subst1-frame s) k)))

> (define make-subst2-cont
    (lambda (v k)
      (cons (make-subst2-frame v) k)))

> (define apply-continuation/reg
    (lambda ()
      (let ((frame (car k-reg)) (k (cdr k-reg)))
	(record-case frame
	  (final-valframe () v-reg)
	  (subst1-frame (s)
	    (set! k-reg (make-subst2-cont v-reg k))
	    (set! s-reg (cdr s))
	    (subst-cps/reg))
	  (subst2-frame (v)
	    (set! k-reg k)
	    (set! v-reg (cons v v-reg))
	    (apply-continuation/reg))))))

> (subst 'a 'b '(a b c b))
(a a c a)

---

Stack ADT

> (begin
    (define empty? 'ignored)
    (define push! 'ignored)
    (define pop! 'ignored)
    (define top 'ignored))

> (let ((stk '()))
    (set! empty?
      (lambda ()
	(null? stk)))
    (set! push!
      (lambda (x)
	(set! stk (cons x stk))))
    (set! pop!
      (lambda ()
	(if (empty?)
          (error "Stack empty")
          (set! stk (cdr stk)))))    
    (set! top
      (lambda ()
	(if (empty?)
          (error "Stack empty")
          (car stk)))))

---

FRAMED STACK form.

> (define subst
    (lambda (new old s)
      (push! (make-final-valframe))
      (set! new-reg new)
      (set! old-reg old)
      (set! s-reg s)
      (subst-cps/reg)))

> (define subst-cps/reg
    (lambda ()
      (if (pair? s-reg)
        (begin
          (push! (make-subst1-frame s-reg))
          (set! s-reg (car s-reg))
          (subst-cps/reg))
        (if (eq? s-reg old-reg)
	  (begin 
	    (set! v-reg new-reg)
	    (apply-continuation/reg))
	  (begin 
	    (set! v-reg s-reg)
	    (apply-continuation/reg))))))

> (subst 'a 'b '(a b c b))
(a a c a)

---

UNFRAMED STACK form.

> (define apply-continuation/reg
    (lambda ()
      (let ((frame (top)))
	(pop!)
	(record-case frame
	  (final-valframe () v-reg)
	  (subst1-frame (s)
	    (push! (make-subst2-frame v-reg))
	    (set! s-reg (cdr s))
	    (subst-cps/reg))
	  (subst2-frame (v)
	    (set! v-reg (cons v v-reg))
	    (apply-continuation/reg))))))

> (define subst
    (lambda (new old s)
      (push! 'final-valframe)
      (set! new-reg new)
      (set! old-reg old)
      (set! s-reg s)
      (subst-cps/reg)))

> (define subst-cps/reg
    (lambda ()
      (if (pair? s-reg)
        (begin (push! s-reg)
	  (push! 'subst1-frame)
	  (set! s-reg (car s-reg))
	  (subst-cps/reg))
        (if (eq? s-reg old-reg)
	  (begin (set! v-reg new-reg)
	    (apply-continuation/reg))
	  (begin (set! v-reg s-reg)
	    (apply-continuation/reg))))))

> (define apply-continuation/reg
    (lambda ()
      (let ((frame-tag (top)))
	(pop!)
	(case frame-tag
	  ((final-valframe) v-reg)
	  ((subst1-frame)
	   (let ((s (top)))
	     (pop!)
	     (push! v-reg)
	     (push! 'subst2-frame)
	     (set! s-reg (cdr s))
	     (subst-cps/reg)))
	  ((subst2-frame)
	   (let ((v (top)))
	     (pop!)
	     (set! v-reg (cons v v-reg))
	     (apply-continuation/reg)))))))

> (subst 'a 'b '(a b c b))
(a a c a)

---

END

---