cps continuous passing style the little scheme

#lang sicp
;Continuation-passing Style
;collector

;build functions to collect more than one value at a time

;1.
;用于收集多个值
;函数的参数有多个，相当于用参数存储了多个值
;收集器有两部分，参数和函数体，参数用于收集多个值，函数体用于对多个值进行处理

;2.
;母函数和收集器，将原来母函数中的逻辑，放入collector中（非collector的body体）
;一个是如何收集值(母函数中的逻辑)（********重点*********）
;一个是对收集的值如何处理(collector的body体)

;3.
;收集器的一般方式
;第一步写出非collector的普通函数
;第二步将非collector的普通函数，改写为带collector的函数
;母函数的参数中，多添加一个参数，该参数为一个方法
;将母函数的操作放入collector中


;例子1
;删除一个list中的多个值，并收集不同的一个列表中，相同的到一个列表中
;例如list为(a b c d a e f)，删除a后为(b c d e f)

;第一步，写出非collector的函数
(define multirember
  (lambda (a lat)
    (cond
      ((null? lat) (quote ()))
      ((eq? (car lat) a)
       (multirember a (cdr lat)))
      (else (cons (car lat)
                  (multirember a (cdr lat)))))))
(newline)
(display (multirember 'a '(a b c d a e f)))

;第二步，改写为带collector的函数
(define multirember&co
  (lambda (a lat col)
    (cond
      ((null? lat) (col (quote ()) (quote ())));将原来的函数逻辑，改写到collector中
      ((eq? (car lat) a)
       (multirember&co a (cdr lat)
                       (lambda (newlat seen)
                         (col newlat (cons (car lat) seen)))))
      (else
       (multirember&co a (cdr lat)
                       (lambda (newlat seen)
                         (col (cons (car lat) newlat) seen)))))))

(newline)
;(display (multirember&co 'a '(a b c d a e f) (lambda (x y)
;                                                (null? y))))

(define a-friend
  (lambda (x y)
    (null? y)))
(display (multirember&co 'a '(a b c d a e f) a-friend))

(newline)
(define b-friend
  (lambda (x y)
    y))
(display (multirember&co 'a '(a b c d a e f) b-friend))

(newline)
(define c-friend
  (lambda (x y)
    x))
(display (multirember&co 'a '(a b c d a e f) c-friend))

(newline)
(define last-friend
  (lambda (x y)
    (length x)))
(display (multirember&co 'a '(a b c d a e f) last-friend))


;例子2
;插入多个
;new为salty oldL为fish oldR为chips 原list为(chips and fish or fish and chips)
;插入后的结果为(chips salty and salty fish or salty fish and chips salty)
;收集器的结果为(col newlat 2 2)

;第一步，原函数为
(define multiinsertLR
  (lambda (new oldL oldR lat)
    (cond
      ((null? lat) (quote ()))
      ((eq? (car lat) oldL)
       (cons new (cons oldL
                     (multiinsertLR new oldL oldR (cdr lat)))))
      ((eq? (car lat) oldR)
        (cons oldR (cons new
                      (multiinsertLR new oldL oldR (cdr lat)))))
      (else
       (cons (car lat) (multiinsertLR new oldL oldR (cdr lat)))))))


(newline)
(display (multiinsertLR 'salty 'fish 'chips '(chips and fish or fish and chips)))


 
(define add1
  (lambda (n)
    (+ n 1)))
;改写为带collector的函数
(define multiinsertLR&co
  (lambda (new oldL oldR lat col)
    (cond
      ((null? lat) (col (quote ()) 0 0))
      ((eq? (car lat) oldL)
       (multiinsertLR&co new oldL oldR (cdr lat)
                         (lambda (newlat L R)
                           (col (cons new (cons oldL newlat)) (add1 L) R))))
      ((eq? (car lat) oldR)
       (multiinsertLR&co new oldL oldR (cdr lat)
                         (lambda (newlat L R)
                           (col (cons oldR (cons new newlat)) L (add1 R)))))
      (else
       (multiinsertLR&co new oldL oldR (cdr lat)
                         (lambda (newlat L R)
                           (col (cons (car lat) newlat) L R)))))))

(newline)
(define f
  (lambda (ls a b)
    (cons ls (cons a (cons b '())))))

(display (multiinsertLR&co 'salty 'fish 'chips '(chips and fish or fish and chips) f))


;例子3
(define /&
  (lambda (n m)
    (cond
      ((< n m) 0)
      (else (add1 (/& (- n m) m))))))


(define even?
  (lambda (n)
    (= (* (/& n 2) 2) n)))

(define atom?
  (lambda (x)
    (and (not (pair? x)) (not (null? x)))))

;原函数
(define evens-only*
  (lambda (l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
       (cond
         ((even? (car l)) (cons (car l)
                                (evens-only* (cdr l))))
         (else (evens-only* (cdr l)))))
      (else (cons (evens-only* (car l))
                   (evens-only* (cdr l)))))))

(newline)
(display (evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2)))

;改写后函数
;收集的值为只有偶数的list 奇数的和 偶数的乘积
;问题1，如何收集：①偶数的list②奇数的和③偶数的乘积（该问题为母函数的逻辑）
;问题2，对收集的结果如何处理（该问题为collector的body体）

(define evens-only*&co
  (lambda (l col)
    (cond
      ((null? l) (col (quote ()) 1 0))
      ((atom? (car l))
       (cond
         ((even? (car l)) (evens-only*&co (cdr l)
                                          (lambda (newl p s)
                                            (col (cons (car l) newl) (* (car l) p) s))))
         (else (evens-only*&co (cdr l)
                               (lambda (newl p s)
                                 (col newl p (+ (car l) s)))))))
      (else (evens-only*&co (car l)
                            (lambda (al ap as)
                              (evens-only*&co (cdr l);此处本应该为收集的动作，但因为接下来依然为evens-only*（参考没有collector的函数），所以需要把cons放入collector中
                                              (lambda (bl bp bs)
                                                (col (cons al bl) (* ap bp) (+ as bs))))))))))

(newline)
(define ff
  (lambda (l a b)
    (cons l (cons a (cons b '())))))
(display (evens-only*&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2) ff))


         

运行结果

(b c d e f)
#f
(a a)
(b c d e f)
5
(chips salty and salty fish or salty fish and chips salty)
((chips salty and salty fish or salty fish and chips salty) 2 2)
((2 8) 10 (() 6) 2)
(((2 8) 10 (() 6) 2) 1920 38)