;; Used to redefine Racket functions in terms of the original functions
(require (rename-in racket
                    (cons racket-cons)
                    (null? racket-null?)
                    (eq? racket-eq?)
                    (+ racket+)
                    (- racket-)
                    (number? racket-number?)))

(provide (all-defined-out))


;;**********************************************************
;; Preface
;;**********************************************************

;; (Primitive)
;; Predicate for determining if a value is an atom or not.
;; The definition of this is found in the preface.
(define (atom? x)
  (and (not (pair? x)) (not (racket-null? x))))
;; Note that we need to use the racket-null? and not our newly contracted null?
;; becuase x may be an atom, which racket-null? supports and null? (as defined
;; in the book and thus our contracted version) does not.


;;**********************************************************
;; Chapter 1
;;**********************************************************

;; (Primitive)
;; Predicate for determining if a value is an S-expression or not
(define (s-exp? x)
  (or (atom? x) (list? x)))

;; (Primitive)
;; Provide a cons as defined in the book such that it requires a list as
;; the second argument. This is enforced using Racket's contract system.
;; Racket's cons works on any values, as mentioned in the footnote on page 8.
(define/contract (cons s l)
  (-> any/c list? list?)
  (racket-cons s l))

;; (Primitive)
;; Provide a cons as defined in the book such that it requires a list as
;; the argument. See the footnote on page 10.
(define/contract (null? l)
  (-> list? boolean?)
  (racket-null? l))

;; (Primitive)
;; Provide an eq? as defined in the book such that it requires a non-numeric
;; atom for each argument. See the footnotes on page 12.
(define/contract (eq? a b)
  (-> (and/c atom? (not/c racket-number?)) (and/c atom? (not/c racket-number?)) boolean?)
  (racket-eq? a b))


;;**********************************************************
;; Chapter 2
;;**********************************************************

