From c93d192c32c376705d3b0a740c81156a44e63ecb Mon Sep 17 00:00:00 2001
From: Akshay <nerdy@peppe.rs>
Date: Wed, 4 Nov 2020 08:53:43 +0530
Subject: add basic evaluator, environment

---
 main.scm | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)
 create mode 100644 main.scm

(limited to 'main.scm')

diff --git a/main.scm b/main.scm
new file mode 100644
index 0000000..08a5a22
--- /dev/null
+++ b/main.scm
@@ -0,0 +1,72 @@
+(include "prelude/primitives.scm")
+(include "util/table.scm")
+(include "util/alist.scm")
+
+(define (lift-bool expr) (if expr 'true 'false))
+
+(define (tagged? expr tag)
+  (if (pair? expr)
+      (eq? (car expr) tag)
+      #f))
+
+;;; self-evaluating
+(define (self-evaluating? expr)
+  (or (number? expr)
+      (string? expr)
+      (bool? expr)))
+
+(define variable? symbol?)
+
+;;; if-else
+(define (if-else? expr) (tagged? expr 'if))
+(define (if-predicate expr) (cadr expr))
+(define (if-consequent expr) (caddr expr))
+(define (if-alternative expr) 
+  (if (not (null? (cdddr expr)))
+      (cadddr expr)
+      'false))
+
+;;; function application
+(define (function-application? expr) (pair? expr))
+(define (operator expr) (car expr))
+(define (operands expr) (cdr expr))
+(define (no-operands? expr) (null? expr))
+(define (list-of-values ls env)
+  (if (no-operands? ls)
+      '()
+      (let ([first (eval-expr (car ls) env)])
+        (let ([rest (list-of-values (cdr ls) env)])
+          (cons first rest)))))
+
+;;; quoted expressions
+(define (quote-form? expr) (tagged? expr 'quote))
+(define (quotation-text expr) (cadr expr))
+
+;;; assignment
+(define (assignment? expr) (tagged? expr 'set!))
+
+(define (eval-expr expr env)
+  (cond
+    [(self-evaluating? expr) expr]
+    [(if-else? expr) (eval-if expr env)]
+    [(quote-form? expr) (quotation-text expr)]
+    [(function-application? expr)
+     (apply-expr (operator expr)
+                 (list-of-values (operands expr) env))]))
+
+(define (eval-if expr env)
+  (if (true? (eval-expr (if-predicate expr) env))
+      (eval-expr (if-consequent expr) env)
+      (eval-expr (if-alternative expr) env)))
+
+(define (primitive? proc)
+  (is-elem-assoc-list proc primitives))
+
+(define (apply-primitive-proc proc args)
+  (let ([p (lookup-assoc-list proc primitives)])
+    (apply p args)))
+
+(define (apply-expr proc args)
+  (cond
+    [(primitive? proc) (apply-primitive-proc proc args)]
+    [else 'false]))
-- 
cgit v1.2.3