the little scheme Y-combinator

#lang sicp
(begin
  (display "Hello, World!")
  (newline)
  (display (car '(a b c)))
  (newline)
(display (cdr '(a b c)))
(newline)
(display (cons 'a '(a b c)))
)

;the little scheme例子
(newline)
(display 'atom)
(newline)
(display 'turkey)
(newline)
(display 1492)
(newline)
(display '1492)
(newline)
(display '(atom))
(newline)
(display '(atom turkey or))
(newline)
(display '((atom turkey) or))
(newline)
(display (car '(a b c)))
(newline)
(display (car (quote (aaaaa b c))))



;atom
;list
;s-expression

(newline)
(display (cons 'peanut '(butter and jelly)))
(newline)
(display (null? (quote ())))
(newline)

;不是pair，也不是null
(define atom?
  (lambda (x)
    (and (not (pair? x)) (not (null? x)))))

(display (atom? 'a))
(newline)


(display (eq? 'a 'a))
;eq?必须为非数字的atom

(define lat?
  (lambda (l)
    (cond
      ((null? l) #t)
      ((atom? (car l)) (lat? (cdr l)))
      (else #f))))

(newline)
(display (lat? '(jack sprat could)))

(newline)
(display (lat? '(jack (sprat could))))

(newline)
(display (or (null? '()) (atom? '(d e f g))))

(define member?
  (lambda (a lat)
    (cond
      ((null? lat) #f)
      (else (or (eq? (car lat) a)
                (member? a (cdr lat)))))))

(newline)
(display '===================)
(newline)
(display (member? 'meat '(mashed po and meat gravy)))

;错误的rember
;(define rember
;  (lambda (a lat)
;    (cond
;      ((null? lat) (quote ()))
;      (else (cond
;              ((eq? (car lat) a) (cdr lat))
;              (else (rember a (cdr lat))))))))


;(newline)
;(display (rember 'bacon '(bacon lettuce and tomato)))
;(newline)
;(display (rember 'and '(bacon lettuce and tomato)))


;(define rember
;  (lambda (a lat)
;    (cond
;      ((null? lat) (quote ()))
;      (else (cond
;              ((eq? (car lat) a) (cdr lat))
;              (else (cons (car lat)
;                          (rember a (cdr lat)))))))))

;(newline)
;(display (rember 'and '(bacon lettuce and tomato)))

;简化rember

(define rember
  (lambda (a lat)
    (cond
      ((null? lat) (quote ()))
      ((eq? (car lat) a) (cdr lat))
      (else (cons (car lat)
                  (rember a (cdr lat)))))))

(newline)
(display (rember 'and '(bacon lettuce and tomato)))

(define firsts
  (lambda (l)
    (cond
      ((null? l) (quote ()))
      (else (cons (car (car l))
                  (firsts (cdr l)))))))

(newline)
(display (firsts '((a b) (c d))))


(define insertR
  (lambda (new old lat)
    (cond
      ((null? lat) (quote ()))
      (else (cond
              ((eq? (car lat) old)
               (cons old
                     (cons new (cdr lat))))
              (else (cons (car lat)
                          (insertR new old (cdr lat)))))))))

(newline)
(display (insertR 'topping 'fudge '(ice cream with fudge topping for dessert)))

;(define insertL
;  (lambda (new old lat)
;    (cond
;      ((null? lat) (quote ()))
;      (else (cond
;              ((eq? (car lat) old)
;               (cons new
;                     (cons old (cdr lat))))
;              (else (cons (car lat)
;                          (insertL new old (cdr lat)))))))))

;简化, 只插入一个
(define insertL
  (lambda (new old lat)
    (cond
      ((null? lat) (quote ()))
      (else (cond
              ((eq? (car lat) old)
               (cons new lat))
              (else (cons (car lat)
                          (insertL new old (cdr lat)))))))))

(newline)
(display (insertL 'topping 'fudge '(ice cream with fudge topping for fudge dessert)))


(define subst
  (lambda (new old lat)
    (cond
      ((null? lat) (quote ()))
      (else (cond
              ((eq? (car lat) old)
               (cons new (cdr lat)))
              (else (cons (car lat)
                          (subst new old (cdr lat)))))))))

(newline)
(display (subst 'topping 'fudge '(ice cream with fudge for dessert)))

;只替换第一个
;(define subst2
;  (lambda (new o1 o2 lat)
;    (cond
;      ((null? lat) (quote ()))
;      (else (cond
;              ((eq? (car lat) o1)
;               (cons new (cdr lat)))
;              ((eq? (car lat) o2)
;               (cons new (cdr lat)))
;              (else (cons (car lat)
;                          (subst2 new o1 o2 (cdr lat)))))))))

;简化版
(define subst2
  (lambda (new o1 o2 lat)
    (cond
      ((null? lat) (quote ()))
      (else (cond
              ((or (eq? (car lat) o1) (eq? (car lat) o2))
               (cons new (cdr lat)))
              (else (cons (car lat)
                          (subst2 new o1 o2 (cdr lat)))))))))

(newline)
(display (subst2 'vanilla 'chocolate 'banana '(banana ice cream with chocolate topping)))

(define multirember
  (lambda (a lat)
    (cond
      ((null? lat) (quote ()))
      (else
       (cond
         ((eq? (car lat) a)
          (multirember a (cdr lat)))
         (else (cons (car lat)
                     (multirember a (cdr lat)))))))))

(newline)
(display (multirember 'cup '(coffee cup tea cup and hick cup)))


(define multiinsertR
  (lambda (new old lat)
    (cond
      ((null? lat) (quote ()))
      (else
       (cond
         ((eq? (car lat) old)
          (cons (car lat);或者用 old替换掉(car lat)，因为两个是等价的
                (cons new (multiinsertR new old (cdr lat)))))         
         (else (cons (car lat)
                   (multiinsertR new old (cdr lat)))))))))

(newline)
(display (multiinsertR 'friend 'fish '(chips and fish or fish and fried)))


;错误版本 out of memory
;(define multiinsertL
;  (lambda (new old lat)
;    (cond
;      ((null? lat) (quote ()))
;      (else
;       (cond
;         ((eq? (car lat) old)
;          (cons new
;                (cons old (multiinsertL new old lat))))
;         (else (cons (car lat)
;                     (multiinsertL new old (cdr lat)))))))))


(define multiinsertL
  (lambda (new old lat)
    (cond
      ((null? lat) (quote ()))
      (else
       (cond
         ((eq? (car lat) old)
          (cons new
                (cons old (multiinsertL new old (cdr lat)))))
         (else (cons (car lat)
                     (multiinsertL new old (cdr lat)))))))))

(newline)
(display (multiinsertL 'friend 'fish '(chips and fish or fish and fried)))


(define multisubst
  (lambda (new old lat)
    (cond
      ((null? lat) (quote ()))
      (else (cond
              ((eq? (car lat) old)
               (cons new
                     (multisubst new old (cdr lat))))
              (else (cons (car lat)
                          (multisubst new old (cdr lat)))))))))

(newline)
(display (multisubst 'topping 'fudge '(fudge abcd ice cream with fudge for dessert)))

(define add1
  (lambda (n)
    (+ n 1)))

(define sub1
  (lambda (n)
    (- n 1)))

(newline)
(display (add1 5))
(newline)
(display (sub1 6))

(newline)
(zero? 0)
(newline)
(display (+ 10 20))


;(+& 7 8)
;add1 (+& 7 7)
;add1 (add1 (+& 7 6))
;add1 (add1 (add1 (+& 7 5)))

(define +&
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (add1 (+& n (sub1 m)))))))

(newline)
(display (+& 7 8))


;(-& 9 3)
;(sub1 (-& 9 2))
;(sub1 (sub1 (-& 9 1)))

(define -&
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (sub1 (-& n (sub1 m)))))))

(newline)
(display (-& 19 3))

;tup is short for tuple（数组，元组）

(define addtup
  (lambda (tup)
    (cond
      ((null? tup) 0)
      (else (+ (car tup) (addtup (cdr tup)))))))

(newline)
(display (addtup '(1 2 3 4 5)))

(define *&
  (lambda (n m)
    (cond
      ((zero? m) 0)
      (else (+ n (*& n (sub1 m)))))))

(newline)
(display (*& 7 8))
(newline)
(display (* 7 8))

;(define tup+
;  (lambda (tup1 tup2)
;    (cond
;      ((and (null? tup1) (null? tup2)) (quote ()))
;      (else
;       (cons (+ (car tup1) (car tup2))
;             (tup+ (cdr tup1) (cdr tup2)))))))

;(newline)
;(display (tup+ '(3 6 9 11 4) '(8 5 2 0 7)))
;(newline)
;(display (tup+ '(3 6 9) '(8 5 2 0 7)))

;(define tup+
;  (lambda (tup1 tup2)
;    (cond
;      ((and (null? tup1) (null? tup2)) (quote ()))
;      ((null? tup1) tup2)
;      ((null? tup2) tup1)
;      (else
;       (cons (+ (car tup1) (car tup2))
;             (tup+ (cdr tup1) (cdr tup2)))))))

;简化
(define tup+
  (lambda (tup1 tup2)
    (cond
      ((null? tup1) tup2)
      ((null? tup2) tup1)
      (else
       (cons (+ (car tup1) (car tup2))
             (tup+ (cdr tup1) (cdr tup2)))))))

(newline)
(display (tup+ '(3 6 9) '(8 5 2 0 7)))

(newline)
(display (> 10 20))

(define >&
  (lambda (n m)
    (cond
      ((zero? m) #t)
      ((zero? n) #f)
      (else (>& (sub1 n) (sub1 m))))))

(newline)
(display (>& 10 20))
(newline)
(display (>& 10 10))

;正确的
(define >&2
  (lambda (n m)
    (cond
      ((zero? n) #f);倒个个
      ((zero? m) #t)      
      (else (>&2 (sub1 n) (sub1 m))))))
(newline)
(display (>&2 10 10))

(define <&
  (lambda (n m)
    (cond
      ((zero? m) #f)
      ((zero? n) #t)      
      (else (<& (sub1 n) (sub1 m))))))

(newline)
(display (<& 10 20))
(newline)
(display (<& 10 10))


(newline)
(display (= 10 10))

(define =&
  (lambda (n m)
    (cond
      ((zero? m) (zero? n))
      ((zero? n) #f)
      ;第一步，写出递归调用
      (else (=& (sub1 n) (sub1 m))))))

(newline)
(display (=& 10 10))

(define =&2
  (lambda (n m)
    (cond
      ((> n m) #f)
      ((< n m) #f)
      (#t))))


(newline)
(display (=&2 10 10))

(newline)
;(display (↑ 2 4))

;次方
(define ↑
  (lambda (n m)
    (cond
      ((zero? m) 1)
      (else (* n (↑ n (sub1 m)))))))
(newline)
(display (↑ 2 4))

;除法
(define /&
  (lambda (n m)
    (cond
      ((< n m) 0)
      (else (add1 (/& (- n m) m))))))

(newline)
(display (/& 10 3))

(define length
  (lambda (lat)
    (cond
      ((null? lat) 0)
      (else (add1 (length (cdr lat)))))))

(newline)
(display (length '(a b c c)))

(define pick
  (lambda (n lat)
    (cond
      ((zero? (sub1 n)) (car lat))
      (else (pick (sub1 n) (cdr lat))))))

(newline)
(display (pick 3 '(hot wiht hottt m)))

(define rempick
  (lambda (n lat)
    (cond
      ((zero? (sub1 n)) (cdr lat))
      (else (cons (car lat)
                  (rempick (sub1 n) (cdr lat)))))))

(newline)
(display (rempick 3 '(hot wiht hottt m)))

(newline)
(number? 3)

(define no-nums
  (lambda (lat)
    (cond
      ((null? lat) (quote ()))
      (else (cond
              ((number? (car lat))
               (no-nums (cdr lat)))
              (else (cons (car lat)
                          (no-nums (cdr lat)))))))))

(newline)
(display (no-nums '(5 pear 6 pr 9 dates)))

(define all-nums
  (lambda (lat)
    (cond
      ((null? lat) (quote ()))
      (else
       (cond
         ((number? (car lat))
          (cons (car lat) (all-nums (cdr lat))))
         (else (all-nums (cdr lat))))))))

(newline)
(display (all-nums '(5 pear 6 pr 9 dates)))

(define eqan?
  (lambda (a1 a2)
    (cond
      ((and (number? a1) (number? a2))
       (= a1 a2))
      ((or (number? a1) (number? a2))
       #f)
      (else (eq? a1 a2)))))

(newline)
(display (eqan? 10 'a))

(define occur
  (lambda (a lat)
    (cond
      ((null? lat) 0)
      (else
       (cond
         ((eq? (car lat) a)
          (add1 (occur a (cdr lat))))
         (else (occur a (cdr lat))))))))

(newline)
(display (occur 'a '(a b a c d a e)))

;(define one?
;  (lambda (n)
;    (cond
;      ((zero? n) #f)
;      (else (zero? (sub1 n))))))

;(define one?
; (lambda (n)
;    (cond
;      (else (= n 1)))));else是个question，答案永远为true

;(define one?
;  (lambda (n)
;    (cond
;      ((= n 1)))));else是个question，答案永远为true，如果省掉else，那question就变成了(= n 1)，值就变成了空

;(define one?
;  (lambda (n)
;    (cond
;      (#t (= n 1)))));else是个question,答案永远为true

(define one?
  (lambda (n)
      (= n 1)))


(newline)
(display (one? 10))

(define rempick&
  (lambda (n lat)
    (cond
      ((one? n) (cdr lat))
      (else (cons (car lat)
                (rempick& (sub1 n) (cdr lat)))))))

(newline)
(display (rempick& 2 '(le me sa pi)))

(define rember*
  (lambda (a l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
       (cond
         ((eq? (car l) a)
          (rember* a (cdr l)))
         (else (cons (car l)
                     (rember* a (cdr l))))))
      (else (cons (rember* a (car l))
                  (rember* a (cdr l)))))))

(newline)
;(display rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup))   the expected number of arguments does not match the given number given: 3
(display (rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup)))


(define insertR*
  (lambda (new old l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
       (cond
         ((eq? (car l) old)
          (cons old
                (cons new
                      (insertR* new old (cdr l)))))
         (else (cons (car l)
                     (insertR* new old (cdr l))))))
      (else (cons (insertR* new old (car l))
                  (insertR* new old (cdr l)))))))

(newline)
(display (insertR* 'roast 'chuck '((how much (wood))
                                   could
                                   ((a (wood chuck))
                                    (((chuck)))
                                    (if (a) ((wood chuck)))
                                    could chuck wood)
                                   )))



(define occur*
  (lambda (a l)
    (cond
      ((null? l) 0)
      ((atom? (car l))
       (cond
         ((eq? (car l) a)
          (add1 (occur* a (cdr l))))
         (else (occur* a (cdr l)))))
      (else (+ (occur* a (car l))
               (occur* a (cdr l)))))))

(newline)
(display (occur* 'banana '((banana)
                                   (split ((((banana ice)))
                                           (cream (banana))
                                           sherbet))
                                   (banana)
                                   (bread)
                                   (banana brandy))))


(define subst*
  (lambda (new old l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
       (cond
         ((eq? (car l) old)
          (cons new
                (subst* new old (cdr l))))
         (else (cons (car l)
                     (subst* new old (cdr l))))))
      (else
       (cons (subst* new old (car l))
             (subst* new old (cdr l)))))))

(newline)
(display (subst* 'orange 'banana '((banana)
                                   (split ((((banana ice)))
                                           (cream (banana))
                                           sherbet))
                                   (banana)
                                   (bread)
                                   (banana brandy))))

(define insertL*
  (lambda (new old l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
       (cond
         ((eq? (car l) old)
          (cons new
                (cons old
                      (insertL* new old (cdr l)))))
         (else (cons (car l)
                     (insertL* new old (cdr l))))))
      (else (cons (insertL* new old (car l))
                  (insertL* new old (cdr l)))))))

(newline)
(display (insertL* 'pecker 'chuck '((how much (wood))
                                   could
                                   ((a (wood chuck))
                                    (((chuck)))
                                    (if (a) ((wood chuck)))
                                    could chuck wood)
                                   )))

(define member*
  (lambda (a l)
    (cond
      ((null? l) #f)
      ((atom? (car l))
       (or (eq? (car l) a)
           (member* a (cdr l))))
      (else (or (member* a (car l))
                (member* a (cdr l)))))))

(newline)
(display (member* 'chips '((potato) (chips ((with) fish) (chips)))))

(define leftmost
  (lambda (l)
    (cond
      ((atom? (car l)) (car l))
      (else (leftmost (car l))))))

(newline)
(display (leftmost '((potato) (chips ((with) fish) (chips)))))

;(define eqlist?
;  (lambda (l1 l2)
;    (cond
;      ((and (null? l1) (null? l2)) #t)
;      ((and (null? l1) (atom? (car l2))) #f) ;
;      ((null? l1) #f)                        ;这两行可合并
;      ((and (atom? (car l1)) (atom? (car l2)))
;       (and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))))
;      ((atom? (car l1)) #f)
;      ((null? l2) #f)
;      ((atom? (car l2)) #f)
;      (else
;       (and (eqlist? (car l1) (car l2))
;            (eqlist? (cdr l1) (cdr l2)))))))

;简化版
;(define eqlist?
;  (lambda (l1 l2)
;    (cond
;      ((and (null? l1) (null? l2)) #t)
;      ((or (null? l1) (null? l2)) #f)
;      ((and (atom? (car l1)) (atom? (car l2)))
;       (and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))))
;      ((or (atom? (car l1)) (atom? (car l2))) #f)
;      (else
;       (and (eqlist? (car l1) (car l2))
;            (eqlist? (cdr l1) (cdr l2)))))))
      
      

;(newline)
;(display (eqlist? '(beef ((sausage)) (and (doda))) '(beef ((sausage)) (and (doda)))))

;(define equal?
;  (lambda (s1 s2)
;   (cond
;      ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
;      ((atom? s1) #f)
;      ((atom? s2) #f)
;      (else (eqlist? s1 s2)))))

;简化版
(define equal?
  (lambda (s1 s2)
   (cond
      ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
      ((or (atom? s1) (atom? s2)) #f)
      (else (eqlist? s1 s2)))))

;使用equal?重写qulist?
(define eqlist?
  (lambda (l1 l2)
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((or (null? l1) (null? l2)) #f)
;      ((and (atom? (car l1)) (atom? (car l2)))
;      (and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))))
;      ((or (atom? (car l1)) (atom? (car l2))) #f)
      (else
       (and (equal? (car l1) (car l2))
            (equal? (cdr l1) (cdr l2)))))))


(newline)
(display (eqlist? '(beef ((sausage)) (and (doda))) '(beef ((sausage)) (and (doda)))))

;(define rember&sl
;  (lambda (s l)
;    (cond
;      ((null? l) (quote ()))
;      ((atom? (car l))
;       (cond
;         ((equal? (car l) s) (cdr l))
;         (else (cons (car l) (rember&sl s (cdr l))))))
;      (else (cond
;              ((equal? (car l) s) (cdr l))
;              (else (cons (car l) (rember&sl s (cdr l)))))))))
;简化
;(define rember&sl
;  (lambda (s l)
;    (cond
;      ((null? l) (quote ()))
;      (else (cond
;              ((equal? (car l) s) (cdr l))
;              (else (cons (car l) (rember&sl s (cdr l)))))))))

;继续简化
(define rember&sl
  (lambda (s l)
    (cond
      ((null? l) (quote ()))
      ((equal? (car l) s) (cdr l))
      (else
       (cons (car l) (rember&sl s (cdr l)))))))


;(define numbered?
;  (lambda (aexp)
;    (cond
;      ((atom? aexp) (number? aexp))
;      ((eq? (car (cdr aexp)) (quote +))
;       (and (numbered? (car aexp))
;            (numbered? (car (cdr (cdr aexp))))))
;      ((eq? (car (cdr aexp)) (quote *))
;       (and (numbered? (car aexp))
;            (numbered? (car (cdr (cdr aexp))))))
;      ((eq? (car (cdr aexp)) (quote ↑))
;       (and (numbered? (car aexp))
;            (numbered? (car (cdr (cdr aexp)))))))))

(define numbered?
  (lambda (aexp)
    (cond
      ((atom? aexp) (number? aexp))
      (else (numbered? (car aexp))
            (numbered? (car (cdr (cdr aexp))))))))
(newline)
(display (numbered? '(3 + 4)))

;中缀表达式计算value
(define value
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      ((eq? (car (cdr nexp)) (quote +))
       (+ (value (car nexp))
          (value (car (cdr (cdr nexp))))))
       ((eq? (car (cdr nexp)) (quote *))
       (* (value (car nexp))
          (value (car (cdr (cdr nexp))))))
       (else
        (↑ (value (car nexp))
          (value (car (cdr (cdr nexp)))))))))

;前缀表达式计算value
(define 1st-sub-exp
  (lambda (aexp)
    (car (cdr aexp))))

(define 2nd-sub-exp
  (lambda (aexp)
    (car (cdr (cdr aexp)))))

(define operator
  (lambda (aexp)
    (car aexp)))

(define value&prefix
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      ((eq? (operator nexp) (quote +))
       (+ (value&prefix (1st-sub-exp nexp))
          (value&prefix (2nd-sub-exp nexp))))
       ((eq? (operator nexp) (quote *))
       (* (value&prefix (1st-sub-exp nexp))
          (value&prefix (2nd-sub-exp nexp))))
       (else
         (↑ (value&prefix (1st-sub-exp nexp))
          (value&prefix (2nd-sub-exp nexp)))))))


(define sero?
  (lambda (n)
    (null? n)))

(define edd1
  (lambda (n)
    (cons (quote()) n)))

(define zub1
  (lambda (n)
    (cdr n)))

(define +&2
  (lambda (n m)
    (cond
      ((sero? m) n)
      (else (edd1 (+&2 n (zub1 m)))))))

(newline)
(display (lat? '((()) (()()) (()()()))))

;(define set?
;  (lambda (lat)
;    (cond
;      ((null? lat) #t)
;      (else
;       (cond
;         ((member? (car lat) (cdr lat)) #f)
;         (else (set? (cdr lat))))))))
;简化
(define set?
  (lambda (lat)
    (cond
      ((null? lat) #t)
      ((member? (car lat) (cdr lat)) #f)
      (else (set? (cdr lat))))))



(newline)
(display (set? '(apples peaches pears plums)))

(newline)
(display (set? '(apples 4 5 6 peaches pears plums)))

;(define makeset
;  (lambda (lat)
;    (cond
;      ((null? lat) (quote ()))
;      ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
;      (else (cons (car lat) (makeset (cdr lat)))))))

;使用multirember重写makeset
(define makeset
  (lambda (lat)
    (cond ;如果忘记写cond会报这个错误 else: not allowed as an expression
    ((null? lat) (quote ()))
    (else (cons (car lat)
                (makeset (multirember (car lat) (cdr lat))))))))

(newline)
(display (makeset '(apple peache peer apple)))

;(define subset?
;  (lambda (set1 set2)
;    (cond
;      ((null? set1) #t)
;      (else (cond
;              ((member? (car set1) set2)
;               (subset? (cdr set1) set2))
;              (else #f))))))

;简化版
;(define subset?
;  (lambda (set1 set2)
;    (cond
;      ((null? set1) #t)
;      ((member? (car set1) set2) (subset? (cdr set1) set2))
;      (else #f))))

;使用and来改写subset?
(define subset?
  (lambda (set1 set2)
    (cond
      ((null? set1) #t)
      (else
       (and (member? (car set1) set2) (subset? (cdr set1) set2))))))

(newline)
(display (subset? '(4 po) '(a b 4 e po)))

;(define eqset?
;  (lambda (set1 set2)
;    (cond
;      ((subset? set1 set2) (subset? set2 set1))
;      (else #f))))

;(define eqset?
;  (lambda (set1 set2)
;    (cond
;      (else (and (subset? set1 set2) (subset? set2 set1))))))

(define eqset?
  (lambda (set1 set2)
    (and (subset? set1 set2) (subset? set2 set1))))

;(define intersect?
;  (lambda (set1 set2)
;    (cond
;      ((null? set1) #f)
;      (else
;       (cond
;         ((member? (car set1) set2) #t)
;         (else (intersect? (cdr set1) set2)))))))

;(define intersect?
;  (lambda (set1 set2)
;    (cond
;      ((null? set1) #f)
;      ((member? (car set1) set2) #t)
;      (else
;       (intersect? (cdr set1) set2)))))

(define intersect?
  (lambda (set1 set2)
    (cond
      ((null? set1) #f)
      (else
       (or (member? (car set1) set2) (intersect? (cdr set1) set2))))))


(newline)
(display (intersect? '(stewed tomatos and) '(maca and tomatos)))


(define intersect
  (lambda (set1 set2)
    (cond
      ((null? set1 ) (quote ()))
      ((member? (car set1 ) set2)
       (cons (car set1)
             (intersect (cdr set1 ) set2)))
      (else (intersect (cdr set1 ) set2)))))

(define union
  (lambda (set1 set2)
    (cond
      ((null? set1 ) set2)
      ((member? ( car set1) set2)
       (union ( cdr set1 ) set2))
      (else (cons ( car set1 )
                  (union (cdr set1 ) set2))))))

(define intersectall
  (lambda ( l-set)
    (cond
      ((null? (cdr l-set)) (car l-set))
      (else (intersect (car l-set)
                       (intersectall (cdr l-set)))))))

;pair a list with only two s-expression

(define a-pair?
  (lambda (x)
    (cond ((atom? x) #f)
          (( null? x) #f)
          (( null? ( cdr x)) #f)
          (( null? ( cdr ( cdr x))) #t )
          (else #f ))))


(define first
  (lambda (p)
    (cond
      (else ( car p)))))

(define second
  (lambda (p)
    (cond
      (else ( car ( cdr p))))))


(define build
  (lambda (sl s2)
    (cond
      (else ( cons sl
             ( cons s2 (quote ())))))))

(define third
  (lambda (l)
    (car (cdr (cdr l)))))

;首元素是否为一个set
(define fun?
  (lambda (rel)
    (set? (firsts rel))))

(newline)
(display (fun? '((8 3) (9 0) (10 2))))

;(define revrel
;  (lambda ( rel)
;    (cond
;      ((null? rel) (quote ()))
;      (else ( cons ( build
;                     (second ( car rel))
;                     (first ( car rel)))
;                   ( revrel ( cdr rel)))))))

;使用cons
;(define revrel
;  (lambda ( rel)
;    (cond
;      ((null? rel) (quote ()))
;      (else ( cons ( cons
;                     ( car ( cdr (car rel)))
;                     ( cons ( car ( car rel))
;                            (quote ())))
;                   (revrel ( cdr rel)))))))
;(newline)
;(display (revrel '((8 3) (9 0) (10 2))))

(define revpair
  (lambda (pair)
    ( build (second pair) (first pair))))

;使用revpair重新定义revrel
(define revrel
  (lambda ( rel)
    (cond
      ((null? rel) (quote ()))
      (else ( cons ( revpair ( car rel))
                   ( revrel ( cdr rel)))))))

(newline)
(display (revrel '((8 3) (9 0) (10 2))))

(define fullfun?
  (lambda (fun)
    (set? (second fun))))

;fullfun的另一个名字
(define one-to-one?
  (lambda (fun)
    (fun? ( revrel fun))))

;(define rember-f
;  (lambda ( test? a l)
;    (cond
;      ( ( null? l) (quote ()))
;      (else (cond
;              ((test? ( car l) a) ( cdr l))
;              (else ( cons ( car l)
;                           (rember-f test? a ( cdr l)))))))))

;简化
(define rember-f
  (lambda ( test? a l)
    (cond
      ((null? l) (quote ()))
      ((test? ( car l) a) ( cdr l))
      (else ( cons ( car l)
                   ( rember-f test? a ( cdr l)))))))

(newline)
(display (rember-f eq? 'jelly '(jelly a b c d)))

;==============================================

(lambda (a)
  (lambda (x)
    (eq? x a)))

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))

(newline)
(display (eq?-c 'salad));procedure程序

(define eq?-salad
  (eq?-c 'salad))

(newline)
(display (eq?-salad 'salad))
(newline)
(display (eq?-salad 'a))

;************
(newline)
(display ((eq?-c 'salad) 'a))

(define rember-f2
  (lambda (test?)
    (lambda (a l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) a) (cdr l))
        (else (cons (car l)
                    ((rember-f2 test?) a (cdr l))))))))

;不知道参数是什么
(define rember-eq?
  (rember-f2 eq?))

(newline)
(display (rember-eq? 'a '(b c d a e a f)))

;((rember-f2 eq?) a l)
(newline)
((rember-f2 eq?) 'a '(b c d a e a f));没有加display

(define insertL-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old)
          (cons new (cons old (cdr l))))
        (else (cons (car l)
                     ((insertL-f test?) new old
                                        (cdr l))))))))

(define insertR-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old)
          (cons old (cons new (cdr l))))
        (else (cons (car l)
                     ((insertR-f test?) new old
                                        (cdr l))))))))

(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))


(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old)
         (seq new old (cdr l)))
        (else (cons (car l)
                     ((insert-g seq) new old (cdr l))))))))

(define insertL2 (insert-g seqL))
(define insertR2 (insert-g seqR))

(define insertL3
  (insert-g (lambda (new old l)
              (cons new (cons old l)))))

(define seqS
  (lambda (new old l)
    (cons new l)))

(define subst2&
  (insert-g seqS))

(define seqrem
  (lambda (new old l)
    l))

(define yyy
  (lambda (a l)
    ((insert-g seqrem) #f a l)))

(newline)
(display (yyy 'su '(pi wi su and ba)))


(define atom-to-function
  (lambda (x)
    (cond
      ((eq? x (quote +)) +)
      ((eq? x (quote *)) *)
      (else ↑))))

(define value&2
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      (else
       ((atom-to-function
         (operator nexp))
        (value&2 (1st-sub-exp nexp))
        (value&2 (2nd-sub-exp nexp)))))))


(define multirember-f
  (lambda (test?)
    (lambda (a lat)
      (cond
        ((null? lat) (quote ()))
        ((test? a (car lat))
         ((multirember-f test?) a (cdr lat)))
        (else (cons (car lat)
                     ((multirember-f test?) a (cdr lat))))))))


(define multirember-eq?
  (multirember-f eq?))


(define eq?-tuna
  (eq?-c 'tuna))

(define multiremberT
  (lambda (test? lat)
    (cond
      ((null? lat) (quote ()))
      ((test? (car lat))
       (multiremberT test? (cdr lat)))
      (else (cons (car lat)
                   (multiremberT test? (cdr lat)))))))

(newline)
(multiremberT eq?-tuna '(sh sa tuna sh and tuna))


;collector的由来：将对元素的操作放入函数中
;multirember删除lat中等于a的atom，得到剩余的lat
;multirember&co 在multirember的基础上添加collector

(define multirember&co
  (lambda (a lat col)
    (cond
      ((null? lat) (col (quote ()) (quote ())))
      ((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)))))))

(define a-friend
  (lambda (x y)
    (null? y)))

(newline)
(display (multirember&co 'tuna '() a-friend))

(newline)
(display (multirember&co 'tuna '(tuna) a-friend))
;再次递归时
;col变成高阶函数，入参为quote () quote ()
;与该高阶函数中变量组合为新的参数，传递给一阶函数，变量为quote() 和 (tuna)

(newline)
(display (multirember&co 'tuna '(str tuna and sw) a-friend))

(define last-friend
  (lambda (x y)
    (length x)))

(newline)
(display (multirember&co 'tuna '(str tuna and sw) last-friend))

;使用函数来一次性收集多个值

(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)))))))

(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)
(display (multiinsertLR&co 'salty 'fish 'chips '(chips and fish or fish and chips) (lambda (l a b)
                                                                                     (cons l (cons a (cons b (quote ())))))))
(newline)
(display (/ 10 2))
(newline)
(display (/& 11 2))

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

(newline)
(display (even? 10))
(display (even? 9))
(display (even? 8))

(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* '(1 2 3 4 5 6 7 8 9)))
(newline)
(display (evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2)))


;(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)
;                            ... )))))
;想想...处应该是什么，对各个子list进行递归处理，第一步，写出递归调用，重点重点重点，对比上面的例子来给出答案，一定不可以看答案，要自己想出来
;最终结果为(((2 8) 10 (() 6) 2) 1920 38)
;第一步newl为(9 1 2 8)
;(lambda (al ap as)
;  (lambda (bl bp bs)
;    (col (cons al bl)
;         (* ap bp)
;         (+ as bs))))

;(lambda (al ap as)
;  (evens-only*&co (cdr l)
;                  (lambda (bl bp bs)
;                    (col (cons al bl)
;                         (* ap bp)
;                         (+ as bs)))))

(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 m a)
                            (col (cons (car l) newl) (* (car l) m) a))))
         (else
          (evens-only*&co (cdr l)
                          (lambda (newl m a)
                            (col newl m (+ (car l) a)))))))
      (else (evens-only*&co (car l)
                            (lambda (newal am aa)
                              (evens-only*&co (cdr l)
                                               (lambda (newbl bm ba)
                                                 (col (cons newal newbl)
                                                      (* am bm)
                                                      (+ aa ba))))))))))


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




(define keep-looking
  (lambda (a sorn lat)
    (cond
      ((number? sorn)
       (keep-looking a (pick sorn lat) lat))
      (else (eq? sorn a)))))

(define looking
  (lambda (a lat)
    (keep-looking a (pick 1 lat) lat)))

(define eternity
  (lambda (x)
    (eternity x)))

;function f(x)
;{
;   return f(x)
;}

(newline)
;(display (eternity 5))

(define shift
  (lambda (pair)
    ( build (first (first pair))
            ( build (second (first pair))
                    (second pair)))))

(define align
  (lambda (pora)
    (cond
      (( atom? pora) pora)
      (( a-pair? (first pora))
       ( align (shift pora)))
      (else ( build (first pora)
                    ( align (second pora)))))))

(newline)
(display (align '(a ((b c) d))))


(define length*
  (lambda (pora)
    (cond
      ((atom? pora) 1)
      (else
       ( + (length* (first pora))
           (length* (second pora)))))))

(define weight*
  (lambda (pora)
    (cond
      ((atom? pora) 1)
      (else
       ( + ( * (weight* (first pora)) 2)
           (weight* (second pora)))))))

(define shuffle
  (lambda (pora)
    (cond
      ((atom? pora) pora)
      (( a-pair? (first pora))
       ( shuffle ( revpair pora)))
      (else ( build (first pora)
                    ( shuffle (second pora)))))))


;y combinator

;lenght0
;只能求空list
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (eternity (cdr l))))))

;能求1个或0个元素的list
;(lambda (l)
;  (cond
;    ((null? l) 0)
;    (else (add1 (length0 (cdr l))))))

(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (
                 (lambda (l)
                   (cond
                     ((null? l) 0)
                     (else (add1 (eternity (cdr l))))))
                 (cdr l))))))
;三个 2个1个或者是0个
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (
                 (lambda (l)
                   (cond
                     ((null? l) 0)
                     (else (add1 (
                                  (lambda (l)
                                    (cond
                                      ((null? l) 0)
                                      (else (add1 (eternity (cdr l))))))
                                  (cdr l))))))
                 (cdr l))))))


(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (
                 (lambda (l)
                   (cond
                     ((null? l) 0)
                     (else (add1 (eternity (cdr l))))))
                 (cdr l))))))


;定义一个匿名函数，该匿名函数用于求list的长度
;参数为一个函数，(即length函数，作用为求一个list的长度)
(lambda (length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l)))))))
;实际入参为eternity
((lambda (length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l)))))))
 eternity)
;也就是
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (eternity (cdr l))))))


;length1
;给length函数，应用length0函数
;而不是给length函数，应用length函数，再应用eternity，（给length函数应用length函数，还是相当于只能求空list）
((lambda (f)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (f (cdr l)))))))
 (
  (lambda (f)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (f (cdr l)))))))
  eternity))


(lambda (f)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (f (cdr l)))))))


;提取公共部分
;
;入参为length，返回为length
;(lambda (length)
;  (lambda (l)
;    (cond
;      ((null? l) 0)
;      (else (add1 (length (cdr l)))))))
;即将这个匿名函数作为参数，传递给一个函数（匿名函数），并返回该函数
(lambda (mk-length)
  (mk-length eternity))
;应用后为
((lambda (mk-length)
  (mk-length eternity))
 (lambda (length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l))))))))
;始终通过匿名函数来进行抽取
;length <= 1  从length1转换过来
(lambda (mk-length)
  (mk-length
   (mk-length eternity)))
;应用函数后为
((lambda (mk-length)
  (mk-length
   (mk-length eternity)))
  (lambda (length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l))))))))

;length <= 2 从length2转换过来
(lambda (mk-length)
  (mk-length
   (mk-length
    (mk-length eternity))))
;应用函数后为
((lambda (mk-length)
  (mk-length
   (mk-length
    (mk-length eternity))))
  (lambda (length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l))))))))

;传递给mk-length的函数什么都无所谓，那么传递给mk-length也可以
(lambda (mk-length)
  (mk-length
   (mk-length
    (mk-length mk-length))))

;甚至可以用mk-length代替length
((lambda (mk-length)
  (mk-length
   (mk-length
    (mk-length mk-length))))
  (lambda (mk-length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (mk-length (cdr l))))))))


;相当于length0
((lambda (mk-length)
  (mk-length mk-length))
 (lambda (mk-length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (mk-length (cdr l))))))))

;使用mk-length多一层递归，也就是length1 为<=1
((lambda (mk-length)
  (mk-length mk-length))
 (lambda (mk-length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 ((mk-length eternity);每入一个函数，就多一层递归
                   (cdr l))))))))

(newline) 
(display ;(
(((lambda (mk-length)
  (mk-length mk-length))
 (lambda (mk-length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 ((mk-length eternity)
                   (cdr l))))))))
'(apples))
);)


(newline)
;这是个死循环，为什么不能是这样
;(display
;(((lambda (mk-length)
;  (mk-length mk-length))
; (lambda (mk-length)
;  (lambda (l)
;    (cond
;      ((null? l) 0)
;      (else (add1 ((mk-length (mk-length eternity))
;                   (cdr l))))))))
;'(apples bbb))
;)


;?????????，为什么这个是个死循环
(newline) 
;(display 
;(((lambda (mk-length)
;  (mk-length mk-length))
; (lambda (mk-length)
;  (lambda (l)
;    (cond
;      ((null? l) 0)
;      (else (add1 ((mk-length eternity)
;                   (cdr l))))))))
;'(apples iii))
;)

;化简
(((lambda (mk-length)
    (mk-length mk-length))
  (lambda (mk-length)
    (lambda (l)
      (cond
        ((null? l) 0)
        (else (add1 ((mk-length eternity) (cdr l))))))))
 '(apples))
;第一步
(
 (lambda (mk-length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 ((mk-length eternity) (cdr l)))))))
 (lambda (mk-length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 ((mk-length eternity) (cdr l)))))))
 )
;第二步
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 ((
                  (lambda (mk-length)
                    (lambda (l)
                      (cond
                        ((null? l) 0)
                        (else (add1 ((mk-length eternity) (cdr l))))))) eternity) (cdr l))))))

;第三步，传入'(apples)
;因为不为null，所以调用add1
;进一步，调用cdr l，并将cdr l的值传递给内层函数
;进一步，内层函数进行调用，此时的mk-length已经是eternity了
;化简内层函数
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (
                 (lambda (l)
                   (cond
                     ((null? l) 0)
                     (else (add1 ((eternity eternity) (cdr l)))))) (cdr l))))))
;即
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (
                 (lambda (l);①
                   (cond
                     ((null? l) 0)
                     (else (add1 ((eternity eternity) (cdr l)))))) '() )))))
;最内层的(eternity eternity)并没有用上，所以这个地方的函数无论是多少层都没有用
;只要①处可以传入list了，内层函数就不再进行继续化简了（思考下解释器的过程）
;即
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 0))))
;结果为1


(newline)
(display '==========)

((lambda (mk-length)
  (mk-length mk-length))
 (lambda (mk-length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 ((mk-length mk-length);提取该部分
                   (cdr l))))))))

;*****************从此开始

(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (eternity (cdr l))))))

;(lambda (l)
;  (cond
;    ((null? l) 0)
;    (else (add1 (eternity (cdr l))))))

(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1 (
                 (lambda (l)
                   (cond
                     ((null? l) 0)
                     (else (add1 (eternity (cdr l)))))) (cdr l))))))
