"NEXT: Introduction to higher-order functions: flip"

(define (flip f)
  (lambda (x y)
    (f y x)))

(define flip
  (lambda (f)
    (lambda (x y)
      (f y x))))

(- 5 6)
((flip -) 5 6)
(cons 5 6)
((flip cons) 5 6)

"NEXT: Introduction to higher-order functions: negate"

(define (negate p)
  (lambda (x) 
    (not (p x))))

(define (is-even? x)
  (= (remainder x 2) 0))

(is-even? 5)
(is-odd? 5)

(define is-odd? (negate is-even?))
(is-odd? 5)

(< 5 6)
((negate <) 5 6)   ; UPS...

(define (negate p)
  (lambda x
    (not (apply p x))))

((negate <) 5 6)

"NEXT: compose"

(define (compose f g)
  (lambda (x)
    (f (g x))))

((compose is-even? (lambda (x) (* 2 x))) 3)

(define ff 
  (compose 
     (lambda (x) (* x x))
     (lambda (x) (+ x 1))))

(ff 5)

"NEXT: Linear search: find-in-list"

(define (find-in-list pred lst)
  (cond ((null? lst) #f)
        ((pred (car lst)) (car lst))
        (else (find-in-list pred (cdr lst)))))

(define lst (list #f 6.7 5 (cons 5 6) #\a (lambda(x) (* x 2))))

(find-in-list integer? lst)
(find-in-list real? lst)
(find-in-list boolean? lst)
(find-in-list pair? lst)
(find-in-list char? lst)
(find-in-list procedure? lst)

"NEXT: Selector functions: first, second, third, .."

(define (make-selector-function n)
  (lambda (lst) (list-ref lst (- n 1))))

(define first  (make-selector-function 1))
(define second (make-selector-function 2))
(define third  (make-selector-function 3))

(let ((lst (list 1 2 3 4 5)))
  (list (third lst) (second lst) (first lst)))


"NEXT: Mapping and filtering"

(define (mymap f lst)
  (if (null? lst)
      '()
      (cons (f (car lst))
            (mymap f (cdr lst)))))

(mymap is-even? (list 1 2 3 4 5 6 7))
(mymap (lambda (x) (* x 2)) (list 1 2 3 4 5 6 7))

(map is-even? (list 1 2 3 4 5 6 7))
(map (lambda (x) (* x 2)) (list 1 2 3 4 5 6 7))

(define (myfilter p lst)
  (cond ((null? lst) lst)
        ((p (car lst)) (cons (car lst) (myfilter p (cdr lst))))
        (else (myfilter p (cdr lst)))))

(myfilter is-even? (list 1 2 3 4 5 6 7 8))
(myfilter (negate is-even?) (list 1 2 3 4 5 6 7 8))

(define (iterative-filter pred lst)
  (reverse (filter-help pred lst '())))

(define (filter-help pred lst res)
  (cond ((null? lst) res)
        ((pred (car lst)) 
           (filter-help pred (cdr lst)  (cons (car lst) res)))
        (else 
           (filter-help pred (cdr lst)  res))))

(iterative-filter is-even? (list 1 2 3 4 5 6 7 8))
(iterative-filter (negate is-even?) (list 1 2 3 4 5 6 7 8))


"NEXT: Reduction and accumulation"

(reduce-right - (list 1 2 3 4 5))  ; undefined
(- 1 (- 2 (- 3 (- 4 5))))

(define (reduce-right f lst)
  (if (null? (cdr lst))
      (car lst)
      (f (car lst) 
         (reduce-right f (cdr lst)))))

(reduce-right - (list 1 2 3 4 5))
(reduce-right - (list 1))
(reduce-right - (list))

(reduce-left - (list 1 2 3 4 5))
(- (- (- (- 1 2) 3) 4) 5)

(define (reduce-left f lst)
  (reduce-help-left f (cdr lst) (car lst)))

(define (reduce-help-left f lst res)
  (if (null? lst)
      res
      (reduce-help-left f (cdr lst) (f res (car lst)))))

(reduce-left - (list 1 2 3 4 5))

(define (reduce-left f lst)  ; All in one
  (letrec ((reduce-help-left
             (lambda (f lst res)
                (if (null? lst)
                    res
                   (reduce-help-left f (cdr lst) (f res (car lst)))))))
    (reduce-help-left f (cdr lst) (car lst))))

(reduce-left - (list 1 2 3 4 5))
(reduce-left - (list 1))
(reduce-left - (list))


(define (accumulate-right f init lst)
  (if (null? lst)
      init
      (f (car lst) (accumulate-right f init (cdr lst)))))

(accumulate-right - 0 (list 1 2 3 4 5))
(accumulate-right - 0 (list 1))
(accumulate-right - 0 (list))

"NEXT: zip"

(define (zip z lst1 lst2)
  (if (null? lst1)
      '()
      (cons 
        (z (car lst1) (car lst2))
        (zip z (cdr lst1) (cdr lst2)))))

(zip cons (list 1 2 3) (list 'a 'b 'c))

"NEXT: Currying"

(define (curry2 f)
  (lambda(x)
    (lambda(y)
      (f x y))))

(- 1 2)
(((curry2 -) 1) 2)

(define (curry3 f)
  (lambda(x)
    (lambda(y)
      (lambda(z)
       (f x y z)))))

(- 1 2 3)
((((curry3 -) 1) 2) 3)

(define (uncurry2 f)
  (lambda (x y)
    ((f x) y)))

((uncurry2 (curry2 -)) 1 2)

(define (uncurry3 f)
  (lambda (x y z)
    (((f x) y) z)))


"NEXT: Continuation passing style"

(define (p-direct a b)
  (* (+ a b) (- a b)))

(p-direct 5 10)

(define (p-cps a b k0)
  (plus a b (lambda(v1)
              (sub a b (lambda(v2)
                         (mult v1 v2 k0))))))

(define (plus a b k) (k (+ a b )))
(define (sub a b k)  (k (- a b)))
(define (mult a b k) (k (* a b)))

(p-cps 5 10 (lambda (x) x))

(define (fact-direct n)
  (if (= n 0)
      1
      (* n (fact-direct (- n 1)))))

(fact-direct 5)

(define (fact-cps n k)
  (if (= n 0)
      (k 1)
      (fact-cps (- n 1)
                (lambda(v)       ; Eventually v becomes (fact (- n 1)). 
                  (k (* n v)))   ; Now pass (* n v) = (* n (fact (- n 1))) to k.
      )
  )
)

(fact-cps 5 (lambda (x) x))

(define (fact-tail-rec n r)
  (if (= 0 n)
      r
      (fact-tail-rec (- n 1) (* r n))))

(fact-tail-rec 5 1)

(define (fact-tail-rec-cps-1 n r k)
  (if (= 0 n)
      (k r)
      (fact-tail-rec-cps-1
        (- n 1)
        (* r n)
        (lambda (v)  ; Eventually v becomes (fact n), because the base case passes 
           (k v))    ; the result via a chain of trivial "pass on" functions.
                     ; Are all these (lambda(v) (k v)) functions really necessary?
      )              ; No - see the next variant called fact-tail-rec-cps-2.
  )
)

(fact-tail-rec-cps-1 5 1 (lambda (x) x))

(define (fact-tail-rec-cps-2 n r k)
  (if (= 0 n)
      (k r)
      (fact-tail-rec-cps-2
        (- n 1)
        (* r n)
        k           ; Eventually (fact n) is passed to k. k is the continuation 
      )             ; of the original call to the factorial function.
   )
)

(fact-tail-rec-cps-2 5 1 (lambda (x) x))

"NEXT: list-length"

(define (list-length lst)
   (cond ((null? lst) 0)
         ((pair? lst) (+ 1 (list-length (cdr lst))))
         (else 'improper-list)))

(list-length '(a b c))
(list-length '(a b c . d))

(define (list-length-direct lst)
  (call-with-current-continuation
   (lambda (do-exit)
     (letrec ((list-length-inner
                (lambda (lst)
                   (cond ((null? lst) 0)
                         ((pair? lst) (+ 1 (list-length-inner (cdr lst))))
                         (else (do-exit 'improper-list))))))
       (list-length-inner lst)))  ))

(list-length-direct '(a b c . d))

(define (list-length-cps lst k0)    ; Now CPS. k0 is the outer continuation - ready to catch exceptional values
  (letrec ((list-length-inner
             (lambda (lst k1) 
               (cond ((null? lst) (k1 0))
                     ((pair? lst) (list-length-inner
                                    (cdr lst)
                                    (lambda (v) (k1 (+ 1 v))) ; v is the length of (cdr l).
                                                              ; Pass 1+v to k1.
                                )
                     )
                     (else (k0 'improper-list)))) ))         ; Pass the symbol improper-list
                                                             ; to the outer continuation k0.
    (list-length-inner lst k0)))

(list-length-cps '(a b c . d) (lambda (x) x))

(define (list-length-iter-cps lst res k0)  ; CPS, but now iterative, tail-recursive.
  ; k0 is passed along the tail recursive calls, and
  ; can also be used for passing 'an exceptional value'.
  (cond ((null? lst) (k0 res))
        ((pair? lst) (list-length-iter-cps (cdr lst) (+ res 1) k0))
        (else (k0 'improper-list))))

(list-length-iter-cps '(a b c . d) 0 (lambda (x) x))
(list-length-iter-cps '(a b c d) 0 (lambda (x) x))

"THE END"