Sigh; more lexical-syntactic hacks. This adds handling

for the @' combination, as in @(bind a @'(foo ,bar))

* parser.l: Handle the new METAQUO token.

* parser.y (METAQUO): New token.
(meta_expr): New "METAQUO expr" case. Added missing METABKT
error handling case.

3 files changed, 41 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 6dbeb145..1b7b94ac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2014-01-26  Kaz Kylheku  <kaz@kylheku.com>
+
+	Sigh; more lexical-syntactic hacks. This adds handling
+	for the @' combination, as in @(bind a @'(foo ,bar))
+
+	* parser.l: Handle the new METAQUO token.
+
+	* parser.y (METAQUO): New token.
+	(meta_expr): New "METAQUO expr" case. Added missing METABKT
+	error handling case.
+
 2014-01-24  Kaz Kylheku  <kaz@kylheku.com>
 
 	* hash.c (hash_update): New function.
diff --git a/parser.l b/parser.l
index 0dca7331..cc348cc2 100644
--- a/parser.l
+++ b/parser.l
@@ -432,17 +432,28 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   return yytext[0];
 }
 
-<SPECIAL>[(\[] |
-<NESTED,BRACED>@?[(\[] {
+<SPECIAL,NESTED,BRACED>[(\[] {
  yy_push_state(NESTED);
- if (yytext[0] == '@') {
-   yylval.chr = yytext[1];
-   return yytext[1] == '(' ? METAPAR : METABKT;
- }
  yylval.lineno = lineno;
  return yytext[0];
 }
 
+<NESTED,BRACED>@[(\['] {
+ yylval.chr = yytext[1];
+ yylval.lineno = lineno;
+ switch (yytext[1]) {
+ case '(': 
+   yy_push_state(NESTED);
+   return METAPAR;
+ case '[':
+   yy_push_state(NESTED);
+   return METABKT;
+ default:
+ case '\'':
+   return METAQUO;
+ }
+}
+
 <NESTED>,[*] {
   yylval.chr = '*';
   return SPLICE;
diff --git a/parser.y b/parser.y
index a29c7f00..ca484e7d 100644
--- a/parser.y
+++ b/parser.y
@@ -81,7 +81,7 @@ static val parsed_spec;
 %token <val> NUMBER METANUM
 
 %token <chr> REGCHAR REGTOKEN LITCHAR
-%token <chr> METAPAR METABKT SPLICE
+%token <chr> METAPAR METABKT METAQUO SPLICE
 
 %type <val> spec clauses clauses_opt clause
 %type <val> all_clause some_clause none_clause maybe_clause block_clause
@@ -106,7 +106,7 @@ static val parsed_spec;
 %right OUTPUT REPEAT REP FIRST LAST EMPTY DEFINE
 %right SPACE TEXT NUMBER
 %nonassoc '[' ']' '(' ')'
-%left '-' ',' '\'' SPLICE
+%left '-' ',' '\'' SPLICE METAQUO
 %left '|' '/'
 %left '&' 
 %right '~' '*' '?' '+' '%'
@@ -700,7 +700,7 @@ list : '(' exprs ')'            { $$ = rl($2, num($1)); }
                                     expr = cons(quote_s, rest(expr));
                                   $$ = rlcp(list(unquote_s, expr, nao), $2); }
      | '\'' expr                { $$ = rlcp(list(choose_quote($2),
-                                            $2, nao), $2); }
+                                                 $2, nao), $2); }
      | SPLICE expr              { val expr = $2;
                                   if (consp(expr) && first(expr) == qquote_s)
                                     expr = cons(quote_s, rest(expr));
@@ -713,15 +713,24 @@ list : '(' exprs ')'            { $$ = rl($2, num($1)); }
 
 meta_expr : METAPAR exprs ')'   { $$ = rlcp(cons(expr_s, expand($2)), $2); }
           | METABKT exprs ']'   { $$ = rlcp(cons(expr_s, 
-                                                 rlcp(expand(cons(dwim_s, $2)),
+                                                 rlcp(expand(cons(dwim_s,
+                                                                  $2)),
                                                       $2)), 
                                             $2); }
           | METAPAR ')'         { $$ = rl(cons(expr_s, nil), num(lineno)); }
           | METABKT ']'         { $$ = rl(cons(expr_s, rl(cons(dwim_s, nil), 
                                                           num(lineno))),
                                           num(lineno)); }
+          | METAQUO expr        { val expnq = expand(list(choose_quote($2),
+                                                          $2, nao));
+                                  val quote = rlcp(expnq, $2);
+                                  $$ = rlcp(cons(expr_s, quote), quote); }
+          | METAQUO error       { $$ = nil;
+                                  yybadtoken(yychar, lit("meta expression")); }
           | METAPAR error       { $$ = nil;
                                   yybadtoken(yychar, lit("meta expression")); }
+          | METABKT error       { $$ = nil;
+                                  yybadtoken(yychar, lit("meta expression")); }
           ;
 
 exprs : expr                    { $$ = rlcp(cons($1, nil), $1); }