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.

8 files changed, 379 insertions, 58 deletions

diff --git a/ChangeLog b/ChangeLog
index 79d36059..491baff6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,42 @@
+2011-11-28  Kaz Kylheku  <kaz@kylheku.com>
+
+	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.
+
 2011-11-26  Kaz Kylheku  <kaz@kylheku.com>
 
 	* parser.y (expr): Set source location info on elements.
diff --git a/eval.c b/eval.c
index d97e9ae6..c74d7576 100644
--- a/eval.c
+++ b/eval.c
@@ -45,14 +45,14 @@
 
 typedef val (*opfun_t)(val, val);
 
-val eval_error_s;
-
-val inc_s, dec_s, push_s, pop_s;
-val gethash_s;
-
 val top_vb, top_fb;
 val op_table;
 
+val eval_error_s;
+val let_s, lambda_s, call_s, cond_s, if_s, and_s, or_s, defvar_s, defun_s;
+val inc_s, dec_s, push_s, pop_s, gethash_s;
+val list_s, append_s;
+
 val make_env(val vbindings, val fbindings, val up_env)
 {
   val env = make_obj();
@@ -153,7 +153,7 @@ static val bind_args(val env, val params, val args, val ctx_form)
     eval_error(ctx_form, lit("~s: too many arguments"), car(ctx_form), nao);
   }
 
-  return make_env(new_bindings, 0, env);
+  return make_env(new_bindings, nil, env);
 }
 
 val apply(val fun, val arglist, val ctx_form)
@@ -258,6 +258,12 @@ val interp_fun(val env, val fun, val args)
   return eval_progn(body, fun_env, body);
 }
 
+static val eval_intrinsic(val form, val env)
+{
+  expand(form);
+  return eval(form, or2(env, make_env(nil, nil, env)), form);
+}
+
 val eval(val form, val env, val ctx_form)
 {
   type_check(env, ENV);
@@ -320,6 +326,11 @@ val eval_progn(val forms, val env, val ctx_form)
   return retval;
 }
 
+static val op_quote(val form, val env)
+{
+  return second(form);
+}
+
 static val op_let(val form, val env)
 {
   val args = rest(form);
@@ -347,7 +358,7 @@ static val op_let(val form, val env)
     list_collect (ptail, cons(var, val));
   }
 
-  return eval_progn(body, make_env(new_bindings, 0, env), form);
+  return eval_progn(body, make_env(new_bindings, nil, env), form);
 }
 
 static val op_lambda(val form, val env)
@@ -508,6 +519,185 @@ static val op_modplace(val form, val env)
   internal_error("unrecognized operator");
 }
 