;(lambda (l)
;  (cond
;    ((null? l) 0)
;    (else (add1 (length0 (cdr l))))))

;(lambda (l)
;  (cond
;    ((null? l) 0)
;    (else (add1 (length1 (cdr l))))))

;......
;抽取方法
;把这一部分叫做length
;(lambda (l)
;  (cond
;    ((null? l) 0)
;    (else (add1 (lengthx/eternity (cdr l))))))
;抽取方法后为
(lambda (length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l)))))))
;第一个方法就是，传入eternity，第二个就是传入length0
((lambda (length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 (length (cdr l)))))))
 eternity)

;((lambda (length)
;   (lambda (l)
;     (cond
;       ((null? l) 0)
;       (else (add1 (length (cdr l)))))))
; eternity)

((lambda (length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 (length (cdr l)))))))
 ((lambda (length)
    (lambda (l)
      (cond
        ((null? l) 0)
        (else (add1 (length (cdr l)))))))
  eternity))

;((lambda (length)
;   (lambda (l)
;     (cond
;       ((null? l) 0)
;       (else (add1 (length (cdr l)))))))
; length0)

;((lambda (length)
;   (lambda (l)
;     (cond
;       ((null? l) 0)
;       (else (add1 (length (cdr l)))))))
; length1)

;......

