<< Previous exercise (4.18) | Index | Next exercise (4.20) >>
I will describe how to implement Eva's scheme (no pun intended).
One way to do so is to topologically sort the non-function definitions in order of dependency. This can be done by converting the sequence of definitions into a directed graph according to the interdependency of the variables. Meanwhile, we can check the graph for cycles and signal an error if found, and evaluate the definitions in topologically sorted order if no cycles are found.
Needless to say, trying to implement directed acyclic graphs in Scheme, to say nothing of topological sort, is probably non-trivial and may arguably be overkill for implementing a measly little Scheme interpreter.
Hence, here is a conceptually easier way to do it. We first take out all the function definitions and put them at the top, since their bodies are delayed and hence will not pose any issues whatsoever. Then, we take the list of the non-function definitions, generate a list of the matching dependent variables in each body, and repeatedly take out all non-function definitions whose bodies are independent of any remaining non-function variables. This is probably asymptotically slower than topological sort, but it works fine, and has the added bonus of being able to naturally check for cycles.
First, we redefine make-procedure: (note I am assuming all code in chapter 4 up to this exercise has been evaluated, so all the helper functions used by the book to redefine eval is available).
(define (function-definition? exp) (and (definition? exp) (lambda? (definition-value exp)))) (define (non-function-definition? exp) (and (definition? exp) (not (function-definition? exp)))) (define (reorder-procedure-body body) (let ((func-defs (filter function-definition? body)) (var-defs (filter non-function-definition? body)) (non-defs (remove definition? body))) (append func-defs (reorder-non-function-definitions var-defs) non-defs))) (define (make-procedure parameters body env) (list 'procedure parameters (reorder-procedure-body body) env))
Then, a few helper functions:
;; unrolls nested lists (define (tree->list tree) (if (list? tree) (apply-in-underlying-scheme append (map tree->list tree)) (list tree))) ;; removes duplicates (define (list->set lst) (if (or (null? lst) (null? (cdr lst))) lst (cons (car lst) (delete (car lst) (list->set (cdr lst)))))) (define (all-included-symbols symbol-pool seq) (intersection-set symbol-pool (list->set (tree->list seq)))) ;; intersection-set is given in chapter 2 of SICP ;; there are likely faster ways to do this ;; computes set1 - set2 nondestructively (define (difference-set set1 set2) (define (in-set2? obj1) (find (lambda (obj2) (eq? obj1 obj2)) set2)) (remove in-set2? set1))
Finally, the main workhorse function:
;; assume no duplicate variables in var-defs, otherwise undefined behavior (define (reorder-non-function-definitions var-defs) (define (no-dependencies? pair) (null? (cdr pair))) ;; pair here means definition / included symbol pair (define (pairs-with-symbols-removed pairs symbols) (map (lambda (pair) (cons (car pair) (difference-set (cdr pair) symbols))) pairs)) (define (iter pairs-defs-included result) (if (null? pairs-defs-included) result (let ((independent (filter no-dependencies? pairs-defs-included)) (dependent (remove no-dependencies? pairs-defs-included))) (if (null? independent) (error "cycle detected in inner non-function defines") (let ((symbols-to-remove (map (lambda (pair) (definition-variable (car pair))) independent))) (iter (pairs-with-symbols-removed dependent symbols-to-remove) (append (map car independent) result))))))) (let* ((symbol-pool (map definition-variable var-defs)) (pairs-defs-included (map (lambda (def) (cons def (all-included-symbols symbol-pool (definition-value def)))) var-defs))) (reverse (iter pairs-defs-included '())))) ;; need to reverse because results built using cons, in reverse order
Now, assuming that eval is *not* the builtin eval but rather the simplified one that has been defined as in the code from the SICP text, here are some examples:
(assert (equal? '((define (f x) 7) (define a 3) (define b a)) (reorder-procedure-body '((define a 3) (define b a) (define (f x) 7))))) ;; example from the exercise (assert (= 20 (eval '(let ((a 1)) (define (f x) (define b (+ a x)) (define a 5) (+ a b)) (f 10)) the-global-environment))) ;; 20, as Eva required.
I ran all code above in MIT Scheme.
note we are assuming the bodies of the non-function definitions do not contain redefinitions of variables shared with other non-function definitions. For example, the following should be perfectly legal but may break our program and result in undefined behavior:
(define (f)
(define a 5)
(define b
(let ((a 6))
a))
b)
This is an admitted limitation of our program: to account for this case requires significant further work.
A simple method, but does not support recursive definition of variables
(define unassigned '*unassigned*) (define define- 'define-) (define (is-define? exp-) (tagged-expression? exp- define-)) ; fringe is in exercise 2.28 (define (vars-is-contained? vars exp-) (define (iter vars exp-list) (if (null? vars) false (if (memq (car vars) exp-list) true (iter (cdr vars) exp-list)))) (iter vars (fringe exp-))) (define (sort-define defines) (define (iter self other depend defs vars) (if (null? defs) (append self other depend) (let* ((first (car defs)) (exp- (definition-value first))) (cond ((self-evaluating? exp-) (iter (cons first self) other depend (cdr defs) vars)) ((vars-is-contained? vars exp-) (iter self other (cons first depend) (cdr defs) vars)) (else (iter self (cons first other) depend (cdr defs) vars)))))) (iter '() '() '() defines (map definition-variable defines))) (define (scan-out-defines proc-body) (let ((is-defines (filter is-define? proc-body))) (if (null? is-defines) proc-body (let* ((others (filter (lambda (exp-) (not (is-define? exp-))) proc-body)) (is-defines (sort-define is-defines)) (vars (map definition-variable is-defines)) (vals (map definition-value is-defines)) (bindings (map (lambda (var) (make-combination var unassigned)) vars)) (sets (map make-set vars vals)) (new-body (append sets others))) (list (make-let bindings new-body))))))
These three viewpoints could be laid out on the scale from "imperative" to "declarative". Ben's idea seems to make the most sense, at least for a programmer used to the imperative style. However, it could cause hard to detect bugs, and Scheme is not supposed to be an imperative language anyway. Eva's desired solution seems to be difficult or maybe even impossible to implement, even if it would be kind of nice from a declarative point of view. Alyssa's way of looking at things avoids the problem by simply showing an error and forcing the programmer to write a "better" procedure. This seems to be a good way out.
I don't know how to implement a general system that would make Eva's idea work. For instance, while we could reorder `define`s in such a way that `a` comes before `b` (on the grounds that `b` uses `a` in its definition), this would not work if we had to work with a circular dependency (i.e. `b` depends on `a`, `a` depends on `b`).
One way to solve this issue would be to treat every binding as a function, i.e. `b` would be a function of no arguments that returns some value, and the same thing would apply to `a`. Then, evaluation of those values would happen during the call, and the most recent definition of `a` would be used even though no reordering has been done. However, this would fundamentally change how Scheme works.