Added evaluation support for quote and quasiquote with unquotes.

New functions list, append and eval.  Code walking framework for
expanding quasiquotes.  quotes right now.

* eval.c (let_s, lambda_s, call_s, cond_s, if_s, and_s, or_s
defvar_s, defun_s, list_s, append_s): New symbol variables.
(eval_intrinsic, op_quote, expand_forms, expand_cond_pairs,
expand_place, expand_qquote): New static functions.
(expand): New external function.
(eval_init): Initialize new symbol variables. Use newly defined symbol
variables to register functions. Also, new functions: quote, append,
list and eval.

* eval.h (expand): Declared.

* lib.c (appendv): New function.
(obj_init): quote and splice operator symbols moved into system
package.
(obj_print, obj_pprint): Support for printing quotes and splices.

* lib.h (appendv): Declared.

* match.c (do_s): New symbol variable.
(syms_init): New variable initialized.
(dir_tales_init): New variable used instead of intern.

* match.h (do_s): Declared.

* parser.y (elem): @(do) form recognized and its argument passed
through the new expander.
(o_elem, quasi_item): Pass list through expander.
(list): Use choose_quote to decide whether to put
regular quote or quasiquote on quoted list.
(meta_expr): Fixed abstract syntax so the expression is a single
argument of the sys:expr, rather than multiple arguments.
(unquotes_occur, choose_quote): New static function.

1 files changed, 73 insertions, 28 deletions

diff --git a/lib.c b/lib.c
index 76abc8cc..63893f0b 100644
--- a/lib.c
+++ b/lib.c
@@ -342,6 +342,25 @@ val append2(val list1, val list2)
   return out;
 }
 
+val appendv(val lists)
+{
+  list_collect_decl (out, ptail);
+
+  for (; lists; lists = cdr(lists)) {
+    val item = car(lists);
+    if (consp(item)) {
+      list_collect_append(ptail, car(lists));
+    } else {
+      if (cdr(lists))
+        uw_throwf(error_s, lit("append: ~s is not a list"), item, nao);
+      list_collect_terminate(ptail, item);
+      return out;
+    }
+  }
+
+  return out;
+}
+
 val nappend2(val list1, val list2)
 {
   val temp, iter;
@@ -2877,10 +2896,10 @@ static void obj_init(void)
   regex_s = intern(lit("regex"), system_package);
   nongreedy_s = intern(lit("nongreedy"), system_package);
   compiled_regex_s = intern(lit("compiled-regex"), system_package);
-  quote_s = intern(lit("quote"), user_package);
-  qquote_s = intern(lit("qquote"), user_package);
-  unquote_s = intern(lit("unquote"), user_package);
-  splice_s = intern(lit("splice"), user_package);
+  quote_s = intern(lit("quote"), system_package);
+  qquote_s = intern(lit("qquote"), system_package);
+  unquote_s = intern(lit("unquote"), system_package);
+  splice_s = intern(lit("splice"), system_package);
   chset_s = intern(lit("chset"), system_package);
   set_s = intern(lit("set"), user_package);
   cset_s = intern(lit("cset"), user_package);
@@ -2962,18 +2981,31 @@ void obj_print(val obj, val out)
   case CONS:
   case LCONS:
     {
-      val iter;
-      put_char(out, chr('('));
-      for (iter = obj; consp(iter); iter = cdr(iter)) {
-        obj_print(car(iter), out);
-        if (nullp(cdr(iter))) {
-          put_char(out, chr(')'));
-        } else if (consp(cdr(iter))) {
-          put_char(out, chr(' '));
-        } else {
-          put_string(out, lit(" . "));
-          obj_print(cdr(iter), out);
-          put_char(out, chr(')'));
+      val sym = car(obj);
+
+      if (sym == quote_s || sym == qquote_s) {
+        put_char(out, chr('\''));
+        obj_print(second(obj), out);
+      } else if (sym == unquote_s) {
+        put_char(out, chr(','));
+        obj_print(second(obj), out);
+      } else if (sym == splice_s) {
+        put_string(out, lit(",*"));
+        obj_print(second(obj), out);
+      } else {
+        val iter;
+        put_char(out, chr('('));
+        for (iter = obj; consp(iter); iter = cdr(iter)) {
+          obj_print(car(iter), out);
+          if (nullp(cdr(iter))) {
+            put_char(out, chr(')'));
+          } else if (consp(cdr(iter))) {
+            put_char(out, chr(' '));
+          } else {
+            put_string(out, lit(" . "));
+            obj_print(cdr(iter), out);
+            put_char(out, chr(')'));
+          }
         }
       }
     }
@@ -3086,18 +3118,31 @@ void obj_pprint(val obj, val out)
   case CONS:
   case LCONS:
     {
-      val iter;
-      put_char(out, chr('('));
-      for (iter = obj; consp(iter); iter = cdr(iter)) {
-        obj_pprint(car(iter), out);
-        if (nullp(cdr(iter))) {
-          put_char(out, chr(')'));
-        } else if (consp(cdr(iter))) {
-          put_char(out, chr(' '));
-        } else {
-          put_string(out, lit(" . "));
-          obj_pprint(cdr(iter), out);
-          put_char(out, chr(')'));
+      val sym = car(obj);
+
+      if (sym == quote_s || sym == qquote_s) {
+        put_char(out, chr('\''));
+        obj_pprint(second(obj), out);
+      } else if (sym == unquote_s) {
+        put_char(out, chr(','));
+        obj_pprint(second(obj), out);
+      } else if (sym == splice_s) {
+        put_string(out, lit(",*"));
+        obj_pprint(second(obj), out);
+      } else {
+        val iter;
+        put_char(out, chr('('));
+        for (iter = obj; consp(iter); iter = cdr(iter)) {
+          obj_pprint(car(iter), out);
+          if (nullp(cdr(iter))) {
+            put_char(out, chr(')'));
+          } else if (consp(cdr(iter))) {
+            put_char(out, chr(' '));
+          } else {
+            put_string(out, lit(" . "));
+            obj_pprint(cdr(iter), out);
+            put_char(out, chr(')'));
+          }
         }
       }
     }