SICP (Manual) concrete evaluator arithmetic OK

Author: ramalho

references/sicp/instructors-manual/concrete-test.rkt

@@ -4,12 +4,22 @@
          "concrete.rkt")
 
 (check-false (ASSQ 'x '()) "Empty bindings")
-(check-equal? (ASSQ 'x '([x 8])) '(x 8) "First binding")
-(check-equal? (ASSQ 'x '([y 7] [x 8])) '(x 8) "Older binding")
-(check-equal? (ASSQ 'z '([x 8])) #f "No binding")
+(check-equal? (ASSQ 'x '([x . 8])) '(x . 8) "First binding")
+(check-equal? (ASSQ 'x '([y . 7] [x . 8])) '(x . 8) "Older binding")
+(check-equal? (ASSQ 'z '([x . 8])) #f "No binding")
 
+(check-equal? (MAKE-FRAME '(a) '(1)) '([a . 1]) "Smalest frame")
+(check-equal? (EXTEND-ENVIRONMENT '(a b) '(1 2) '()) '(([a . 1] [b . 2])))
+(check-equal? (EXTEND-ENVIRONMENT '() '() '()) '(()) )
 
 (check-exn (regexp "Unbound variable 'x") (lambda ()
-    (LOOKUP-VARIABLE-VALUE 'x '())) "Wrong error")
+    (LOOKUP-VARIABLE-VALUE 'x '())))
 ; WIP:
-; (check-equal? (LOOKUP-VARIABLE-VALUE 'x '([x 8])) 8)
+(check-equal? (LOOKUP-VARIABLE-VALUE 'x '(([x . 8]))) 8)
+
+(check-equal? (MAKE-FRAME '(a) '(1)) '([a . 1]) "Smalest frame")
+
+(check-equal? (EVAL 1 '()) 1)
+(check-equal? (EVAL 'x (EXTEND-ENVIRONMENT '(x) '(8) '())) 8)
+(check-equal? (EVAL '(+ 3 4) (MAKE-BUILTINS)) 7)
+(check-equal? (EVAL '(+ (* 3 4) (* 5 6)) (MAKE-BUILTINS)) 42)

references/sicp/instructors-manual/concrete.rkt

@@ -9,19 +9,57 @@
 ; Function names changed to ALL-CAPS to avoid potential
 ; confusion with functions provided by Racket.
 
+(define (EVAL exp environ)
+  ;; dispatch on expression type
+  (cond [(number? exp) exp]    ; self-evaluating
+        [(symbol? exp)
+         (LOOKUP-VARIABLE-VALUE exp environ)]
+        [else
+         (apply (EVAL (car exp) environ)       ; operator
+                (LIST-OF-VALUES (cdr exp)  ; operands
+                                environ))]))
+
+
+(define (LIST-OF-VALUES exps environ)
+  (if (null? exps)
+      '()
+      (cons (EVAL (car exps) environ)
+            (LIST-OF-VALUES (cdr exps) environ))))
+
+(define (EXTEND-ENVIRONMENT vars values base-environ)
+  (cons (MAKE-FRAME vars values) base-environ))
+
+(define (MAKE-FRAME vars values)
+  (cond [(and (null? vars) (null? values)) '()]
+        [(null? vars) (error "Too many arguments" values)]
+        [(null? values) (error "Too few arguments" vars)]
+        [else
+         (cons (cons (car vars) (car values)) ; make binding
+               (MAKE-FRAME (cdr vars) (cdr values)))]))
+        
+(define (LOOKUP-VARIABLE-VALUE var environ)
+  (if (null? environ)
+      (error "Unbound variable" var)
+      (let ([binding (ASSQ var (car environ))]) ; look in first frame
+        (if (eq? binding #f)
+            (LOOKUP-VARIABLE-VALUE var (cdr environ))
+            (cdr binding)))))
+
 (define (ASSQ var bindings)
   (cond [(null? bindings) #f]
         [(eq? var (caar bindings)) (car bindings)]
         [else (ASSQ var (cdr bindings))]))
 
-(define (LOOKUP-VARIABLE-VALUE var env)
-  (if (null? env)
-      (error "Unbound variable" var)
-      (let ([binding (ASSQ var (car env))])
-        (if (eq? binding #f)
-            (LOOKUP-VARIABLE-VALUE var (cdr env))
-            (cdr binding)))))
+(define (MAKE-BUILTINS)
+  (EXTEND-ENVIRONMENT
+   '(+ - * /)
+   (list + - * /)
+   '()))
 
 ; Needed to support rackunit tests in concrete-test.rkt.
 (provide ASSQ
-         LOOKUP-VARIABLE-VALUE)
+         LOOKUP-VARIABLE-VALUE
+         EXTEND-ENVIRONMENT
+         MAKE-FRAME
+         EVAL
+         MAKE-BUILTINS)