+static val expand_forms(val form)
+{
+  if (atom(form)) {
+    return form;
+  } else {
+    val f = car(form);
+    val r = cdr(form);
+    val ex_f = expand(f);
+    val ex_r = expand_forms(r);
+
+    if (ex_f == f && ex_r == r)
+      return form;
+    return rlcp(cons(ex_f, ex_r), form);
+  }
+}
+
+static val expand_cond_pairs(val form)
+{
+  if (atom(form)) {
+    return form;
+  } else {
+    val pair = first(form);
+    val others = rest(form);
+    val pair_ex = expand_forms(pair);
+    val others_ex = expand_cond_pairs(others);
+
+    if (pair_ex == pair && others_ex == others)
+      return form;
+    return rlcp(cons(pair_ex, others_ex), form);
+  }
+}
+
+static val expand_place(val place)
+{
+  if (atom(place)) {
+    return place;
+  } else {
+    val sym = first(place);
+    if (sym == gethash_s) {
+      val hash = second(place);
+      val key = third(place);
+      val dfl_val = fourth(place);
+      val hash_ex = expand(hash);
+      val key_ex = expand(key);
+      val dfl_val_ex = expand(dfl_val);
+
+      if (hash == hash_ex && key == key_ex && dfl_val == dfl_val_ex)
+        return place;
+
+      return rlcp(cons(sym, cons(hash_ex, cons(key_ex, 
+                                               cons(dfl_val_ex, nil)))), 
+                  place);
+    } else {
+      eval_error(place, lit("unrecognized place: ~s"), place, nao);
+    }
+    abort();
+  }
+}
+
+static val expand_qquote(val qquoted_form)
+{
+  if (nullp(qquoted_form)) {
+    return nil;
+  } if (atom(qquoted_form)) {
+    return rlcp(cons(quote_s, cons(qquoted_form, nil)), qquoted_form);
+  } else {
+    val sym = car(qquoted_form);
+
+    if (sym == splice_s) {
+      eval_error(qquoted_form, lit("',*~s syntax is invalid"),
+                 second(qquoted_form), nao);
+    } else if (sym == unquote_s) {
+      return expand(second(qquoted_form));
+    } else {
+      val f = car(qquoted_form);
+      val r = cdr(qquoted_form);
+      val f_ex;
+      val r_ex = expand_qquote(r);
+
+      if (consp(f)) {
+        val qsym = car(f);
+        if (qsym == splice_s) {
+          f_ex = expand(second(f));
+        } else if (qsym == unquote_s) {
+          f_ex = cons(list_s, cons(expand(second(f)), nil));
+        } else if (qsym == quote_s) {
+          f_ex = cons(quote_s, cons(cons(second(f), nil), nil));
+        } else if (qsym == qquote_s) {
+          f_ex = cons(list_s, cons(expand_qquote(expand_qquote(second(f))), nil));
+        } else {
+          f_ex = cons(list_s, cons(expand_qquote(f), nil));
+        }
+      } else {
+        f_ex = cons(list_s, cons(expand_qquote(f), nil));
+      }
+
+      if (atom(r_ex)) {
+        return rlcp(cons(append_s, cons(f_ex, r_ex)), qquoted_form);
+      } else {
+        if (car(r_ex) == append_s)
+          r_ex = cdr(r_ex);
+        return rlcp(cons(append_s, cons(f_ex, r_ex)), qquoted_form);
+      }
+    }
+  }
+  return num(42);
+}
+
+
+val expand(val form)
+{
+  if (atom(form)) {
+    return form;
+  } else {
+    val sym = car(form);
+
+    if (sym == let_s || sym == lambda_s) {
+      val body = rest(rest(form));
+      val args = second(form);
+      val body_ex = expand_forms(body);
+      if (body == body_ex)
+        return form;
+      return rlcp(cons(sym, cons(args, body_ex)), form);
+    } else if (sym == call_s || sym == if_s || sym == and_s || sym == or_s) {
+      val body = rest(form);
+      val body_ex = expand_forms(body);
+      if (body == body_ex)
+        return form;
+      return rlcp(cons(sym, body_ex), form);
+    } else if (sym == cond_s) {
+      val pairs = rest(form);
+      val pairs_ex = expand_cond_pairs(pairs);
+
+      if (pairs == pairs_ex)
+        return form;
+      return rlcp(cons(cond_s, pairs_ex), form);
+    } else if (sym == defvar_s) {
+      val name = second(form);
+      val init = third(form);
+      val init_ex = expand(init);
+
+      if (init == init_ex)
+        return form;
+      return rlcp(cons(sym, cons(name, cons(init_ex, nil))), form);
+    } else if (sym == defun_s) {
+      val name = second(form);
+      val args = third(form);
+      val body = rest(rest(rest(form)));
+      val body_ex = expand_forms(body);
+
+      if (body == body_ex)
+        return form;
+      return rlcp(cons(sym, cons(name, cons(args, body_ex))), form);
+    } else if (sym == inc_s || sym == dec_s || sym == push_s || sym == pop_s) {
+      val place = second(form);
+      val inc = third(form);
+      val place_ex = expand_place(place);
+      val inc_x = expand(inc);
+
+      if (place == place_ex && inc == inc_x)
+        return form;
+      return rlcp(cons(sym, cons(place, cons(inc_x, nil))), form);
+    } else if (sym == quote_s) {
+      return form;
+    } else if (sym == qquote_s) {
+      return expand_qquote(second(form));
+    } else{
+      /* funtion call */
+      val args = rest(form);
+      val args_ex = expand_forms(args);
+
+      if (args == args_ex)
+        return form;
+      return rlcp(cons(sym, args_ex), form);
+    }
+    abort();
+  }
+}
+
 static void reg_fun(val sym, val fun)
 {
   sethash(top_fb, sym, cons(sym, fun));
@@ -520,22 +710,33 @@ void eval_init(void)
   top_vb = make_hash(t, nil, nil);
   op_table = make_hash(nil, nil, nil);
 
+  let_s = intern(lit("let"), user_package);
+  lambda_s = intern(lit("lambda"), user_package);
+  call_s = intern(lit("call"), user_package);
+  cond_s = intern(lit("cond"), user_package);
+  if_s = intern(lit("if"), user_package);
+  and_s = intern(lit("and"), user_package);
+  or_s = intern(lit("or"), user_package);
+  defvar_s = intern(lit("defvar"), user_package);
+  defun_s = intern(lit("defun"), user_package);
   inc_s = intern(lit("inc"), user_package);
   dec_s = intern(lit("dec"), user_package);
   push_s = intern(lit("push"), user_package);
   pop_s = intern(lit("pop"), user_package);
   gethash_s = intern(lit("gethash"), user_package);
-
-  sethash(op_table, intern(lit("let"), user_package), cptr((mem_t *) op_let));
-  sethash(op_table, intern(lit("lambda"), user_package), cptr((mem_t *) op_lambda));
-  sethash(op_table, intern(lit("call"), user_package), cptr((mem_t *) op_call));
-  sethash(op_table, intern(lit("cond"), user_package), cptr((mem_t *) op_cond));
-  sethash(op_table, intern(lit("if"), user_package), cptr((mem_t *) op_if));
-  sethash(op_table, intern(lit("and"), user_package), cptr((mem_t *) op_and));
-  sethash(op_table, intern(lit("or"), user_package), cptr((mem_t *) op_or));
-  sethash(op_table, intern(lit("defvar"), user_package), cptr((mem_t *) op_defvar));
-  sethash(op_table, intern(lit("defun"), user_package), cptr((mem_t *) op_defun));
-
+  list_s = intern(lit("list"), user_package);
+  append_s = intern(lit("append"), user_package);
+
+  sethash(op_table, quote_s, cptr((mem_t *) op_quote));
+  sethash(op_table, let_s, cptr((mem_t *) op_let));
+  sethash(op_table, lambda_s, cptr((mem_t *) op_lambda));
+  sethash(op_table, call_s, cptr((mem_t *) op_call));
+  sethash(op_table, cond_s, cptr((mem_t *) op_cond));
+  sethash(op_table, if_s, cptr((mem_t *) op_if));
+  sethash(op_table, and_s, cptr((mem_t *) op_and));
+  sethash(op_table, or_s, cptr((mem_t *) op_or));
+  sethash(op_table, defvar_s, cptr((mem_t *) op_defvar));
+  sethash(op_table, defun_s, cptr((mem_t *) op_defun));
   sethash(op_table, inc_s, cptr((mem_t *) op_modplace));
   sethash(op_table, dec_s, cptr((mem_t *) op_modplace));
   sethash(op_table, set_s, cptr((mem_t *) op_modplace));
@@ -547,6 +748,8 @@ void eval_init(void)
   reg_fun(intern(lit("cdr"), user_package), func_n1(car));
   reg_fun(intern(lit("first"), user_package), func_n1(car));
   reg_fun(intern(lit("rest"), user_package), func_n1(cdr));
+  reg_fun(append_s, func_n0v(appendv));
+  reg_fun(list_s, func_n0v(identity));
 
   reg_fun(intern(lit("atom"), user_package), func_n1(atom));
   reg_fun(intern(lit("null"), user_package), func_n1(nullp));
@@ -574,7 +777,7 @@ void eval_init(void)
   reg_fun(intern(lit("match-regex"), user_package), func_n3(match_regex));
 
   reg_fun(intern(lit("make-hash"), user_package), func_n3(make_hash));
-  reg_fun(intern(lit("gethash"), user_package), func_n3(gethash_n));
+  reg_fun(gethash_s, func_n3(gethash_n));
   reg_fun(intern(lit("sethash"), user_package), func_n3(sethash));
   reg_fun(intern(lit("pushhash"), user_package), func_n3(pushhash));
   reg_fun(intern(lit("remhash"), user_package), func_n2(remhash));
@@ -584,6 +787,8 @@ void eval_init(void)
   reg_fun(intern(lit("set-hash-userdata"), user_package),
           func_n2(set_hash_userdata));
 
+  reg_fun(intern(lit("eval"), user_package), func_n2(eval_intrinsic));
+
   eval_error_s = intern(lit("eval-error"), user_package);
   uw_register_subtype(eval_error_s, error_s);
 }
