path: root/parser.y

%{

/* Copyright 2009-2024
 * Kaz Kylheku <kaz@kylheku.com>
 * Vancouver, Canada
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *
 * 1. Redistributions of source code must retain the above copyright notice,
 *    this list of conditions and the following disclaimer.
 *
 * 2. Redistributions in binary form must reproduce the above copyright notice,
 *    this list of conditions and the following disclaimer in the documentation
 *    and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 */

#include <stddef.h>
#include <stdio.h>
#include <assert.h>
#include <limits.h>
#include <stdlib.h>
#include <wchar.h>
#include <signal.h>
#include "config.h"
#include "alloca.h"
#include "lib.h"
#include "signal.h"
#include "unwind.h"
#include "regex.h"
#include "match.h"
#include "filter.h"
#include "hash.h"
#include "struct.h"
#include "eval.h"
#include "tree.h"
#include "y.tab.h"
#include "debug.h"
#include "txr.h"
#include "itypes.h"
#include "buf.h"
#include "parser.h"

static void set_syntax_tree(parser_t *parser, val tree);
static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed);
static val repeat_rep_helper(val sym, val args, val main, val parts);
static void process_catch_exprs(val exprs);
static val define_transform(parser_t *parser, val define_form);
static val optimize_text(val text_form);
static val rlrec(parser_t *, val form, val line);
static val rlcp_parser(parser_t *parser, val to, val from);
static wchar_t char_from_name(const wchar_t *name);
static val make_expr(parser_t *, val sym, val rest, val lineno);
static val check_parse_time_action(val spec_rev);
static val uref_helper(parser_t *, val expr);
static val uoref_helper(parser_t *, val expr);
static val qref_helper(parser_t *, val lexpr, val rexpr);
static val fname_helper(parser_t *, val name);
static val output_helper(parser_t *, val sym, val exprs, val clauses);

#if YYBISON
union YYSTYPE;
int yylex(union YYSTYPE *, yyscan_t scanner);
int yyparse(scanner_t *, parser_t *);
#endif

#define rl(form, line) rlrec(parser, form, line)
#define rlc(to, from) rlcp_parser(parser, to, from)
#define mkexp(sym, rest, lineno) make_expr(parser, sym, rest, lineno)
#define symhlpr(lexeme, meta_allowed) sym_helper(parser, lexeme, meta_allowed)
#define yyerr(msg) yyerror(scnr, parser, msg)
#define yybadtok(tok, context) yybadtoken(parser, tok, context)
#define ifnign(expr) (parser->ignore ? nil : (expr))

INLINE val expand_forms_ver(val forms, int ver)
{
  if (!opt_compat || opt_compat >= ver)
    return expand_forms(forms, nil);
  return forms;
}

INLINE val expand_form_ver(val form, int ver)
{
  if (!opt_compat || opt_compat >= ver)
    return expand(form, nil);
  return form;
}

%}

%pure-parser
%parse-param{scanner_t *scnr}
%parse-param{parser_t *parser}
%lex-param{yyscan_t scnr}

%union {
  wchar_t *lexeme;
  union obj *val;
  wchar_t chr;
  cnum lineno;
}

%token <lexeme> SPACE TEXT SYMTOK
%token <lineno> ALL SOME NONE MAYBE CASES BLOCK CHOOSE GATHER
%token <lineno> AND OR END COLLECT
%token <lineno> UNTIL COLL OUTPUT REPEAT PUSH REP SINGLE FIRST LAST EMPTY
%token <lineno> MOD MODLAST DEFINE TRY CATCH FINALLY IF
%token <lineno> ERRTOK /* deliberately not used in grammar */
%token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H HASH_S HASH_R HASH_J
%token <lineno> HASH_SEMI HASH_B_QUOTE HASH_N HASH_T
%token <lineno> WORDS WSPLICE QWORDS QWSPLICE
%token <lineno> SECRET_ESCAPE_R SECRET_ESCAPE_E SECRET_ESCAPE_I SECRET_ESCAPE_J
%token <lineno> OLD_DOTDOT

%token <val> NUMBER METANUM JSKW
%token <val> HASH_N_EQUALS HASH_N_HASH

%token <chr> REGCHAR REGTOKEN LITCHAR SPLICE JSPLICE OLD_AT
%token <chr> CONSDOT LAMBDOT UREFDOT OREFDOT UOREFDOT

%type <val> spec hash_semi_or_n_expr hash_semi_or_i_expr
%type <val> clauses_rev clauses_opt clause
%type <val> all_clause some_clause none_clause maybe_clause block_clause
%type <val> cases_clause choose_clause gather_clause collect_clause until_last
%type <val> collect_repeat
%type <val> clause_parts additional_parts gather_parts additional_gather_parts
%type <val> output_clause output_push define_clause try_clause catch_clauses_opt
%type <val> if_clause elif_clauses_opt else_clause_opt
%type <val> line elems_opt elems clause_parts_h additional_parts_h
%type <val> text texts elem var var_op modifiers
%type <val> vector hash struct range tnode tree
%type <val> json json_val json_vals json_pairs json_col
%type <val> exprs exprs_opt n_exprs listacc i_expr i_dot_expr
%type <val> n_expr n_exprs_opt n_dot_expr
%type <val> list dwim meta compound
%type <val> out_clauses out_clauses_opt out_clause
%type <val> repeat_clause repeat_parts_opt o_line
%type <val> out_if_clause out_elif_clauses_opt out_else_clause_opt
%type <val> o_elems_opt o_elems o_elem o_var q_var rep_elem rep_parts_opt
%type <val> regex lisp_regex regexpr regbranch
%type <val> regterm regtoken regclass regclassterm regrange
%type <val> strlit chrlit quasilit quasi_items quasi_item litchars restlitchar
%type <val> wordslit wordsqlit buflit buflit_items buflit_item not_a_clause
%type <chr> regchar
%type <val> byacc_fool
%type <lineno> '(' '[' '@'

%nonassoc LOW /* used for precedence assertion */
%right SYMTOK '{' '}'
%right ALL SOME NONE MAYBE CASES CHOOSE AND OR END COLLECT UNTIL COLL
%right OUTPUT REPEAT REP FIRST LAST EMPTY DEFINE IF ELIF ELSE
%right SPACE TEXT NUMBER METANUM HASH_N_EQUALS HASH_N_HASH HASH_B_QUOTE
%nonassoc '[' ']' '(' ')'
%left '-' ',' '\'' '^' SPLICE OLD_AT
%left '|' '/'
%left '&'
%right '~' '*' '?' '+' '%'
%right DOTDOT
%right '.' CONSDOT LAMBDOT UREFDOT OREFDOT UOREFDOT REGCHAR REGTOKEN LITCHAR
%right OLD_DOTDOT '@'

%%

spec : clauses_opt              { set_syntax_tree(parser, $1); }
     | SECRET_ESCAPE_R regexpr  { set_syntax_tree(parser, $2);
                                  end_of_regex(scnr); }
     | SECRET_ESCAPE_E hash_semi_or_n_expr
                                { set_syntax_tree(parser, $2); YYACCEPT; }
       byacc_fool               { internal_error("notreached"); }
     | SECRET_ESCAPE_I hash_semi_or_i_expr
                                { set_syntax_tree(parser, $2); YYACCEPT; }
       byacc_fool               { internal_error("notreached"); }
     | SECRET_ESCAPE_E          { if (yychar == YYEOF) {
                                    parser->syntax_tree = nao;
                                    YYACCEPT;
                                  } else {
                                    yybadtok(yychar, nil);
                                    parser->syntax_tree = nil;
                                  } }
     | SECRET_ESCAPE_I          { if (yychar == YYEOF) {
                                    parser->syntax_tree = nao;
                                    YYACCEPT;
                                  } else {
                                    yybadtok(yychar, nil);
                                    parser->syntax_tree = nil;
                                  } }
     | SECRET_ESCAPE_J json_val { set_syntax_tree(parser, $2);
                                  YYACCEPT; }
       byacc_fool               { internal_error("notreached"); }
     | SECRET_ESCAPE_J          { if (yychar == YYEOF) {
                                    parser->syntax_tree = nao;
                                    YYACCEPT;
                                  } else {
                                    yybadtok(yychar, nil);
                                    parser->syntax_tree = nil;
                                  } }
     | error '\n'               { parser->syntax_tree = nil;
                                  if (parser->errors >= 8)
                                    YYABORT;
                                  yyerrok;
                                  yybadtok(yychar, nil); }

     ;


hash_semi_or_n_expr : HASH_SEMI                 { parser->ignore = 1; }
                      n_expr                    { parser->ignore = 0;
                                                  $$ = nao; }
                    | HASH_SEMI '.'             { parser->ignore = 1; }
                      n_expr                    { parser->ignore = 0;
                                                  $$ = nao; }
                    | HASH_SEMI OREFDOT         { parser->ignore = 1; }
                      n_expr                    { parser->ignore = 0;
                                                  $$ = nao; }
                    | n_expr                    { $$ = $1; }
                    | '.' n_expr                { $$ = uref_helper(parser, $2); }
                    | OREFDOT n_expr            { $$ = uoref_helper(parser, $2); }
                    ;

hash_semi_or_i_expr : HASH_SEMI                 { parser->ignore = 1; }
                      i_expr                    { parser->ignore = 0;
                                                  $$ = nao; }
                    | HASH_SEMI '.'             { parser->ignore = 1; }
                      i_expr                    { parser->ignore = 0;
                                                  $$ = nao; }
                    | HASH_SEMI OREFDOT         { parser->ignore = 1; }
                      i_expr                    { parser->ignore = 0;
                                                  $$ = nao; }
                    | i_expr                    { $$ = $1; }
                    | '.' i_expr                { $$ = uref_helper(parser, $2); }
                    | OREFDOT i_expr            { $$ = uoref_helper(parser, $2); }
                    ;


/* Hack needed for Berkeley Yacc */
byacc_fool : n_expr { internal_error("notreached"); }
           | HASH_SEMI { internal_error("notreached"); }
           | { internal_error("notreached"); }
           ;

clauses_rev : clause                    { $$ = check_parse_time_action(cons($1, nil)); }
            | clauses_rev clause        { $$ = check_parse_time_action(cons($2, $1));  }
            ;

clauses_opt : clauses_rev       { $$ = us_nreverse($1); }
            | /* empty */       { $$ = nil; }
            ;

