summaryrefslogtreecommitdiffstats
path: root/ps03_evalapply
diff options
context:
space:
mode:
Diffstat (limited to 'ps03_evalapply')
-rw-r--r--ps03_evalapply/bnewbold_interp.scm141
-rw-r--r--ps03_evalapply/bnewbold_ps3.txt82
-rw-r--r--ps03_evalapply/bnewbold_work.scm367
-rw-r--r--ps03_evalapply/load.scm8
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)