diff --git a/eval.h b/eval.h
index edea999f..0c2fa80a 100644
--- a/eval.h
+++ b/eval.h
@@ -33,6 +33,7 @@ val interp_fun(val env, val fun, val args);
 val apply(val fun, val arglist, val ctx_form);
 val eval_progn(val forms, val env, val ctx_form);
 val eval(val form, val env, val ctx_form);
+val expand(val form);
 val bindable(val obj);
 
 void eval_init(void);
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(')'));
+          }
         }
       }
     }
diff --git a/lib.h b/lib.h
index c78464a6..d83a0cef 100644
--- a/lib.h
+++ b/lib.h
@@ -314,6 +314,7 @@ val nreverse(val in);
 val reverse(val in);
 val append2(val list1, val list2);
 val nappend2(val list1, val list2);
+val appendv(val lists);
 val ldiff(val list1, val list2);
 val flatten(val list);
 val memq(val obj, val list);
diff --git a/match.c b/match.c
index 1eeed66f..ad3d56cc 100644
--- a/match.c
+++ b/match.c
@@ -55,7 +55,7 @@ int opt_arraydims = 1;
 val decline_k, next_spec_k, repeat_spec_k;
 val mingap_k, maxgap_k, gap_k, mintimes_k, maxtimes_k, times_k;
 val lines_k, chars_k;
