let there be lambda!

* begin form
* define form
* let derived form
* function application and stuff

3 files changed, 99 insertions, 13 deletions

diff --git a/environment.scm b/environment.scm
index 5906a1d..4917a40 100644
--- a/environment.scm
+++ b/environment.scm
@@ -1,6 +1,9 @@
 (define-module (environment)
                #: export (lookup-variable-value
-                           setup-environment))
+                           setup-environment
+                           set-variable-value!
+                           define-variable!
+                           extend-env))
 
 (add-to-load-path ".")
 (use-modules (prelude/primitives))
diff --git a/main.scm b/main.scm
index 8db3289..7476efb 100644
--- a/main.scm
+++ b/main.scm
@@ -44,7 +44,7 @@
       [(cond-else? (car clauses)) (cond-consequent (car clauses))]
       [(last-clause? clauses) (make-if (cond-predicate (car clauses))
                                        (cond-consequent (car clauses))
-                                       '())]
+                                       'false)]
       [else (make-if (cond-predicate (car clauses))
                      (cond-consequent (car clauses))
                      (cond->if (make-cond (cdr clauses))))])))
@@ -64,16 +64,56 @@
 
 ;;; assignment
 (define (assignment? expr) (tagged? expr 'set!))
+(define (assignment-name expr) (cadr expr))
+(define (assignment-value expr) (caddr expr))
+
+;;; definition
+(define (definition? expr) (tagged? expr 'define))
+(define (definition-name expr) (cadr expr))
+(define (definition-value expr) (caddr expr))
+
+;;; lambda
+(define (lambda-form? expr) (tagged? expr 'lambda))
+(define (lambda-params expr) (cadr expr))
+(define (lambda-body expr) (cddr expr))
+(define (make-lambda params body) (cons 'lambda (cons params body)))
+
+;;; begin
+(define (begin-form? expr) (tagged? expr 'begin))
+(define (begin-actions begin-form) (cdr begin-form))
+(define (last-action? actions) (null? (cdr actions)))
+(define (make-begin actions) (cons 'begin actions))
+(define (sequence->expr actions)
+  (cond
+    [(null? actions) '()]
+    [(last-action? actions) (car actions)]
+    [else (make-begin actions)]))
+
+;;; let
+(define (let-form? expr) (tagged? expr 'let))
+(define (let-bindings expr) (cadr expr))
+(define (let-body expr) (cddr expr))
+(define (let-binding-variables bindings) (map car bindings))
+(define (let-binding-values bindings) (map cadr bindings))
+(define (let->lambda expr)
+  (let ([bindings (let-bindings expr)])
+    (make-lambda (let-binding-variables bindings)
+                 (let-body expr))))
 
 (define (eval-expr expr env)
   (cond
     [(self-evaluating? expr) expr]
+    [(variable? expr) (lookup-variable-value expr env)]
     [(if-else? expr) (eval-if expr env)]
+    [(begin-form? expr) (eval-sequence (begin-actions expr) env)]
+    [(lambda-form? expr) (make-lambda (lambda-params expr)
+                                      (lambda-body expr))]
+    [(let-form? expr) (eval-let expr env)]
+    [(assignment? expr) (eval-assignment expr env)]
+    [(definition? expr) (eval-definition expr env)]
     [(cond-form? expr) (eval-cond expr env)]
     [(quote-form? expr) (quotation-text expr)]
-    [(function-application? expr)
-     (apply-expr (operator expr)
-                 (list-of-values (operands expr) env))]))
+    [(function-application? expr) (eval-function-application expr env)]))
 
 (define (eval-if expr env)
   (if (true? (eval-expr (if-predicate expr) env))
@@ -83,6 +123,43 @@
 (define (eval-cond expr env)
   (eval-expr (cond->if expr) env))
 
+(define (eval-sequence exprs env)
+  (cond
+    [(last-action? exprs) (eval-expr (car exprs) env)]
+    [else (begin
+            (eval-expr (car exprs) env)
+            (eval-sequence (cdr exprs) env))]))
+
+(define (eval-let expr env)
+  (eval-function-application (cons (let->lambda expr)
+                                   (let-binding-values (let-bindings expr)))
+                             env))
+
+(define (eval-assignment expr env)
+  (set-variable-value! 
+    (assignment-name expr)
+    (eval-expr (assignment-value expr) env)
+    env))
+
+(define (eval-definition expr env)
+  (define-variable! 
+    (definition-name expr)
+    (eval-expr (definition-value expr) env)
+    env))
+
+(define (eval-function-application expr env)
+  (let ([proc (operator expr)]
+        [args (list-of-values (operands expr) env)])
+    (cond
+      [(primitive? proc) (apply-primitive-proc proc args)]
+      [else
+        (let ([compound-proc (eval-expr proc env)])
+          (eval-sequence
+            (lambda-body compound-proc)
+            (extend-env (lambda-params compound-proc)
+                        args
+                        env)))])))
+
 (define (primitive? proc)
   (is-elem-assoc-list proc primitives))
 
@@ -113,4 +190,9 @@
         (driver-loop))))))
 
 (define (show-lisp-expr object)
-  (display object))
+  (cond
+    [(tagged? object 'lambda)
+     (display "#<procedure ")
+     (display (lambda-params object))
+     (display ">")]
+    [else (display object)]))
diff --git a/prelude/primitives.scm b/prelude/primitives.scm
index 2e5f5d9..cd7f1bf 100644
--- a/prelude/primitives.scm
+++ b/prelude/primitives.scm
@@ -7,7 +7,7 @@
                            bool?
                            true?))
 
-(define (lift-bool expr) (if expr 'true 'false))
+(define (convert-bool expr) (if expr 'true 'false))
 (define (true? expr) (eq? expr 'true))
 (define (false? expr) (eq? expr 'false))
 (define (bool? expr)
@@ -34,17 +34,18 @@
 
 (define (not-fn x) (not (true? x)))
 
-(define (lift-arithmetic op)
-  (lambda vals (lift-bool (apply op vals))))
+(define (lift-bool op)
+  (lambda vals (convert-bool (apply op vals))))
 
 (define primitives
   `((+ . ,+)
     (- . ,-)
     (* . ,*)
-    (< . ,(lift-arithmetic <))
-    (> . ,(lift-arithmetic >))
-    (<= . ,(lift-arithmetic <=))
-    (>= . ,(lift-arithmetic >=))
+    (< . ,(lift-bool <))
+    (> . ,(lift-bool >))
+    (<= . ,(lift-bool <=))
+    (>= . ,(lift-bool >=))
+    (eq? . ,(lift-bool eq?))
     (&& . ,and-special)
     (|| . ,or-special)
     (/= . ,not-fn)