CSE 505	Homework #2 Sample Solutions


1)	In computing (f1 5), the value of n is 3 in the expression (+ x n).
	The value 3 is bound to n at the definition of f1; then the lambda
	expression in the definition of add-n captures the closure including
	the mapping from n to 3.  When f1 is executed, the environment with
	n mapped to 3 comes into scope and when executing (+ x n) we find
	n=3 in the current environment.

	If Scheme were dynamically scoped, the search for n would go from the
	scope created by the lambda (which maps x to 5) to the global scope.
	If there is no definition of n in the global scope, we get an
	Unbound variable error.  If there is such a definition it will be
	used; i.e.

	< definitions in problem >

	(define n 31)
	(f1 5) => 36

2)	Merge sort is a nice sort for a functional language:

		;; takes a comparison function and returns a merge sort that
		;; uses that function to order elements
	(define (curried-merge-sort less)

			;; splits a list evenly in two
		(define (split-list list)

				;; chops an element off of the source list,
				;; cons's it on to dest1, and calls slice
				;; recursively with the destination lists
				;; swapped.  When slice is empty, returns
				;; a list of the two destination lists.
			(define (slice source dest1 dest2)
				(if (null? source)
					(cons dest1 (cons dest2 ()))
					(slice (cdr source) dest2
						(cons (car source) dest1))))
			(slice list () ()))

			;; merges list1 and list2, accumulating a reversed
			;; result in dest.
		(define (merge list1 list2 dest)
				;; base case: at least one list null, so
				;; reverse dest and append the other
			(cond	((null? list1) (append (reverse dest) list2))
				((null? list2) (append (reverse dest) list1))

				;; recursive case; take the least element from
				;; the two lists and add it to dest in a
				;; recursive call to merge
				((less (car list1) (car list2))
					(merge (cdr list1) list2
						(cons (car list1) dest)))
				(else
					(merge list1 (cdr list2)
						(cons (car list2) dest)))))

			;; the merge sort function--splits the list in two,
			;; calls merge sort recursively, and merges the two
			;; resulting lists. 
		(define (merge-sort list)
				;; base cases--return 0 or 1-element lists
			(cond ((null? list) list)
				((null? (cdr list)) list)
				(else (let* ( (lists (split-list list))
					(list1 (merge-sort (car lists)))
					(list2 (merge-sort (car (cdr lists)))))
				  (merge list1 list2 ())))))

			;; return the curried merge-sort function.
		merge-sort)

	Here's a sort that sorts numbers in descending order:

	(define descending-number-sort (curried-merge-sort >))

	Test cases:

	(descending-number-sort ()) => ()

	(descending-number-sort '(0)) => (0)

	(descending-number-sort '(3 5 8 9 3 1 7 8 90 5 4 32 75 214 87 32))
		=> (214 90 87 75 32 32 9 8 8 7 5 5 4 3 3 1)

	And one that sorts list in ascending order of length:

	(define ascending-list-sort (curried-merge-sort
		(lambda (l1 l2) (< (length l1) (length l2)))))

	Test cases:

	(ascending-list-sort `()) => ()

	(ascending-list-sort `((1))) => ((1))

		; from David Ely
	(ascending-list-sort `((1) (3 3 3) () (2 2) (4 4 4 4) (1) ()))
		=> (() () (1) (1) (2 2) (3 3 3) (4 4 4 4))

3a)	Here's example code:

	;; adds an entry to the database
(define (add-db entry db)
  (cons entry db))

	;; deletes all entries equal to entry in the database
(define (delete-db entry db)
  (cond ((null? db) db)
        ((equal? entry (car db)) (delete-db entry (cdr db)))
        (#t (cons (car db) (delete-db entry (cdr db))))))

	;; returns a list of all entries for which query-fn returns true
(define (query-db query-fn db)
  (cond ((null? db) db)
        ((query-fn (car db)) (cons (car db) (query-db query-fn (cdr db))))
        (#t (query-db query-fn (cdr db)))))

3b)	Here's example code (from Manu Thambi):

;; Stoppable query function
(define (stoppable-query-db db predicate)

  ;; first we define a tail recursive function.
  ;; This helps in making the appropriate continuation
  (define (stoppable-query-db-aux db exit partial-result)
    (cond ((null? db) partial-result)
          ((predicate (car db) (lambda () (exit partial-result)))
           (stoppable-query-db-aux (cdr db) 
                                   exit 
                                   (cons (car db) partial-result)))
          (else (stoppable-query-db-aux (cdr db) exit partial-result))))

  ;; save the continuation and make the call
  (call-with-current-continuation (lambda (exit) 
             (stoppable-query-db-aux db exit ()))))

Test code:

(stoppable-query-db '((1 1) (2 -1) (3 2) (4 0) (5 5))
                    (lambda (assoc exit-cont)
                      (let ((value (cadr assoc)))
                           (if (zero? value) 
                               (exit-cont) ;; break out of search
                               (positive? value)))))

result: ((3 2) (1 1))

4)	Here are the (correct) changes David Ely made.  This interpreter
	uses a non-side-effecting define; i.e., recursion doesn't work
	without Craig's trick.

replace

	;; use the lambda S-expr itself to represent the fn
	expr)

with

        ;; return a closure instead of only the function body
        (list expr vars))

and replace

          ;; check for applying a lambda
          ((and (pair? fn) (equal? (car fn) 'lambda))
            (apply-lambda (cadr fn) (caddr fn) args vars depth))

with

          ;; we're working with a closure now instead of only 
          ;; a function body.  Thus fn is a list of (lbody cvars)
	  ;; where lbody is what fn used to be and cvars is the stored
	  ;; environment
        
          ((and (pair? fn) (pair? (car fn)) (equal? (caar fn) 'lambda))
           (let* ((cvars (cadr fn)) 
                  (lbody (car fn)))
             (apply-lambda (cadr lbody) (caddr lbody) args cvars depth)))

Some neat test cases:

1 ]=> 
(process 
 '((define add-n 
     (lambda (n)
       (lambda (x) (+ x n))))
   (define add-3 (add-n 3))
   (add-3 5)))

;Value: 8

;; would have produced an error if dynamic scoping


1 ]=> 
(process
 '((define x 10)
   (define add-x
     (lambda (n)
       (+ n x)))
   (define x 20)
   (cons x (cons (add-x 5) ()))))

;Value 14: (20 15)

;; would have produced (20 25) if dynamic scoping


1 ]=>
(process
 '((define n 10)
   (define sub-n
     (lambda (x)
       (- x n)))
   (define sub-n2
     (lambda (n)
       (sub-n n)))
   (sub-n2 20)))

;Value: 10

;; would have produced 0 if dynamic scoping