;;;;;;;;;;;;;;;;;;;;
;;; Question 1-a ;;;
;;;;;;;;;;;;;;;;;;;;

(define sym-prefix
  (lambda (ls)
    (sym-prefix-cps ls 
      (lambda (v)
          (set! result v)
          'done))))

(define sym-prefix-cps
  (lambda (ls k)
    (if (or (null? ls)
            (symbol? (car ls)))
        (k '())
        (sym-prefix-cps (cdr ls)
          (lambda (v)
            (k (cons (car ls) v)))))))


;;;;;;;;;;;;;;;;;;;;
;;; Question 1-b ;;;
;;;;;;;;;;;;;;;;;;;;

(define found?
  (lambda (s ls)
    (found?-cps s ls
      (lambda (v)
          (set! result v)
          'done))))

(define found?-cps
  (lambda (s ls k)
    (cond
      ((null? ls) (k #f))
      ((eq? s (car ls))  (k #t))
      (else (found?-cps s (cdr ls) k)))))


;;;;;;;;;;;;;;;;;;;;
;;; Question 1-c ;;;
;;;;;;;;;;;;;;;;;;;;

(define double
  (lambda (f-cps)
    (double-cps f-cps
      (lambda (v)
          (set! result v)
          'done))))

(define double-cps
  (lambda (f-cps k)
    (k (lambda (x k)
         (f-cps x
           (lambda (v)
             (f-cps v k)))))))


;;;;;;;;;;;;;;;;;;
;;; Question 2 ;;;
;;;;;;;;;;;;;;;;;;

(define sym-prefix
  (lambda (ls)
    (sym-prefix-cps ls (make-init-k))))

(define sym-prefix-cps
  (lambda (ls k)
    (if (or (null? ls)
            (symbol? (car ls)))
        (apply-cont k '())
        (sym-prefix-cps (cdr ls) (make-cont-1 ls k)))))

(define init-k
  (lambda (v)
    (set! result v)
    'done)))      

(define make-init-k
  (lambda ()
    init-k))

(define make-cont-1
  (lambda (ls k)
    (lambda (v)
      (apply-cont k (cons (car ls) v)))))

(define apply-cont
  (lambda (k x)
    (k x)))


;;;;;;;;;;;;;;;;;;
;;; Question 3 ;;;
;;;;;;;;;;;;;;;;;;

(define sym-prefix
  (lambda (ls)
    (sym-prefix-cps ls (make-init-k))))

(define sym-prefix-cps
  (lambda (ls k)
    (if (or (null? ls)
            (symbol? (car ls)))
        (apply-cont k '())
        (sym-prefix-cps (cdr ls) (make-cont-1 ls k)))))

(define make-init-k
  (lambda ()
    (list 'init-k)))

(define make-cont-1
  (lambda (ls k)
    (list 'cont-1 ls k)))

(define apply-cont
  (lambda (k x)
    (case (car k)
      ((init-k) (set! result x)
                'done)
      ((cont-1) (apply-cont (caddr k) (cons (car (cadr k)) x))))))


;;;;;;;;;;;;;;;;;;
;;; Question 4 ;;;
;;;;;;;;;;;;;;;;;;

(define sym-prefix
  (lambda (ls)
    (set! val-reg 'ignored)
    (set! ls-reg ls)
    (set! k-reg (make-init-k))
    (sym-prefix-cps/reg)))

(define sym-prefix-cps/reg
  (lambda ()
    (if (or (null? ls-reg)
            (symbol? (car ls-reg)))
        (begin
          (set! val-reg '())
          (apply-cont))
        (begin
          (set! k-reg (make-cont-1 ls-reg k-reg))
          (set! ls-reg (cdr ls-reg))
          (sym-prefix-cps/reg)))))

(define make-init-k
  (lambda ()
    (list 'init-k)))

(define make-cont-1
  (lambda (ls k)
    (list 'cont-1 ls k)))

(define apply-cont
  (lambda ()
    (case (car k-reg)
      (init-k (set! result val-reg)
              'done)
      (cont-1 (begin
                (set! val-reg (cons (car (cadr k-reg)) val-reg))
                (set! k-reg (caddr k-reg))
                (apply-cont))))))


;;;;;;;;;;;;;;;;;;
;;; Question 5 ;;;
;;;;;;;;;;;;;;;;;;

;;; stack implementation ;;;

(define stack-size 100)
(define the-stack (make-vector stack-size '*))
(define stack-pointer -1)

(define push!
  (lambda (v)
    (set! stack-pointer (+ 1 stack-pointer))
    (if (>= stack-pointer stack-size) (error 'push! "Stack overflow"))
    (vector-set! the-stack stack-pointer v)))

(define pop!
  (lambda ()
    (if (< stack-pointer 0) (error 'pop! "Stack underflow"))
    (set! stack-pointer (- stack-pointer 1))
    (vector-ref the-stack (+ stack-pointer 1))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define sym-prefix
  (lambda (ls)
    (set! val-reg 'ignored)
    (set! ls-reg ls)
    (push! (make-init-k))
    (sym-prefix-cps/reg)))

(define sym-prefix-cps/reg
  (lambda ()
    (if (or (null? ls-reg)
            (symbol? (car ls-reg)))
        (begin
          (set! val-reg '())
          (apply-cont))
        (begin
          (push! (make-cont-1 ls-reg (pop!)))
          (set! ls-reg (cdr ls-reg))
          (sym-prefix-cps/reg)))))

(define make-init-k
  (lambda ()
    (list 'init-k)))

(define make-cont-1
  (lambda (ls k)
    (list 'cont-1 ls k)))

(define apply-cont
  (lambda ()
    (let ((k (pop!)))
      (case (car k)
        (init-k (set! result val-reg)
                'done)
        (cont-1 (begin
                  (set! val-reg (cons (car (cadr k)) val-reg))
                  (push! (caddr k))
                  (apply-cont)))))))


;;;;;;;;;;;;;;;;;;;;
;;; Question 6-a ;;;
;;;;;;;;;;;;;;;;;;;;

(define sym-prefix
  (lambda (ls)
    (sym-prefix-cps ls 
      (lambda (v)
          (set! result v)
          'done))))

(define sym-prefix-cps
  (lambda (ls k)
    (cond
      ((null? ls) #f)
      ((symbol? (car ls)) (k '()))
      (else (sym-prefix-cps (cdr ls)
              (lambda (v)
                (k (cons (car ls) v))))))))


;;;;;;;;;;;;;;;;;;;;
;;; Question 6-b ;;;
;;;;;;;;;;;;;;;;;;;;

(define sym-prefix
  (lambda (ls)
    (call/cc
      (lambda (k)
        (letrec 
          ((local-loop
             (lambda (ls) 
               (cond
                 ((null? ls) (k #f))
                 ((symbol? (car ls)) '())
                 (else (cons (car ls) (local-loop (cdr ls))))))))
          (local-loop ls))))))