clause : all_clause             { $$ = cons($1, nil); rlc($$, $1); }
       | some_clause            { $$ = cons($1, nil); rlc($$, $1); }
       | none_clause            { $$ = cons($1, nil); rlc($$, $1); }
       | maybe_clause           { $$ = cons($1, nil); rlc($$, $1); }
       | cases_clause           { $$ = cons($1, nil); rlc($$, $1); }
       | block_clause           { $$ = cons($1, nil); rlc($$, $1); }
       | choose_clause          { $$ = cons($1, nil); rlc($$, $1); }
       | collect_clause         { $$ = cons($1, nil); rlc($$, $1); }
       | gather_clause          { $$ = cons($1, nil); rlc($$, $1); }
       | define_clause          { $$ = list(define_transform(parser, $1), nao);
                                  rlc(car($$), $1);
                                  rlc($$, $1); }
       | try_clause             { $$ = cons($1, nil); rlc($$, $1); }
       | if_clause              { $$ = cons($1, nil); rlc($$, $1); }
       | output_clause          { $$ = cons($1, nil); rlc($$, $1); }
       | line                   { $$ = $1; }
       ;

all_clause : ALL newl clause_parts      { $$ = list(all_s, $3, nao);
                                          rl($$, num($1)); }
           | ALL newl error             { $$ = nil;
                                          yybadtok(yychar, lit("all clause")); }
           ;

some_clause : SOME exprs_opt ')'
              newl clause_parts         { $$ = list(some_s, $5, $2, nao);
                                          rl($$, num($1)); }
            | SOME exprs_opt ')'
              newl error
                                        { $$ = nil;
                                          yybadtok(yychar, lit("some clause")); }
            ;

none_clause : NONE newl clause_parts    { $$ = list(none_s, $3, nao);
                                          rl($$, num($1)); }
            | NONE newl error           { $$ = nil;
                                          yybadtok(yychar, lit("none clause")); }
            ;

maybe_clause : MAYBE newl clause_parts  { $$ = list(maybe_s, $3, nao);
                                          rl($$, num($1)); }
             | MAYBE newl error         { $$ = nil;
                                          yybadtok(yychar, lit("maybe clause")); }
             ;

cases_clause : CASES newl clause_parts  { $$ = list(cases_s, $3, nao);
                                          rl($$, num($1)); }
             | CASES newl error         { $$ = nil;
                                          yybadtok(yychar, lit("cases clause")); }
             ;

block_clause  : BLOCK exprs_opt ')'
                newl clauses_opt
                END newl                { val name = first($2);
                                          if (gt(length($2), one))
                                            yyerr("block: takes zero or no arguments");
                                          if (name && !bindable(name))
                                            yyerrorf(scnr,
                                                     lit("block: ~s is not a bindable symbol"),
                                                     name, nao);
                                          $$ = list(block_s, name, $5, nao);
                                          rl($$, num($1)); }
              | BLOCK exprs_opt ')'
                newl error              { $$ = nil;
                                          yybadtok(yychar, lit("block clause")); }
              ;

choose_clause : CHOOSE exprs_opt ')'
                newl clause_parts       { $$ = list(choose_s, $5, $2, nao);
                                          rl($$, num($1)); }
              | CHOOSE exprs_opt ')'
                newl error              { $$ = nil;
                                          yybadtok(yychar, lit("choose clause")); }
              ;

gather_clause : GATHER exprs_opt ')'
                newl gather_parts
                END newl                { val args = match_expand_keyword_args($2);
                                          $$ = list(gather_s,
                                                    append2(mapcar(pa_12_1(func_n2(cons), nil),
                                                                   first($5)), rest($5)),
                                                    args, nao);
                                          rl($$, num($1)); }

              | GATHER exprs_opt ')'
                newl gather_parts
                until_last exprs_opt ')' newl
                clauses_opt
                END newl                { val args = match_expand_keyword_args($2);
                                          $$ = list(gather_s,
                                                    append2(mapcar(pa_12_1(func_n2(cons), nil),
                                                                   first($5)), rest($5)),
                                                    args, cons(cdr($6),
                                                             cons($7, $10)), nao);
                                          rl($$, num($1)); }

              | GATHER exprs_opt ')'
                newl error              { $$ = nil;
                                          yybadtok(yychar, lit("gather clause")); }
              ;

gather_parts : clauses_opt additional_gather_parts
                                        { $$ = if2($1, cons($1, $2)); }
             ;

additional_gather_parts : AND newl gather_parts { $$ = $3; }
                        | OR newl gather_parts  { $$ = $3; }
                        | /* empty */           { $$ = nil; }
                        ;

collect_clause : collect_repeat exprs_opt ')' newl
                 clauses_opt END newl     { val args = match_expand_keyword_args($2);
                                            $$ = list(car($1),
                                                      $5, nil, args,
                                                      nao);
                                            rl($$, cdr($1)); }
               | collect_repeat exprs_opt ')'
                 newl clauses_opt until_last exprs_opt ')'
                 newl clauses_opt END newl
                                          { val args = match_expand_keyword_args($2);
                                            if (nilp($10))
                                              yyerr("empty until/last in collect");
                                            $$ = list(car($1), $5,
                                                      cons(cdr($6),
                                                           cons($7, $10)),
                                                      args, nao);
                                            rl($$, cdr($1));
                                            rl($10, car($6)); }
               | collect_repeat exprs_opt ')'
                 newl error             { $$ = nil;
                                          yybadtok(yychar, lit("collect clause")); }
               ;

collect_repeat : COLLECT { $$ = cons(collect_s, num($1)); }
               | REPEAT { $$ = cons(repeat_s, num($1)); }
               ;

until_last : UNTIL { $$ = cons(num($1), until_s); }
           | LAST  { $$ = cons(num($1), last_s); }
           ;

clause_parts : clauses_opt additional_parts     { $$ = if2($1, cons($1, $2)); }
             ;

additional_parts : END newl                     { $$ = nil; }
                 | AND newl clause_parts        { $$ = $3; }
                 | OR newl clause_parts         { $$ = $3; }
                 ;

if_clause : IF n_exprs_opt ')'
            newl clauses_opt
            elif_clauses_opt
            else_clause_opt
            END newl            { if (opt_compat && opt_compat <= 136)
                                  { val xexp = expand_meta($2, nil);
                                    val req = rlc(cons(require_s, xexp), $2);
                                    val iff = rlc(cons(cons(cons(req, nil), $5), nil), $2);
                                    val elifs = $6;
                                    val els = cons($7, nil);
                                    val cases = nappend2(nappend2(iff, elifs), els);
                                    $$ = list(cases_s, cases, nao); }
                                  else
                                  { val expr = expand(car($2), nil);
                                    val ifs = $5;
                                    val branch = cons(cons(expr, ifs), nil);
                                    val elifs = $6;
                                    val els = $7;
                                    if (cdr($2))
                                      yyerr("extra expression in if");
                                    $$ = cons(if_s,
                                              nappend2(branch, nappend2(elifs, els)));
                                    rl($$, num($1)); } }
          | IF n_exprs_opt ')'
            newl error          { $$ = nil; yybadtok(yychar, lit("if clause")); }
          ;

elif_clauses_opt : ELIF n_exprs_opt ')' newl
                   clauses_opt
                   elif_clauses_opt  { if (opt_compat && opt_compat <= 136)
                                       { val xexp = expand_meta($2, nil);
                                         val req = rlc(cons(require_s, xexp), $2);
                                         $$ = cons(cons(cons(req, nil), $5), $6); }
                                       else
                                       { val expr = expand(car($2), nil);
                                         val elifs = $5;
                                         val branch = cons(cons(expr, elifs), nil);
                                         if (cdr($2))
                                           yyerr("extra expression in elif");
                                         $$ = nappend2(branch, $6); } }
                 |                   { $$ = nil; }
                 ;

else_clause_opt : ELSE newl
                  clauses_opt        { if (opt_compat && opt_compat <= 136)
                                       { $$ = $3; }
                                       else
                                       { $$ = cons(cons(t, $3), nil); } }
                  |                  { $$ = nil; }
                  ;

line : elems_opt '\n'           { $$ = $1; }
     ;

elems_opt : elems               { $$ = $1; }
          |                     { $$ = nil; }
          ;

elems : elem                    { $$ = cons($1, nil);
                                  rlc($$, $1); }
      | elem elems              { $$ = cons($1, $2);
                                  rlc($$, $1); }
      ;


text : TEXT                     { $$ = rl(string_own($1), num(parser->lineno)); }
     | SPACE                    { if ($1[0] == ' ' && $1[1] == 0)
                                  { val spaces = list(oneplus_s,
                                                      chr(' '), nao);
                                    free($1);
                                    $$ = regex_compile(spaces, nil);
                                    rl($$, num(parser->lineno)); }
                                  else
                                  { $$ = rl(string_own($1), num(parser->lineno)); }}
     | regex                    { $$ = $1;
                                  rl($$, num(parser->lineno)); }
     | EMPTY                    { $$ = null_string; }
     ;

texts : text %prec LOW          { $$ = rlc(cons($1, nil), $1); }
      | text texts              { $$ = rlc(cons($1, $2), $2); }
      ;

elem : texts                    { $$ = rlc(cons(text_s, $1), $1);
                                  $$ = rlc(optimize_text($$), $$); }
     | var                      { $$ = rl($1, num(parser->lineno));
                                  match_reg_elem($$); }
     | list                     { val sym = first($1);
                                  if (sym ==  do_s || sym == require_s)
                                    $$ = rlc(cons(sym,
                                                   expand_forms(rest($1), nil)),
                                              $1);
                                  else if (sym == mdo_s)
                                  { eval_intrinsic(cons(progn_s, cdr($1)), nil, nil);
                                    $$ = cons(do_s, nil); }
                                  else
                                  { $$ = match_expand_elem($1);
                                    match_reg_elem($$); } }
     | COLL exprs_opt ')' elems_opt END { val args = match_expand_keyword_args($2);
                                          $$ = list(coll_s, $4, nil, args, nao);
                                          rl($$, num($1)); }
     | COLL exprs_opt ')' elems_opt
       until_last exprs_opt ')'
       elems_opt END            { val args = match_expand_keyword_args($2);
                                  $$ = list(coll_s, $4, cons(cdr($5),
                                                             cons($6, $8)),
                                            args, nao);
                                  rl($$, num($1));
                                  rl($6, car($5)); }
     | REP exprs_opt ')' elems END     { val args = match_expand_keyword_args($2);
                                         $$ = list(rep_s, $4, nil, args, nao);
                                         rl($$, num($1)); }
     | REP exprs_opt ')' elems
       until_last exprs_opt ')'
       elems END
                                { val args = match_expand_keyword_args($2);
                                  $$ = list(rep_s, $4, cons(cdr($5),
                                                            cons($6, $8)),
                                            args, nao);
                                  rl($$, num($1));
                                  rl($6, car($5)); }
     | BLOCK exprs_opt ')' elems END { $$ = list(block_s, car($2),
                                                 cons($4, nil), nao);
                                       rl($$, num($1)); }
     | COLL error               { $$ = nil;
                                  yybadtok(yychar, lit("coll clause")); }
     | REP error               { $$ = nil;
                                 yybadtok(yychar, lit("rep clause")); }
     | BLOCK error             { $$ = nil;
                                 yybadtok(yychar, lit("rep clause")); }
     | ALL clause_parts_h       { $$ = rl(list(all_s, t, $2, nao), num($1)); }
     | SOME exprs_opt ')'
       clause_parts_h           { $$ = rl(list(some_s, t, $4, $2, nao), num($1)); }
     | NONE clause_parts_h      { $$ = rl(list(none_s, t, $2, nao), num($1)); }
     | MAYBE clause_parts_h     { $$ = rl(list(maybe_s, t, $2, nao), num($1)); }
     | CASES clause_parts_h     { $$ = rl(list(cases_s, t, $2, nao), num($1)); }
     | CHOOSE exprs_opt ')'
       clause_parts_h           { $$ = list(choose_s, t, $4, $2, nao);
                                  rl($$, num($1)); }
     | DEFINE exprs ')' elems END
                                { $$ = list(define_s, t, $4, $2, nao);
                                  rl($$, num($1));
                                  match_reg_params(second($2)); }
     ;

