From be7e5da6c3839002ac5355a86f5164c3f60c86cc Mon Sep 17 00:00:00 2001
From: Akshay <nerdy@peppe.rs>
Date: Thu, 5 Nov 2020 21:51:30 +0530
Subject: let there be lambda!

* begin form
* define form
* let derived form
* function application and stuff
---
 main.scm | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 87 insertions(+), 5 deletions(-)

(limited to 'main.scm')

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)]))
-- 
cgit v1.2.3