;; Predicate for determining if a value is a list of atoms or not
(define lat?
  (lambda (l)
    (cond
      ((null? l) #t)
      ((atom? (car l)) (lat? (cdr l)))
      (else #f))))

;; Predicate for determining if a value is an element of the list of atoms or not
#;(define member?
    (lambda (a lat)
      (cond
        ((null? lat) #f)
        (else (or (eq? (car lat) a)
                  (member? a (cdr lat)))))))


;;**********************************************************
;; Chapter 3
;;**********************************************************

;; Removes the first occurence of the atom, if possible, in the list of atoms
;; (Rewritten below in the Chapter 5 section using equal? as instructed by the book)
#;(define rember
    (lambda (a lat)
      (cond
        ((null? lat) '())
        ((eq? a (car lat)) (cdr lat))
        (else (cons (car lat)
                    (rember a (cdr lat)))))))

;; Takes a list and returns a list of the first elements of each sublist
(define firsts
  (lambda (l)
    (cond
      ((null? l) '())
      (else (cons (car (car l))
                  (firsts (cdr l)))))))

;; Inserts new after the first occurrence, if any, of old in lat, a list of atoms
;; (Rewritten using insert-g in Chapter 8.)
#;(define insertR
    (lambda (new old lat)
      (cond
        ((null? lat) '())
        ((eq? old (car lat)) (cons old
                                   (cons new (cdr lat))))
        (else (cons (car lat)
                    (insertR new old (cdr lat)))))))

;; Inserts new before the first occurrence, if any, of old in lat, a list of atoms
;; (Rewritten using insert-g in Chapter 8.)
#;(define insertL
    (lambda (new old lat)
      (cond
        ((null? lat) '())
        ((eq? old (car lat)) (cons new lat)) ; since (cons old (cdr lat)) = lat when old = (car lat)
        (else (cons (car lat)
                    (insertL new old (cdr lat)))))))

;; Replaces the first occurrence of old, if any, with new, in lat, a list of atoms
;; (Rewritten using insert-g in Chapter 8.)
#;(define subst
    (lambda (new old lat)
      (cond
        ((null? lat) '())
        ((eq? old (car lat)) (cons new (cdr lat)))
        (else (cons (car lat)
                    (subst new old (cdr lat)))))))

;; Replaces the first occurence of o1 or o2, if any, in lat, a list of atoms
(define subst2
  (lambda (new o1 o2 lat)
    (cond
      ((null? lat) '())
      ((or (eq? o1 (car lat)) (eq? o2 (car lat))) (cons new (cdr lat)))
      (else (cons (car lat)
                  (subst2 new o1 o2 (cdr lat)))))))

;; Removes all occurrences of a in lat, a list of atoms
#;(define multirember
    (lambda (a lat)
      (cond
        ((null? lat) '())
        ((eq? a (car lat)) (multirember a (cdr lat)))
        (else (cons (car lat)
                    (multirember a (cdr lat)))))))

;; Inserts new after all occurrences of old in lat, a list of atoms
(define multiinsertR
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      ((eq? old (car lat)) (cons old
                                 (cons new
                                       (multiinsertR new old (cdr lat)))))
      (else (cons (car lat)
                  (multiinsertR new old (cdr lat)))))))

;; Inserts new before all occurrences of old in lat, a list of atoms
(define multiinsertL
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      ((eq? old (car lat)) (cons new
                                 (cons (car lat)
                                       (multiinsertL new old (cdr lat))))) ; since (cons old (cdr lat)) = lat when old = (car lat)
      (else (cons (car lat)
                  (multiinsertL new old (cdr lat)))))))

;; Replaces all occurrences of old with new in lat, a list of atoms
(define multisubst
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      ((eq? old (car lat)) (cons new (multisubst new old (cdr lat))))
      (else (cons (car lat)
                  (multisubst new old (cdr lat)))))))


;;**********************************************************
;; Chapter 4
;;**********************************************************

;; Adds 1 to the number n
(define add1
  (lambda (n)
    (racket+ n 1)))

;; Subtracts 1 from the number n
(define sub1
  (lambda (n)
    (racket- n 1)))

;; Add two non-negative integer numbers
(define +
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (+ (add1 n) (sub1 m))))))
; I think this is more clear by adding 1 to n rather than the result

;; Subtract two non-negative integer numbers
(define -
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (- (sub1 n) (sub1 m))))))
; I think this is more clear by subtracting 1 from n rather than the result

;; (Primitive)
;; Predicate for determining if a list is a list of non-negative numbers or not
(define (tup? x)
  (andmap exact-nonnegative-integer? x))

;; Adds all the numbers in a tuple together
(define addtup
  (lambda (tup)
    (cond
      ((null? tup) 0)
      (else (+ (car tup) (addtup (cdr tup)))))))

;; Multiples two non-negative integer numbers
(define *
  (lambda (n m)
    (cond
      ((zero? m) 0)
      (else (+ n (* n (sub1 m)))))))

;; Adds the elements of two tuples together
(define tup+
  (lambda (tup1 tup2)
    (cond
      ((null? tup1) tup2)
      ((null? tup2) tup1)
      (else (cons (+ (car tup1) (car tup2))
                  (tup+ (cdr tup1) (cdr tup2)))))))

