; ycombinator - Apply this fn to this pair in the list
; ------------------------------
; The Little Lisper 3rd Edition
; Chapter 9
; Exercise 2
; Common Lisp
; http://t...content-available-to-author-only...r.com/thelittlelisper
; http://t...content-available-to-author-only...t.com/2010/06/little-lisper-chapter-9-lamdba-ultimate.html
; http://t...content-available-to-author-only...t.com/2010/06/little-lisper.html
; ------------------------------

(defun first_ (l)
  (cond
   ((null l) '())
   (t (car l))))

(defun second_ (l)
  (cond
   ((null l) '())
   (t (car (cdr l)))))
   
(defun third_ (l)
  (cond
   ((null l) '())
   (t (car (cdr (cdr l))))))
   
(defun pair? (lat)
  (cond
   ((null lat) NIL)
   ((atom lat) NIL)
   ((and (and (not (eq (first_ lat) NIL))
              (not (eq (second_ lat) NIL))))
    (eq (third_ lat) NIL))
   (t NIL)))

(defun eq-pair-first (pair-a-first pair-b)
  (cond
   ((null pair-a-first) NIL)
   ((null pair-b) NIL)
   ((not(atom pair-a-first)) NIL)
   ((atom pair-b) NIL)
   ((not (pair? pair-b)) NIL)
   ((eq pair-a-first 
             (first_ pair-b)))
   (t NIL)))

(print (eq-pair-first 'a '(a b)))
;T

(print (eq-pair-first 'a '(b a)))
;NIL false


(defun rel? (rel)
  (cond
   ((null rel) t)
   ((atom rel) NIL)
   ((pair? (car rel))
    (rel? (cdr rel)))
   (t NIL)))

(print (rel? '((a b)(a c)(a a))))
;T

(defun exists? (first rel)   
  (cond
   ((null first) t)
   ((null rel) NIL)
   ((not(rel? rel)) NIL)
   ((eq-pair-first first (car rel)) t)   
   (t (exists? first (cdr rel)))))

(print (exists? 'a '((a b)(a c)(a a))))
;T

(print (exists? 'd '((a b)(a c)(a a))))
;NIL false
   
(defun find-match (a l)
  (cond
   ((null a) '())
   ((null l) NIL)
   ((not(rel? l)) NIL)
   ((eq-pair-first a (car l) ) (car l))   
   (t (find-match a (cdr l)))))

(print (find-match 'a '((a b)(a c)(a a))))
;(A B)

(defun assq-sf (a l sk fk)
  (cond
   ((exists? a l)
    (funcall sk (find-match a l)))
   (t (funcall fk a))))

(defun build (a b)
  (cons a (cons b '())))

(defun add1 (n) 
  (+ 1 n))

(setf a 'apple)
(setf b1 '())
(setf b2 '((apple 1)(plum 2)))
(setf b3 '((peach 3)))
(setf sk (lambda (p)(build (first p) (add1 (second p)))))
(setf fk (lambda  (name) (cons name (quote (not-in-list)))))

(print (assq-sf a b1 sk fk))
;(APPLE NOT-IN-LIST)

(print (assq-sf a b2 sk fk))
;(APPLE 2)

(print (assq-sf a b3 sk fk))
;(APPLE NOT-IN-LIST)