-val text_s, choose_s, gather_s;
+val text_s, choose_s, gather_s, do_s;
 val longest_k, shortest_k, greedy_k;
 val vars_k, resolve_k;
 val append_k, into_k, var_k, list_k, string_k, env_k;
@@ -3291,6 +3291,7 @@ static void syms_init(void)
   text_s = intern(lit("text"), user_package);
   choose_s = intern(lit("choose"), user_package);
   gather_s = intern(lit("gather"), user_package);
+  do_s = intern(lit("do"), user_package);
   longest_k = intern(lit("longest"), keyword_package);
   shortest_k = intern(lit("shortest"), keyword_package);
   greedy_k = intern(lit("greedy"), keyword_package);
@@ -3344,8 +3345,7 @@ static void dir_tables_init(void)
   sethash(v_directive_table, deffilter_s, cptr((mem_t *) v_deffilter));
   sethash(v_directive_table, filter_s, cptr((mem_t *) v_filter));
   sethash(v_directive_table, eof_s, cptr((mem_t *) v_eof));
-  sethash(v_directive_table, intern(lit("do"), user_package), 
-          cptr((mem_t *) v_do));
+  sethash(v_directive_table, do_s, cptr((mem_t *) v_do));
 
   sethash(h_directive_table, text_s, cptr((mem_t *) h_text));
   sethash(h_directive_table, var_s, cptr((mem_t *) h_var));
@@ -3368,8 +3368,7 @@ static void dir_tables_init(void)
   sethash(h_directive_table, trailer_s, cptr((mem_t *) h_trailer));
   sethash(h_directive_table, define_s, cptr((mem_t *) h_define));
   sethash(h_directive_table, eol_s, cptr((mem_t *) h_eol));
-  sethash(h_directive_table, intern(lit("do"), user_package), 
-          cptr((mem_t *) h_do));
+  sethash(h_directive_table, do_s, cptr((mem_t *) h_do));
 }
 
 void match_init(void)
diff --git a/match.h b/match.h
index e939208f..24afd7c3 100644
--- a/match.h
+++ b/match.h
@@ -24,6 +24,7 @@
  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  */
 
+val do_s;
 void match_init(void);
 val match_funcall(val name, val arg, val other_args);
 int extract(val spec, val filenames, val bindings);
diff --git a/parser.y b/parser.y
index 37d6af35..6aa4d2e0 100644
--- a/parser.y
+++ b/parser.y
@@ -38,6 +38,7 @@
 #include "utf8.h"
 #include "match.h"
 #include "hash.h"
