New quasiquote idea: let's have two quasiquote macros sharing one

expander. One macro based on sys:qquote, sys:unquote and sys:splice,
and the other based on qquote, unquote and splice in the user package.
The read syntax puts out the sys: one.

* eval.c (expand_qquote): Takes three additional arguments: the
qquote, unquote and splice symbols to recognize.
The invalid splice diagnostic is adjusted based on which backquote
we are expanding.
(me_qquote): Look at the symbol in the first position of the form
and then expand either the internal quasiquote macro or the public one,
passing the right symbols into expand_qquote.
(eval_init): Register error-throwing stub functions
for the sys_qquote_s, sys_unquote_s and sys_splice_s symbols.
Register a macro for sys_qquote_s.

* lib.c (sys_qquote_s, sys_unquote_s, sys_splice_s): New symbol
variables.
(obj_init): Initialize new variables. Change qquote_s,
unquote_s and splice_s to user package.
(obj_print, obj_pprint): Convert only sys_qquote_s,
sys_unquote_s and sys_splice_s to the read syntax.
The quote_s, unquote_s and splice_s symbols are not
treated specially.

* lib.h (sys_qquote_s, sys_unquote_s, sys_splice_s): Declared.

* parser.y (n_expr): Use sys_qquote_s, sys_unquote_s and
sys_splice_s rather than qquote_s, unquote_s and splice_s.
(unquotes_occur): Likewise.

* txr.1: Documented.

6 files changed, 148 insertions, 66 deletions

diff --git a/ChangeLog b/ChangeLog
index d4504ada..9f6ea743 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,40 @@
 2014-03-01  Kaz Kylheku  <kaz@kylheku.com>
 
+	New quasiquote idea: let's have two quasiquote macros sharing one
+	expander. One macro based on sys:qquote, sys:unquote and sys:splice,
+	and the other based on qquote, unquote and splice in the user package.
+	The read syntax puts out the sys: one.
+
+	* eval.c (expand_qquote): Takes three additional arguments: the
+	qquote, unquote and splice symbols to recognize.
+	The invalid splice diagnostic is adjusted based on which backquote
+	we are expanding.
+	(me_qquote): Look at the symbol in the first position of the form
+	and then expand either the internal quasiquote macro or the public one,
+	passing the right symbols into expand_qquote.
+	(eval_init): Register error-throwing stub functions
+	for the sys_qquote_s, sys_unquote_s and sys_splice_s symbols.
+	Register a macro for sys_qquote_s.
+
+	* lib.c (sys_qquote_s, sys_unquote_s, sys_splice_s): New symbol
+	variables.
+	(obj_init): Initialize new variables. Change qquote_s,
+	unquote_s and splice_s to user package.
+	(obj_print, obj_pprint): Convert only sys_qquote_s,
+	sys_unquote_s and sys_splice_s to the read syntax.
+	The quote_s, unquote_s and splice_s symbols are not
+	treated specially.
+
+	* lib.h (sys_qquote_s, sys_unquote_s, sys_splice_s): Declared.
+
+	* parser.y (n_expr): Use sys_qquote_s, sys_unquote_s and
+	sys_splice_s rather than qquote_s, unquote_s and splice_s.
+	(unquotes_occur): Likewise.
+
+	* txr.1: Documented.
+
+2014-03-01  Kaz Kylheku  <kaz@kylheku.com>
+
 	* configure: changed numerous "if ! conftest" tests to "if conftest",
 	swapping around the consequent and alternative clauses.
 
diff --git a/eval.c b/eval.c
index dc712b89..e718853a 100644
--- a/eval.c
+++ b/eval.c
@@ -2007,7 +2007,8 @@ static val expand_cond_pairs(val form, val menv)
   }
 }
 
