func.scm

(define atom?
  (lambda (x)
    (and (not (pair? x))(not (null? x)))))

(define (lat? ls)
  (cond
   ((null? ls) #t)
   ((atom? (car ls)) (lat? (cdr ls)))
   (else #f)))

(define (member? a lat)
  (cond
   ((null? lat) #f)
   (else (or (equal? a (car lat))
	     (member? a (cdr lat))))))

(define (rember a lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) a) (cdr lat))
   (else
    (cons (car lat)
	  (rember a (cdr lat))))))

(define (multirember a lat)
  (cond
   ((null? lat) '())
   ((equal? (car lat) a)
    (multirember a (cdr lat)))
   (else
    (cons (car lat) (multirember a (cdr lat))))))

(define (firsts lat)
  (cond
   ((null? lat) '())
   (else
    (cons (car (car lat))
	  (firsts (cdr lat))))))

(define (insertR new old lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) old)
    (cons old (cons new (cdr lat))))
   (else
    (cons (car lat) (insertR new old (cdr lat))))))

(define (multiinsertR new old lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) old)
    (cons old (cons new (multiinsertR new old (cdr lat)))))
   (else
    (cons (car lat) (multiinsertR new old (cdr lat))))))

(define (insertL new old lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) old)
    (cons new lat))
   (else
    (cons (car lat) (insertL new old (cdr lat))))))

(define (multiinsertL new old lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) old)
    (cons new (cons old (multiinsertL new old (cdr lat)))))
   (else
    (cons (car lat) (multiinsertL new old (cdr lat))))))

(define (subst new old lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) old)
    (cons new (cdr lat)))
   (else
    (cons (car lat) (subst new old (cdr lat))))))

(define (multisubst new old lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) old)
    (multisubst new old (cdr lat)))
   (else
    (cons (car lat) (multisubst new old (cdr lat))))))

(define (add1 n)
  (+ n 1))

(define (sub1 n)
  (- n 1))

(define (plus a b)
  (cond
   ((zero? b) a)
   (else (plus (add1 a) (sub1 b)))))

(define (minus a b)
  (cond
   ((zero? b) a)
   (else (minus (sub1 a) (sub1 b)))))

(define (product a b)
  (cond
   ((zero? b) 0)
   (else (plus a (product a (sub1 b))))))

(define (divisor a b)
  (cond
   ((< a b) 0)
   (else (add1 (divisor (minus a b) b)))))

(define (addtup tup)
  (cond
   ((null? tup) 0)
   (else (plus (car tup) (addtup (cdr tup))))))

