From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Mon, 7 Nov 2011 16:38:24 +0000 (+0530)
Subject: solutions to 4.5, 4.6, 4.7, 4.8 and the corresponding eval function
X-Git-Url: https://git.rkrishnan.org/pf/components/com_hotproperty/$sch_link?a=commitdiff_plain;h=fe56a72fefca339868ef4b1a412435f4dda47e8e;p=sicp.git

solutions to 4.5, 4.6, 4.7, 4.8 and the corresponding eval function
---

diff --git a/src/sicp/ex4_5.rkt b/src/sicp/ex4_5.rkt
new file mode 100644
index 0000000..50ad427
--- /dev/null
+++ b/src/sicp/ex4_5.rkt
@@ -0,0 +1,31 @@
+#lang racket
+
+(define (cond? exp) (tagged-list? exp 'cond))
+(define (cond-clauses exp) (cdr exp))
+(define (cond-else-clause? clause)
+  (eq? (cond-predicate clause) 'else))
+(define (cond-predicate clause) (car clause))
+
+(define (cond-arrow-clause? clause) (eq? (cadr (cond-actions clause)) '=>))
+(define (cond-arrow-clause-recipient clause) (caddr clause))
+(define (cond-actions clause) 
+  (if (cond-arrow-clause? clause)
+      (apply (cond-arrow-clause-recipient clause) (cond-predicate clause))
+      (cdr clause)))
+
+(define (cond->if exp)
+  (expand-clauses (cond-clauses exp)))
+
+(define (expand-clauses clauses)
+  (if (null? clauses)
+      'false                          ; no else clause
+      (let ((first (car clauses))
+            (rest (cdr clauses)))
+        (if (cond-else-clause? first)
+            (if (null? rest)
+                (sequence->exp (cond-actions first))
+                (error "ELSE clause isn't last -- COND->IF"
+                       clauses))
+            (make-if (cond-predicate first)
+                     (sequence->exp (cond-actions first))
+                     (expand-clauses rest))))))
\ No newline at end of file
diff --git a/src/sicp/ex4_6.rkt b/src/sicp/ex4_6.rkt
new file mode 100644
index 0000000..6ba2950
--- /dev/null
+++ b/src/sicp/ex4_6.rkt
@@ -0,0 +1,30 @@
+#lang racket/base
+
+(provide let->combination)
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+      (eq? (car exp) tag)
+      #f))
+
+
+(define (make-lambda params body)
+  (cons 'lambda (cons params body)))
+
+(define (let? expr)
+  (tagged-list? expr 'let))
+
+(define (let-bindings expr) (cadr expr))
+(define (let-bindings-variables bindings) (map car bindings))
+(define (let-bindings-values bindings) (map cadr bindings))
+(define (let-body expr) (cddr expr))
+
+(define (let->combination expr)
+  (let ([bindings (let-bindings expr)])
+    (let ([vars (let-bindings-variables bindings)]
+          [vals (let-bindings-values bindings)]
+          [body (let-body expr)])
+      (cons (make-lambda vars body) vals))))
+
+(define ns (make-base-namespace))
+(eval (let->combination '(let ((x 2) (y 3)) (+ x y))) ns)
diff --git a/src/sicp/ex4_7.rkt b/src/sicp/ex4_7.rkt
new file mode 100644
index 0000000..956095d
--- /dev/null
+++ b/src/sicp/ex4_7.rkt
@@ -0,0 +1,63 @@
+#lang racket
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+      (eq? (car exp) tag)
+      #f))
+
+(define (make-lambda params body)
+  (cons 'lambda (cons params body)))
+
+(define (let*? expr)
+  (tagged-list? expr 'let*))
+
+(define (let*-bindings expr) (cadr expr))
+(define (let*-body expr) (cddr expr))
+
+
+(define (let*->let bindings body)
+  (cond [(empty? bindings) '()]
+        [else 
+         (let ([binding (car bindings)]
+               [rest-bindings (cdr bindings)])
+           (if (empty? rest-bindings)
+               (cons 'let (cons (list binding) body))
+               (cons 'let (cons (list binding) (list (let*->let rest-bindings body))))))]))
+
+#|
+
+(define (make-let bindings body)
+  (cons 'let (cons bindings body)))
+
+(define (let*->let bindings body)
+  (cond [(empty? bindings) body]
+        [else
+         (make-let (list (car bindings))
+                   (list (let*->let (cdr bindings) body))]))
+|#
+
+(define (let*->nested-lets exp)
+  (let ([bindings (let*-bindings exp)]
+        [body     (let*-body exp)])
+    (let*->let bindings body)))
+
+;; b
+#|
+
+It is enough to add an action for let* expression in eval, as eval
+gets recursively called for the transformed expressions (assuming that
+eval has case handlers for let expression whose action is to transform 
+into lambda expression application and eval it).
+
+if we add the following action for let* expressions in eval:
+
+(eval (let*->nested-lets exp) env)
+ =>
+(eval (let-expression) env)
+=>
+(eval (let->combination exp) env)
+=>
+(eval (application exp parameters) env)
+
+
+|#
\ No newline at end of file
diff --git a/src/sicp/ex4_8.rkt b/src/sicp/ex4_8.rkt
new file mode 100644
index 0000000..d58eb4d
--- /dev/null
+++ b/src/sicp/ex4_8.rkt
@@ -0,0 +1,59 @@
+#lang racket
+
+(provide let->combination)
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+      (eq? (car exp) tag)
+      #f))
+
+(define (variable? expr)
+  (symbol? expr))
+
+(define (make-lambda params body)
+  (cons 'lambda (cons params body)))
+
+(define (let? expr)
+  (tagged-list? expr 'let))
+
+(define (named-let? expr)
+  (if (variable? (cadr expr))
+      #t
+      #f))
+
+(define (let-name expr)
+  (if (named-let? expr)
+      (cadr expr)
+      #f))
+
+(define (let-bindings expr) 
+  (if (let-name expr) 
+      (caddr expr)
+      (cadr expr)))
+
+(define (let-bindings-variables bindings) (map car bindings))
+(define (let-bindings-values bindings) (map cadr bindings))
+(define (let-body expr) 
+  (if (let-name expr)
+      (cdddr expr)
+      (cddr expr)))
+
+(define (let->combination expr)
+  (let ([bindings (let-bindings expr)])
+    (let ([vars (let-bindings-variables bindings)]
+          [vals (let-bindings-values bindings)]
+          [body (let-body expr)])
+      (if (not (let-name expr))
+          (cons (make-lambda vars body) vals)
+          (list (list 'define (let-name expr) (make-lambda vars body))
+                (list (let-name expr) vals))))))
+
+(define ns (make-base-namespace))
+(eval (let->combination '(let ((x 2) (y 3)) (+ x y))) ns)
+(eval (let->combination '(let ((x 2) (y 3)) (+ x y))) ns)
+(let->combination '(let fib-iter ((a 1)
+                                       (b 0)
+                                       (count n))
+                          (if (= count 0)
+                              b
+                              (fib-iter (+ a b) a (- count 1)))))
diff --git a/src/sicp/metacircular.rkt b/src/sicp/metacircular.rkt
index 596d9bb..24ef7e0 100644
--- a/src/sicp/metacircular.rkt
+++ b/src/sicp/metacircular.rkt
@@ -1,5 +1,8 @@
 #lang racket
 
+(require "ex4_8.rkt" ;; for let and named let
+         "ex4_7.rkt")
+
 ;; metacircular evaluator
 (define (eval exp env)
   (cond ((self-evaluating? exp) exp)
@@ -14,6 +17,8 @@
                          env))
         ((begin? exp) (eval-sequence (begin-actions exp) env))
         ((cond? exp) (eval (cond->if exp) env))
+        ((let? exp) (eval (let->combination exp) env))  ;; from ex4.8
+        ((let*? exp) (eval (let*->nested-lets exp) env)) ;; from ex4_7
         ((application? exp)
          (apply (eval (operator exp) env)
                 (list-of-values (operands exp) env)))