clause_parts_h : elems_opt additional_parts_h   { $$ = if2($1, cons($1, $2)); }
               ;

additional_parts_h : END                        { $$ = nil; }
                   | AND clause_parts_h         { $$ = $2; }
                   | OR clause_parts_h          { $$ = $2; }
                   ;

define_clause : DEFINE exprs ')' newl
                clauses_opt
                END newl        { $$ = list(define_s, $2, $5, nao);
                                  rl($$, num($1));
                                  match_reg_params(second($2)); }
              | DEFINE ')' newl
                clauses_opt
                END newl        { $$ = list(define_s, nil, $4, nao);
                                  rl($$, num($1)); }
              | DEFINE error    { $$ = nil;
                                  yybadtok(yychar, lit("define directive")); }
              | DEFINE exprs ')' newl
                error           { $$ = nil; yybadtok(yychar, lit("define")); }
              | DEFINE ')' newl
                error           { $$ = nil;
                                  yybadtok(yychar, lit("define")); }
              ;

try_clause : TRY newl
             clauses_opt
             catch_clauses_opt
             END newl           { $$ = list(try_s,
                                            flatten(mapcar(func_n1(second),
                                                           $4)),
                                            $3, $4, nao);
                                  rl($$, num($1)); }
           | TRY newl
             error              { $$ = nil;
                                  yybadtok(yychar, lit("try clause")); }
           ;

catch_clauses_opt : CATCH ')' newl
                    clauses_opt
                    catch_clauses_opt   { $$ = cons(list(catch_s, cons(t, nil),
                                                         $4, nao), $5);
                                          rl($$, num($1)); }
                  | CATCH exprs ')' newl
                    clauses_opt
                    catch_clauses_opt   { $$ = cons(list(catch_s, $2, $5, nao),
                                                    $6);
                                          process_catch_exprs($2);
                                          rl($$, num($1)); }
                  | FINALLY newl
                    clauses_opt         { $$ = cons(list(finally_s, nil,
                                                         $3, nao),
                                                    nil);
                                          rl($$, num($1)); }
                  |                     { $$ = nil; }
                  | CATCH ')' newl
                    error               { $$ = nil;
                                          yybadtok(yychar, lit("catch clause")); }
                  | CATCH exprs ')' newl
                    error               { $$ = nil;
                                          yybadtok(yychar, lit("catch clause")); }
                  | FINALLY newl
                    error               { $$ = nil;
                                          yybadtok(yychar, lit("finally clause")); }
                  ;


output_clause : output_push ')' o_elems '\n'
                out_clauses
                END newl        { $$ = nil;
                                  yyerrorf(scnr, lit("~a: traling material"),
                                           car($1), nao); }
              | output_push ')' newl
                END newl        { $$ = rl(list(car($1), nao), $1); }
              | output_push ')' newl
                out_clauses
                END newl        { $$ = rl(list(car($1), $4, nao), $1); }
              | output_push exprs ')' newl
                out_clauses
                END newl        { $$ = output_helper(parser, car($1), $2, $5);
                                  rl($$, $1); }
              | output_push exprs ')' o_elems '\n'
                out_clauses
                END newl        { $$ = nil;
                                  yyerr("invalid combination of old and "
                                        "new syntax in output directive"); }
              | output_push error    { $$ = nil;
                                  yybadtok(yychar, lit("output directive")); }
              | output_push ')' o_elems '\n'
                error           { $$ = nil;
                                  yybadtok(yychar, lit("output clause")); }
              | output_push ')' newl
                error           { $$ = nil;
                                  yybadtok(yychar, lit("output clause")); }
              | output_push exprs ')' o_elems '\n'
                error           { $$ = nil;
                                  yybadtok(yychar, lit("output clause")); }
              | output_push exprs ')' newl
                error           { $$ = nil;
                                  yybadtok(yychar, lit("output clause")); }
              ;

output_push : OUTPUT { $$ = cons(output_s, num($1)); }
            | PUSH { $$ = cons(push_s, num($1)); }
            ;

out_clauses : out_clause                { $$ = cons($1, nil); }
            | out_clause out_clauses    { $$ = cons($1, $2);  }
            ;

out_clause : repeat_clause              { $$ = cons($1, nil); }
           | out_if_clause              { $$ = cons($1, nil); }
           | o_line                     { $$ = $1; }
           ;

repeat_clause : REPEAT n_exprs_opt ')' newl
                out_clauses_opt
                repeat_parts_opt
                END newl                { $$ = repeat_rep_helper(repeat_s,
                                                                 $2, $5, $6);
                                          rl($$, num($1)); }
              | REPEAT newl
                error           { $$ = nil;
                                  yybadtok(yychar, lit("repeat clause")); }
              ;

repeat_parts_opt : SINGLE newl
                   out_clauses_opt
                   repeat_parts_opt     { $$ = cons(cons(single_s, $3), $4);
                                          rl($$, num($1)); }
                 | FIRST newl
                   out_clauses_opt
                   repeat_parts_opt     { $$ = cons(cons(first_s, $3), $4);
                                          rl($$, num($1)); }
                 | LAST exprs_opt ')' newl
                   out_clauses_opt
                   repeat_parts_opt     { if ($2)
                                            yyerrorf(scnr,
                                                     lit("last: in output, "
                                                         "takes no arguments"),
                                                     nao);
                                          $$ = cons(cons(last_s, $5), $6);
                                          rl($$, num($1)); }
                 | EMPTY newl
                   out_clauses_opt
                   repeat_parts_opt     { $$ = cons(cons(empty_s, $3), $4);
                                          rl($$, num($1)); }
                 | MOD exprs_opt ')'
                   newl
                   out_clauses_opt
                   repeat_parts_opt     { $$ = cons(cons(mod_s,
                                                         cons(expand_forms_ver($2, 166),
                                                              $5)), $6);
                                          rl($$, num($1)); }
                 | MODLAST exprs_opt ')'
                   newl
                   out_clauses_opt
                   repeat_parts_opt     { $$ = cons(cons(modlast_s,
                                                         cons(expand_forms_ver($2, 166),
                                                              $5)), $6);
                                          rl($$, num($1)); }
                 | /* empty */          { $$ = nil; }
                 ;

out_if_clause : IF n_expr ')' newl
                out_clauses_opt
                out_elif_clauses_opt
                out_else_clause_opt
                END newl        { val expr = expand($2, nil);
                                  val ifs = $5;
                                  val branch = cons(cons(expr, ifs), nil);
                                  val elifs = $6;
                                  val els = $7;
                                  $$ = cons(if_s,
                                            nappend2(branch, nappend2(elifs, els)));
                                  rl($$, num($1)); }
              | IF ')'
                                { $$ = nil;
                                  yyerr("if requires expression"); }
              | IF n_expr ')' newl
                error           { $$ = nil; yybadtok(yychar, lit("if clause")); }
              ;

out_elif_clauses_opt : ELIF n_exprs_opt ')' newl
                       out_clauses_opt
                       out_elif_clauses_opt
                                { val expr = expand(car($2), nil);
                                  val elifs = $5;
                                  val branch = cons(cons(expr, elifs), nil);
                                  if (null($2))
                                    yyerr("elif requires expression");
                                  else if (cdr($2))
                                    yyerr("extra expression in elif");
                                  $$ = nappend2(branch, $6); }
                     |          { $$ = nil; }
                     ;

out_else_clause_opt : ELSE newl
                      out_clauses_opt
                                { $$ = cons(cons(t, $3), nil); }
                      |         { $$ = nil; }
                      ;

out_clauses_opt : out_clauses   { $$ = $1; }
                | /* empty */   { $$ = nil; }

o_line : o_elems_opt '\n'       { $$ = $1; }
       ;

o_elems_opt : o_elems           { $$ = $1;
                                  rl($$, num(parser->lineno)); }
            |                   { $$ = nil; }
            ;

o_elems : o_elem                { $$ = cons($1, nil); }
        | o_elem o_elems        { $$ = cons($1, $2); }
        | not_a_clause          { $$ = cons($1, nil); }
        | not_a_clause o_elems  { $$ = cons($1, $2); }
        ;

o_elem : TEXT                   { $$ = string_own($1);
                                  rl($$, num(parser->lineno)); }
       | SPACE                  { $$ = string_own($1);
                                  rl($$, num(parser->lineno)); }
       | o_var                  { $$ = $1; }
       | compound               { $$ = rlc(list(expr_s,
                                                 expand($1, nil), nao), $1); }
       | rep_elem               { $$ = $1; }
       ;

rep_elem : REP n_exprs_opt ')' o_elems_opt
           rep_parts_opt END    { $$ = repeat_rep_helper(rep_s, $2, $4, $5);
                                  rl($$, num($1)); }
         | REP error            { $$ = nil;
                                  yybadtok(yychar, lit("rep clause")); }
         ;

