X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2Fsicp%2Fmetacircular2.rkt;h=0a4a575116774a972f28a4c334830ad13e101ac3;hb=26c9af18426fa429a470d267350f08b9213a2c6d;hp=1e8e0e3c9b01f89e7c7581fdf23ddac45d64e665;hpb=3e66d12e055a0aca2ed8556f4a1a3dcb966264f6;p=sicp.git

diff --git a/src/sicp/metacircular2.rkt b/src/sicp/metacircular2.rkt
index 1e8e0e3..0a4a575 100644
--- a/src/sicp/metacircular2.rkt
+++ b/src/sicp/metacircular2.rkt
@@ -4,6 +4,8 @@
                     (apply apply-in-underlying-scheme)
                     (eval eval-in-underlying-scheme)))
 
+(provide (all-defined-out))
+
 (define (self-evaluating? expr)
   (match expr
     [(? number? expr) #t]
@@ -13,12 +15,12 @@
 
 (define (variable? expr) (symbol? expr))
 
-
 ;; sequence
 (define (eval-sequence exps env)
-  (cond ((last-exp? exps) (eval (first-exp exps) env))
-        (else (eval (first-exp exps) env)
-              (eval-sequence (rest-exps exps) env))))
+  (cond 
+    [(last-exp? exps) (eval (first-exp exps) env)]
+    [else (eval (first-exp exps) env)
+          (eval-sequence (rest-exps exps) env)]))
 
 ;; begin
 (define (last-exp? seq) (null? (cdr seq)))
@@ -59,7 +61,7 @@
 
 (define (lookup-variable-value var env)
   (if (eq? env the-empty-environment)
-      (error "unbound variable:" var)
+      (error "unbound variable: " var)
       (let ([frame (first-frame env)])
         (let ([value (hash-ref frame var (lambda () (lookup-variable-value var (enclosing-environment env))))])
           (if (eq? value '*unassigned*)
@@ -68,7 +70,7 @@
 
 (define (set-variable-value! var val env)
   (if (eq? env the-empty-environment)
-      (error "unbound variable")
+      (error "unbound variable: " var)
       (let ([frame (first-frame env)])
         (if (hash-has-key? frame var)
             (hash-set! frame var val)
@@ -93,7 +95,9 @@
         (list '- -)
         (list '* *)
         (list '/ /)
-        (list '= =)))
+        (list '= =)
+        (list '> >)
+        (list '< <)))
 
 (define (primitive-procedure-names)
   (map car primitive-procedures))
@@ -107,7 +111,7 @@
    (primitive-implementation proc) args))
 
 ;; global env
-(define (setup-environment)
+(define (make-environment)
   (let ((initial-env
          (extend-environment (primitive-procedure-names)
                              (primitive-procedure-objects)
@@ -116,7 +120,7 @@
     (define-variable! 'false false initial-env)
     initial-env))
 
-(define the-global-environment (setup-environment))
+(define the-global-environment (make-environment))
 
 ;; application
 (define (list-of-values exps env)
@@ -141,11 +145,11 @@
   (match procedure
     [`(primitive ,f ...)  (apply-primitive-procedure procedure arguments)]
     [`(procedure ,f ...)  (eval-sequence
-                       (procedure-body procedure)
-                       (extend-environment
-                        (procedure-parameters procedure)
-                        arguments
-                        (procedure-environment procedure)))]
+                           (procedure-body procedure)
+                           (extend-environment
+                            (procedure-parameters procedure)
+                            arguments
+                            (procedure-environment procedure)))]
     [_                (error "Unknown procedure type -- APPLY" procedure)]))
 
 ;; truth
@@ -172,10 +176,17 @@
 
 ;; let
 (define (let->combination lexpr)
-  (match-let* ([`(let ,bindings ,body ..1) lexpr]
+  (match-let* ([`(let ,(? (lambda (x) (or (pair? x) (empty? x))) bindings) ,body ..1) lexpr]
                [`((,var ,val) ...) bindings])
     `((lambda ,var ,@body) ,@val)))
 
+;; named let
+(define (named-let->combination lexpr)
+  (match-let* ([`(let ,(? symbol? name) ,(? (lambda (x) (or (pair? x) (empty? x))) bindings) ,body ..1) lexpr]
+               [`((,var ,val) ...) bindings])
+    `(begin (define ,name (lambda ,var ,@body))
+            (,name ,@val))))
+
 ;; let*
 (define (let*->nested-lets lexpr)
   (match lexpr
@@ -216,13 +227,15 @@
     [`(define ,(? (lambda (x) (not (pair? x))) var) ,b) (define-variable! var (eval b env) env)]
     [`(define ,(? pair? var) ,b ..1) (define-variable! (car var) (eval (make-lambda (cdr var) b) env) env)]
     [`(if ,pred ,consequent ,alternative) (if (true? (eval pred env)) (eval consequent env) (eval alternative env))]
+    [`(unless ,condition ,consequent ,alternative) (if (true? (eval condition env)) (eval alternative env) (eval consequent env))]
     [`(lambda ,parameters ,body ..1) (make-procedure parameters body env)]
     [`(begin ,exp ...) (eval-sequence exp env)]
     [`(cond ,clauses ...) (eval (cond->if clauses) env)]
-    [`(let ,bindings ,body ..1) (eval (let->combination exp) env)]
+    [`(let ,(? (lambda (x) (or (pair? x) (empty? x))) bindings) ,body ..1) (eval (let->combination exp) env)]
+    [`(let ,(? symbol? name) ,bindings ,body ..1) (eval (named-let->combination exp) env)]
     [`(let* ,bindings ,body ..1) (eval (let*->nested-lets exp) env)]
     [`(letrec ,bindings ,body ..1) (eval (letrec->combination exp) env)]
-    [(list f x ...) (apply (eval f env) (list-of-values x env))]
+    [`(,f ,x ...) (apply (eval f env) (list-of-values x env))]
     [_ (error "unable to evaluate expression -- EVAL " exp)]))