;; Programming Languages -- Spring 1996
;; Solutions to Homework Two: More Basic Scheme

;; erik hilsdale

;; ---- union

(define union
  (lambda (s0 s1)
    (cond
      ((null? s0) s1)
      ((memq (car s0) s1) (union (cdr s0) s1))
      (else
	(cons (car s0) (union (cdr s0) s1))))))

;; ---- set?

(define set?
  (lambda (ls)
    (cond
      ((null? ls) #t)
      ((memq (car ls) (cdr ls)) #f)
      (else (set? (cdr ls))))))

;; ---- depth

(define depth
  (lambda (ls)
    (cond
      ((null? ls) 1)
      ((or (pair? (car ls)) (null? (car ls)))
       (max (add1 (depth (car ls)))
	 (depth (cdr ls))))
      (else
	(depth (cdr ls))))))

;; ---- div

(define div
  (lambda (a b)
    (cond
      ((> b a) 0)
      (else
	(add1 (div (- a b) b))))))

;; ---- double*

(define double*
  (lambda (a ls)
    (cond
      ((null? ls) '())
      ((pair? (car ls))
       (cons (double* a (car ls))
	 (double* a (cdr ls))))
      ((eq? (car ls) a)
       (cons a (cons (car ls) (double* a (cdr ls)))))
      (else
	(cons (car ls) (double* a (cdr ls)))))))

;; ---- prefixes

(define prefixes
  (letrec ((prefixes-help
	     (lambda (upto-now ls)
	       (cond
		 ((null? ls) '())
		 (else
		   (let ((new-prefix (snoc upto-now (car ls))))
		     (cons new-prefix
		       (prefixes-help new-prefix (cdr ls)))))))))
    (lambda (ls)
      (cons '() (prefixes-help '() ls)))))

(define snoc
  (lambda (ls i)
    (if (null? ls)
	(cons i '())
	(cons (car ls) (snoc (cdr ls) i)))))

;; ---- curry2

(define curry2
  (lambda (f)
    (lambda (a)
      (lambda (b)
	(f a b)))))

;; ---- vector-index

(define vector-index
  (lambda (a v)
    (let ((len (vector-length v)))
      (letrec ((vi-help
		 (lambda (i)
		   (cond
		     ((= i len) -1)
		     ((eq? (vector-ref v i) a) i)
		     (else (vi-help (add1 i)))))))
	(vi-help 0)))))

;; ---- flatten

(define flatten
  (lambda (ls)
    (cond
      ((null? ls) '())
      ((or (pair? (car ls)) (null? (car ls)))
       (append (flatten (car ls)) (flatten (cdr ls))))
      (else
	(cons (car ls) (flatten (cdr ls)))))))

;; ---- path

(define path
  (lambda (n bst)
    (cond
      ((= (car bst) n) '())
      ((> (car bst) n)
       (cons 'l (path n (cadr bst))))
      (else
	(cons 'r (path n (caddr bst)))))))