rep_parts_opt : SINGLE o_elems_opt
                rep_parts_opt           { $$ = cons(cons(single_s, $2), $3);
                                          rl($$, num($1)); }
              | FIRST o_elems_opt
                rep_parts_opt           { $$ = cons(cons(first_s, $2), $3);
                                          rl($$, num($1)); }
              | LAST exprs_opt ')'
                o_elems_opt rep_parts_opt { if ($2)
                                            yyerrorf(scnr,
                                                     lit("last: in output, "
                                                         "takes no arguments"),
                                                     nao);
                                          $$ = cons(cons(last_s, $4), $5);
                                          rl($$, num($1)); }
              | EMPTY o_elems_opt
                rep_parts_opt           { $$ = cons(cons(empty_s, $2), $3);
                                          rl($$, num($1)); }
              | MOD exprs_opt ')'
                o_elems_opt
                rep_parts_opt           { $$ = cons(cons(mod_s,
                                                         cons(expand_forms_ver($2, 166),
                                                              $4)), $5);
                                          rl($$, num($1)); }
              | MODLAST exprs_opt ')'
                o_elems_opt
                rep_parts_opt           { $$ = cons(cons(modlast_s,
                                                         cons(expand_forms_ver($2, 166),
                                                              $4)), $5);
                                          rl($$, num($1)); }
              | /* empty */             { $$ = nil; }
              ;


/* This sucks, but factoring '*' into a nonterminal
 * that generates an empty phrase causes reduce/reduce conflicts.
 */
var : SYMTOK                    { $$ = list(var_s, symhlpr($1, nil), nao); }
    | '{' SYMTOK '}'            { $$ = list(var_s, symhlpr($2, nil), nao); }
    | '{' SYMTOK modifiers '}'  { $$ = list(var_s, symhlpr($2, nil), $3, nao); }
    | var_op SYMTOK             { $$ = list(var_s, symhlpr($2, nil), $1, nao); }
    | var_op '{' SYMTOK '}'     { $$ = list(var_s, symhlpr($3, nil), $1, nao); }
    | var_op '{' SYMTOK regex '}'       { $$ = nil;
                                          free($3);
                                          yyerr("longest match "
                                                "not useable with regex"); }
    | var_op '{' SYMTOK NUMBER '}'      { $$ = nil;
                                          free($3);
                                          yyerr("longest match "
                                                "not useable with "
                                                "fixed width match"); }
    | SYMTOK error              { $$ = nil;
                                  free($1);
                                  yybadtok(yychar, lit("variable spec")); }
    | var_op error              { $$ = nil;
                                  yybadtok(yychar, lit("variable spec")); }
    ;

var_op : '*'                    { $$ = list(t, nao); }
       ;

modifiers : NUMBER              { $$ = cons($1, nil); }
          | regex               { $$ = cons($1, nil);
                                  rlc($$, $1); }
          | compound            { $$ = rlc(cons(expand_meta($1, nil),
                                                 nil), $1); }
          | SYMTOK              { $$ = cons(symhlpr($1, nil), nil); }
          ;

o_var : SYMTOK                  { val expr = symhlpr($1, nil);
                                  if (!opt_compat || opt_compat > 128)
                                    expr = expand(expr, nil);
                                  $$ = list(var_s, expr, nao);
                                  rl($$, num(parser->lineno)); }
      | '{' n_expr n_exprs_opt '}'
                                { if (opt_compat && opt_compat <= 128)
                                  { $$ = list(var_s,
                                              expand_meta($2, nil),
                                              expand_meta($3, nil), nao); }
                                  else
                                  { val quasi_var = list(var_s, $2, $3, nao);
                                    val quasi_items = cons(quasi_var, nil);
                                    $$ = car(expand_quasi(quasi_items, nil)); } }
      | SYMTOK error            { $$ = nil;
                                  free($1);
                                  yybadtok(yychar, lit("variable spec")); }
      ;

q_var : '@' '{' n_expr n_exprs_opt '}'
                                { $$ = list(var_s, $3, $4, nao);
                                  rl($$, num(parser->lineno)); }
      | '@' '{' error           { $$ = nil;
                                  yybadtok(yychar, lit("variable spec")); }
      ;


vector : '#' list               { if (parser->quasi_level > 0)
                                    $$ = rlc(cons(vector_lit_s,
                                                   cons($2, nil)), $2);
                                  else
                                    $$ = rlc(vec_list($2), $2); }
       | '#' error              { $$ = nil;
                                  yybadtok(yychar, lit("unassigned/reserved # notation")); }
       ;

hash : HASH_H list              { if (parser->ignore)
                                    $$ = nil;
                                  else if (parser->quasi_level > 0)
                                    $$ = rl(cons(hash_lit_s, $2), num($1));
                                  else
                                    $$ = rl(hash_construct(first($2),
                                                             rest($2)),
                                            num($1)); }
     | HASH_H error              { $$ = nil;
                                    yybadtok(yychar, lit("hash literal")); }
     ;

struct : HASH_S list            {  if (parser->ignore)
                                   { $$ = nil; }
                                   else if ((parser->quasi_level > 0) ||
                                           (parser->read_unknown_structs &&
                                            !find_struct_type(first($2))))
                                  { $$ = rl(cons(struct_lit_s, $2), num($1)); }
                                  else
                                  { val strct = make_struct_lit(first($2),
                                                                rest($2));
                                    $$ = rl(strct, num($1)); } }
       | HASH_S error           { $$ = nil;
                                    yybadtok(yychar, lit("struct literal")); }
       ;

range : HASH_R list             { if (length($2) != two)
                                    yyerr("range literal needs two elements");
                                  { val range = rcons(first($2), second($2));
                                    $$ = rl(range, num($1)); } }
      | HASH_R error            { $$ = nil;
                                  yybadtok(yychar, lit("range literal")); }
      ;

tnode : HASH_N list             { if (gt(length($2), three))
                                    yyerr("excess elements in tree node");
                                  { val tn = tnode(first($2), second($2),
                                                   third($2));
                                    $$ = rl(tn, num($1)); } }
      | HASH_N error            { $$ = nil;
                                  yybadtok(yychar, lit("tree node literal")); }
      ;

tree : HASH_T list             { if (parser->ignore)
                                 { $$ = nil; }
                                 else if (parser->quasi_level > 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, t);
                                     $$ = rl(tr, num($1)); } }
     | HASH_T error            { $$ = nil;
                                 yybadtok(yychar, lit("tree node literal")); }
     ;

json : HASH_J json_val          { $$ = list(json_s, quote_s, $2, nao);
                                  end_of_json(scnr); }
     | HASH_J '^'               { parser->quasi_level++; }
       json_val                 { parser->quasi_level--;
                                  end_of_json(scnr);
                                  $$ = list(json_s, sys_qquote_s, $4, nao); }
json_val : NUMBER               { $$ = $1; }
         | JSKW                 { $$ = $1; }
         | '"' '"'              { $$ = null_string; }
         | '"' litchars '"'     { $$ = $2;
                                  rl($$, num(parser->lineno)); }
         | '[' ']'              { $$ = vector(zero, nil); }
         | '[' json_vals
               opt_comma ']'    { $$ = if3(vectorp($2),
                                           $2,
                                           rl(cons(vector_lit_s,
                                                   cons(nreverse($2), nil)),
                                              $2)); }
         | '{' '}'              { $$ = make_hash(hash_weak_none, t); }
         | '{' json_pairs
               opt_comma '}'    { $$ = if3(hashp($2),
                                           $2,
                                           rl(cons(hash_lit_s,
                                                   cons(nil, nreverse($2))),
                                                   $2)); }
         | '~'                  { parser->quasi_level--; }
           n_dot_expr           { parser->quasi_level++;
                                  end_of_json_unquote(scnr);
                                  $$ = rl(rlc(list(sys_unquote_s, $3, nao), $3),
                                          num(parser->lineno)); }
         | JSPLICE              { parser->quasi_level--; }
           n_dot_expr           { parser->quasi_level++;
                                  end_of_json_unquote(scnr);
                                  $$ = rl(rlc(list(sys_splice_s, $3, nao), $3),
                                          num(parser->lineno)); }
         | HASH_N_EQUALS        { parser_circ_def(parser, $1, unique_s); }
           json_val             { parser_circ_def(parser, $1, $3);
                                  $$ = $3; }
         | HASH_N_HASH          { $$ = parser_circ_ref(parser, $1); }
         | '"' error            { $$ = nil;
                                  yybadtok(yychar, lit("JSON string")); }
         | '[' error            { $$ = nil;
                                  yybadtok(yychar, lit("JSON array")); }
         | '{' error            { $$ = nil;
                                  yybadtok(yychar, lit("JSON hash")); }
         ;

opt_comma : ','                 { if (!parser->read_bad_json)
                                    yyerr("trailing comma in JSON array"); }
          |
          ;

json_vals : json_val                    { $$ = if3(parser->quasi_level > 0,
                                                   cons($1, nil),
                                                   vector(one, $1)); }
          | json_vals ',' json_val      { if (consp($1))
                                          { $$ = cons($3, $1); }
                                          else if (parser->quasi_level > 0)
                                          { val li = list_vec($1);
                                            $$ = cons($3, li); }
                                          else
                                          { vec_push($1, $3);
                                            $$ = $1; } }
          | json_vals json_val          { yyerr("missing comma in JSON array");
                                          $$ = $1; }
          | json_vals error             { yybadtok(yychar, lit("JSON array"));
                                          $$ = $1; }
          ;

json_pairs : json_val json_col json_val { if (parser->quasi_level > 0)
                                          { $$ = cons(list($1, $3, nao), nil); }
                                          else
                                          { $$ = make_hash(hash_weak_none, t);
                                            sethash($$, $1, $3); } }
           | json_pairs ','
             json_val json_col json_val { if (consp($1))
                                          { $$ = cons(list($3, $5, nao), $1); }
                                          else if (parser->quasi_level > 0)
                                          { val pa = hash_pairs($1);
                                            $$ = cons(list($3, $5, nao), pa); }
                                          else
                                          { sethash($1, $3, $5);
                                            $$ = $1; } }
           | json_val json_val          { yyerr("missing colon in JSON hash"); }
           | json_pairs json_val
             error                      { yyerr("missing comma in JSON hash"); }
           | json_val error             { yybadtok(yychar, lit("JSON hash")); }
           ;

json_col : SYMTOK       { if ($1[0] == ':' && $1[1] == 0)
                          { $$ = nil; }
                          else
                          { yybadtok(yychar, lit("JSON hash")); } }
         | ':'          { $$ = nil; }
         ;


list : '(' n_exprs ')'          { $$ = rl($2, num($1)); }
     | '(' '.' n_exprs ')'      { val a = car($3);
                                  val ur = uref_helper(parser, a);
                                  if (ur == a)
                                    $$ = $3;
                                  else
                                    $$ = rlc(cons(ur, cdr($3)), ur); }
     | '(' ')'                  { $$ = nil; }
     | '(' LAMBDOT n_expr ')'   { $$ = $3; }
     | '(' CONSDOT n_expr ')'   { $$ = $3; }
     | '(' error                { $$ = nil;
                                  yybadtok(yychar, lit("expression")); }
     ;

