* lib.c (obj_print, obj_pprint): Render quasi-quote hash and

vector literals using their original notation.

* parser.y (unquotes_occur): Takes new argument, level.
Only finds quotes which are at the given quasiquoting level.
Finally, this is the right semantics. In the first version of this
function, we were not eager enough: we neglected to find unquotes
that were wrapped in nested quasiquotes. Then we were too eager:
finding any unquotes, even ones belonging to the inner backquotes.
(vector, hash, choose_quote): Pass zero to unquotes_occur function.

3 files changed, 36 insertions, 8 deletions

diff --git a/ChangeLog b/ChangeLog
index 267ea79a..cc335b54 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
 2014-02-24  Kaz Kylheku  <kaz@kylheku.com>
 
+	* lib.c (obj_print, obj_pprint): Render quasi-quote hash and
+	vector literals using their original notation.
+
+	* parser.y (unquotes_occur): Takes new argument, level. 
+	Only finds quotes which are at the given quasiquoting level.
+	Finally, this is the right semantics. In the first version of this
+	function, we were not eager enough: we neglected to find unquotes
+	that were wrapped in nested quasiquotes. Then we were too eager:
+	finding any unquotes, even ones belonging to the inner backquotes.
+	(vector, hash, choose_quote): Pass zero to unquotes_occur function.
+
+2014-02-24  Kaz Kylheku  <kaz@kylheku.com>
+
 	* eval.c (expand_qquote): Bugfix. Was not handling an unquote
 	in the dotted position: (qquote x1 .. xn . (unquote form)),
 	which looks like the structure (qquote x1 .. xn unquote form).
diff --git a/lib.c b/lib.c
index 21362724..3c4b4636 100644
--- a/lib.c
+++ b/lib.c
@@ -5194,6 +5194,12 @@ val obj_print(val obj, val out)
       } else if (sym == splice_s) {
         put_string(lit(",*"), out);
         obj_print(second(obj), out);
+      } else if (sym == vector_lit_s) {
+        put_string(lit("#"), out);
+        obj_print(second(obj), out);
+      } else if (sym == hash_lit_s) {
+        put_string(lit("#H"), out);
+        obj_print(rest(obj), out);
       } else if (sym == var_s && (symbolp(second(obj)) || integerp(second(obj)))
                  && !cdr(cdr(obj)))
       {
@@ -5374,6 +5380,12 @@ val obj_pprint(val obj, val out)
       } else if (sym == splice_s) {
         put_string(lit(",*"), out);
         obj_pprint(second(obj), out);
+      } else if (sym == vector_lit_s) {
+        put_string(lit("#"), out);
+        obj_print(second(obj), out);
+      } else if (sym == hash_lit_s) {
+        put_string(lit("#H"), out);
+        obj_print(rest(obj), out);
       } else if (sym == var_s && (symbolp(second(obj)) || integerp(second(obj)))
                  && !cdr(cdr(obj)))
       {
@@ -5397,7 +5409,7 @@ val obj_pprint(val obj, val out)
           obj_print(sym, out);
           if (second(obj)) {
             put_string(lit(" (. "), out);
-            obj_print(second(obj), out);
+            obj_pprint(second(obj), out);
             put_char(chr(')'), out);
           } else {
             put_string(lit(" ()"), out);
diff --git a/parser.y b/parser.y
index 3ea01e43..848670e5 100644
--- a/parser.y
+++ b/parser.y
@@ -54,7 +54,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 unquotes_occur(val quoted_form);
+static val unquotes_occur(val quoted_form, int level);
 static val choose_quote(val quoted_form);
 static val expand_meta(val form, val menv);
 static wchar_t char_from_name(const wchar_t *name);
@@ -684,14 +684,14 @@ o_var : SYMTOK                  { $$ = list(var_s, sym_helper($1, nil), nao);
                                     yybadtoken(yychar, lit("variable spec")); }
       ;
 
-vector : '#' list               { if (unquotes_occur($2))
+vector : '#' list               { if (unquotes_occur($2, 0))
                                     $$ = rlcp(cons(vector_lit_s,
                                                    cons($2, nil)), $2);
                                   else
                                     $$ = rlcp(vector_list($2), $2); }
        ;
 
-hash : HASH_H list              { if (unquotes_occur($2))
+hash : HASH_H list              { if (unquotes_occur($2, 0))
                                     $$ = rlcp(cons(hash_lit_s, $2),
                                               num($1));
                                   else
@@ -1098,7 +1098,7 @@ static val optimize_text(val text_form)
   return text_form;
 }
 
-static val unquotes_occur(val quoted_form)
+static val unquotes_occur(val quoted_form, int level)
 {
   uses_or2;
 
@@ -1107,14 +1107,17 @@ static val unquotes_occur(val quoted_form)
   } else {
     val sym = car(quoted_form);
     if (sym == unquote_s || sym == splice_s)
-      return t;
-    return or2(unquotes_occur(sym), unquotes_occur(cdr(quoted_form)));
+      return (level == 0) ? t : unquotes_occur(cdr(quoted_form), level - 1);
+    if (sym == qquote_s)
+      return unquotes_occur(cdr(quoted_form), level + 1);
+    return or2(unquotes_occur(sym, level),
+               unquotes_occur(cdr(quoted_form), level));
   }
 }
 
 static val choose_quote(val quoted_form)
 {
-  return unquotes_occur(quoted_form) ? qquote_s : quote_s;
+  return unquotes_occur(quoted_form, 0) ? qquote_s : quote_s;
 }
 
 static val expand_meta(val form, val menv)