From a39a6fd97fa07ead2d501bdbf77af0d00f06d5de Mon Sep 17 00:00:00 2001
From: bakpakin <calsrose@gmail.com>
Date: Sat, 15 Jul 2017 16:56:03 -0400
Subject: [PATCH] More work on bootstrapping code. Have working macro
 expansion.

---
 .gitignore                  |  3 ++
 core/stl.c                  | 17 ++++++++
 libs/bootstrap.gst          | 78 +++++++++++++++++++++++++++++++++++++
 libs/repl.gst               | 26 -------------
 libs/{hello.gst => stl.gst} |  0
 5 files changed, 98 insertions(+), 26 deletions(-)
 create mode 100644 libs/bootstrap.gst
 delete mode 100644 libs/repl.gst
 rename libs/{hello.gst => stl.gst} (100%)

diff --git a/.gitignore b/.gitignore
index 641acb95..37ea8911 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,6 +2,9 @@
 /client/gst
 gst
 
+# Generated files
+*.genh
+
 # Tags
 tags
 
diff --git a/core/stl.c b/core/stl.c
index d12ec291..8a9143c2 100644
--- a/core/stl.c
+++ b/core/stl.c
@@ -1020,6 +1020,21 @@ static int gst_stl_compile(Gst *vm) {
     gst_c_return(vm, gst_compile(vm, env, gst_arg(vm, 0)));
 }
 
+/* Get vm->env */
+static int gst_stl_getenv(Gst *vm) {
+    gst_c_return(vm, gst_wrap_table(vm->env));
+}
+
+/* Set vm->env */
+static int gst_stl_setenv(Gst *vm) {
+    GstValue newEnv = gst_arg(vm, 0);
+    if (newEnv.type != GST_TABLE) {
+        gst_c_throwc(vm, "expected table");
+    }
+    vm->env = newEnv.data.table;
+    return GST_RETURN_OK;
+}
+
 /****/
 /* Bootstraping */
 /****/
@@ -1058,6 +1073,8 @@ static const GstModuleItem std_module[] = {
     {"parse-status", gst_stl_parser_status},
     {"parse", gst_stl_parse},
     /* Compile */
+    {"getenv", gst_stl_getenv},
+    {"setenv", gst_stl_setenv},
     {"compile", gst_stl_compile},
     /* Other */
     {"not", gst_stl_not},
diff --git a/libs/bootstrap.gst b/libs/bootstrap.gst
new file mode 100644
index 00000000..ddf7321a
--- /dev/null
+++ b/libs/bootstrap.gst
@@ -0,0 +1,78 @@
+
+# This file is executed without any macro expansion (macros are not
+# yet defined). Cannot use macros or anything outside the stl.
+
+# Helper for macro expansion
+(def macroexpander (fn [x env f]
+	(if (= (type x) :tuple)
+		(if (> (length x) 0)
+			(do
+				(def first (get x 0))
+				(def macros (get env :macros))
+				(if macros
+					(do
+						(def macro (get macros first))
+						(if macro
+							(f (apply macro (slice x 1)))
+							x))
+					x)
+				x)
+			x)
+		x)))
+
+# Macro expansion
+(def macroexpand (fn [x env]
+	(macroexpander x (if env env (getenv)) macroexpander)))
+
+# Function to create macros
+(def global-macro (fn [name f]
+	(def env (getenv))
+	(def env-macros (get env :macros))
+	(def macros (if env-macros env-macros {}))
+	(set! env :macros macros)
+	(set! macros (symbol name) f)
+	f))
+
+# Make defn
+(global-macro "defn" (fn [name &]
+	(tuple 'def name (apply tuple 'fn &))))
+
+# Make defmacro
+(global-macro "defmacro" (fn [name &]
+	(tuple global-macro (string name) (apply tuple 'fn &))))
+
+# Comment returns nil
+(global-macro "comment" (fn [] nil))
+
+# The source file to read from
+(var *sourcefile* stdin)
+
+# The *read* macro gets the next form from the source file, and
+# returns it. It is a var and therefor can be overwritten.
+(var *read* (fn []
+	(def b (buffer))
+	(def p (parser))
+	(while (not (parse-hasvalue p))
+		(read *sourcefile* 1 b)
+		(if (= (length b) 0)
+			(error "parse error: unexpected end of source"))
+		(parse-charseq p b)
+		(if (= (parse-status p) :error)
+			(error (string "parse error: " (parse-consume p))))
+		(clear b))
+	(parse-consume p)))
+
+# Evaluates a form by macro-expanding it, compiling it, and
+# then executing it.
+(def eval (fn [x]
+	(def func (compile (macroexpand x)))
+	(if (= :function (type func))
+		(func)
+		(error (string "compiler error: " func)))))
+
+# A simple repl for testing.
+(while true
+	(def t (thread (fn []
+		(while true
+			(print (eval (*read*)))))))
+	(print (tran t)))
diff --git a/libs/repl.gst b/libs/repl.gst
deleted file mode 100644
index 2f9c2409..00000000
--- a/libs/repl.gst
+++ /dev/null
@@ -1,26 +0,0 @@
-(var *sourcefile* stdin)
-
-(var *compile* (fn [x]
-	(def ret (compile x))
-	(if (= :function (type ret))
-		ret
-		(error (string "compile error: " ret)))))
-
-(var *read* (fn []
-	(def b (buffer))
-	(def p (parser))
-	(while (not (parse-hasvalue p))
-		(read *sourcefile* 1 b)
-		(if (= (length b) 0)
-			(error "unexpected end of source"))
-		(parse-charseq p b)
-		(clear b))
-	(parse-consume p)))
-
-(def eval (fn [x &]
-	(apply (*compile* x) &)))
-
-(def t (thread (fn []
-	(while true
-		(eval (*read*))))))
-(print (tran t))
diff --git a/libs/hello.gst b/libs/stl.gst
similarity index 100%
rename from libs/hello.gst
rename to libs/stl.gst