;再次抽取方法(调用，传入一个方法，返回一个方法，高阶函数)
;把这一部分叫做mk-length
;(lambda (length)
;  (lambda (l)
;    (cond
;      ((null? l) 0)
;      (else (add1 (length (cdr l))))))) ②
;而不是这一部分，因为这一部分包含到了调用，而不是单纯的方法，抽取为抽取调用中的方法
;((lambda (length)
;   (lambda (l)
;     (cond
;       ((null? l) 0)
;       (else (add1 (length (cdr l)))))))
; lengthx/eternity)
;这一部分为mk-length调用eternity或者是length0，length1等等
;抽取调用（***********）
(lambda (mk-length)
  (mk-length eternity))
;其中mk-length为②
;也就是，即length0
((lambda (mk-length)
   (mk-length eternity))
 (lambda (length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 (length (cdr l))))))))

;((lambda (mk-length)
;   (mk-length
;    (mk-length eternity))))

;((lambda (mk-length)
;   (mk-length
;    (mk-length
;     (mk-length eternity)))))


;不关心最深层的方法是什么，因为可以把最深层的方法换成mk-length
(lambda (mk-length)
   (mk-length mk-length))

;由于参数的名字仅仅是个符号，因此甚至可以把length换成mk-length
;也就是
((lambda (mk-length)
   (mk-length mk-length))
 (lambda (mk-length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 (mk-length (cdr l))))))));此时该行中mk-length的入参为(cdr l)，类型不对，应该为一个方法，即length方法（重点）

