diff options
| -rw-r--r-- | ps03_evalapply/bnewbold_interp.scm | 141 | ||||
| -rw-r--r-- | ps03_evalapply/bnewbold_ps3.txt | 38 | ||||
| -rw-r--r-- | ps03_evalapply/general-procedures.scm | 141 | ||||
| -rw-r--r-- | ps03_evalapply/ghelper.scm | 102 | ||||
| -rw-r--r-- | ps03_evalapply/interp.scm | 131 | ||||
| -rw-r--r-- | ps03_evalapply/kons.scm | 12 | ||||
| -rw-r--r-- | ps03_evalapply/load-general.scm | 17 | ||||
| -rw-r--r-- | ps03_evalapply/load.scm | 13 | ||||
| -rw-r--r-- | ps03_evalapply/ps.txt | 317 | ||||
| -rw-r--r-- | ps03_evalapply/repl.scm | 48 | ||||
| -rw-r--r-- | ps03_evalapply/rtdata.scm | 88 | ||||
| -rw-r--r-- | ps03_evalapply/syntax.scm | 188 | ||||
| -rw-r--r-- | ps03_evalapply/utils.scm | 17 |
13 files changed, 1253 insertions, 0 deletions
diff --git a/ps03_evalapply/bnewbold_interp.scm b/ps03_evalapply/bnewbold_interp.scm new file mode 100644 index 0000000..67bcad1 --- /dev/null +++ b/ps03_evalapply/bnewbold_interp.scm @@ -0,0 +1,141 @@ +(declare (usual-integrations eval apply)) + +(define (default-eval expression environment) + (cond ((application? expression) + (apply (eval (operator expression) environment) + (operands expression) + environment)) + (else + (error "Unknown expression type" expression)))) + +(define (default-apply procedure operands calling-environment) + (error "Unknown procedure type" procedure)) + + + +(define eval + (make-generic-operator 2 default-eval)) + +(defhandler eval + (lambda (expression environment) expression) + self-evaluating?) + +(defhandler eval lookup-variable-value variable?) + +(defhandler eval + (lambda (expression environment) + (text-of-quotation expression)) + quoted?) + +(defhandler eval + (lambda (expression environment) + (make-compound-procedure + (lambda-parameters expression) + (lambda-body expression) + environment)) + lambda?) + +(defhandler eval + (lambda (expression environment) + (if (eval (if-predicate expression) environment) + (eval (if-consequent expression) environment) + (eval (if-alternative expression) environment))) + if?) + +(defhandler eval + (lambda (expression environment) + (eval (cond->if expression) environment)) + cond?) + +(defhandler eval + (lambda (expression environment) + (eval (let->combination expression) environment)) + let?) + +(defhandler eval + (lambda (expression environment) + (evaluate-sequence (begin-actions expression) + environment)) + begin?) + +(define (evaluate-sequence actions environment) + (cond ((null? actions) + (error "Empty sequence")) + ((null? (rest-exps actions)) + (eval (first-exp actions) environment)) + (else + (eval (first-exp actions) environment) + (evaluate-sequence (rest-exps actions) environment)))) + +(defhandler eval + (lambda (expression environment) + (define-variable! (definition-variable expression) + (eval (definition-value expression) environment) + environment) + (definition-variable expression)) + definition?) + +(defhandler eval + (lambda (expression environment) + (set-variable-value! (assignment-variable expression) + (eval (assignment-value expression) environment) + environment)) + assignment?) + +(define apply + (make-generic-operator 3 default-apply)) + +(defhandler apply + (lambda (procedure operands calling-environment) + (apply-primitive-procedure procedure + (evaluate-list operands calling-environment))) + strict-primitive-procedure?) + +(define (evaluate-list operands calling-environment) + (cond ((null? operands) '()) + ((null? (rest-operands operands)) + (list (eval (first-operand operands) + calling-environment))) + (else + (cons (eval (first-operand operands) + calling-environment) + (evaluate-list (rest-operands operands) + calling-environment))))) + +(defhandler apply + (lambda (procedure operands calling-environment) + (if (not (= (length (procedure-parameters procedure)) + (length operands))) + (error "Wrong number of operands supplied")) + (let ((arguments + (map (lambda (parameter operand) + (evaluate-procedure-operand parameter + operand + calling-environment)) + (procedure-parameters procedure) + operands))) + (eval (procedure-body procedure) + (extend-environment + (map procedure-parameter-name + (procedure-parameters procedure)) + arguments + (procedure-environment procedure))))) + compound-procedure?) + +(defhandler apply + (lambda (proc-vector operands calling-environment) + (vector-map + (lambda (proc) (apply proc + operands + calling-environment)) + proc-vector)) + vector?) + +(define evaluate-procedure-operand + (make-generic-operator 3 + (lambda (parameter operand environment) + (eval operand environment)))) + +(define procedure-parameter-name + (make-generic-operator 1 (lambda (x) x))) + diff --git a/ps03_evalapply/bnewbold_ps3.txt b/ps03_evalapply/bnewbold_ps3.txt new file mode 100644 index 0000000..3d80a95 --- /dev/null +++ b/ps03_evalapply/bnewbold_ps3.txt @@ -0,0 +1,38 @@ +;;; 6.945 Problem Set #3 +;;; 02/25/2009 +;;; Bryan Newbold <bnewbold@mit.edu> + + +Problem 3.1 +------------------------ +(shouldn't be too hard, handling vectors of procedures as procedures) + + +Problem 3.2 +------------------------ +(use tagged variable symbols?) +(use tagged function symbols?) + +Problem 3.3 +------------------------ +a. +(description) + +b. +(description...?) + + +Problem 3.4 +------------------------ +a. +(non-memoizing: generation of random lists? generators? streams?) + +b. +(not sure) + +c. +(not sure) + +Problem 3.5 +------------------------ +(ahhh! open ended project!) diff --git a/ps03_evalapply/general-procedures.scm b/ps03_evalapply/general-procedures.scm new file mode 100644 index 0000000..2412500 --- /dev/null +++ b/ps03_evalapply/general-procedures.scm @@ -0,0 +1,141 @@ +;;; Modifications to provide for general procedures. + +;;; Syntax extension: allow decorated parameter names. + +(defhandler procedure-parameter-name car pair?) + + +;;; run-time-data extension + +(define (delay expression environment) + (vector 'delayed expression environment)) + +(define (delay-memo expression environment) + (vector 'delayed-memo expression environment)) + +(define (delayed? x) + (and (vector? x) + (eq? (vector-ref x 0) 'delayed))) + +(define (delayed-memo? x) + (and (vector? x) + (eq? (vector-ref x 0) 'delayed-memo))) + +(define (deferred? x) + (or (delayed? x) (delayed-memo? x))) + +(define (undelayed-memo? x) + (and (vector? x) + (eq? (vector-ref x 0) 'undelayed-memo))) + +(define (delayed-expression x) + (vector-ref x 1)) + +(define (delayed-environment x) + (vector-ref x 2)) + + +(define (undelay-memo! x value) + (vector-set! x 0 'undelayed-memo) + (vector-set! x 1 value) + (vector-set! x 2 the-empty-environment)) + +(define (undelayed-value x) + (vector-ref x 1)) + +;;; Evaluator extension -- change to IF: +;;; Must have actual predicate value to proceed from IF. + +(defhandler eval + (lambda (expression environment) + (if (undelay! + (eval (if-predicate expression) environment)) + (eval (if-consequent expression) environment) + (eval (if-alternative expression) environment))) + if?) + + +;;; Apply extension: +;;; Must have actual procedure to apply it. + +(defhandler apply + (lambda (procedure operands calling-environment) + (apply (undelay! procedure) + operands + calling-environment)) + deferred?) + + +;;; Must have values of arguments for strict primitives. + +(define (evaluate-list operands calling-environment) + (cond ((null? operands) '()) + ((null? (rest-operands operands)) + (list (undelay! (eval (first-operand operands) + calling-environment)))) + (else + (cons (undelay! (eval (first-operand operands) + calling-environment)) + (evaluate-list (rest-operands operands) + calling-environment))))) + + +(defhandler evaluate-procedure-operand + (lambda (parameter operand environment) + (delay operand environment)) + lazy?) + +(defhandler evaluate-procedure-operand + (lambda (parameter operand environment) + (delay-memo operand environment)) + lazy-memo?) + +(define undelay! + (make-generic-operator 1 (lambda (x) x))) + +(defhandler undelay! + (lambda (object) + (undelay! (eval (delayed-expression object) + (delayed-environment object)))) + delayed?) + +(defhandler undelay! + (lambda (object) + (let ((value + (undelay! (eval (delayed-expression object) + (delayed-environment object))))) + (undelay-memo! object value) + value)) + delayed-memo?) + +(defhandler undelay! + undelayed-value + undelayed-memo?) + + +;;; For printing output + +(defhandler write + (compose write undelay!) + deferred?) + +(defhandler write-line + (compose write-line undelay!) + deferred?) + +(defhandler pp + (compose pp undelay!) + deferred?) + + +(defhandler write + (compose write undelayed-value) + undelayed-memo?) + +(defhandler write-line + (compose write-line undelayed-value) + undelayed-memo?) + +(defhandler pp + (compose pp undelayed-value) + undelayed-memo?) diff --git a/ps03_evalapply/ghelper.scm b/ps03_evalapply/ghelper.scm new file mode 100644 index 0000000..7b8613d --- /dev/null +++ b/ps03_evalapply/ghelper.scm @@ -0,0 +1,102 @@ +;;;; Most General Generic-Operator Dispatch + +(declare (usual-integrations)) + +;;; Generic-operator dispatch is implemented here by a discrimination +;;; list, where the arguments passed to the operator are examined by +;;; predicates that are supplied at the point of attachment of a +;;; handler (by ASSIGN-OPERATION). + +;;; To be the correct branch all arguments must be accepted by +;;; the branch predicates, so this makes it necessary to +;;; backtrack to find another branch where the first argument +;;; is accepted if the second argument is rejected. Here +;;; backtracking is implemented by OR. + +(define (make-generic-operator arity default-operation) + (let ((record (make-operator-record arity))) + + (define (operator . arguments) + (if (not (= (length arguments) arity)) + (error:wrong-number-of-arguments operator arity arguments)) + (let ((succeed + (lambda (handler) + (apply handler arguments)))) + (let per-arg + ((tree (operator-record-tree record)) + (args arguments) + (fail + (lambda () + (error:no-applicable-methods operator arguments)))) + (let per-pred ((tree tree) (fail fail)) + (cond ((pair? tree) + (if ((caar tree) (car args)) + (if (pair? (cdr args)) + (per-arg (cdar tree) + (cdr args) + (lambda () + (per-pred (cdr tree) fail))) + (succeed (cdar tree))) + (per-pred (cdr tree) fail))) + ((null? tree) + (fail)) + (else + (succeed tree))))))) + + (hash-table/put! *generic-operator-table* operator record) + (if default-operation + (assign-operation operator default-operation)) + operator)) + +(define *generic-operator-table* + (make-eq-hash-table)) + +(define (make-operator-record arity) (cons arity '())) +(define (operator-record-arity record) (car record)) +(define (operator-record-tree record) (cdr record)) +(define (set-operator-record-tree! record tree) (set-cdr! record tree)) + +(define (assign-operation operator handler . argument-predicates) + (let ((record + (let ((record (hash-table/get *generic-operator-table* operator #f)) + (arity (length argument-predicates))) + (if record + (begin + (if (not (<= arity (operator-record-arity record))) + (error "Incorrect operator arity:" operator)) + record) + (let ((record (make-operator-record arity))) + (hash-table/put! *generic-operator-table* operator record) + record))))) + (set-operator-record-tree! record + (bind-in-tree argument-predicates + handler + (operator-record-tree record)))) + operator) + +(define defhandler assign-operation) + +(define (bind-in-tree keys handler tree) + (let loop ((keys keys) (tree tree)) + (if (pair? keys) + (let find-key ((tree* tree)) + (if (pair? tree*) + (if (eq? (caar tree*) (car keys)) + (begin + (set-cdr! (car tree*) + (loop (cdr keys) (cdar tree*))) + tree) + (find-key (cdr tree*))) + (cons (cons (car keys) + (loop (cdr keys) '())) + tree))) + (if (pair? tree) + (let ((p (last-pair tree))) + (if (not (null? (cdr p))) + (warn "Replacing a handler:" (cdr p) handler)) + (set-cdr! p handler) + tree) + (begin + (if (not (null? tree)) + (warn "Replacing top-level handler:" tree handler)) + handler)))))
\ No newline at end of file diff --git a/ps03_evalapply/interp.scm b/ps03_evalapply/interp.scm new file mode 100644 index 0000000..f16ad8b --- /dev/null +++ b/ps03_evalapply/interp.scm @@ -0,0 +1,131 @@ +(declare (usual-integrations eval apply)) + +(define (default-eval expression environment) + (cond ((application? expression) + (apply (eval (operator expression) environment) + (operands expression) + environment)) + (else + (error "Unknown expression type" expression)))) + +(define (default-apply procedure operands calling-environment) + (error "Unknown procedure type" procedure)) + + + +(define eval + (make-generic-operator 2 default-eval)) + +(defhandler eval + (lambda (expression environment) expression) + self-evaluating?) + +(defhandler eval lookup-variable-value variable?) + +(defhandler eval + (lambda (expression environment) + (text-of-quotation expression)) + quoted?) + +(defhandler eval + (lambda (expression environment) + (make-compound-procedure + (lambda-parameters expression) + (lambda-body expression) + environment)) + lambda?) + +(defhandler eval + (lambda (expression environment) + (if (eval (if-predicate expression) environment) + (eval (if-consequent expression) environment) + (eval (if-alternative expression) environment))) + if?) + +(defhandler eval + (lambda (expression environment) + (eval (cond->if expression) environment)) + cond?) + +(defhandler eval + (lambda (expression environment) + (eval (let->combination expression) environment)) + let?) + +(defhandler eval + (lambda (expression environment) + (evaluate-sequence (begin-actions expression) + environment)) + begin?) + +(define (evaluate-sequence actions environment) + (cond ((null? actions) + (error "Empty sequence")) + ((null? (rest-exps actions)) + (eval (first-exp actions) environment)) + (else + (eval (first-exp actions) environment) + (evaluate-sequence (rest-exps actions) environment)))) + +(defhandler eval + (lambda (expression environment) + (define-variable! (definition-variable expression) + (eval (definition-value expression) environment) + environment) + (definition-variable expression)) + definition?) + +(defhandler eval + (lambda (expression environment) + (set-variable-value! (assignment-variable expression) + (eval (assignment-value expression) environment) + environment)) + assignment?) + +(define apply + (make-generic-operator 3 default-apply)) + +(defhandler apply + (lambda (procedure operands calling-environment) + (apply-primitive-procedure procedure + (evaluate-list operands calling-environment))) + strict-primitive-procedure?) + +(define (evaluate-list operands calling-environment) + (cond ((null? operands) '()) + ((null? (rest-operands operands)) + (list (eval (first-operand operands) + calling-environment))) + (else + (cons (eval (first-operand operands) + calling-environment) + (evaluate-list (rest-operands operands) + calling-environment))))) + +(defhandler apply + (lambda (procedure operands calling-environment) + (if (not (= (length (procedure-parameters procedure)) + (length operands))) + (error "Wrong number of operands supplied")) + (let ((arguments + (map (lambda (parameter operand) + (evaluate-procedure-operand parameter + operand + calling-environment)) + (procedure-parameters procedure) + operands))) + (eval (procedure-body procedure) + (extend-environment + (map procedure-parameter-name + (procedure-parameters procedure)) + arguments + (procedure-environment procedure))))) + compound-procedure?) + +(define evaluate-procedure-operand + (make-generic-operator 3 + (lambda (parameter operand environment) + (eval operand environment)))) + +(define procedure-parameter-name + (make-generic-operator 1 (lambda (x) x))) diff --git a/ps03_evalapply/kons.scm b/ps03_evalapply/kons.scm new file mode 100644 index 0000000..4fc7b73 --- /dev/null +++ b/ps03_evalapply/kons.scm @@ -0,0 +1,12 @@ +;;; A valuable special form -- the nonstrict version of CONS: + +(define (kons? exp) + (and (pair? exp) + (eq? (car exp) 'kons))) + +(defhandler eval + (lambda (expression environment) + (cons (delay-memo (cadr expression) environment) + (delay-memo (caddr expression) environment))) + kons?) + diff --git a/ps03_evalapply/load-general.scm b/ps03_evalapply/load-general.scm new file mode 100644 index 0000000..569aeba --- /dev/null +++ b/ps03_evalapply/load-general.scm @@ -0,0 +1,17 @@ +(load "utils" user-initial-environment) +(load "ghelper" user-initial-environment) +(load "syntax" user-initial-environment) +(load "rtdata" user-initial-environment) + + +(define generic-evaluation-environment + (extend-top-level-environment user-initial-environment)) + +(load "interp" generic-evaluation-environment) +(load "repl" generic-evaluation-environment) + +;;; This allows nonstrict definitions. +(load "general-procedures" generic-evaluation-environment) +(load "kons" generic-evaluation-environment) + +(ge generic-evaluation-environment)
\ No newline at end of file diff --git a/ps03_evalapply/load.scm b/ps03_evalapply/load.scm new file mode 100644 index 0000000..ebca908 --- /dev/null +++ b/ps03_evalapply/load.scm @@ -0,0 +1,13 @@ +(load "utils" user-initial-environment) +(load "ghelper" user-initial-environment) +(load "syntax" user-initial-environment) +(load "rtdata" user-initial-environment) + + +(define generic-evaluation-environment + (extend-top-level-environment user-initial-environment)) + +(load "bnewbold_interp" generic-evaluation-environment) +(load "repl" generic-evaluation-environment) + +(ge generic-evaluation-environment) diff --git a/ps03_evalapply/ps.txt b/ps03_evalapply/ps.txt new file mode 100644 index 0000000..389affa --- /dev/null +++ b/ps03_evalapply/ps.txt @@ -0,0 +1,317 @@ + + + MASSACHVSETTS INSTITVTE OF TECHNOLOGY + Department of Electrical Engineering and Computer Science + + 6.945 Spring 2009 + Problem Set 3 + + Issued: Wed. 18 Feb. 2009 Due: Wed. 25 Feb. 2009 + +Reading: + SICP, From Chapter 4: 4.1 and 4.2; (pp. 359--411) + en.wikipedia.org/wiki/Evaluation_strategy + www.cs.indiana.edu/cgi-bin/techreports/TRNNN.cgi?trnum=TR44 + +Code: load.scm, utils.scm, ghelper.scm, + syntax.scm, rtdata.scm, interp.scm, repl.scm + general-procedures.scm + code is on the class web page... no reason to kill more trees. + + +Evaluators for Extended Scheme + +You will be working with an evaluator system for an extended version +of Scheme similar to the ones described in SICP, Chapter 4. Without a +good understanding of how the evaluator is structured it is very easy +to become confused between the programs that the evaluator is +interpreting, the procedures that implement the evaluator itself, and +Scheme procedures called by the evaluator. You will need to study +Chapter 4 through subsection 4.2.2 carefully in order to do this +assignment. + +The interpreters in the code that we will work with in this problem +set are built on the generic operations infrastructure we developed in +the last problem set. (Actually, there is a small change: we specify +a handler with "defhandler" as an alias for "assign-operation". Also, +we allow handlers to be specified without declaring all of the +arguments, avoiding the need for "any?".) Indeed, in these +interpreters, unlike the ones in SICP, EVAL and APPLY are generic +operations! That means that we may easily extend the types of +expressons (by adding new handlers to EVAL) and the types of +procedures (by adding new handlers to APPLY). + +Before beginning work on this problem set you should carefully read +the code in interp.scm. Also, look at the difference between the +ghelper.scm in this problem set and the ghelper.scm in the previous +set. + + Using the generic interpreter + +Download the supplied code to a fresh directory in your computer. +Get a fresh Scheme system, and load the file load.scm: + + (load "<your-code-directory>/load") + +Initialize the evaluator: + + (init) + +You will get a prompt: + + eval> + +You can enter an expression at the prompt: + + eval> (define cube (lambda (x) (* x x x))) + cube + + eval> (cube 3) + 27 + +The evaluator code we supplied does not have an error system of its +own, so it reverts to the underlying Scheme error system. (Maybe an +interesting little project? It is worth understanding how to make +exception-handling systems!) If you get an error, clear the error +with two control Cs and then continue the evaluator with "(go)" at the +Scheme. If you redo "(init)" you will lose the definition of cube, +because a new environment will be made. + + eval> (cube a) + ;Unbound variable a + ;Quit! + + (go) + + eval> (cube 4) + 64 + + eval> (define (fib n) + (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) + fib + + eval> (fib 10) + 55 + +You can always get out of the generic evaluator and get back to the +underlying Scheme system by quitting (with two control Cs). + +------------- +Problem 3.1: Warmup + +In mathematical text a common abuse of notation is to identify a +tuple of functions with a function that returns a tuple of values. +For example, (written in Lisp prefix form) + + If (cos 0.6) ==> 0.8253356149096783 + and (sin 0.6) ==> 0.5646424733950354 + + then we expect + + ((vector cos sin) 0.6) ==> #(0.8253356149096783 0.5646424733950354) + +This requires that an extension to APPLY so it can handle Scheme +vectors as a kind of function. Make this extension; demonstrate it; +show that it interoperates with more conventional code. +------------- + + +------------- +Problem 3.2: Unbound-variable handling + +In Lisps, including Scheme, attempting to evaluate an unbound symbol +is an unbound-variable error. However, in some algebraic processes it +is sensible to allow an unbound symbol to be a self-evaluating object. +For example, if we generically extend arithmetic to build algebraic +expressions with symbolic values, it is sometimes useful to allow the +following: + +(+ (* 2 3) (* 4 5)) ==> 26 + +(+ (* a 3) (* 4 5)) ==> (+ (* a 3) 20) + +In this case, the symbol "a" is unbound and self-evaluating. The +operators "*" and "+" are extended to just build expressions when +their arguments are not reducible to numbers. + +Make generic extensions to +, *, -, /, and to EVAL, to allow this kind +of behavior. + +Also augment APPLY to allow literal functions, known only by their +names: + +(+ (f 3) (* 4 5)) ==> (+ (f 3) 20) + +These extensions to EVAL and APPLY are generally dangerous, because +they hide real unbound-variable errors. Make them contingent on the +value of a user-settable variable: ALLOW-SELF-EVALUATING-SYMBOLS. +------------- + +Much more powerful extensions are available once we accept generic +operations at this level. For example, we can allow procedures to +have both strict and non-strict arguments. + + If you don't know what we are talking about here please read + the article: http://en.wikipedia.org/wiki/Evaluation_strategy. + +If you load the file general-procedures.scm into the underlying +Scheme, after loading (with '(load "load")') the generic interpreter, +you will find that there are extensions that allow us to define +procedures with some formal parameters asking for the matching +arguments to be lazy (or lazy and memoized). Other undecorated +parameters take their arguments strictly. These extensions make it +relatively easy to play otherwise painful games. For example, we may +define the UNLESS conditional as an ordinary procedure: + + ;Quit! + + (load "general-procedures" generic-evaluation-environment) + ;Loading "general-procedures.scm"... + ;Warning: Replacing top-level handler + ;... done + ;Value: #[compound-procedure 17 operator] + + + (go) + + eval> (define unless + (lambda (condition (usual lazy) (exception lazy)) + (if condition exception usual))) + +We may use the usual define abbreviations (see syntax.scm): + + eval> (define (unless condition (usual lazy) (exception lazy)) + (if condition exception usual)) + unless + + eval> (define (ffib n) + (unless (< n 2) + (+ (ffib (- n 1)) (ffib (- n 2))) + n)) + ffib + + eval> (ffib 10) + 55 + +Notice that UNLESS is declared to be strict in its first argument (the +predicate) but nonstrict in the alternatives: neither alternative will +be evaluated until it is necessary. + +Additionally, if we include the file kons.scm we get a special form +that is the non-strict memoized version of CONS. This immediately +gives us the power of infinite streams: + + ;Quit! + + (load "kons" generic-evaluation-environment) + ;Loading "kons.scm"... done + ;Value: #[compound-procedure 19 operator] + + (go) + + eval> (define (add-streams s1 s2) + (kons (+ (car s1) (car s2)) + (add-streams (cdr s1) (cdr s2)))) + add-streams + + eval> (define (ref-stream stream n) + (if (= n 0) + (car stream) + (ref-stream (cdr stream) (- n 1)))) + ref-stream + + eval> (define fibs + (kons 0 + (kons 1 + (add-streams (cdr fibs) fibs)))) + fibs + + eval> (ref-stream fibs 10) + 55 + + eval> (ref-stream fibs 20) + 6765 + + eval> (ref-stream fibs 30) + 832040 + + eval> (ref-stream fibs 40) + 102334155 + + +------------- +Problem 3.3: Streams + +a. The non-strict procedure KONS adds great power to the system. +Notice that there is no need to make CAR or CDR different to obtain +the use of streams. In a short paragraph explain why KONS is almost +sufficient. It may be instructive to read an ancient paper by +Friedman and Wise: + www.cs.indiana.edu/cgi-bin/techreports/TRNNN.cgi?trnum=TR44 + +b. Unfortunately, the addition of KONS does not, in itself, solve all +stream problems. For example, the difficulty alluded to in SICP +section 4.2.3 (p. 411) does not automatically dissipate. If we make +the following definitions: + + (define (map-stream proc items) + (kons (proc (car items)) + (map-stream proc (cdr items)))) + + (define (scale-stream items factor) + (map-stream (lambda (x) (* x factor)) + items)) + + (define (integral integrand initial-value dt) + (define int + (kons initial-value + (add-streams (scale-stream integrand dt) + int))) + int) + + (define (solve f y0 dt) + (define y (integral dy y0 dt)) + (define dy (map-stream f y)) + y) + +and then we try: + + (ref-stream (solve (lambda (x) x) 1 0.001) 1000) + +we will get an error (try it!). Why? Explain the error. What other +declarations should be made in these stream-procedure definitions to +fix all such errors? +------------- + + +------------- +Problem 3.4: Why not? + +a. The KONS special form is equivalent to a CONS with both arguments +lazy and memoized. If the arguments were not memoized the computation +(ref-stream fibs 40) in Problem 3.3a above would take a very long +time. Is there ever any advantage to not memoizing? When might it +matter? + +b. Why, given that CONS is a strict procedure imported from Scheme, +could we not have defined KONS simply as: + + (define (kons (a lazy memo) (d lazy memo)) + (cons a d)) +? + +c. More generally, the Lisp community has avoided changing CONS to be +KONS, as recommended by Friedman and Wise. What potentially serious +problems are avoided by using CONS rather than KONS? Assume that we +do not care about small constant factors in performance. +------------- + + +------------- +Problem 3.5: Your turn + +Invent some fun, interesting construct that can easily be implemented +using generic EVAL/APPLY that would be rather painful without that +kind of generic support. Show us the construct, the implementation, +and some illustrative examples. Enjoy! +------------- diff --git a/ps03_evalapply/repl.scm b/ps03_evalapply/repl.scm new file mode 100644 index 0000000..94a0500 --- /dev/null +++ b/ps03_evalapply/repl.scm @@ -0,0 +1,48 @@ +(declare (usual-integrations write write-line pp eval)) + +(define write + (make-generic-operator 1 + (access write user-initial-environment))) + +(define write-line + (make-generic-operator 1 + (access write-line user-initial-environment))) + +(define pp + (make-generic-operator 1 + (access pp user-initial-environment))) + +(define (procedure-printable-representation procedure) + `(compound-procedure + ,(procedure-parameters procedure) + ,(procedure-body procedure) + <procedure-environment>)) + +(defhandler write + (compose write procedure-printable-representation) + compound-procedure?) + +(defhandler write-line + (compose write-line procedure-printable-representation) + compound-procedure?) + +(defhandler pp + (compose pp procedure-printable-representation) + compound-procedure?) + + + (define (read) (prompt-for-command-expression "eval> ")) + +(define the-global-environment) + +(define (init) + (set! the-global-environment + (extend-environment '() '() the-empty-environment)) + (repl)) + +(define (repl) + (let ((input (read))) + (write-line (eval input the-global-environment)) + (repl))) + +(define go repl) diff --git a/ps03_evalapply/rtdata.scm b/ps03_evalapply/rtdata.scm new file mode 100644 index 0000000..dad3d7a --- /dev/null +++ b/ps03_evalapply/rtdata.scm @@ -0,0 +1,88 @@ +;;; -*- Mode:Scheme -*- + +(declare (usual-integrations)) + +(define the-unspecified-value (list 'the-unspecified-value)) + +(define (true? x) + (if x true false)) + +(define (false? x) + (if x false true)) + +;;; Primitive procedures are inherited from Scheme. + +(define strict-primitive-procedure? procedure?) +(define apply-primitive-procedure apply) + + +;;; Compound procedures + +(define (make-compound-procedure vars bproc env) + (vector 'compound-procedure vars bproc env)) + +(define (compound-procedure? obj) + (and (vector? obj) + (eq? (vector-ref obj 0) 'compound-procedure))) + +(define (procedure-parameters p) (vector-ref p 1)) +(define (procedure-body p) (vector-ref p 2)) +(define (procedure-environment p) (vector-ref p 3)) + +;;; An ENVIRONMENT is a chain of FRAMES, made of vectors. + +(define (extend-environment variables values base-environment) + (if (fix:= (length variables) (length values)) + (vector variables values base-environment) + (if (fix:< (length variables) (length values)) + (error "Too many arguments supplied" variables values) + (error "Too few arguments supplied" variables values)))) + +(define (environment-variables env) (vector-ref env 0)) +(define (environment-values env) (vector-ref env 1)) +(define (environment-parent env) (vector-ref env 2)) + +(define the-empty-environment '()) + +(define (lookup-variable-value var env) + (let plp ((env env)) + (if (eq? env the-empty-environment) + (lookup-scheme-value var) + (let scan + ((vars (vector-ref env 0)) + (vals (vector-ref env 1))) + (cond ((null? vars) (plp (vector-ref env 2))) + ((eq? var (car vars)) (car vals)) + (else (scan (cdr vars) (cdr vals)))))))) + +;;; Extension to make underlying Scheme values available to interpreter + +(define (lookup-scheme-value var) + (lexical-reference generic-evaluation-environment var)) + +(define (define-variable! var val env) + (if (eq? env the-empty-environment) + (error "Unbound variable -- DEFINE" var) ;should not happen. + (let scan + ((vars (vector-ref env 0)) + (vals (vector-ref env 1))) + (cond ((null? vars) + (vector-set! env 0 (cons var (vector-ref env 0))) + (vector-set! env 1 (cons val (vector-ref env 1)))) + ((eq? var (car vars)) + (set-car! vals val)) + (else + (scan (cdr vars) (cdr vals))))))) + +(define (set-variable-value! var val env) + (let plp ((env env)) + (if (eq? env the-empty-environment) + (error "Unbound variable -- SET!" var) + (let scan + ((vars (vector-ref env 0)) + (vals (vector-ref env 1))) + (cond ((null? vars) (plp (vector-ref env 2))) + ((eq? var (car vars)) (set-car! vals val)) + (else (scan (cdr vars) (cdr vals)))))))) + + diff --git a/ps03_evalapply/syntax.scm b/ps03_evalapply/syntax.scm new file mode 100644 index 0000000..7c058e4 --- /dev/null +++ b/ps03_evalapply/syntax.scm @@ -0,0 +1,188 @@ +;;; -*- Mode:Scheme; Base:10 -*- + +(declare (usual-integrations)) + +;;; Self-evaluating entities + +(define (self-evaluating? exp) + (or (number? exp) + (eq? exp #t) + (eq? exp #f) + (string? exp))) ; Our prompt (viz., "EVAL==> ") is a string. + +;;; Variables + +(define (variable? exp) (symbol? exp)) + +(define (same-variable? var1 var2) (eq? var1 var2)) ;; Nice abstraction + +;;; Special forms (in general) + +(define (tagged-list? exp tag) + (and (pair? exp) + (eq? (car exp) tag))) + +;;; Quotations + +(define (quoted? exp) (tagged-list? exp 'quote)) + +(define (text-of-quotation quot) (cadr quot)) + +;;; Assignment--- SET! + +(define (assignment? exp) (tagged-list? exp 'set!)) + +(define (assignment-variable assn) (cadr assn)) +(define (assignment-value assn) (caddr assn)) + +;;; Definitions + +(define (definition? exp) (tagged-list? exp 'define)) + +(define (definition-variable defn) + (if (variable? (cadr defn)) ;; (DEFINE foo ...) + (cadr defn) + (caadr defn))) ;; (DEFINE (foo ...) ...) + +(define (definition-value defn) + (if (variable? (cadr defn)) ;; (DEFINE foo ...) + (caddr defn) + (cons 'lambda ;; (DEFINE (foo p...) b...) + (cons (cdadr defn) ;; = (DEFINE foo + (cddr defn))))) ;; (LAMBDA (p...) b...)) + +;;; LAMBDA expressions + +(define (lambda? exp) (tagged-list? exp 'lambda)) +(define (lambda-parameters lambda-exp) (cadr lambda-exp)) +(define (lambda-body lambda-exp) + (let ((full-body (cddr lambda-exp))) + (sequence->begin full-body))) + + +(define declaration? pair?) + +(define (parameter-name var-decl) + (if (pair? var-decl) + (car var-decl) + var-decl)) + +(define (lazy? var-decl) + (and (pair? var-decl) + (memq 'lazy (cdr var-decl)) + (not (memq 'memo (cdr var-decl))))) + +(define (lazy-memo? var-decl) + (and (pair? var-decl) + (memq 'lazy (cdr var-decl)) + (memq 'memo (cdr var-decl)))) + +(define (sequence->begin seq) + (cond ((null? seq) seq) + ((null? (cdr seq)) (car seq)) + ((begin? (car seq)) seq) + (else (make-begin seq)))) + +(define (make-begin exp) (cons 'begin exp)) + +;;; If conditionals + +(define (if? exp) (tagged-list? exp 'if)) + +(define (if-predicate exp) (cadr exp)) + +(define (if-consequent exp) (caddr exp)) + +(define (if-alternative exp) + (if (not (null? (cdddr exp))) + (cadddr exp) + 'the-unspecified-value)) + +(define (make-if pred conseq alternative) + (list 'IF pred conseq alternative)) + + +;;; COND Conditionals + +(define (cond? exp) (tagged-list? exp 'cond)) + +(define (clauses cndl) (cdr cndl)) +(define (no-clauses? clauses) (null? clauses)) +(define (first-clause clauses) (car clauses)) +(define (rest-clauses clauses) (cdr clauses)) +(define (else-clause? clause) (eq? (predicate clause) 'else)) + +(define (predicate clause) (car clause)) + +(define (actions clause) + (sequence->begin (cdr clause))) + +(define (cond->if cond-exp) + (define (expand clauses) + (cond ((no-clauses? clauses) + (list 'error "COND: no values matched")) + ((else-clause? (car clauses)) + (if (no-clauses? (cdr clauses)) + (actions (car clauses)) + (error "else clause isn't last -- INTERP" exp))) + (else + (make-if (predicate (car clauses)) + (actions (car clauses)) + (expand (cdr clauses)))))) + (expand (clauses cond-exp))) + + +;;; BEGIN expressions (a.k.a. sequences) + +(define (begin? exp) (tagged-list? exp 'begin)) +(define (begin-actions begin-exp) (cdr begin-exp)) + +(define (last-exp? seq) (null? (cdr seq))) +(define (first-exp seq) (car seq)) +(define (rest-exps seq) (cdr seq)) +(define no-more-exps? null?) ; for non-tail-recursive vers. + +;;; LET expressions + +(define (let? exp) (tagged-list? exp 'let)) +(define (let-bound-variables let-exp) + (map car (cadr let-exp))) +(define (let-values let-exp) (map cadr (cadr let-exp))) +(define (let-body let-exp) (sequence->begin (cddr let-exp))) +(define (let->combination let-exp) + (let ((names (let-bound-variables let-exp)) + (values (let-values let-exp)) + (body (let-body let-exp))) + (cons (list 'LAMBDA names body) + values))) + +;;; Procedure applications -- NO-ARGS? and LAST-OPERAND? added + +(define (application? exp) + (pair? exp)) + +(define (no-args? exp) ;; Added for tail recursion + (and (pair? exp) + (null? (cdr exp)))) + +(define (args-application? exp) ;; Changed from 5.2.1 + (and (pair? exp) + (not (null? (cdr exp))))) + + +(define (operator app) (car app)) +(define (operands app) (cdr app)) + +(define (last-operand? args) ;; Added for tail recursion + (null? (cdr args))) + +(define (no-operands? args) (null? args)) +(define (first-operand args) (car args)) +(define (rest-operands args) (cdr args)) + +;;; Another special form that will be needed later. + +(define (amb? exp) + (and (pair? exp) (eq? (car exp) 'amb))) + +(define (permanent-assignment? exp) (tagged-list? exp 'set!!)) diff --git a/ps03_evalapply/utils.scm b/ps03_evalapply/utils.scm new file mode 100644 index 0000000..cac9281 --- /dev/null +++ b/ps03_evalapply/utils.scm @@ -0,0 +1,17 @@ +(declare (usual-integrations)) + + +(define (identity x) x) + +(define (any? x) #t) + + +(define ((compose f g) x) (f (g x))) + + +;;; This is to keep the Scheme printer from going into an infinite +;;; loop if you try to print a circular data structure, such as an +;;; environment + +(set! *unparser-list-depth-limit* 10) +(set! *unparser-list-breadth-limit* 10) |