;; Determines if n > m
(define >
  (lambda (n m)
    (cond
      ((zero? n) #f)
      ((zero? m) #t)
      (else (> (sub1 n) (sub1 m))))))

;; Determines if n < m
(define <
  (lambda (n m)
    (cond
      ((zero? m) #f)
      ((zero? n) #t)
      (else (< (sub1 n) (sub1 m))))))

;; Determines if two numbers are equal or not
(define =
  (lambda (n m)
    (cond
      ((< n m) #f)
      ((> n m) #f)
      (else #t))))

;; Computes n to the power of m
(define ^
  (lambda (n m)
    (cond
      ((zero? m) 1)
      (else (* n (^ n (sub1 m)))))))

;; Computes how many times m divides n
(define /
  (lambda (n m)
    (cond
      ((< n m) 0)
      (else (add1 (/ (- n m) m))))))

;; Returns the length of lat, a list of atoms
(define length
  (lambda (lat)
    (cond
      ((null? lat) 0)
      (else (add1 (length (cdr lat)))))))

;; Picks the nth element of lat, a list of atoms
(define pick
  (lambda (n lat)
    (cond
      ((zero? (sub1 n)) (car lat))
      (else (pick (sub1 n) (cdr lat))))))

;; Removes the nth element from lat, a list of atoms
(define rempick
  (lambda (n lat)
    (cond
      ((one? n) (cdr lat))
      (else (cons (car lat)
                  (rempick (sub1 n) (cdr lat)))))))

;; (Primitive)
;; Predicate for determining if a value is a numeric atom, i.e. a non-negative integer, or not
(define (number? x)
  (exact-nonnegative-integer? x))

;; Removes all numbers from lat, a list of atoms
(define no-nums
  (lambda (lat)
    (cond
      ((null? lat) '())
      ((number? (car lat)) (no-nums (cdr lat)))
      (else (cons (car lat)
                  (no-nums (cdr lat)))))))

;; Returns a tuple made out of all the numbers in lat, a list of atoms
(define all-nums
  (lambda (lat)
    (cond
      ((null? lat) '())
      ((number? (car lat)) (cons (car lat) (all-nums (cdr lat))))
      (else (all-nums (cdr lat))))))

;; Predicate that determines if a1 and a2 are the same number or same atom
(define eqan?
  (lambda (a1 a2)
    (cond
      ((and (number? a1) (number? a2)) (= a1 a2))
      ((or (number? a1) (number? a2)) #f)
      (else (eq? a1 a2)))))

;; Counts the number of times the atom a occurs in lat, a list of atoms
(define occur
  (lambda (a lat)
    (cond
      ((null? lat) 0)
      ((eq? a (car lat)) (add1 (occur a (cdr lat))))
      (else (occur a (cdr lat))))))

;; Predicate that determines if n is 1 or not
(define one?
  (lambda (n)
    (= n 1)))


;;**********************************************************
;; Chapter 5
;;**********************************************************

;; Removes the atom a everywhere it occurs the list l
(define rember*
  (lambda (a l)
    (cond
      ((null? l) '())
      ((atom? (car l))
       (cond
         ((eq? a (car l)) (rember* a (cdr l)))
         (else (cons (car l) (rember* a (cdr l))))))
      (else (cons (rember* a (car l)) (rember* a (cdr l)))))))

;; Inserts new to the right of where old appears everywhere in the list l
(define insertR*
  (lambda (new old l)
    (cond
      ((null? l) '())
      ((atom? (car l))
       (cond
         ((eq? old (car l)) (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)))))))

;; Counts how many times the atom a occurs in the list l
(define occur*
  (lambda (a l)
    (cond
      ((null? l) 0)
      ((atom? (car l))
       (cond
         ((eq? a (car l)) (add1 (occur* a (cdr l))))
         (else (occur* a (cdr l)))))
      (else (+ (occur* a (car l))
               (occur* a (cdr l)))))))

;; Replaces old with new everywhere old appears in the list l
(define subst*
  (lambda (new old l)
    (cond
      ((null? l) '())
      ((atom? (car l))
       (cond
         ((eq? old (car l)) (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)))))))

;; Inserts new to the left of where old appears everywhere in the list l
(define insertL*
  (lambda (new old l)
    (cond
      ((null? l) '())
      ((atom? (car l))
       (cond
         ((eq? old (car l)) (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)))))))

;; Determines if the atom is found in the list l
(define member*
  (lambda (a l)
    (cond
      ((null? l) #f)
      ((atom? (car l)) (or (eq? a (car l))
                           (member* a (cdr l))))
      (else (or (member* a (car l))
                (member* a (cdr l)))))))

;; Returns the leftmost atom in a non-empty list
(define leftmost
  (lambda (l)
    (cond
      ((atom? (car l)) (car l))
      (else (leftmost (car l))))))

;; Determines if the two lists are equal or not
;; (Rewritten below using equal? as instructed by the book)
#;(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)))))))

;; Determines if the two S-expressions are equal or not
(define equal?
  (lambda (s1 s2)
    (cond
      ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
      ((or (atom? s1) (atom? s2)) #f)
      (else (eqlist? s1 s2)))))

;; Determines if the two lists are equal or not
(define eqlist?
  (lambda (l1 l2)
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((or (null? l1) (null? l2)) #f)
      (else (and (equal? (car l1) (car l2))
                 (equal? (cdr l1) (cdr l2)))))))

;; Removes the first occurence of the atom, if possible, in the list of atoms
(define rember
  (lambda (s l)
    (cond
      ((null? l) '())
      ((equal? s (car l)) (cdr l))
      (else (cons (car l)
                  (rember s (cdr l)))))))


;;**********************************************************
;; Chapter 6
;;**********************************************************

;; Determines if the arithmetic expression aexp contains only numbers besides +, *, and ^
#;(define numbered?
    (lambda (aexp)
      (cond
        ((atom? aexp) (number? aexp))
        ((or (eq? (car (cdr aexp)) (quote +))
             (eq? (car (cdr aexp)) (quote *))
             (eq? (car (cdr aexp)) (quote ^))) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
        (else #f))))
;; Note: the book assumes aexp is already an arithmetic expression such that we don't need to test that it is
;; as this implementation does, looking for +, *, and ^.

;; Determines if the arithmetic expression aexp contains only numbers besides +, *, and ^
(define numbered?
  (lambda (aexp)
    (cond
      ((atom? aexp) (number? aexp))
      (else (and (numbered? (car aexp))
                 (numbered? (car (cdr (cdr aexp)))))))))

;; The book has two implementations of value for two different representations.
;; The value for the first representation is what is implemented here.

;; Evaluates the value of a numbered arithmetic expression
#;(define value
    (lambda (nexp)
      (cond
        ((atom? nexp) nexp) ; Really should ask number? and not just atom?
        ((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))))))
        ((eq? (car (cdr nexp)) (quote ^)) (^ (value (car nexp)) (value (car (cdr (cdr nexp)))))))))
;; Note: I'm not a fan of the book's implementation, which assumes ^.

;; Gets the first sub-expression from an arithmetic expression
(define 1st-sub-exp
  (lambda (aexp)
    (car (cdr aexp))))

;; Gets the second sub-expression from an arithmetic expression
(define 2nd-sub-exp
  (lambda (aexp)
    (car (cdr (cdr aexp)))))

;; Gets the operator from an arithmetic expression
(define operator
  (lambda (aexp)
    (car aexp)))

;; Evaluates the value of a numbered arithmetic expression
;; (Rewritten using atom-to-function in  Chapter 8.)
#;(define value
    (lambda (nexp)
      (cond
        ((atom? nexp) nexp)
        ((eq? (operator nexp) (quote +)) (+ (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp))))
        ((eq? (operator nexp) (quote *)) (* (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp))))
        ((eq? (operator nexp) (quote ^)) (^ (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp)))))))
;; Note: I'm not a fan of the book's implementation, which assumes ^.


;;**********************************************************
;; Chapter 7
;;**********************************************************

;; Predicate for determining if a value is an element of the list of atoms or not
;; Redefined using equal? instead of eq?
(define member?
  (lambda (a lat)
    (cond
      ((null? lat) #f)
      (else (or (equal? (car lat) a)
                (member? a (cdr lat)))))))

;; Determines whether a list of atoms is a set or not
(define set?
  (lambda (lat)
    (cond
      ((null? lat) #t)
      ((member? (car lat) (cdr lat)) #f)
      (else (set? (cdr lat))))))

;; Makes a set out of a list of atoms
#;(define makeset
    (lambda (lat)
      (cond
        ((null? lat) '())
        ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
        (else (cons (car lat) (makeset (cdr lat)))))))

;; Removes all occurrences of a in lat, a list of atoms
;; Redefined using equal? instead of eq?
(define multirember
  (lambda (a lat)
    (cond
      ((null? lat) '())
      ((equal? a (car lat)) (multirember a (cdr lat)))
      (else (cons (car lat)
                  (multirember a (cdr lat)))))))

;; Makes a set out of a list of atoms
(define makeset
  (lambda (lat)
    (cond
      ((null? lat) '())
      (else (cons (car lat)
                  (makeset (multirember (car lat) (makeset (cdr lat)))))))))

;; Determines if set1 is a subset of set2 or not
(define subset?
  (lambda (set1 set2)
    (cond
      ((null? set1) #t)
      (else (and (member? (car set1) set2)
                 (subset? (cdr set1) set2))))))

;; Determines if the two sets are equal or not
(define eqset?
  (lambda (set1 set2)
    (and (subset? set1 set2)
         (subset? set2 set1))))

;; Determines if the two set intersect or not
(define intersect?
  (lambda (set1 set2)
    (cond
      ((null? set1) #t)
      (else (or (member? (car set1) set2)
                (intersect? (cdr set1) set2))))))

;; Returns the intersection of the two sets
(define intersect
  (lambda (set1 set2)
    (cond
      ((null? set1) '())
      ((member? (car set1) set2) (cons (car set1)
                                       (intersect (cdr set1) set2)))
      (else (intersect (cdr set1) set2)))))

;; Returns the union of the two sets
(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))))))

;; Intersects all the sets in the list of sets
(define intersectall
  (lambda (l-set)
    (cond
      ((null? (cdr l-set)) (car l-set))
      (else (intersect (car l-set) (intersectall (cdr l-set)))))))

;; Determines whether an S-expression is a list of only two S-expressions
(define a-pair?
  (lambda (x)
    (cond
      ((atom? x) #f)
      ((null? x) #f)
      ((null? (cdr x)) #f)
      (else (and (s-exp? (car x))
                 (s-exp? (car (cdr x)))
                 (null? (cdr (cdr x))))))))

;; Returns the first S-expression of a list or pair
(define first
  (lambda (p)
    (car p)))

;; Returns the second S-expression of a list or pair
(define second
  (lambda (p)
    (car (cdr p))))

;; Returns the third S-expression of a list
(define third
  (lambda (p)
    (car (cdr (cdr p)))))

;; Builds a pair out of the two S-expressions
(define build
  (lambda (s1 s2)
    (cons s1 (cons s2 '()))))

;; Determines whether a relation is a function or not
(define fun?
  (lambda (rel)
    (set? (firsts rel))))

;; Reverses a pair
(define revpair
  (lambda (pair)
    (build (second pair)
           (first pair))))

;; Reverses a relation
(define revrel
  (lambda (rel)
    (cond
      ((null? rel) '())
      (else (cons (revpair (car rel))
                  (revrel (cdr rel)))))))

;; Takes a list and returns a list of the second elements of each sublist
(define seconds
  (lambda (l)
    (cond
      ((null? l) '())
      (else (cons (second (car l))
                  (seconds (cdr l)))))))

;; Determines whether a function is full or not
(define fullfun?
  (lambda (fun)
    (set? (seconds fun))))

;; Determines whether a function is one-to-one or not
(define one-to-one?
  (lambda (fun)
    (fun? (revrel fun))))


;;**********************************************************
;; Chapter 8
;;**********************************************************

;; Removes the first occurence of the atom a where (test? a) is true in the list of atoms
;; (Rewritten below as instructed by the book)
#;(define rember-f
    (lambda (test? a l)
      (cond
        ((null? l) '())
        ((test? a (car l)) (cdr l))
        (else (cons (car l)
                    (rember-f test? a (cdr l)))))))

;; Returns a function that tests equality against the atom a
(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))

;; A function to test if the argument is eq? to 'salad
(define eq?-salad (eq?-c 'salad))

;; Removes the first occurence of the atom a where (test? a) is true in the list of atoms
(define rember-f
  (lambda (test?)
    (lambda (a l)
      (cond
        ((null? l) '())
        ((test? a (car l)) (cdr l))
        (else (cons (car l)
                    ((rember-f test?) a (cdr l))))))))

;; Removes the first occurence of the atom a, using eq?, in the list of atoms
(define rember-eq? (rember-f eq?))

;; Inserts new before the first occurrence, if any, of old in lat, a list of atoms
(define insertL-f
  (lambda (test?)
    (lambda (new old lat)
      (cond
        ((null? lat) '())
        ((test? old (car lat)) (cons new lat)) ; since (cons old (cdr lat)) = lat when old = (car lat)
        (else (cons (car lat)
                    ((insertL-f test?) new old (cdr lat))))))))

;; Inserts new after the first occurrence, if any, of old in lat, a list of atoms
(define insertR-f
  (lambda (test?)
    (lambda (new old lat)
      (cond
        ((null? lat) '())
        ((test? old (car lat)) (cons old
                                     (cons new (cdr lat))))
        (else (cons (car lat)
                    ((insertR-f test?) new old (cdr lat))))))))

;; Conses new onto the cons of old and l
(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

;; Conses old onto the cons of new and l
(define seqR
  (lambda (new old l)
    (cons old (cons new l))))

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

;; Inserts new before the first occurrence, if any, of old in lat, a list of atoms
(define insertL (insert-g seqL))

;; Inserts new after the first occurrence, if any, of old in lat, a list of atoms
(define insertR (insert-g seqR))

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

;; Replaces the first occurrence of old, if any, with new, in lat, a list of atoms
(define subst (insert-g seqS))

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

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

;; Takes '+, '*, and '^ and returns +, *, and ^, respectively
(define atom-to-function
  (lambda (x)
    (cond
      ((eq? x (quote +)) +)
      ((eq? x (quote *)) *)
      (else ^))))

;; Evaluates the value of a numbered arithmetic expression
;; (Rewritten below in Chapter 10)
#;(define value
    (lambda (nexp)
      (cond
        ((atom? nexp) nexp)
        (else ((atom-to-function (operator nexp))
               (value (1st-sub-exp nexp))
               (value (2nd-sub-exp nexp)))))))

;; Removes all occurrences of a, using test?, in lat, a list of atoms
(define multirember-f
  (lambda (test?)
    (lambda (a lat)
      (cond
        ((null? lat) '())
        ((test? a (car lat)) ((multirember-f test?) a (cdr lat)))
        (else (cons (car lat)
                    ((multirember-f test?) a (cdr lat))))))))

;; Removes all occurrences of a, using eq?, in lat, a list of atoms
(define multirember-eq? (multirember-f eq?))

;; A function to test if the argument is eq? to 'tuna
(define eq?-tuna (eq?-c (quote tuna)))

;; Removes all occurences that pass the test test? in lat, a list of atoms
(define multiremberT
  (lambda (test? lat)
    (cond ((null? lat) '())
          ((test? (car lat)) (multiremberT test? (cdr lat)))
          (else (cons (car lat)
                      (multiremberT test? (cdr lat)))))))

;; Looks at every atom of lat, a list of atoms, to see whether
;; the atom is equal, using eq?, to a. Those atoms that are not
;; equal are collected in one list ls1. The atoms that are equal
;; are collected in a second list ls2. Finally, it determines the
;; value of (f ls1 ls2).
(define multirember&co
  (lambda (a lat col)
    (cond ((null? lat) (col '() '()))
          ((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)))

(define new-friend
  (lambda (newlat seen)
    (a-friend newlat
              (cons (car 'tuna) seen))))

(define latest-friend
  (lambda (newlat seen)
    (a-friend (cons 'and newlat)
              seen)))

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

;; Inserts new to the left of oldL and to the right of oldR in lat, a list of atoms,
;; for every occurrence of oldL and oldR
(define multiinsertLR
  (lambda (new oldL oldR lat)
    (cond ((null? lat) '())
          ((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 '() 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)))))))

;; Determines whether the number is even or not
(define even?
  (lambda (n)
    (= (* (/ n 2) 2) n)))

;; Removes all odd numbers from a list of nested lists
(define evens-only*
  (lambda (l)
    (cond ((null? l) '())
          ((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)))))))

(define evens-only*&co
  (lambda (l col)
    (cond ((null? l) (col '() 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)
                                                  (lambda (dl dp ds)
                                                    (col (cons al dl)
                                                         (* ap dp)
                                                         (+ as ds))))))))))

(define the-last-friend
  (lambda (newl product sum)
    (cons sum
          (cons product newl))))


;;**********************************************************
;; Chapter 9
;;**********************************************************

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

(define keep-looking
  (lambda (a sorn lat)
    (cond ((number? sorn) (keep-looking a (pick sorn lat) lat))
          (else (eq? sorn a)))))
;; Note: a sorn is a symbol or a number

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

;; Takes a pair whose first component is a pair and builds a pair by
;; shifting the second part of the first component into the second
;; component
(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)))))))

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

(define C
  (lambda (n)
    (cond ((one? n) 1)
          (else (cond ((even? n) (C (/ n 2)))
                      (else (C (add1 (* 3 n)))))))))

(define A
  (lambda (n m)
    (cond ((zero? n) (add1 m))
          ((zero? m) (A (sub1 n) 1))
          (else (A (sub1 n)
                   (A n (sub1 m)))))))

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


;;**********************************************************
;; Chapter 10
;;**********************************************************

;; Builds an entry from a set of names and a list of values
(define new-entry build)

;; Looks up the value corresponding to the name in the entry
;; and calls entry-f on name if the name is not in the entry
(define lookup-in-entry
  (lambda (name entry entry-f)
    (lookup-in-entry-help name
                          (first entry)
                          (second entry)
                          entry-f)))

;; Helper function for lookup-in-entry
(define lookup-in-entry-help
  (lambda (name names values entry-f)
    (cond ((null? names) (entry-f name))
          ((eq? (car names) name) (car values))
          (else (lookup-in-entry-help name
                                      (cdr names)
                                      (cdr values)
                                      entry-f)))))

;; Takes an entry and table and returns a new table with the
;; entry at the front
(define extend-table cons)

;; Looks up the value corresponding to the name in the table, using
;; the first value found, and calls entry-f on name if the name is not
;; found in the entries listed in the table
(define lookup-in-table
  (lambda (name table table-f)
    (cond ((null? table) (table-f name))
          (else (lookup-in-entry name
                                 (car table)
                                 (lambda (name)
                                   (lookup-in-table name
                                                    (cdr table)
                                                    (table-f))))))))

;; Converts an expression to an action
(define expression-to-action
  (lambda (e)
    (cond ((atom? e) (atom-to-action e))
          (else (list-to-action e)))))

;; Converts an atom to an action
(define atom-to-action
  (lambda (e)
    (cond ((number? e) *const)
          ((eq? e #t) *const)
          ((eq? e #f) *const)
          ((eq? e 'cons) *const)
          ((eq? e 'car) *const)
          ((eq? e 'cdr) *const)
          ((eq? e 'null?) *const)
          ((eq? e 'eq?) *const)
          ((eq? e 'atom?) *const)
          ((eq? e 'zero?) *const)
          ((eq? e 'add1) *const)
          ((eq? e 'sub1) *const)
          ((eq? e 'number?) *const)
          (else *identifier))))

;; Converts a list to an action
(define list-to-action
  (lambda (e)
    (cond ((atom? (car e))
           (cond ((eq? (car e) 'quote) *quote)
                 ((eq? (car e) 'lambda) *lambda)
                 ((eq? (car e) 'cond) *cond)
                 (else *application)))
          (else *application))))

(define value
  (lambda (e)
    (meaning e '())))

(define meaning
  (lambda (e table)
    ((expression-to-action e) e table)))

(define *const
  (lambda (e table)
    (cond ((number? e) e)
          ((eq? e #t) #t)
          ((eq? e #f) #f)
          (else (build 'primitive e)))))

(define *quote
  (lambda (e table)
    (text-of e)))

(define text-of second)

(define *identifier
  (lambda (e table)
    (lookup-in-table e table initial-table)))

(define initial-table
  (lambda (name)
    (car '())))

(define *lambda
  (lambda (e table)
    (build 'non-primitive
           (cons table (cdr e)))))

(define table-of first)

(define formals-of second)

(define body-of third)

(define evcon
  (lambda (lines table)
    (cond ((else? (question-of (car lines)))
           (meaning (answer-of (car lines)) table))
          ((meaning (question-of (car lines)) table)
           (meaning (answer-of (car lines)) table))
          (else (evcon (cdr lines) table)))))

(define else?
  (lambda (x)
    (cond
      ((atom? x) (eq? x 'else))
      (else #f))))

(define question-of first)

(define answer-of second)

(define *cond
  (lambda (e table)
    (evcon (cond-lines-of e) table)))

(define cond-lines-of cdr)

(define evlis
  (lambda (args table)
    (cond ((null? args) '())
          (else (cons (meaning (car args) table)
                      (evlis (cdr args) table))))))

(define *application
  (lambda (e table)
    (apply (meaning (function-of e) table)
           (evlis (arguments-of e) table))))

(define function-of car)

(define arguments-of cdr)

(define primitive?
  (lambda (l)
    (eq? (first l) 'primitive)))

(define non-primitive?
  (lambda (l)
    (eq? (first l) 'non-primitive)))

(define apply
  (lambda (fun vals)
    (cond ((primitive? fun) (apply-primitive (second fun) vals))
          ((non-primitive? fun) (apply-closure (second fun) vals)))))

(define apply-primitive
  (lambda (name vals)
    (cond ((eq? name 'cons) (cons (first vals) (second vals)))
          ((eq? name 'car) (car (first vals)))
          ((eq? name 'cdr) (cdr (first vals)))
          ((eq? name 'null?) (null? (first vals)))
          ((eq? name 'eq?) (eq? (first vals) (second vals)))
          ((eq? name 'atom?) (atom? (first vals)))
          ((eq? name 'add1) (add1 (first vals)))
          ((eq? name'sub1) (sub1 (first vals)))
          ((eq? name 'number?) (number? (first vals))))))

(define apply-closure
  (lambda (closure vals)
    (meaning (body-of closure)
             (extend-table
              (new-entry
               (formals-of closure)
               vals)
              (table-of closure)))))


;;**********************************************************
;; Tests
;;**********************************************************

(module+ test
  (require rackunit)

  ;;********************************************************
  ;; Primitives
  ;;********************************************************

  (check-false (atom? (quote ())))

  (check-false (atom? '()))

  (check-true (s-exp? '()))

  (check-true (s-exp? 'symbol))

  (check-equal? (cons 'a '()) '(a))

  (check-equal? (cons 'a '(b)) '(a b))

  (check-exn exn:fail? (thunk(cons 'a 'b)))

  (check-pred null? '())

  (check-pred null? (quote ()))

  (check-pred null? empty)

  (check-exn exn:fail? (thunk (null? 'a)))
  )