;展开为
((lambda (mk-length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 (mk-length (cdr l)))))))
 (lambda (mk-length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 (mk-length (cdr l))))))))

;继续
(lambda (l)
  (cond
    ((null? l) 0)
    (else (add1
           (lambda (mk-length)
             (lambda (l)
               (cond
                 ((null? l) 0)
                 (else (add1 (mk-length (cdr l))))))) (cdr l)))))
;此时最内层mk-length的入参为(cdr l)，按理说mk-length的入参为一个方法，即length方法
;将mk-length的入参改为方法，本身最内层方法也没有用，所以改为方法，也不影响结果
((lambda (mk-length)
   (mk-length mk-length))
 (lambda (mk-length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 ((mk-length eternity) (cdr l))))))))
;再次将mk-length传递给它自己
((lambda (mk-length)
   (mk-length mk-length))
 (lambda (mk-length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 ((mk-length mk-length) (cdr l))))))))

;从此处开始两个方向
;提取出(mk-length mk-length)
;((lambda (mk-length)
;   (mk-length mk-length))
; (lambda (mk-length)
;   ((lambda (length)
;     (lambda (l)
;       (cond
;         ((null? l) 0)
;         (else (add1 (length (cdr l)))))))
;   (mk-length mk-length))))
;中间部分就是length函数