-static val expand_qquote(val qquoted_form, val menv)
+static val expand_qquote(val qquoted_form, val menv,
+                         val qq, val unq, val spl)
 {
   if (nilp(qquoted_form)) {
     return nil;
@@ -2016,44 +2017,50 @@ static val expand_qquote(val qquoted_form, val menv)
   } 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) {
+    if (sym == spl) {
+      val error_msg = if3(spl == sys_splice_s,
+                          lit("the splice ,*~s cannot occur as an atom "
+                              "or in the dotted position of a list"),
+                          lit("(splice ~s) cannot occur as an atom "
+                              "or in the dotted position of a list"));
+        eval_error(qquoted_form, error_msg,
+                   second(qquoted_form), nao);
+    } else if (sym == unq) {
       return expand(second(qquoted_form), menv);
-    } else if (sym == qquote_s) {
+    } else if (sym == qq) {
       return rlcp(expand_qquote(expand_qquote(second(qquoted_form),
-                                              menv),
-                                menv), 
+                                              menv, qq, unq, spl),
+                                menv, qq, unq, spl), 
                   qquoted_form);
     } else if (sym == hash_lit_s) {
-      val args = expand_qquote(second(qquoted_form), menv);
-      val pairs = expand_qquote(rest(rest(qquoted_form)), menv);
+      val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl);
+      val pairs = expand_qquote(rest(rest(qquoted_form)), menv, qq, unq, spl);
       return rlcp(list(hash_construct_s, args, pairs, nao), qquoted_form);
     } else if (sym == vector_lit_s) {
-      val args = expand_qquote(second(qquoted_form), menv);
+      val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl);
       return rlcp(list(vector_list_s, args, nao), qquoted_form);
     } else {
       val f = sym;
       val r = cdr(qquoted_form);
       val f_ex;
-      val r_ex = expand_qquote(r, menv);
+      val r_ex = expand_qquote(r, menv, qq, unq, spl);
 
       if (consp(f)) {
         val qsym = car(f);
-        if (qsym == splice_s) {
+        if (qsym == spl) {
           f_ex = expand(second(f), menv);
-        } else if (qsym == unquote_s) {
+        } else if (qsym == unq) {
           f_ex = cons(list_s, cons(expand(second(f), menv), nil));
-        } else if (qsym == qquote_s) {
+        } else if (qsym == qq) {
           f_ex = cons(list_s, cons(expand_qquote(expand_qquote(second(f),
-                                                               menv),
-                                                 menv), nil));
+                                                               menv, qq,
+                                                               unq, spl),
+                                                 menv, qq, unq, spl), nil));
         } else {
-          f_ex = cons(list_s, cons(expand_qquote(f, menv), nil));
+          f_ex = cons(list_s, cons(expand_qquote(f, menv, qq, unq, spl), nil));
         }
       } else {
-        f_ex = cons(list_s, cons(expand_qquote(f, menv), nil));
+        f_ex = cons(list_s, cons(expand_qquote(f, menv, qq, unq, spl), nil));
       }
 
       if (nilp(r_ex)) {
@@ -2061,7 +2068,7 @@ static val expand_qquote(val qquoted_form, val menv)
       } else if (atom(r_ex)) {
         return rlcp(cons(append_s, cons(f_ex, cons(r_ex, nil))), qquoted_form);
       } else {
-        if (consp(r) && car(r) == unquote_s)
+        if (consp(r) && car(r) == unq)
           r_ex = cons(r_ex, nil);
         else if (car(r_ex) == append_s)
           r_ex = cdr(r_ex);
@@ -2076,7 +2083,12 @@ static val expand_qquote(val qquoted_form, val menv)
 
 static val me_qquote(val form, val menv)
 {
-  return expand_qquote(second(form), menv);
+  if (first(form) == sys_qquote_s)
+    return expand_qquote(second(form), menv,
+                         sys_qquote_s, sys_unquote_s, sys_splice_s);
+  return expand_qquote(second(form), menv,
+                       qquote_s, unquote_s, splice_s);
+                       
 }
 
 static val expand_vars(val vars, val menv, val form,
@@ -3062,8 +3074,11 @@ void eval_init(void)
 
   reg_op(quote_s, op_quote);
   reg_op(qquote_s, op_qquote_error);
+  reg_op(sys_qquote_s, op_qquote_error);
   reg_op(unquote_s, op_unquote_error);
+  reg_op(sys_unquote_s, op_unquote_error);
   reg_op(splice_s, op_unquote_error);
+  reg_op(sys_splice_s, op_unquote_error);
   reg_op(progn_s, op_progn);
   reg_op(prog1_s, op_prog1);
   reg_op(let_s, op_let);
@@ -3112,6 +3127,7 @@ void eval_init(void)
   reg_mac(op_s, me_op);
   reg_mac(do_s, me_op);
   reg_mac(qquote_s, me_qquote);
+  reg_mac(sys_qquote_s, me_qquote);
 
   reg_fun(cons_s, func_n2(cons));
   reg_fun(intern(lit("make-lazy-cons"), user_package), func_n1(make_lazy_cons));
diff --git a/lib.c b/lib.c
index dee6af8f..04c550fa 100644
--- a/lib.c
+++ b/lib.c
@@ -75,6 +75,7 @@ val env_s, bignum_s, float_s;
 val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 val nongreedy_s, compiled_regex_s;
 val quote_s, qquote_s, unquote_s, splice_s;
+val sys_qquote_s, sys_unquote_s, sys_splice_s;
 val zeroplus_s, optional_s, compl_s, compound_s, or_s, and_s, quasi_s;
 val skip_s, trailer_s, block_s, next_s, freeform_s, fail_s, accept_s;
 val all_s, some_s, none_s, maybe_s, cases_s, collect_s, until_s, coll_s;
@@ -5139,9 +5140,12 @@ static void obj_init(void)
   nongreedy_s = intern(lit("ng0+"), user_package);
   compiled_regex_s = intern(lit("compiled-regex"), system_package);
   quote_s = intern(lit("quote"), user_package);
-  qquote_s = intern(lit("qquote"), system_package);
-  unquote_s = intern(lit("unquote"), system_package);
-  splice_s = intern(lit("splice"), system_package);
+  qquote_s = intern(lit("qquote"), user_package);
+  unquote_s = intern(lit("unquote"), user_package);
+  splice_s = intern(lit("splice"), user_package);
+  sys_qquote_s = intern(lit("qquote"), system_package);
+  sys_unquote_s = intern(lit("unquote"), system_package);
+  sys_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);
@@ -5229,13 +5233,13 @@ val obj_print(val obj, val out)
     {
       val sym = car(obj);
 
-      if (sym == quote_s || sym == qquote_s) {
+      if (sym == quote_s || sym == sys_qquote_s) {
         put_char(chr('\''), out);
         obj_print(second(obj), out);
-      } else if (sym == unquote_s) {
+      } else if (sym == sys_unquote_s) {
         put_char(chr(','), out);
         obj_print(second(obj), out);
-      } else if (sym == splice_s) {
+      } else if (sym == sys_splice_s) {
         put_string(lit(",*"), out);
         obj_print(second(obj), out);
       } else if (sym == vector_lit_s) {
@@ -5415,13 +5419,13 @@ val obj_pprint(val obj, val out)
     {
       val sym = car(obj);
 
-      if (sym == quote_s || sym == qquote_s) {
+      if (sym == quote_s || sym == sys_qquote_s) {
         put_char(chr('\''), out);
         obj_pprint(second(obj), out);
-      } else if (sym == unquote_s) {
+      } else if (sym == sys_unquote_s) {
         put_char(chr(','), out);
         obj_pprint(second(obj), out);
-      } else if (sym == splice_s) {
+      } else if (sym == sys_splice_s) {
         put_string(lit(",*"), out);
         obj_pprint(second(obj), out);
       } else if (sym == vector_lit_s) {
diff --git a/lib.h b/lib.h
index b6eb69cc..cb9a9762 100644
--- a/lib.h
+++ b/lib.h
@@ -329,6 +329,7 @@ extern val env_s, bignum_s, float_s;
 extern val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 extern val nongreedy_s, compiled_regex_s;
 extern val quote_s, qquote_s, unquote_s, splice_s;
+extern val sys_qquote_s, sys_unquote_s, sys_splice_s;
 extern val zeroplus_s, optional_s, compl_s, compound_s, or_s, and_s, quasi_s;
 extern val skip_s, trailer_s, block_s, next_s, freeform_s, fail_s, accept_s;
 extern val all_s, some_s, none_s, maybe_s, cases_s, collect_s, until_s, coll_s;
diff --git a/parser.y b/parser.y
index b1540c90..2c48e43b 100644
--- a/parser.y
+++ b/parser.y
@@ -754,15 +754,17 @@ n_expr : SYMTOK                 { $$ = sym_helper($1, t); }
        | strlit                 { $$ = $1; }
        | quasilit               { $$ = $1; }
        | ',' n_expr             { val expr = $2;
-                                  if (consp(expr) && first(expr) == qquote_s)
+                                  if (consp(expr) && car(expr) == sys_qquote_s)
                                     expr = cons(quote_s, rest(expr));
-                                  $$ = rlcp(list(unquote_s, expr, nao), $2); }
+                                  $$ = rlcp(list(sys_unquote_s, expr, nao),
+				            $2); }
        | '\'' n_expr            { $$ = rlcp(list(choose_quote($2),
                                                  $2, nao), $2); }
        | SPLICE n_expr          { val expr = $2;
-                                  if (consp(expr) && first(expr) == qquote_s)
+                                  if (consp(expr) && car(expr) == sys_qquote_s)
                                     expr = cons(quote_s, rest(expr));
-                                  $$ = rlcp(list(splice_s, expr, nao), $2); }
+                                  $$ = rlcp(list(sys_splice_s, expr, nao),
+				            $2); }
        ;
 
 regex : '/' regexpr '/'         { $$ = cons(regex_s, $2); end_of_regex();
@@ -1112,9 +1114,9 @@ static val unquotes_occur(val quoted_form, int level)
     return nil;
   } else {
     val sym = car(quoted_form);
-    if (sym == unquote_s || sym == splice_s)
+    if (sym == unquote_s || sym == sys_splice_s)
       return (level == 0) ? t : unquotes_occur(cdr(quoted_form), level - 1);
-    if (sym == qquote_s)
+    if (sym == sys_qquote_s)
       return unquotes_occur(cdr(quoted_form), level + 1);
     return or2(unquotes_occur(sym, level),
                unquotes_occur(cdr(quoted_form), level));
@@ -1123,7 +1125,7 @@ static val unquotes_occur(val quoted_form, int level)
 
 static val choose_quote(val quoted_form)
 {
-  return unquotes_occur(quoted_form, 0) ? qquote_s : quote_s;
+  return unquotes_occur(quoted_form, 0) ? sys_qquote_s : quote_s;
 }
 
 static val expand_meta(val form, val menv)
diff --git a/txr.1 b/txr.1
index 0ac12a81..90b72fb8 100644
--- a/txr.1
+++ b/txr.1
@@ -4893,9 +4893,10 @@ value of 'a is the symbol a itself, whereas the value of a is the value
 of the variable a.
 
 Note that TXR Lisp does not have a distinct quote and backquote read syntax.
-There is only one quote, which supports unquoting. However, there is an
-underlying expression syntax which distinguishes them: see the documentation
-quote operator and sys:qquote macro operator.
+There is only one quote, which supports unquoting. However, this is true
+only of the read syntax. There is a quote special operator, and
+a qquote macro. The quote read syntax translates either to the quote
+operator, or to an inernal version of qquote.
 
 A quoted form which contains no unquotes codifies an ordinary quote.
 
@@ -13023,12 +13024,12 @@ Example:
 
   (quote (+ 2 2)) ;; yields (+ 2 2), not 4.
 
-.SS Macro sys:qquote
+.SS Macro qquote
 
 .TP
 Syntax:
 
-  (sys:qquote <form>)
+  (qquote <form>)
 
 .TP
 Description:
@@ -13060,48 +13061,71 @@ when <val-x> is treated as a Lisp expression and evaluated.
 .TP
 Examples:
 
-  (sys:qquote a) -> a
+  (qquote a) -> a
 
-  (sys:qquote (a b c)) -> (a b c)
+  (qquote (a b c)) -> (a b c)
 
-  (sys:qquote (1 2 3 (sys:unquote (+ 2 2) (+ 2 3)))) -> (1 2 3 4 (+ 2 3))
+  (qquote (1 2 3 (unquote (+ 2 2) (+ 2 3)))) -> (1 2 3 4 (+ 2 3))
 
-  (quote (sys:unquote (+ 2 2))) -> 4
+  (qquote (unquote (+ 2 2))) -> 4
 
 In the second-to-last example, the 1 2 3 and the (+ 2 3) were taken verbatim.
 But the (unquote (+ 2 2)) operator caused the evaluation of (+ 2 2) and the
 substitution of the resulting value.
 
 The last example shows that <form> can itself be an unquote operator.
-However, note: (sys:quote (sys:splice <form>)) is not valid.
+However, note: (quote (splice <form>)) is not valid.
 
 Note: a way to understand the nesting behavior is a model of quasi-quote
 expansion which recursively compiles any nested quasi quotes first, and then
 treats the result of their expansion. For instance, in the processing of
-(sys:qquote (sys:qquote (sys:unquote (sys:unquote x)))), the quote operator
-finds the internal (sys:qquote ...) and compiles it to code. During that recursive
-compilation, the syntax (sys:unquote (sys:unquote x)) is encountered.
+(qquote (qquote (unquote (unquote x)))), the quote operator
+finds the internal (qquote ...) and compiles it to code. During that recursive
+compilation, the syntax (unquote (unquote x)) is encountered.
 The inner quote processes the outer unquote which belongs to it,
 and the (unquote x) becomes material embedded in the compilation,
 which will then be found when the outer quasiquote takes the inner
 compilation and processes its interior.
 
-Note: qquote, and related symbols, are in the system namespace,
-and so carry the sys: package prefix.  This is for hygiene. User code which
-uses the quasiquote syntax can use symbols like unquote without encountering
-problems. For instance the user who is not aware of the internal symbols
-might write '(foo unquote bar) which evaluates to the expected (foo unquote bar).
-Since unquote is not sys:unquote, this is not interpreted
-as '(foo .  (unquote bar)) which corresponds to '(foo . ,bar).  
+.TP
+Dialect note:
+
+In Lisp dialects which have a published syntax, there is the expectation
+that the quasiquote read syntax corresponds to it. That is to say, that
+for instance 1(a b ,c) is translated to (qquote b (unquote c)).
+
+In TXR Lisp, this is not true! Although '(b b ,c) is translated to a
+quasiquoting macro, it is an internal one, not based on the public qquote,
+unquote and splice symbols.
+
+This idea exists for hygiene. The quasiquote read syntax is not confused
+by the presence of the symbols qquote, unquote or splice in the template,
+since it doesn't treat them specially.
+
+This also allows programmers to use the quasiquote read syntax to construct
+quasiquote macros. For instance
 
-.SS Operator sys:unquote
+  '(qquote (unquote ,x))
+
+does not mean '',x.  To the quasiquote reader, the qquote and unquote symbols
+mean nothing special, and so this syntax simply means that if the value of x is
+foo, the result will be (qquote (unquote foo)).
+
+The form's expansion is actually this:
+
+  (sys:qquote (qquote (unquote (sys:unquote x))))
+
+the sys:qquote macro recognizes sys:unquote embedded in the form, and 
+the other symbols not in the sys: package are just static template material.
+
+.SS Operator unquote
 
 .TP
 Syntax:
 
-  (sys:qquote (... (sys:unquote <form>) ...))
+  (qquote (... (unquote <form>) ...))
 
-  (sys:qquote (sys:unquote <form>))
+  (qquote (unquote <form>))
 
 .TP
 Description:
@@ -13111,17 +13135,17 @@ binding in the global environment. It is a special syntax that is recognized
 within a qquote form, to indicate forms within the quasiquote which are to be
 evaluated and insertd into the resulting structure.
 
-The variant (sys:qquote (sys:unquote <form>)) is equivalent to <form>: the
+The variant (qquote (unquote <form>)) is equivalent to <form>: the
 qquote and unquote "cancel out".
 
 Nesting of qquotes and unquotes is explained in the qquote operator.
 
-.SS Operator sys:splice
+.SS Operator splice
 
 .TP
 Syntax:
 
-  (sys:qquote (... (sys:splice <form>) ...))
+  (qquote (... (splice <form>) ...))
 
 .TP
 Description:
@@ -13131,15 +13155,15 @@ binding in the global environment. It is a special syntax that is recognized
 within a qquote form, to indicate forms within the quasiquote which are to be
 evaluated and inserted into the resulting structure.
 
-The variant (sys:qquote (sys:unquote <form>)) is not permitted and raises
+The variant (qquote (unquote <form>)) is not permitted and raises
 an exception if evaluated. The splice syntax must occur within a list,
 and not in the dotted position.
 
-The splice form differs from unquote in that (sys:splice <form>)
+The splice form differs from unquote in that (splice <form>)
 requires that <form> must evaluate to a list. That list is 
 integrated into the surrounding list. 
 
-Nesting of qquotes and unquotes is explained in the sys:qquote operator.
+Nesting of qquotes and unquotes is explained in the qquote operator.
 
 .SH MACROS