cleaner way for function application inside `eval'.

[sicp.git] / src / sicp / metacircular2.rkt

diff --git a/src/sicp/metacircular2.rkt b/src/sicp/metacircular2.rkt
index 83d89fac906b406c429a1b99f1305d52d51f2496..0a4a575116774a972f28a4c334830ad13e101ac3 100644 (file)
--- a/src/sicp/metacircular2.rkt
+++ b/src/sicp/metacircular2.rkt
@@ -15,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)))
@@ -145,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
@@ -176,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
@@ -220,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)]))