+#include "eval.h"
 #include "parser.h"
 
 int yylex(void);
@@ -48,6 +49,7 @@ static val o_elems_transform(val output_form);
 static val define_transform(val define_form);
 static val lit_char_helper(val litchars);
 static val optimize_text(val text_form);
+static val choose_quote(val quoted_form);
 static wchar_t char_from_name(wchar_t *name);
 
 static val parsed_spec;
@@ -290,7 +292,15 @@ texts : text %prec LOW          { $$ = rlcp(cons($1, nil), $1); }
 elem : texts                    { $$ = rlcp(cons(text_s, $1), $1);
                                   $$ = rlcp(optimize_text($$), $$); }
      | var                      { $$ = rl($1, num(lineno)); }
-     | list                     { $$ = $1; }
+     | list                     { if (first($1) == do_s)
+                                  { val form = second($1);
+                                    val form_ex = expand(form);
+
+                                    if (form == form_ex)
+                                      $$ = $1;
+                                    else
+                                      $$ = rlcp(cons(do_s, cons(form_ex, nil)),
+                                                $1); }}
      | COLL exprs_opt ')' elems END     { $$ = list(coll_s, $4, nil, $2, nao);
                                           rl($$, num($1)); }
      | COLL exprs_opt ')' elems
@@ -515,7 +525,7 @@ o_elem : TEXT                   { $$ = string_own($1);
        | SPACE                  { $$ = string_own($1);
                                   rl($$, num(lineno)); }
        | o_var                  { $$ = $1; }
-       | list                   { $$ = rlcp(cons(expr_s, $1), $1); }
+       | list                   { $$ = rlcp(cons(expr_s, expand($1)), $1); }
        | rep_elem               { $$ = $1; }
        ;
 
@@ -603,14 +613,15 @@ var_op : '*'                    { $$ = list(t, nao); }
 list : '(' exprs ')'            { $$ = rl($2, num($1)); }
      | '(' ')'                  { $$ = nil; }
      | ',' expr                 { $$ = rlcp(list(unquote_s, $2, nao), $2); }
-     | '\'' expr                { $$ = rlcp(list(qquote_s, $2, nao), $2); }
+     | '\'' expr                { $$ = rlcp(list(choose_quote($2),
+                                            $2, nao), $2); }
      | SPLICE expr              { $$ = rlcp(list(splice_s, $2, nao), $2); }
      | '(' error                { $$ = nil;
                                   yybadtoken(yychar, lit("list expression")); }
      ;
 
-meta_expr : METAPAR exprs ')'   { $$ = cons(expr_s, $2); }
-          | METAPAR ')'         { $$ = cons(expr_s, nil); }
+meta_expr : METAPAR exprs ')'   { $$ = rlcp(cons(expr_s, expand($2)), $2); }
+          | METAPAR ')'         { $$ = rl(cons(expr_s, nil), num(lineno)); }
           | METAPAR error       { $$ = nil;
                                   yybadtoken(yychar, lit("meta expression")); }
           ;
@@ -752,7 +763,7 @@ quasi_items : quasi_item                { $$ = cons($1, nil); }
 quasi_item : litchars           { $$ = lit_char_helper($1); }
            | TEXT               { $$ = string_own($1); }
            | var                { $$ = $1; }
-           | list               { $$ = rlcp(cons(expr_s, $1), $1); }
+           | list               { $$ = rlcp(cons(expr_s, expand($1)), $1); }
            ;
 
 litchars : LITCHAR              { $$ = cons(chr($1), nil); }
@@ -879,6 +890,25 @@ static val optimize_text(val text_form)
   return text_form;
 }
 
+static val unquotes_occur(val quoted_form)
+{
+  if (atom(quoted_form)) {
+    return nil;
+  } else {
+    val sym = car(quoted_form);
+    if (sym == unquote_s || sym == splice_s)
+      return t;
+    if (sym == quote_s)
+      return nil;
+    return or2(unquotes_occur(sym), unquotes_occur(cdr(quoted_form)));
+  }
+}
+
+static val choose_quote(val quoted_form)
+{
+  return unquotes_occur(quoted_form) ? qquote_s : quote_s;
+}
+
 val rl(val form, val lineno)
 {
   sethash(form_to_ln_hash, form, lineno);