From 76600aad9835aa1a0af4ccde23b9cb2c1addae17 Mon Sep 17 00:00:00 2001
From: bnewbold <bnewbold@eta.mit.edu>
Date: Thu, 26 Feb 2009 02:15:39 -0500
Subject: ps3 done

---
 ps03_evalapply/bnewbold_interp.scm | 141 --------------
 ps03_evalapply/bnewbold_ps3.txt    |  82 +++++++--
 ps03_evalapply/bnewbold_work.scm   | 367 +++++++++++++++++++++++++++++++++++++
 ps03_evalapply/load.scm            |   8 +-
 4 files changed, 444 insertions(+), 154 deletions(-)
 delete mode 100644 ps03_evalapply/bnewbold_interp.scm
 create mode 100644 ps03_evalapply/bnewbold_work.scm

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)
-- 
cgit v1.2.3