diff options
| -rw-r--r-- | ps03_evalapply/bnewbold_interp.scm | 141 | ||||
| -rw-r--r-- | ps03_evalapply/bnewbold_ps3.txt | 82 | ||||
| -rw-r--r-- | ps03_evalapply/bnewbold_work.scm | 367 | ||||
| -rw-r--r-- | ps03_evalapply/load.scm | 8 |
4 files changed, 444 insertions, 154 deletions
diff --git a/ps03_evalapply/bnewbold_interp.scm b/ps03_evalapply/bnewbold_interp.scm deleted file mode 100644 index 67bcad1..0000000 --- a/ps03_evalapply/bnewbold_interp.scm +++ /dev/null @@ -1,141 +0,0 @@ -(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 index 3d80a95..9bcaa26 100644 --- a/ps03_evalapply/bnewbold_ps3.txt +++ b/ps03_evalapply/bnewbold_ps3.txt @@ -1,38 +1,96 @@ -;;; 6.945 Problem Set #3 +;;; 6.945 Problem Set #3 Comments ;;; 02/25/2009 ;;; Bryan Newbold <bnewbold@mit.edu> +Note: I loaded the attached file bnewbold_work.scm load.scm and +load-general.scm after everything else, if that helps you run things! Problem 3.1 ------------------------ -(shouldn't be too hard, handling vectors of procedures as procedures) +Ugh! This was super tricky because compound-procedure? and vector? are not +mutually exclusive... this took hours to figure out, the solution of writing +my own predicate was easy once I knew what the problem was. Of course rereading +the hints that were emailed out I can see where I went wrong. Stupid! I should +have just asked! +[see bnewbold_work.scm] Problem 3.2 ------------------------ -(use tagged variable symbols?) -(use tagged function symbols?) +It would probably make more sense to have some symbols and functions as tagged +lists with 'self-evaluating-symbol and 'self-evaluating-function or some such, +but I just went with it. + +I only did binary operations because I got the comment "Don't worry about +arity!" on my last problem set ;) + +For the literal-functions I went a bit over board and only allowed single +character names and required registration with declare-literal-function. + +[see bnewbold_work.scm] Problem 3.3 ------------------------ -a. -(description) +a. +KONS is good enough on it's own because it creates an actual list that can be +understood by CAR and CDR. The final un-delaying and memoization logic in +eval and apply are what are doing the heavy lifting. CAR and CDR just choose +which path evaluation should continue down. -b. -(description...?) +b. +We have to delay the integrand call even further than kons does; fortunately +we have good syntax for this now! + +#| +(define (integral (integrand lazy) initial-value dt) + (define int + (kons initial-value + (add-streams (scale-stream integrand dt) + int))) + int) +; integral +(define (solve f y0 dt) + (define y (integral dy y0 dt)) + (define dy (map-stream f y)) + y) +; solve +(ref-stream (solve (lambda (x) x) 1 0.001) 1000) +; 2.716923932235896 Problem 3.4 ------------------------ a. -(non-memoizing: generation of random lists? generators? streams?) +I will answer with a quick program (see code). b. -(not sure) +CONS wants a list as it's second argument (at least most schemes, MIT/GNU seems +a little looser?), (dy lazy memo) would have to get checked sooner rather than +later. c. -(not sure) +KONS creates some real headache lexical scoping issues which could be hard to +debug. It's prevalent use could also effectively tie up every potential object +created, blocking garbage collection. + Problem 3.5 ------------------------ -(ahhh! open ended project!) +I implemented crude profiling: after evaluating an expression, a table can be +printed out showing the number of procedure and primative calls. + +A pair of eq-based hash tables are used to store the running call counts. +Performance does seem to be negatively effected (eg (fib 12) took 10+ seconds +using a very crude algorithm vs. almost instant in the top level repl), but +that might just be the generic dispatch stuff. + +I put in code for an enable/disable flag but i'm not sure it's even neccessary. + +The most-needed-change is to print just the primative/compound procedure name +symbols, not their string representations. I wanted to make sure that the +same procedure by different names would be counted together, but in the end +it looks like a big mess. My scmutils-enabled version of MIT Scheme has a +procedure-name method that does the trick, but it doesn't seem to be in the +default distribution so I left it out. + + diff --git a/ps03_evalapply/bnewbold_work.scm b/ps03_evalapply/bnewbold_work.scm new file mode 100644 index 0000000..e74c65e --- /dev/null +++ b/ps03_evalapply/bnewbold_work.scm @@ -0,0 +1,367 @@ +;;; 6.945 Problem Set #3 Scheme Code +;;; 02/25/2009 +;;; Bryan Newbold + +; Note: See the attached bnewbold_ps3.txt for comments + +; This file should be loaded into the generic-evaluation-environment + +;;; Problem 3.1 + +(defhandler apply + (lambda (proc-vector ops env) + (vector-map + (lambda (proc) + (apply proc ops env)) + proc-vector)) + (lambda (thing) + (and (vector? thing) + (not (compound-procedure? thing))))) + +(define add1 (lambda (x) (+ 1 x))) + +#| Test +eval> (define cube (lambda (x) (* x x x))) +cube + +eval> (cube 3) +27 + +eval> ((vector cube sin cos sqrt) 1) +#(1 .8414709848078965 .5403023058681398 1) +|# + +;;; Problem 3.2 + +(define ALLOW-SELF-EVALUATING-SYMBOLS #t) + +(define (unbound-symbol? s) + (if (symbol? s) + (eq? 'unbound (environment-reference-type + (nearest-repl/environment) + s)) + #f)) + +(define ((binary-pass symbol) a b) + (if (not ALLOW-SELF-EVALUATING-SYMBOLS) + (error "We don't ALLOW-SELF-EVALUATING-SYMBOLS!") + (if (for-all? + (list a b) + (lambda (x) + (or (number? x) + (unbound-symbol? x) + (and (list? x) + (not (null? x)) + (or (member (car x) (list '+ '* '/ '-)) + (literal-function? (car x))))))) ; see below + (list symbol a b) + (error "Not a number or symbol: " a b)))) + + +(define add (make-generic-operator 2 (binary-pass '+))) +(define multiply (make-generic-operator 2 (binary-pass '*))) +(define divide (make-generic-operator 2 (binary-pass '/))) +(define subtract (make-generic-operator 2 (binary-pass '-))) + +(defhandler add + number? number?) +(defhandler multiply * number? number?) +(defhandler divide / number? number?) +(defhandler subtract - number? number?) + + + +#| Test: +(add (multiply 42 5365) (add (subtract 'a 3) (divide 4 5))) +;Value: (+ 225330 (+ (- a 3) 4/5)) +(add (multiply 42 5365) (add (subtract 'a cos) (divide 4 5))) +;Not a number or symbol: a #[compiled-procedure 69 ("arith" #xce) #xf #x1c05fb] +|# + +(define *literal-functions* '()) + +(define (declare-literal-function f) + (if (and (symbol? f) (< (string-length (symbol->string f)) 2)) + (begin + (set! *literal-functions* (cons (environment-define + (nearest-repl/environment) + f + f) + *literal-functions*)) + (display + "Okey-doke, it is now a literal function")) + (error "Not a good function name (make it short): " f))) + +(define (literal-function? f) + (if (member f *literal-functions*) + #t + #f)) + +(defhandler apply (lambda (f opts env) + (if ALLOW-SELF-EVALUATING-SYMBOLS + (cons f (evaluate-list opts env)) + (error "We don't ALLOW-SELF-EVALUATING-SYMBOLS: " f))) + literal-function?) + +(defhandler eval (lambda (e env) e) + literal-function?) + +#| Test: TODO COPY +#| +eval> (declare-literal-function 'a) +Okey-doke, it is now a literal function#!unspecific + +eval> a +a + +eval> (a 2 4 5) +(a 2 4 5) + +eval> (add (a 1 2) 'b) +(+ (a 1 2) b) + +eval> (multiply (a (add 3 4) 'b) 99) +(* (a 7 b) 99) +|# +|# + +;;; Problem 3.3 + +(define add-streams + (lambda (a b) + (kons (+ (car a) (car b)) + (add-streams (cdr a) (cdr b))))) + +(define ref-stream + (lambda (s n) + (if (= n 0) + (car s) + (ref-stream (cdr s) (- n 1))))) + +(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)) + +#| type these in manually to the eval> prompt + +(define (integral (integrand lazy) initial-value dt) + (define int + (kons initial-value + (add-streams (scale-stream integrand dt) + int))) + int) +; integral +(define (solve f y0 dt) + (define y (integral dy y0 dt)) + (define dy (map-stream f y)) + y) +; solve +(ref-stream (solve (lambda (x) x) 1 0.001) 1000) +; 2.716923932235896 + +|# + +;;; Problem 3.4a + +(define some-options (list 'beef + 'thai 'indian 'pasta 'sandwich + 'crepes 'mexican)) ; len=7 + +#| +(define whats-for-dinner + (kons (list-ref some-options (random-integer 7)) + whats-for-dinner)) + + +(define (mealplan w) + (pp (car w)) + (mealplan (cdr w))) + +; Test: + +eval> (mealplan whats-for-dinner) +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +sandwich +...etc + +;That's depressing! + +|# + + +;;; Problem 3.5 + +; Profiling! + +(define PROFILING-ENABLED #f) + +(define *primative-call-database* + (make-eq-hash-table)) + +(define *compound-call-database* + (make-eq-hash-table)) + +#| +(define (clear-profile-results) + (set! PROFILING-ENABLED #f) + ( *primative-call-database* + (set! *compound-call-database* + (make-eq-hash-table)) + (set! PROFILING-ENABLED #t)) +(define cpr clear-profile-results) ; shorter +|# + + +(define (print-profile-results) + (set! PROFILING-ENABLED #f) + (begin + (display "----------- Profiling Results ---------------") (newline) + (display "Primative Procedures:") (newline) + (hash-table/for-each *primative-call-database* + (lambda (key val) + (display " ") + (display val) + (display " ") + (display key) (newline))) + (display "Compound Procedures:") (newline) + (hash-table/for-each *compound-call-database* + (lambda (key val) + (display " ") + (display val) + (display " ") + (display key) (newline))) + (display "----------- End of Table ---------------") (newline) + (set! PROFILING-ENABLED #t))) + +(define ppr print-profile-results) ; shorter + + +(define (count-primative proc) + (hash-table-set! *primative-call-database* + proc + (+ 1 (hash-table-ref/default *primative-call-database* + proc + 0)))) + +(define (count-compound proc) + (hash-table-set! *compound-call-database* + proc + (+ 1 (hash-table-ref/default *compound-call-database* + proc + 0)))) + +; from rtdata: +(define strict-primative-procedure? procedure?) + +(defhandler apply + (lambda (proc opers env) + (if PROFILING-ENABLED (count-primative proc)) + (apply-primitive-procedure proc + (evaluate-list opers env))) + strict-primative-procedure?) + +(defhandler apply + (lambda (procedure operands calling-environment) + (if PROFILING-ENABLED (count-compound procedure)) + (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?) + +#| Testing + +;; the order is a little off here, I cherry picked out examples from a +;; session so the actual counts are off a bit + +(init) +eval> (ppr) +----------- Profiling Results --------------- +Primative Procedures: +Compound Procedures: +----------- End of Table --------------- + +eval> (define cube (lambda (x) (* x x x))) +cube + +eval> (cube 12) +1728 + +eval> (ppr) +----------- Profiling Results --------------- +Primative Procedures: + 2 #[compound-procedure 18 print-profile-results] + 1 #[arity-dispatched-procedure 20] + 1 #[arity-dispatched-procedure 19] +Compound Procedures: + 1 #(compound-procedure (x) (* x x x) #((cube) (#(compound-procedure (x) (* + x x x) #((cube) (#(compound-procedure (x) (* x x x) #((cube) (#(compound-proced +ure ... ... ...)) ()))) ()))) ())) +----------- End of Table --------------- + +eval> (define (fib n) (if (< n 2) 1 (+ (fib (- n 2)) (fib (- n 1)))))) +fib + +eval> (fib 12) +233 + +eval> (ppr) +----------- Profiling Results --------------- +Primative Procedures: + 1 #[compound-procedure 21 operator] + 13134 #[arity-dispatched-procedure 19] + 1 #[compound-procedure 22 operator] + 1 #[arity-dispatched-procedure 20] + 26168 #[arity-dispatched-procedure 23] + 5 #[compound-procedure 18 print-profile-results] + 26173 #[arity-dispatched-procedure 24] +Compound Procedures: + 1 #(compound-procedure (x) (* x x x) #((fib cube) (#(compound-procedure (n) (if (< n 2) 1 (+ (fib (- n 2)) (fib (- n 1)))) #((fib cube) (#(compound-procedure (n) (if (< n 2) 1 (+ (fib ...) (fib ...))) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ())) #(compound-procedure (x) (* x x x) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ()))) ())) #(compound-procedure (x) (* x x x) #((fib cube) (#(compound-procedure (n) (if (< n 2) 1 (+ (fib ...) (fib ...))) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ())) #(compound-procedure (x) (* x x x) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ()))) ()))) ())) + 26172 #(compound-procedure (n) (if (< n 2) 1 (+ (fib (- n 2)) (fib (- n 1)))) #((fib cube) (#(compound-procedure (n) (if (< n 2) 1 (+ (fib (- n 2)) (fib (- n 1)))) #((fib cube) (#(compound-procedure (n) (if (< n 2) 1 (+ (fib ...) (fib ...))) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ())) #(compound-procedure (x) (* x x x) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ()))) ())) #(compound-procedure (x) (* x x x) #((fib cube) (#(compound-procedure (n) (if (< n 2) 1 (+ (fib ...) (fib ...))) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ())) #(compound-procedure (x) (* x x x) #((fib cube) (#(compound-procedure ... ... ...) #(compound-procedure ... ... ...)) ()))) ()))) ())) +----------- End of Table --------------- + +|# + diff --git a/ps03_evalapply/load.scm b/ps03_evalapply/load.scm index ebca908..bff6946 100644 --- a/ps03_evalapply/load.scm +++ b/ps03_evalapply/load.scm @@ -7,7 +7,13 @@ (define generic-evaluation-environment (extend-top-level-environment user-initial-environment)) -(load "bnewbold_interp" generic-evaluation-environment) +(load "interp" generic-evaluation-environment) (load "repl" generic-evaluation-environment) (ge generic-evaluation-environment) + +;;; This allows nonstrict definitions. +(load "general-procedures" generic-evaluation-environment) +(load "kons" generic-evaluation-environment) + +(load "bnewbold_work" generic-evaluation-environment) |