meta : '@' n_expr               { if (consp($2))
                                    $$ = rl(cons(expr_s, cons($2, nil)), num($1));
                                  else
                                    $$ = rl(cons(var_s, cons($2, nil)),
                                            num($1)); }
     | '@' error                { $$ = nil;
                                  yybadtok(yychar, lit("meta expression")); }
     ;

meta : OLD_AT n_expr            { if (consp($2))
                                    $$ = rl(cons(expr_s, cons($2, nil)), num($1));
                                  else
                                    $$ = rl(cons(var_s, cons($2, nil)),
                                            num($1)); }
     | OLD_AT error             { $$ = nil;
                                  yybadtok(yychar, lit("meta expression")); }
     ;

dwim : '[' '.' n_exprs ']'      { val a = car($3);
                                  val ur = uref_helper(parser, a);
                                  $$ = rlcp_tree(cons(dwim_s,
                                                      cons(ur, cdr($3))), ur); }
     | '[' n_exprs ']'          { $$ = rl(cons(dwim_s, $2), num($1)); }
     | '[' ']'                  { $$ = rl(cons(dwim_s, nil), num($1)); }
     | '[' LAMBDOT n_expr ']'   { $$ = rl(cons(dwim_s, $3), num($1)); }
     | '[' CONSDOT n_expr ']'   { $$ = rl(cons(dwim_s, $3), num($1)); }
     | '[' error                { $$ = nil;
                                  yybadtok(yychar, lit("DWIM expression")); }
     ;

compound : list
         | dwim
         | meta
         ;

exprs : n_exprs                 { $$ = rlc(expand_meta($1, nil), $1); }
      ;

exprs_opt : exprs               { $$ = $1; }
          | /* empty */         { $$ = nil; }
          ;

n_exprs : listacc               { $$ = $1->c.cdr;
                                  $1->c.cdr = nil;
                                  if ($$->c.car == nao)
                                    $$ = $$->c.cdr; }
        | listacc CONSDOT n_expr
                                { $$ = $1->c.cdr;
                                  $1->c.cdr = $3; }
        ;

listacc : n_expr                { $$ = cons($1, nil);
                                  rlc($$, $1);
                                  $$->c.cdr = $$; }
        | HASH_SEMI             { parser->ignore = 1; }
          n_expr                { parser->ignore = 0;
                                  $$ = cons(nao, nil);
                                  $$->c.cdr = $$; }
        | HASH_SEMI '.'         { parser->ignore = 1; }
          n_expr                { parser->ignore = 0;
                                  $$ = cons(nao, nil);
                                  $$->c.cdr = $$; }
        | listacc HASH_SEMI     { parser->ignore = 1; }
          n_expr                { parser->ignore = 0;
                                  $$ = $1; }
        | listacc HASH_SEMI '.' { parser->ignore = 1; }
          n_expr                { parser->ignore = 0;
                                  $$ = $1; }
        | listacc n_expr        { uses_or2;
                                  $$ = rlc(cons($2, $1->c.cdr), or2($2, $1->c.cdr));
                                  $1->c.cdr = $$; }
        | WSPLICE wordslit      { $$ = lastcons(rl($2, num($1)));
                                  $$->c.cdr = $2; }
        | listacc WSPLICE
          wordslit              { $$ = lastcons(rl($3, num($2)));
                                  $$->c.cdr = $1->c.cdr;
                                  $1->c.cdr = $3; }
        | QWSPLICE wordsqlit    { $$ = lastcons(rl($2, num($1)));
                                  $$->c.cdr = $2; }
        | listacc QWSPLICE
          wordsqlit             { $$ = lastcons(rl($3, num($2)));
                                  $$->c.cdr = $1->c.cdr;
                                  $1->c.cdr = $3; }
        ;

i_expr : SYMTOK                 { $$ = ifnign(symhlpr($1, t)); }
       | METANUM                { $$ = cons(var_s, cons($1, nil));
                                  rl($$, num(parser->lineno)); }
       | NUMBER                 { $$ = $1; }
       | compound               { $$ = $1; }
       | vector                 { $$ = $1; }
       | hash                   { $$ = $1; }
       | struct                 { $$ = $1; }
       | range                  { $$ = $1; }
       | tnode                  { $$ = $1; }
       | tree                   { $$ = $1; }
       | json                   { $$ = $1; }
       | lisp_regex             { $$ = $1; }
       | chrlit                 { $$ = $1; }
       | strlit                 { $$ = $1; }
       | quasilit               { $$ = $1; }
       | WORDS wordslit         { $$ = rl($2, num($1)); }
       | QWORDS wordsqlit       { $$ = rl(cons(quasilist_s, $2), num($1)); }
       | buflit                 { $$ = $1; }
       | '\'' i_dot_expr        { $$ = rl(rlc(list(quote_s, $2, nao), $2),
                                          num(parser->lineno)); }
       | '^'                    { parser->quasi_level++; }
         i_dot_expr             { parser->quasi_level--;
                                  $$ = rl(rlc(list(sys_qquote_s, $3, nao), $3),
                                          num(parser->lineno)); }
       | ','                    { parser->quasi_level--; }
         i_dot_expr             { parser->quasi_level++;
                                  $$ = rl(rlc(list(sys_unquote_s, $3, nao), $3),
                                          num(parser->lineno)); }
       | SPLICE                 { parser->quasi_level--; }
         i_dot_expr             { parser->quasi_level++;
                                  $$ = rl(rlc(list(sys_splice_s, $3, nao), $3),
                                          num(parser->lineno)); }
       | HASH_N_EQUALS          { parser_circ_def(parser, $1, unique_s); }
         i_dot_expr             { parser_circ_def(parser, $1, $3);
                                  $$ = $3; }
       | HASH_N_HASH            { $$ = parser_circ_ref(parser, $1); }
       ;

i_dot_expr : '.' i_expr         { $$ = uref_helper(parser, $2); }
           | i_expr %prec LOW   { $$ = $1; }
           ;
n_expr : SYMTOK                 { $$ = ifnign(symhlpr($1, t)); }
       | METANUM                { $$ = cons(var_s, cons($1, nil));
                                  rl($$, num(parser->lineno)); }
       | NUMBER                 { $$ = $1; }
       | compound               { $$ = $1; }
       | vector                 { $$ = $1; }
       | hash                   { $$ = $1; }
       | struct                 { $$ = $1; }
       | range                  { $$ = $1; }
       | tnode                  { $$ = $1; }
       | tree                   { $$ = $1; }
       | json                   { $$ = $1; }
       | lisp_regex             { $$ = $1; }
       | chrlit                 { $$ = $1; }
       | strlit                 { $$ = $1; }
       | quasilit               { $$ = $1; }
       | WORDS wordslit         { $$ = rl($2, num($1)); }
       | QWORDS wordsqlit       { $$ = rl(cons(quasilist_s, $2), num($1)); }
       | buflit                 { $$ = $1; }
       | '\'' n_dot_expr        { $$ = rl(rlc(list(quote_s, $2, nao), $2),
                                          num(parser->lineno)); }
       | '^'                    { parser->quasi_level++; }
         n_dot_expr             { parser->quasi_level--;
                                  $$ = rl(rlc(list(sys_qquote_s, $3, nao), $3),
                                          num(parser->lineno)); }
       | ','                    { parser->quasi_level--; }
         n_dot_expr             { parser->quasi_level++;
                                  $$ = rl(rlc(list(sys_unquote_s, $3, nao), $3),
                                          num(parser->lineno)); }
       | SPLICE                 { parser->quasi_level--; }
         n_dot_expr             { parser->quasi_level++;
                                  $$ = rl(rlc(list(sys_splice_s, $3, nao), $3),
                                          num(parser->lineno)); }
       | n_expr DOTDOT n_expr   { uses_or2;
                                  $$ = rlc(list(rcons_s, $1, $3, nao),
                                            or2($1, $3)); }
       | n_expr DOTDOT '.' n_expr
                                { uses_or2;
                                  $$ = rlc(list(rcons_s, $1,
                                                          uref_helper(parser, $4),
                                                          nao),
                                            or2($1, $4)); }
       | n_expr OLD_DOTDOT n_expr
                                { uses_or2;
                                  $$ = rlc(list(rcons_s, $1, $3, nao),
                                            or2($1, $3)); }
       | n_expr OLD_DOTDOT '.' n_expr
                                { uses_or2;
                                  $$ = rlc(list(rcons_s, $1,
                                                          uref_helper(parser, $4),
                                                          nao),
                                            or2($1, $4)); }
       | n_expr '.' n_expr      { $$ = qref_helper(parser, $1, $3); }
       | n_expr OREFDOT n_expr  { $$ = qref_helper(parser,
                                                   cons(t, cons($1, nil)),
                                                        $3); }
       | UREFDOT n_expr         { $$ = uref_helper(parser, $2); }
       | UOREFDOT n_expr        { $$ = uoref_helper(parser, $2); }
       | HASH_N_EQUALS          { parser_circ_def(parser, $1, unique_s); }
         n_dot_expr             { parser_circ_def(parser, $1, $3);
                                  $$ = $3; }
       | HASH_N_HASH            { $$ = parser_circ_ref(parser, $1); }
       ;

n_exprs_opt : n_exprs           { $$ = $1; }
            | /* empty */       { $$ = nil; }
          ;

n_dot_expr : '.' n_expr         { $$ = uref_helper(parser, $2); }
           | OREFDOT n_expr     { $$ = uoref_helper(parser, $2); }
           | n_expr %prec LOW   { $$ = $1; }
           ;

regex : '/' regexpr '/'         { $$ = regex_compile($2, nil);
                                  end_of_regex(scnr);
                                  rl($$, num(parser->lineno)); }
      | '/' error               { $$ = nil;
                                  yybadtok(yychar, lit("regex"));
                                  end_of_regex(scnr); }
      ;

lisp_regex : HASH_SLASH regexpr '/'
                                { $$ = regex_compile($2, nil);
                                  end_of_regex(scnr);
                                  rl($$, num(parser->lineno)); }
           | HASH_SLASH error
                                { $$ = nil;
                                  yybadtok(yychar, lit("regex"));
                                  end_of_regex(scnr); }
           ;

regexpr : regbranch                     { $$ = if3(cdr($1),
                                                   cons(compound_s, $1),
                                                   car($1)); }
        | regexpr '|' regexpr           { $$ = list(or_s, $1, $3, nao); }
        | regexpr '&' regexpr           { $$ = list(and_s, $1, $3, nao); }
        | '~' regexpr                   { $$ = list(compl_s, $2, nao); }
        | /* empty */ %prec LOW         { $$ = nil; }
        ;

regbranch : regterm %prec LOW   { $$ = cons($1, nil); }
          | regterm regbranch   { $$ = cons($1, $2); }
          | regterm '~' regexpr { $$ = list($1, list(compl_s, $3, nao), nao); }
          ;