(define (tup+ tup1 tup2)
  (cond
   ((and (null? tup1) (null? tup2)) '())
   ((null? tup1) tup2)
   ((null? tup2) tup1)
   (else
    (cons (plus (car tup1)
		(car tup2))
	  (tup+ (cdr tup1)
		(cdr tup2))))))

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

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

(define (equal n m)
  (cond
   ((or (grt n m)(lrt n m)) #f)
   (else #t)))

(define (length lat)
  (cond
   ((null? lat) 0)
   (else
    (add1 (length (cdr lat))))))

(define (pick a lat)
  (cond
   ((null? lat) ())
   ((zero? (sub1 a)) (car lat))
   (else
    (pick (sub1 a) (cdr lat)))))

(define (rempick a lat)
  (cond
   ((null? lat) '())
   ((zero? (sub1 a)) (cdr lat))
   (else
    (cons (car lat)
	  (rempick (sub1 a) (cdr lat))))))

(define (no-nums lat)
  (cond
   ((null? lat) '())
   ((number? (car lat)) (no-nums (cdr lat)))
   (else
    (cons (car lat) (no-nums (cdr lat))))))

(define (all-nums lat)
  (cond
   ((null? lat) '())
   ((number? (car lat))
    (cons (car lat) (all-nums (cdr lat))))
   (else
    (all-nums (cdr lat)))))

(define (eqan? a1 a2)
  (cond
   ((and (number? a1) (number? a2))
    (= a1 a2))
   ((or (number? a1) (number? a2))
    #f)
   (else
    (eq? a1 a2))))

(define (occur a lat)
  (cond
   ((null? lat) 0)
   ((eq? a (car lat))
    (add1 (occur a (cdr lat))))
   (else
    (occur a (cdr lat)))))

(define (one? n)
  (= n 1))

(define (rember* a l)
  (cond
   ((null? l) '())
   ((atom? (car l))
    (cond
     ((eq? (car l) a)
      (rember* a (cdr l)))
     (else
      (cons (car l) (rember* a (cdr l))))))
   (else
    (cons (rember* a (car l))
	  (rember* a (cdr l))))))

(define (insertR* new old l)
  (cond
   ((null? l) '())
   ((atom? (car l))
    (cond
     ((eq? (car l) old)
      (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))))))

(define (insertL* new old l)
  (cond
   ((null? l) '())
   ((atom? (car l))
    (cond
     ((eq? (car l) old)
      (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))))))

(define (occur* a l)
  (cond
   ((null? l) 0)
   ((atom? (car l))
    (cond
     ((eq? (car l) a)
      (add1 (occur* a (cdr l))))
     (else
      (occur* a (cdr l)))))
   (else
    (plus (occur* a (car l))
	  (occur* a (cdr l))))))

(define (subst* new old l)
  (cond
   ((null? l) '())
   ((atom? (car l))
    (cond
     ((eq? (car l) old)
      (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))))))

(define (member* a l)
  (cond
   ((null? l) #f)
   ((atom? (car l))
    (or (eq? (car l) a) (member* a (cdr l))))
   (else
    (or (member* a (car l))
	(member* a (cdr l))))))

(define (leftmost l)
  (cond
   ((null? l) '())
   ((atom? (car l)) (car l))
   (else
    (leftmost (car l)))))

(define (eqlist? 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))))))

(define (equal? s1 s2)
  (cond
   ((and (atom? s1) (atom? s2))
    (eqan? s1 s2))
   ((or (atom? s1) (atom? s2)) #f)
   (else
    (eqlist? s1 s2))))

(define (numbered? aexp)
  (cond
   ((atom? aexp) (number? aexp))
   (else
    (and (numbered? (car aexp))
	 (numbered? (car (cdr (cdr aexp))))))))

(define (value nexp)
  (cond
   ((atom? nexp) nexp)
   ((eq? (operator nexp) '+)
    (plus (value (1st-sub-exp nexp))
	  (value (2nd-sub-exp nexp))))
   ((eq? (operator nexp) '*)
    (product (value (1st-sub-exp nexp))
	     (value (2nd-sub-exp nexp))))
   (else
    (expt (value (1st-sub-exp nexp))
	  (value (2nd-sub-exp nexp))))))

(define (1st-sub-exp aexp)
  (car aexp))

(define (2nd-sub-exp aexp)
  (car (cdr (cdr aexp))))

(define (operator aexp)
  (car (cdr aexp)))

;; (define (sero? n)
;;   (null? n))

;; (define (edd1 n)
;;   (cons '() n))

;; (define (zub1 n)
;;   (cdr n))

;; (define (pluz n m)
;;   (cond
;;    ((sero? m) n)
;;    (else
;;     (pluz (edd1 n) (zub1 m)))))

;; (define (1at? l)
;;   (cond
;;    ((null? l) #t)
;;    ((atom? (car l)) (lat (cdr l)))
;;    (else #f)))

(define (set? lat)
  (cond
   ((null? lat) #t)
   ((member? (car lat) (cdr lat)) #f)
   (else
    (set? (cdr lat)))))
    
(define (makeset lat)
  (cond
   ((null? lat) '())
   ((member? (car lat) (cdr lat))
    (makeset (cdr lat)))
   (else
    (cons (car lat) (makeset (cdr lat))))))

(define (makeset lat)
  (cond
   ((null? lat) '())
   (else
    (cons (car lat)
	  (makeset
	   (multirember (car lat) (cdr lat)))))))