;; MoreFunctionals.scm
;; NKU CSC 601  - Fall 2002 - Kirby
;; -----------------------------------------------------------
;; Some more Scheme examples, with an emphasis on functionals.
;; -----------------------------------------------------------


;; I. Four functionals lifted out of C++ <functional> 
;;    (See Stroustrup, p518.)

(define bind1st~
  ; Curry first arg of 2-arg function.  
  (lambda (c f)
    (lambda (x)
      (f c x))))

(define bind2nd~
  ; Curry second arg of 2-arg function.   
  (lambda (f c)
    (lambda (x)
      (f x c))))

(define not1~
  ; Negator functional.  
  (lambda (pred)
    (lambda (x)
      (not (pred x)))))

(define not2~
  ; Negator functional, for 2-arg predicates. 
  (lambda (pred1 pred2)
    (lambda (x)
      (not (pred x y)))))



;; II. Some functors lifted out of C++ <functional>
;;    (See Stroustrup, p516.)


(define and~
  ; Functional that &&s two 1-arg predicates. Cf. "logical_and" in C++ STL.
  (lambda (pred1 pred2)
    (lambda (x)
      (and (pred1 x) (pred2 x)))))

(define <~
  ; Called "less" in C++ STL.
  (lambda (x)
    (bind2nd~ < x)))

(define >~
  ; Called "greater" in C++ STL.
  (lambda (x)
    (bind2nd~ > x)))

(define eq~
  ; Called "equal_to" in C++ STL.
  (lambda (x)
    (bind2nd~ eq? x)))




;; III. Other functionals.

(define compose~
  ; Compose two 1-arg functions.
  (lambda (f g)
    (lambda (x)
      (f (g x)))))




;; IV.  Some usage.

(define young-adult? 
  (and~ (>~ 17) (<~ 28)))

(define even-list?
  ; A list with an even number of items.
  (and~ list?
        (compose~ even? length)))

(define couple?
  ; A list with 2 items.
  (and~ pair? 
        (compose~ (eq~ 2) length)))




;; V. Quantifiers.

(define for-all
  (lambda (pred s)
    (if (null? s)
        #t
        (and (pred (car s))
             (for-all pred (cdr s))))))

(define for-some
  (lambda (pred s)
    (if (null? s)
        #f
        (or (pred (car s))
             (for-some pred (cdr s))))))

; (for-all even? '(16 24 42 56))  ; ==> #t
; (for-all even? '(15 28 40 55))  ; ==> #f
; (for-some even? '(16 28 40 55)) ; ==> #t