regterm : regterm '*'           { $$ = list(zeroplus_s, $1, nao); }
        | regterm '+'           { $$ = list(oneplus_s, $1, nao); }
        | regterm '?'           { $$ = list(optional_s, $1, nao); }
        | regterm '%' regexpr   { $$ = list(nongreedy_s, $1, $3, nao); }
        | '[' regclass ']'      { if (first($2) == chr('^'))
                                  { if (rest($2))
                                      $$ = cons(cset_s, rest($2));
                                    else
                                      $$ = wild_s; }
                                  else
                                    $$ = cons(set_s, $2); }
        | '[' ']'               { $$ = cons(set_s, nil); }
        | '[' error             { $$ = nil;
                                  yybadtok(yychar, lit("regex character class")); }
        | '.'                   { $$ = wild_s; }
        | ']'                   { $$ = chr(']'); }
        | '-'                   { $$ = chr('-'); }
        | REGCHAR               { $$ = chr($1); }
        | regtoken              { $$ = $1; }
        | TEXT                  { $$ = list(compound_s, string_own($1), nao); }
        | '(' regexpr ')'       { $$ = $2; }
        | '(' error             { $$ = nil;
                                  yybadtok(yychar, lit("regex subexpression")); }
        ;

regclass : regclassterm                 { $$ = cons($1, nil); }
         | regclassterm regclass        { $$ = cons($1, $2); }
         ;

regclassterm : regrange         { $$ = $1; }
             | regchar          { $$ = chr($1); }
             | regtoken         { $$ = $1; }
             ;

regrange : regchar '-' regchar  { $$ = cons(chr($1), chr($3)); }

regchar : '?'                   { $$ = '?'; }
        | '.'                   { $$ = '.'; }
        | '*'                   { $$ = '*'; }
        | '+'                   { $$ = '+'; }
        | '('                   { $$ = '('; }
        | ')'                   { $$ = ')'; }
        | '|'                   { $$ = '|'; }
        | '~'                   { $$ = '~'; }
        | '&'                   { $$ = '&'; }
        | '%'                   { $$ = '%'; }
        | '/'                   { $$ = '/'; }
        | REGCHAR               { $$ = $1; }
        ;

regtoken : REGTOKEN             { switch ($1)
                                  { case 's':
                                      $$ = space_k; break;
                                    case 'S':
                                      $$ = cspace_k; break;
                                    case 'd':
                                      $$ = digit_k; break;
                                    case 'D':
                                      $$ = cdigit_k; break;
                                    case 'w':
                                      $$ = word_char_k; break;
                                    case 'W':
                                      $$ = cword_char_k; break; }}

newl : '\n'
     | error '\n'       { yyerr("newline expected after directive");
                          yyerrok; }
     ;

strlit : '"' '"'                { $$ = null_string; }
       | '"' litchars '"'       { $$ = $2;
                                  rl($$, num(parser->lineno)); }
       | '"' error              { $$ = nil;
                                  yybadtok(yychar, lit("string literal")); }
       ;

chrlit : HASH_BACKSLASH SYMTOK  { wchar_t ch;
                                  val str = string_own($2);
                                  const wchar_t *cstr = c_str(str, nil);

                                  if (cstr[1] == 0)
                                  { ch = cstr[0]; }
                                  else
                                  { ch = char_from_name(cstr);
                                    if (ch == L'!')
                                    { yyerrorf(scnr, lit("unknown character name: ~a"),
                                               str, nao); }}
                                  end_of_char(scnr);
                                  $$ = chr(ch); }
       | HASH_BACKSLASH LITCHAR { $$ = chr($2);
                                  end_of_char(scnr); }
       | HASH_BACKSLASH TEXT     { free($2);
                                   yyerrorf(scnr,
                                            lit("invalid UTF-8 used as character name"),
                                            nao); }
       | HASH_BACKSLASH error   { $$ = nil;
                                  yybadtok(yychar,
                                             lit("character literal")); }
       ;

quasilit : '`' '`'              { $$ = null_string; }
         | '`' quasi_items '`'  { $$ = cons(quasi_s, $2);
                                  rlc($$, $2);
                                  rl($$, num(parser->lineno)); }
         | '`' error            { $$ = nil;
                                  yybadtok(yychar, lit("quasistring")); }
         ;

quasi_items : quasi_item                { $$ = cons($1, nil);
                                          rl($$, num(parser->lineno)); }
            | quasi_item quasi_items    { $$ = cons($1, $2);
                                          rl($$, num(parser->lineno)); }
            ;

quasi_item : litchars           { $$ = $1; }
           | q_var              { $$ = $1; }
           | METANUM            { $$ = cons(var_s, cons($1, nil));
                                  rl($$, num(parser->lineno)); }
           | '@' n_expr         { if (integerp($2) || symbolp($2))
                                    $$ = rlcp_tree(cons(var_s, cons($2, nil)),
                                                   $2);
                                  else
                                    $$ = $2; }
           ;

litchars : LITCHAR              { $$ = mkstring(one, chr($1)); }
         | LITCHAR restlitchar  { val ch = mkstring(one, chr($1));
                                  $$ = string_extend(ch, $2, t); }
         | TEXT                 { $$ = string_own($1); }
         | TEXT restlitchar     { $$ = string_extend(string_own($1), $2, t); }
         ;

restlitchar : LITCHAR                   { $$ = mkstring(one, chr($1)); }
            | restlitchar LITCHAR       { $$ = string_extend($1, chr($2), nil); }
            | TEXT                      { $$ = string_own($1); }
            | restlitchar TEXT          { $$ = string_extend($1, string_own($2), nil); }
            ;

wordslit : '"'                  { $$ = nil; }
         | ' ' wordslit         { $$ = $2; }
         | litchars wordslit    { val word = $1;
                                  $$ = rlc(cons(word, $2), $1); }
         | error                { $$ = nil;
                                  yybadtok(yychar, lit("word list")); }
         ;

wordsqlit : '`'                  { $$ = nil; }
          | ' ' wordsqlit        { $$ = $2; }
          | quasi_items '`'      { val qword = cons(quasi_s, $1);
                                   $$ = rlc(cons(qword, nil), $1); }
          | quasi_items ' '
            wordsqlit
                                 { val qword = cons(quasi_s, $1);
                                   $$ = rlc(cons(qword, $3), $1); }
          ;

buflit : HASH_B_QUOTE '\''               { $$ = make_buf(zero, nil, nil);
                                           end_of_buflit(scnr); }
       | HASH_B_QUOTE buflit_items '\''  { end_of_buflit(scnr);
                                           buf_trim($2);
                                           $$ = $2; }
       | HASH_B_QUOTE error              { yyerr("unterminated buffer literal");
                                           end_of_buflit(scnr);
                                           yyerrok; }
       ;

buflit_items : buflit_items buflit_item { buf_put_u8($1, length_buf($$), $2);
                                          $$ = $1; }
             | buflit_item              { $$ = make_buf(zero, nil, num_fast(512));
                                          buf_put_u8($$, zero, $1); }
             ;

buflit_item  : LITCHAR LITCHAR          { $$ = num($1 << 4 | $2); }
             | LITCHAR error            { $$ = zero;
                                          yyerr("unpaired digit in buffer literal");
                                          yyerrok; }
             ;



not_a_clause : ALL              { $$ = mkexp(all_s, nil, num(parser->lineno)); }
             | SOME             { $$ = mkexp(some_s, nil, num(parser->lineno)); }
             | NONE             { $$ = mkexp(none_s, nil, num(parser->lineno)); }
             | MAYBE            { $$ = mkexp(maybe_s, nil, num(parser->lineno)); }
             | CASES            { $$ = mkexp(cases_s, nil, num(parser->lineno)); }
             | AND              { $$ = mkexp(and_s, nil, num(parser->lineno)); }
             | OR               { $$ = mkexp(or_s, nil, num(parser->lineno)); }
             | TRY              { $$ = mkexp(try_s, nil, num(parser->lineno)); }
             | FINALLY          { $$ = mkexp(finally_s, nil, num(parser->lineno)); }
             | BLOCK
               exprs_opt ')'    { $$ = mkexp(block_s, $2, nil); }
             | CHOOSE
               exprs_opt ')'    { $$ = mkexp(choose_s, $2, nil); }
             | COLLECT
               exprs_opt ')'    { $$ = mkexp(collect_s, $2, nil); }
             | COLL
               exprs_opt ')'    { $$ = mkexp(coll_s, $2, nil); }
             | GATHER
               exprs_opt ')'    { $$ = mkexp(gather_s, $2, nil); }
             | DEFINE
               exprs_opt ')'    { $$ = mkexp(define_s, $2, nil); }
             | CATCH
               exprs_opt ')'    { $$ = mkexp(catch_s, $2, nil); }
             | IF
               n_expr n_expr exprs_opt ')'  { $$ = mkexp(if_s,
                                                         cons($2,
                                                              cons($3, $4)),
                                                         nil); }
             | OUTPUT
                exprs_opt ')'   { yyerr("@(output) doesn't nest"); }
             | PUSH
                exprs_opt ')'   { yyerr("@(push) doesn't nest"); }
             ;

%%

const int have_yydebug = YYDEBUG;

int yylex(YYSTYPE *, yyscan_t scanner);

void yydebug_onoff(int val)
{
#if YYDEBUG
  yydebug = val;
#else
  (void) val;
#endif
}

static void set_syntax_tree(parser_t *parser, val tree)
{
  if (tree == nao)
    parser->syntax_tree = tree;
  else
    set(mkloc(parser->syntax_tree, parser->parser), tree);
}

static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed)
{
  scanner_t *scnr = parser->scanner;
  int leading_at = *lexeme == L'@';
  wchar_t *tokfree = lexeme;
  wchar_t *colon = wcschr(lexeme, L':');
  val sym;

  if (leading_at) {
    if (!meta_allowed) {
      val tok = string_own(lexeme);
      yyerrorf(scnr, lit("~a: meta variable not allowed in this context"), tok, nao);
      return nil;
    }
    lexeme++;
  }

  if (colon != 0)
    *colon = 0;

  if (colon == lexeme) {
    val sym_name = string(colon + 1);
    scrub_scanner(parser->scanner, SYMTOK, tokfree);
    free(tokfree);
    sym = intern(sym_name, keyword_package);
  } else if (colon != 0) {
    val pkg_name = string(lexeme);
    val sym_name = string(colon + 1);
    scrub_scanner(parser->scanner, SYMTOK, tokfree);
    free(tokfree);
    if (equal(pkg_name, lit("#"))) {
      sym = make_sym(sym_name);
    } else {
      val package = find_package(pkg_name);
      if (!package) {
        yyerrorf(scnr, lit("~a:~a: package ~a not found"),
                 pkg_name, sym_name, pkg_name, nao);
        return nil;
      }
      sym = intern(sym_name, package);
    }
  } else {
    val sym_name = string(lexeme);
    scrub_scanner(parser->scanner, SYMTOK, tokfree);
    free(tokfree);
    sym = intern_fallback(sym_name, cur_package);
  }

  return leading_at ? rl(list(var_s, sym, nao), num(parser->lineno)) : sym;
}

