;; Examples for using continuation-passing style to make something
;;  easier to use or implement.

;; Example 1: simple use of continuation-passing style
;;            to distinguish success and failure

;; An assoc is (cons sym num)

;; find-in-list : list-of-assoc sym (num -> X) (-> X) -> X
(define (find-in-list l s find-k fail-k)
  (cond
    [(null? l) (fail-k)]
    [else (if (eq? s (car (car l)))
              (find-k (cdr (car l)))
              (find-in-list (cdr l) s find-k fail-k))]))

(find-in-list '() 'b number->string (lambda () #f)) "should be" #f
(find-in-list '((a . 1) (b . 2)) 'b number->string (lambda () #f)) "should be" "2"
(find-in-list '((a . 1) (b . 2)) 'c number->string (lambda () #f)) "should be" #f


;; Example 2: using continuation-passing style
;;            for a parsimonious replace

;; A symtree is either
;;  - symbol
;;  - (cons symtree symtree)

;; replace : symtree sym sym -> symtree
;;  allocates only as many cons cells
;;  as absolutely necessary (remaining functional)
(define (replace st old new)
  (replace* st old new 
            ;; new-k:
            (lambda (st-new) st-new)
            ;; old-k:
            (lambda () st)))

(define (replace* st old new new-k old-k)
  (cond
    [(symbol? st) (if (eq? st old)
                      (new-k new)
                      (old-k))]
    [(pair? st) (replace* (car st) old new
                          (lambda (new-car-st)
                            (replace* (cdr st) old new
                                      (lambda (new-cdr-st)
                                        ;; Both car & cdr changed:
                                        (new-k (cons new-car-st new-cdr-st)))
                                      (lambda ()
                                        ;; Only car changed:
                                        (new-k (cons new-car-st (cdr st))))))
                          (lambda ()
                            (replace* (cdr st) old new
                                      (lambda (new-cdr-st)
                                        ;; Only car changed:
                                        (new-k (cons (car st) new-cdr-st)))
                                      ;; If neither changed:
                                      old-k)))]))

(define st1 '(a . b))
(define st2 '((a . b) . (c . d)))

(replace st1 'a 'x) "should be" '(x . b)
(replace st1 'b 'x) "should be" '(a . x)

(define no-change-st (replace st2 'y 'x))
(eq? st1 no-change-st) "should be" #t

(define car-change-st (replace st2 'a 'x))
car-change-st "should be" '((x . b) . (c . d))
(eq? (cdr st2) (cdr car-change-st)) "should be" #t

(define cdr-change-st (replace st2 'd 'x))
cdr-change-st "should be" '((a . b) . (c . x))
(eq? (car st2) (car cdr-change-st)) "should be" #t