The Little Schemer

gistfile1.rkt

#lang racket
(define atom?
  (lambda (x)
    (and (not (pair? x)) (not (null? x)))))
 
;; Is each element in list l an atom?
(define lat?
  (lambda (l)
    (cond
      ((null? l) #t)
      ((atom? (car l)) (lat? (cdr l)))
      (else #f))))
 
;; Is atom a member of lat?
(define member?
  (lambda (a lat)
    (cond
      ((null? lat) #f)
      (else (or (eq? a (car lat))
                 (member? a (cdr lat)))))))
 
;; Removes atom a from lat
(define rember
  (lambda (a lat)
    (cond
      ((null? lat) '())
      (else (cond
              ((eq? a (car lat)) (cdr lat))
              (else (cons (car lat) 
                          (rember a (cdr lat)))))))))
 
;; Builds a list containing the first S-expression of each list inside of l
(define firsts
  (lambda (l)
    (cond
      ((null? l) '())
      (else (cons 
             (car (car l)) 
             (firsts (cdr l)))))))

;; inserts atom new to the right of atom old in list lat
(define insertR
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      (else
       (cond
         ((eq? (car lat) old) 
          (cons old (cons new (cdr lat))))
         (else (cons (car lat)
                     (insertR new old (cdr lat)))))))))

;; inserts atom new to the left of atom old in list lat
(define insertL
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      (else
       (cond
         ((eq? (car lat) old)
          (cons new lat))
         (else 
          (cons 
           (car lat) 
           (insertL new old (cdr lat)))))))))

;; replaces for occurrence of atom old with atom new in list lat
(define subst
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      (else (cond ((eq? (car lat) old) (cons new (cdr lat)))
                  (else (cons 
                         (car lat) 
                         (subst new old (cdr lat)))))))))

;; replaces first occurrence of atom o1 or the first occurrence of atom o2
;; by atom new in list lat
(define subst2
  (lambda (new o1 o2 lat)
    (cond
      ((null? lat) '())
      (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)))))))))
                    
;; Removes all occurrences of atom a from list lat
(define multirember
  (lambda (a lat)
    (cond
      ((null? lat) '())
      (else (cond
              ((eq? (car lat) a) (multirember a (cdr lat)))
              (else (cons (car lat)
                          (multirember a (cdr lat)))))))))

;; inserts atom new after each occurrence of atom old in list lat
(define multiinsertR
 (lambda (new old lat)
   (cond
     ((null? lat) '())
     (else (cond 
             ((eq? (car lat) old) 
              (cons old (cons new (multiinsertR new old (cdr lat)))))
             (else (cons 
                    (car lat) 
                    (multiinsertR new old (cdr lat)))))))))
                    
;; inserts atom new before each occurrence of atom old in list lat
(define multiinsertL
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      (else (cond 
              ((eq? (car lat) old) 
               (cons 
                new 
                (cons 
                 (car lat) 
                 (multiinsertL new old (cdr lat)))))
              (else 
               (cons 
                (car lat) 
                (multiinsertL new old (cdr lat)))))))))
                
;; replaces all occurences of atom old with atom new in list lat
(define multisubst
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      (else
       (cond
         ((eq? (car lat) old) 
          (cons new (multisubst new old (cdr lat))))
         (else
          (cons (car lat) (multisubst new old (cdr lat)))))))))
          
;; replaces all occurences of atom old with atom new in list lat
(define multisubst
  (lambda (new old lat)
    (cond
      ((null? lat) '())
      (else
       (cond
         ((eq? (car lat) old) 
          (cons new (multisubst new old (cdr lat))))
         (else
          (cons (car lat) (multisubst new old (cdr lat)))))))))

gistfile2.rkt

(define add1
  (lambda (n)
    (+ n 1)))
 
(define sub1
  (lambda (n)
    (- n 1)))
 
(define o+
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (o+ (add1 n) (sub1 m))))))
 
(define o-
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (o- (sub1 n) (sub1 m))))))
 
(define addtup
  (lambda (tup)
    (cond
      ((null? tup) 0)
      (else (o+ (car tup) (addtup (cdr tup)))))))

(define x
  (lambda (n m)
    (cond
      ((zero? m) 0)
      (else (o+ n (x n (sub1 m)))))))

(define tup+
  (lambda (tup1 tup2)
    (cond
      ((null? tup1) tup2)
      ((null? tup2) tup1)
      (else
       (cons 
        (o+ (car tup1) (car tup2))
        (tup+ (cdr tup1) (cdr tup2)))))))

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

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

(define =
  (lambda (n m)
    (cond
      ((or (> n m) (< n m)) #f)
      (else #t))))