static val expand_repeat_rep_args(val args)
{
  list_collect_decl (out, ptail);
  val exp_pair = nil, exp_pairs = nil;

  for (; args; args = cdr(args)) {
    val arg = car(args);

    if (consp(arg)) {
      if (exp_pairs) {
        list_collect_decl (iout, iptail);
        for (; arg; arg = cdr(arg)) {
          val iarg = car(arg);
          if (consp(iarg)) {
            val sym = first(iarg);
            iptail = list_collect(iptail, list(sym,
                                               expand(second(iarg), nil),
                                               nao));
            match_reg_var(sym);
          } else {
            iptail = list_collect(iptail, iarg);
            match_reg_var(iarg);
          }
        }
        ptail = list_collect(ptail, iout);
      } else if (exp_pair) {
        val sym = first(arg);
        ptail = list_collect(ptail, list(sym,
                                         expand(second(arg), nil),
                                         nao));
        match_reg_var(sym);
      } else {
        ptail = list_collect(ptail, arg);
      }
    } else if (!exp_pair && !exp_pairs) {
      if (arg == counter_k) {
        exp_pair = t;
        ptail = list_collect(ptail, arg);
        continue;
      } else if (arg == vars_k) {
        exp_pairs = t;
        ptail = list_collect(ptail, arg);
        continue;
      }
    } else if (exp_pair) {
      match_reg_var(arg);
      ptail = list_collect(ptail, arg);
    }

    exp_pair = exp_pairs = nil;
  }

  return out;
}

static val extract_vars(val output_spec)
{
  list_collect_decl (vars, tai);

  if (consp(output_spec)) {
    val sym = first(output_spec);
    if (sym == var_s) {
      val expr = second(output_spec);
      val modifiers = third(output_spec);

      if (bindable(expr)) {
        tai = list_collect(tai, expr);
      } else if (opt_compat && opt_compat <= 128) {
        tai = list_collect_nconc(tai, extract_vars(expr));
      } else {
        val frefs = expand_with_free_refs(expr, nil, nil);
        tai = list_collect_nconc(tai, second(frefs));
      }

      for (; modifiers; modifiers = cdr(modifiers)) {
        val mod = car(modifiers);
        if (bindable(mod)) {
          tai = list_collect(tai, mod);
        } else if (consp(mod)) {
          val msym = car(mod);

          if (msym == dwim_s) {
            val arg = second(mod);

            if (bindable(arg)) {
              tai = list_collect(tai, arg);
            } else if (consp(arg) && car(arg) == rcons_s) {
              val f = second(arg);
              val t = third(arg);
              if (bindable(f))
                tai = list_collect(tai, f);
              if (bindable(t))
                tai = list_collect(tai, t);
            }
          }
        }
      }
    } else if (sym == expr_s) {
      val expr = second(output_spec);
      val frefs = expand_with_free_refs(expr, nil, nil);
      tai = list_collect_nconc(tai, second(frefs));
    } else {
      for (; output_spec; output_spec = cdr(output_spec))
        tai = list_collect_nconc(tai, extract_vars(car(output_spec)));
    }
  }

  return vars;
}

static val repeat_rep_helper(val sym, val args, val main, val parts)
{
  uses_or2;
  val exp_args = expand_repeat_rep_args(args);
  val single_parts = nil, single_parts_p = nil;
  val first_parts = nil, first_parts_p = nil;
  val last_parts = nil, last_parts_p = nil;
  val empty_parts = nil, empty_parts_p = nil;
  val mod_parts = nil, mod_parts_p = nil;
  val modlast_parts = nil, modlast_parts_p = nil;
  val occur_vars = nil;
  val iter;

  for (iter = parts; iter != nil; iter = cdr(iter)) {
    val part = car(iter);
    val sym = car(part);
    val clauses = copy_list(cdr(part));

    if (sym == single_s) {
      single_parts = nappend2(single_parts, clauses);
      single_parts_p = t;
    } else if (sym == first_s) {
      first_parts = nappend2(first_parts, clauses);
      first_parts_p = t;
    } else if (sym == last_s) {
      last_parts = nappend2(last_parts, clauses);
      last_parts_p = t;
    } else if (sym == empty_s) {
      empty_parts = nappend2(empty_parts, clauses);
      empty_parts_p = t;
    } else if (sym == mod_s) {
      mod_parts = cons(clauses, mod_parts);
      mod_parts_p = t;
    } else if (sym == modlast_s) {
      modlast_parts = cons(clauses, modlast_parts);
      modlast_parts_p = t;
    } else {
      abort();
    }
  }

  single_parts = or2(single_parts, single_parts_p);
  first_parts = or2(first_parts, first_parts_p);
  last_parts = or2(last_parts, last_parts_p);
  empty_parts = or2(empty_parts, empty_parts_p);
  mod_parts = or2(nreverse(mod_parts), mod_parts_p);
  modlast_parts = or2(nreverse(modlast_parts), modlast_parts_p);

  occur_vars = extract_vars(main);
  occur_vars = nappend2(occur_vars, extract_vars(single_parts));
  occur_vars = nappend2(occur_vars, extract_vars(first_parts));
  occur_vars = nappend2(occur_vars, extract_vars(last_parts));
  occur_vars = nappend2(occur_vars, extract_vars(empty_parts));
  occur_vars = nappend2(occur_vars, extract_vars(mod_parts));
  occur_vars = uniq(occur_vars);

  return list(sym, exp_args, main, single_parts, first_parts,
              last_parts, empty_parts, nreverse(mod_parts),
              nreverse(modlast_parts), occur_vars, nao);
}

static void process_catch_exprs(val exprs)
{
  val params = second(exprs);
  for (; params; params = cdr(params)) {
    val param = first(params);
    if (consp(param))
      match_reg_var(car(param));
    else
      match_reg_var(param);
  }
}

static val define_transform(parser_t *parser, val define_form)
{
  scanner_t *scnr = parser->scanner;
  val sym = first(define_form);
  val args = second(define_form);

  if (define_form == nil)
    return nil;

  assert (sym == define_s);

  if (args == nil) {
    yyerr("define requires arguments");
    return define_form;
  }

  if (!consp(args) || !listp(cdr(args))) {
    yyerr("bad define argument syntax");
    return define_form;
  } else {
    val name = first(args);
    val params = second(args);

    if (!symbolp(name)) {
      yyerr("function name must be a symbol");
      return define_form;
    }

    if (!proper_list_p(params)) {
      yyerr("invalid function parameter list");
      return define_form;
    }

    if (!all_satisfy(params, func_n1(symbolp), nil))
      yyerr("function parameters must be symbols");
  }

  return define_form;
}

static val optimize_text(val text_form)
{
  if (all_satisfy(rest(text_form), func_n1(stringp), nil))
    return cat_str(rest(text_form), lit(""));
  return text_form;
}

val expand_meta(val form, val menv)
{
  val sym;

  if (atom(form))
    return form;

  menv = default_arg(menv, make_env(nil, nil, nil));

  if ((sym = car(form)) == quasi_s) {
    if (opt_compat && opt_compat <= 128) {
      list_collect_decl (out, ptail);

      for (; consp(form); form = cdr(form)) {
        val subform = car(form);
        if (consp(subform) && car(subform) == expr_s)
          ptail = list_collect(ptail, expand_meta(subform, menv));
        else
          ptail = list_collect(ptail, subform);
      }

      ptail = list_collect_nconc(ptail, form);

      return rlcp(out, form);
    }

    return expand(form, nil);
  }

  if ((sym = car(form)) == expr_s) {
    val exp_x = expand(second(form), menv);
    if (!bindable(exp_x))
      return rlcp(cons(sym, cons(exp_x, nil)), form);
    return rlcp(cons(var_s, cons(exp_x, nil)), form);
  }

  if (sym == var_s) {
    val var_x = expand(second(form), menv);
    if (!bindable(var_x))
      return rlcp(cons(expr_s, cons(var_x, nil)), form);
    return rlcp(cons(var_s, cons(var_x, nil)), form);
  }

  {
    list_collect_decl (out, ptail);

    for (; consp(form); form = cdr(form)) {
      loc nptail = list_collect(ptail, expand_meta(car(form), menv));
      rlcp(deref(ptail), form);
      ptail = nptail;
    }

    ptail = list_collect_nconc(ptail, form);

    return out;
  }
}

static val rlviable(val form)
{
  switch (type(form)) {
  case NIL:
  case LIT:
  case CHR:
  case NUM:
  case SYM:
  case BGNUM:
  case FLNUM:
    return nil;
  default:
    return t;
  }
}

val rlset(val form, val info)
{
  if (rlviable(form)) {
    loc place = gethash_l(lit("rlcp"), form_to_ln_hash, form, nulloc);
    if (nilp(deref(place)))
      set(place, info);
  }
  return form;
}

val rlrec(parser_t *parser, val form, val line)
{
  if (parser->rec_source_loc)
    rlset(form, cons(line, parser->name));
  return form;
}

val rlcp_parser(parser_t *parser, val to, val from)
{
  if (parser->rec_source_loc)
    rlset(to, source_loc(from));
  return to;
}

static val rlcp_tree_rec(val to, val from, struct circ_stack *up)
{
  val ret = to;

  while (consp(to)) {
    val a = car(to);
    struct circ_stack rlcs = { up, a };
    rlcp(to, from);
    if (!parser_callgraph_circ_check(up, a))
      break;
    rlcp_tree_rec(a, from, &rlcs);
    to = cdr(to);
    if (!parser_callgraph_circ_check(up, to))
      break;
  }
  return ret;
}


val rlcp_tree(val to, val from)
{
  return rlcp_tree_rec(to, from, 0);
}

static wchar_t char_from_name(const wchar_t *name)
{
  static struct {
    const wchar_t *name;
    const wchar_t ch;
  } map[] = {
    { L"nul", 0 },
    { L"alarm", L'\a' },
    { L"backspace", L'\b' },
    { L"tab", L'\t' },
    { L"linefeed", L'\n' },
    { L"newline", L'\n' },
    { L"vtab", L'\v' },
    { L"page", L'\f' },
    { L"return", L'\r' },
    { L"esc", 27 },
    { L"space", L' ' },
    { L"pnul", 0xDC00 },
    { 0, 0 },
  };
  int i;

  for (i = 0; map[i].name; i++) {
    if (wcscmp(map[i].name, name) == 0)
      return map[i].ch;
  }

  return L'!'; /* code meaning not found */
}

