tree: allow quasiquoting into #T syntax.

* eval.c (tree_lit_s, tree_construct_s): New symbol variables.
(expand_qquote_rec): Handle sys:tree-lit syntax generated by
quasi-quoted #T notaton by expanding and converting to
sys:tree-constuct call.
(eval_init): Initialize tree_lit_s and tree_construct_s.

* eval.h (tree_lit_s, tree_construct_s): Declared.

* parser.y (tree): Produce sys:tree-lit syntax when #T is
quasi-quoted, and unquotes occur inside it.

* tree.c (tree_construct_fname, tree_construct): New static
functions.
(tree_init): Register sys:tree-construct intrinsic function.

1 files changed, 13 insertions, 10 deletions

diff --git a/parser.y b/parser.y
index 4bcb8b8b..c77babc4 100644
--- a/parser.y
+++ b/parser.y
@@ -868,16 +868,19 @@ tnode : HASH_N list             { if (gt(length($2), three))
                                   yybadtok(yychar, lit("tree node literal")); }
       ;
 
-tree : HASH_T list             { val opts = first($2);
-                                 val key_fn_name = pop(&opts);
-                                 val less_fn_name = pop(&opts);
-                                 val equal_fn_name = pop(&opts);
-                                 val key_fn = fname_helper(parser, key_fn_name);
-                                 val less_fn = fname_helper(parser, less_fn_name);
-                                 val equal_fn = fname_helper(parser, equal_fn_name);
-                                 val tr = tree(rest($2), key_fn,
-                                               less_fn, equal_fn);
-                                   $$ = rl(tr, num($1)); }
+tree : HASH_T list             { if (parser->quasi_level > 0 && unquotes_occur($2, 0))
+                                   $$ = rl(cons(tree_lit_s, $2), num($1));
+                                 else
+                                 { val opts = first($2);
+                                   val key_fn_name = pop(&opts);
+                                   val less_fn_name = pop(&opts);
+                                   val equal_fn_name = pop(&opts);
+                                   val key_fn = fname_helper(parser, key_fn_name);
+                                   val less_fn = fname_helper(parser, less_fn_name);
+                                   val equal_fn = fname_helper(parser, equal_fn_name);
+                                   val tr = tree(rest($2), key_fn,
+                                                 less_fn, equal_fn);
+                                     $$ = rl(tr, num($1)); } }
      | HASH_T error            { $$ = nil;
                                  yybadtok(yychar, lit("tree node literal")); }
      ;