;展开后依然为无限调用mk-length，参见课本

;另一种方式
((lambda (mk-length)
   (mk-length mk-length))
 (lambda (mk-length)
   (lambda (l)
     (cond
       ((null? l) 0)
       (else (add1 (
                    (lambda (x)
                      ((mk-length mk-length) x))(cdr l))))))))
;③
((lambda (mk-length)
   (mk-length mk-length))
 (lambda (mk-length)
   ((lambda (length)
     (lambda (l)
       (cond
         ((null? l) 0)
         (else (add1 (length (cdr l)))))))
   (lambda (x)
     ((mk-length mk-length) x)))))

;展开为
((lambda (mk-length)
   ((lambda (length)
      (lambda (l)
        (cond
          ((null? l) 0)
          (else (add1 (length (cdr l)))))))
    (lambda (x)
      ((mk-length mk-length) x))))
 (lambda (mk-length)
   ((lambda (length)
      (lambda (l)
        (cond
          ((null? l) 0)
          (else (add1 (length (cdr l)))))))
    (lambda (x)
      ((mk-length mk-length) x)))))

;继续
((lambda (length)
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l)))))))
 (lambda (x)
   ((
     (lambda (mk-length)
       ((lambda (length)
          (lambda (l)
            (cond
              ((null? l) 0)
              (else (add1 (length (cdr l)))))))
        (lambda (x)
          ((mk-length mk-length) x))));
    (lambda (mk-length)
      ((lambda (length)
         (lambda (l)
           (cond
             ((null? l) 0)
             (else (add1 (length (cdr l)))))))
       (lambda (x)
         ((mk-length mk-length) x))));
    ) x)))

;将③中length提取出来
(lambda (le)
  ((lambda (mk-length)
     (mk-length mk-length))
   (lambda (mk-length)
     (le (lambda (x)
           ((mk-length mk-length) x))))))

(define Y
  (lambda (le)
    ((lambda (f) (f f))
     (lambda (f)
       (le (lambda (x)
             ((f f) x)))))))

(newline)
(display ((Y
          (lambda (length)
            (lambda (l)
              (cond
                ((null? l) 0)
                (else (add1 (length (cdr l)))))))) '(apple or dfa dsf)))

;((Y f) '(a b c d))