static val make_expr(parser_t *parser, val sym, val rest, val lineno)
{
  val expr = cons(sym, rest);
  val ret = cons(expr_s, cons(expand(expr, nil), nil));

  if (rest) {
    rlc(expr, rest);
    rlc(ret, rest);
  } else {
    rl(expr, lineno);
    rl(ret, lineno);
  }

  return ret;
}

static val check_parse_time_action(val spec_rev)
{
  val line = first(spec_rev);

  if (consp(line)) {
    val elem = first(line);
    if (consp(elem)) {
      val sym = car(elem);
      if (sym == include_s) {
        return nappend2(nreverse(include(line)), rest(spec_rev));
      }
      if (sym == in_package_s) {
        eval_intrinsic(elem, nil, nil);
        return nil;
      }
    }
  }
  return spec_rev;
}

static val uref_helper(parser_t *parser, val expr)
{
  if (consp(expr) && car(expr) == qref_s) {
    return rplaca(expr, uref_s);
  } else {
    return rl(rlc(list(uref_s, expr, nao), expr), num(parser->lineno));
  }
}

static val uoref_helper(parser_t *parser, val expr)
{
  val uref = uref_helper(parser, expr);
  rplacd(uref, cons(t, cdr(uref)));
  return uref;
}

static val qref_helper(parser_t *parser, val lexpr, val rexpr)
{
  uses_or2;

  if (consp(rexpr) && car(rexpr) == qref_s) {
    rplacd(rexpr, rlc(cons(lexpr, cdr(rexpr)), lexpr));
    return rl(rexpr, num(parser->lineno));
  } else {
    return rl(rlc(list(qref_s, lexpr, rexpr, nao),
                  or2(lexpr, rexpr)),
                  num(parser->lineno));
  }
}

static val fname_helper(parser_t *parser, val name)
{
  if (!name) {
    return nil;
  } else if (!bindable(name)) {
    yyerrorf(parser->scanner, lit("#T: ~s isn't a function name"),
             name, nao);
  } else if (!memq(name, tree_fun_whitelist)) {
    yyerrorf(parser->scanner, lit("#T: ~s not in *tree-fun-whitelist*"),
             name, nao);
  } else {
    val fbinding = lookup_fun(nil, name);
    if (fbinding)
      return cdr(fbinding);
    yyerrorf(parser->scanner, lit("#T: function named ~s doesn't exist"),
             name, nao);
  }

  return nil;
}

static val output_helper(parser_t *parser, val sym, val exprs, val clauses)
{
  cons_bind (dest, rest, exprs);

  val dest_ex = expand_form_ver(dest, 166);
  val args = if3(dest_ex == dest, exprs, cons(dest_ex, rest));
  val args_kw = keywordp(car(args));
  val alist = improper_plist_to_alist(if3(args_kw, args, cdr(args)),
                                      v_output_keys);

  if (!args_kw && sym == push_s)
  {
    yyerrorf(parser->scanner, lit("~s: doesn't support destination argument"),
             sym, nao);
  }


  while (alist) {
    val key = car(pop(&alist));

    if (key == filter_k)
      continue;

    if (sym != push_s) {
      if (key == nothrow_k || key == append_k ||
          key == named_k || key == continue_k ||
          key == finish_k || key == into_k)
      {
        continue;
      }
    }

    yyerrorf(parser->scanner, lit("~s: unsupported keyword ~s"),
             sym, key, nao);
  }

  if (sym != push_s) {
    val into_var = second(memql(into_k, args));
    val named_var = second(memql(named_k, args));
    match_reg_var(into_var);
    match_reg_var(named_var);
  }

  return list(sym, clauses, args, nao);
}

#ifndef YYEOF
#define YYEOF 0
#endif

void yybadtoken(parser_t *parser, int tok, val context)
{
  val problem = nil;
  scanner_t *scnr = parser->scanner;

  switch (tok) {
  case ERRTOK:
    return;
  case SPACE:   problem = lit("space"); break;
  case TEXT:    problem = lit("text"); break;
  case SYMTOK:  problem = lit("symbol-token"); break;
  case METANUM: problem = lit("metanum"); break;
  case ALL:     problem = lit("\"all\""); break;
  case SOME:    problem = lit("\"some\""); break;
  case NONE:    problem = lit("\"none\""); break;
  case MAYBE:   problem = lit("\"maybe\""); break;
  case CASES:   problem = lit("\"cases\""); break;
  case BLOCK:   problem = lit("\"block\""); break;
  case CHOOSE:  problem = lit("\"choose\""); break;
  case GATHER:  problem = lit("\"gather\""); break;
  case AND:     problem = lit("\"and\""); break;
  case OR:      problem = lit("\"or\""); break;
  case END:     problem = lit("\"end\""); break;
  case COLLECT: problem = lit("\"collect\""); break;
  case UNTIL:   problem = lit("\"until\""); break;
  case COLL:    problem = lit("\"coll\""); break;
  case OUTPUT:  problem = lit("\"output\""); break;
  case REPEAT:  problem = lit("\"repeat\""); break;
  case REP:     problem = lit("\"rep\""); break;
  case SINGLE:  problem = lit("\"single\""); break;
  case FIRST:   problem = lit("\"first\""); break;
  case LAST:    problem = lit("\"last\""); break;
  case EMPTY:   problem = lit("\"empty\""); break;
  case MOD:     problem = lit("\"mod\""); break;
  case MODLAST: problem = lit("\"modlast\""); break;
  case DEFINE:  problem = lit("\"define\""); break;
  case TRY:     problem = lit("\"try\""); break;
  case CATCH:   problem = lit("\"catch\""); break;
  case FINALLY: problem = lit("\"finally\""); break;
  case IF:      problem = lit("\"if\""); break;
  case ELIF:    problem = lit("\"elif\""); break;
  case ELSE:    problem = lit("\"else\""); break;
  case NUMBER:  problem = lit("number"); break;
  case JSKW:    problem = lit("JSON keyword"); break;
  case REGCHAR: problem = lit("regular expression character"); break;
  case REGTOKEN: problem = lit("regular expression token"); break;
  case LITCHAR: problem = lit("string literal character"); break;
  case SPLICE:  problem = lit("*"); break;
  case JSPLICE: problem = lit("~*"); break;
  case CONSDOT:
  case LAMBDOT: problem = lit("consing dot"); break;
  case DOTDOT: problem = lit(".."); break;
  case OLD_DOTDOT:     problem = lit(".."); break;
  case UREFDOT:        problem = lit("referencing dot"); break;
  case OREFDOT:
  case UOREFDOT:       problem = lit("referencing .?"); break;
  case HASH_BACKSLASH: problem = lit("#\\"); break;
  case HASH_SLASH:     problem = lit("#/"); break;
  case HASH_H:         problem = lit("#H"); break;
  case HASH_S:         problem = lit("#S"); break;
  case HASH_R:         problem = lit("#R"); break;
  case HASH_N:         problem = lit("#N"); break;
  case HASH_T:         problem = lit("#T"); break;
  case HASH_J:         problem = lit("#J"); break;
  case HASH_SEMI:      problem = lit("#;"); break;
  case HASH_N_EQUALS:  problem = lit("#<n>="); break;
  case HASH_N_HASH:    problem = lit("#<n>#"); break;
  case HASH_B_QUOTE:   problem = lit("#b'"); break;
  case WORDS:   problem = lit("#\""); break;
  case WSPLICE: problem = lit("#*\""); break;
  case QWORDS:         problem = lit("#`"); break;
  case QWSPLICE:       problem = lit("#*`"); break;
  case OLD_AT:         problem = lit("@"); break;
  }

  if (problem != 0)
    if (context)
      yyerrorf(scnr, lit("misplaced ~a in ~a"), problem, context, nao);
    else
      yyerrorf(scnr, lit("unexpected ~a"), problem, nao);
  else
    if (context) /* Byacc sets yychar to 0 */
      if (tok == YYEOF || tok == YYEMPTY)
        yyerrorf(scnr, lit("unterminated ~a"), context, nao);
      else if (tok == '\n')
        yyerrorf(scnr, lit("newline in ~a"), context, nao);
      else
        yyerrorf(scnr, lit("misplaced character ~a in ~a"), chr(tok), context, nao);
    else
      if (tok == YYEOF)
        yyerrorf(scnr, lit("unexpected end of input"), nao);
      else if (tok == YYEMPTY)
        return;
      else
        yyerrorf(scnr, lit("unexpected character ~a"), chr(tok), nao);
}

int parse_once(val self, val stream, val name)
{
  int res = 0;
#if CONFIG_DEBUG_SUPPORT
  unsigned dbg_state = debug_clear(opt_dbg_expansion ? 0 : DBG_ENABLE);
#endif
  val parser_obj = ensure_parser(stream, name);
  parser_t *parser = parser_get_impl(self, parser_obj);
  parser->rec_source_loc = 1;

  uw_catch_begin(cons(error_s, nil), esym, eobj);


  res = yyparse(parser->scanner, parser);

  parser_resolve_circ(parser);

  uw_catch(esym, eobj) {
    yyerrorf(parser->scanner, lit("error exception during parse"), nao);
    uw_throw(esym, eobj);
  }

  uw_unwind {
#if CONFIG_DEBUG_SUPPORT
    debug_set(dbg_state);
#endif
  }

  uw_catch_end;

  return res;
}

int parse(parser_t *parser, val name, enum prime_parser prim)
{
  int res = 0;
  cnum start_line = parser->lineno;

  parser->errors = 0;
  parser->eof = 0;
  parser->ignore = 0;
  parser->prepared_msg = nil;
  parser->circ_ref_hash = nil;
  parser->circ_count = 0;
  parser->syntax_tree = nil;
  parser->quasi_level = 0;

  prime_parser(parser, name, prim);

  uw_catch_begin(cons(error_s, nil), esym, eobj);

  res = yyparse(parser->scanner, parser);

  prime_parser_post(parser, prim);

  parser_resolve_circ(parser);

  uw_catch(esym, eobj) {
    yyerrorf(parser->scanner, lit("error exception during parse"), nao);
    uw_throw(esym, eobj);
  }

  uw_unwind;

  uw_catch_end;

  if (parser->errors && parser->syntax_tree == nil &&
      parser->lineno != start_line)
  {
    cnum curline = parser->lineno;
    parser->lineno = start_line;
    yyerrorf(parser->scanner,
             lit("while parsing expression starting on this line"), nao);
    parser->lineno = curline;
  }

  return res;
}