/* parse.y                                              -*- text -*-

Copyright (C) 1992, 1993 John W. Eaton

This file is part of Octave.

Octave is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

Octave is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with Octave; see the file COPYING.  If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

*/

// Parser for Octave.

/*
 * C decarations.
 */
%{
#define YYDEBUG 1

#include "SLStack.h"

#include "Matrix.h"

#include "error.h"
#include "variables.h"
#include "user-prefs.h"
#include "input.h"
#include "utils.h"
#include "tree.h"
#include "symtab.h"
#include "builtins.h"
#include "octave.h"
#include "parse.h"
#include "lex.h"

// Identifier to define if we are reading an M-fie.
tree_identifier *id_to_define;

// Nonzero means we're in the middle of defining a function.
int defining_func = 0;

// Nonzero means we're in the middle of defining a loop.
int looping = 0;

// Nonzero means we're in the middle of defining a conditional expression.
int iffing = 0;

// Nonzero means we need to do some extra lookahead to avoid being
// screwed by bogus function syntax.
int maybe_screwed = 0;

// Nonzero means we need to do some extra lookahead to avoid being
// screwed by bogus function syntax.
int maybe_screwed_again = 0;

// Temporary symbol table pointer used to cope with bogus function syntax.
symbol_table *tmp_local_sym_tab = (symbol_table *) NULL;

// Stack to hold list of literal matrices.
SLStack <tree_matrix *> ml;

// A nonzero element corresponding to an element of ml means we just
// started reading a new matrix.  This should probably be part of a
// new struct for matrix lists... 
SLStack <int> mlnm;

// The current input line number.
int input_line_number = 0;

// The column of the current token.
int current_input_column = 0;

// Buffer for help text snagged from M-files.
// Probably shouldn't be a fixed size...
char help_buf [HELP_BUF_LENGTH];

// Nonzero means we're working on a plot command.
int plotting = 0;

// Nonzero means we're looking at the range part of a plot command.
int in_plot_range = 0;

// Nonzero means we're looking at the using part of a plot command.
int in_plot_using = 0;

// Nonzero means we're looking at the style part of a plot command.
int in_plot_style = 0;

// The type of an END token.  This declaration is repeated in lex.l.
enum end_tok_type
  {
    simple_end,
    for_end,
    function_end,
    if_end,
    while_end,
  };

// The type of a PLOT token.  This declaration is repeated in lex.l.
enum plot_tok_type
  {
    two_dee = 2,
    three_dee = 3,
  };

// Error mesages for mismatched end statements.
static void end_error (char *type, end_tok_type ettype);

// Generic error messages.
static void yyerror (char *s);

static tree *maybe_convert_to_ans_assign (tree *expr);
static void maybe_warn_assign_as_truth_value (tree *expr);

#define ABORT_PARSE \
  do \
    { \
      global_command = NULL_TREE; \
      reset_parser (); \
      yyerrok; \
      if (interactive) \
	YYACCEPT; \
      else \
	YYABORT; \
    } \
  while (0)

%}

/*
 * Bison declarations.
 */
%union
{
  tree *tree_type;
  tree_constant *tree_constant_type;
  tree_matrix *tree_matrix_type;
  tree_identifier *tree_identifier_type;
  tree_function *tree_function_type;
  tree_index_expression *tree_index_expression_type;
  tree_colon_expression *tree_colon_expression_type;
  tree_argument_list *tree_argument_list_type;
  tree_parameter_list *tree_parameter_list_type;
  tree_word_list *tree_word_list_type;
  tree_command *tree_command_type;
  tree_if_command *tree_if_command_type;
  tree_command_list *tree_command_list_type;
  tree_word_list_command *tree_word_list_command_type;
  tree_plot_command *tree_plot_command_type;
  tree_subplot_list *tree_subplot_list_type;
  tree_plot_limits *tree_plot_limits_type;
  tree_plot_range *tree_plot_range_type;
  tree_subplot_using *tree_subplot_using_type;
  tree_subplot_style *tree_subplot_style_type;
  symbol_record *sym_rec;
  double number;
  char *string;
  end_tok_type ettype;
  plot_tok_type pttype;
}

/*
 * There are 20 shift/reduce conflicts, ok?
 */
%expect 20

/*
 * Reserved words.
 */
%token FOR WHILE IF ELSEIF ELSE FCN BREAK CONTINUE FUNC_RET SCREW_TWO
%token END_OF_INPUT GLOBAL CLEAR

%token USING TITLE WITH COLON OPEN_BRACE CLOSE_BRACE

// tree
%type <tree_type> input command 
%type <tree_type> ans_expression expression simple_expr simple_expr1
%type <tree_type> title

// tree_matrix
%type <tree_matrix_type> matrix

// tree_identifier
%type <tree_identifier_type> identifier

// tree_function 
%type <tree_function_type> func_def func_def1 func_def2 func_def3

// tree_index_expression
%type <tree_index_expression_type> variable

// tree_colon_expression
%type <tree_colon_expression_type> colon_expr

// tree_argument_list
%type <tree_argument_list_type> arg_list arg_list1

// tree_parameter_list
%type <tree_parameter_list_type> param_list param_list1 func_def1a 

// tree_word_list
%type <tree_word_list_type> word_list word_list1

// tree_command
%type <tree_command_type> statement

// tree_if_command
%type <tree_if_command_type> elseif

// tree_command_list
%type <tree_command_list_type> simple_list simple_list1 list list1 opt_list

// tree_word_list_command
%type <tree_word_list_command_type> word_list_cmd

// tree_plot_command
%type <tree_plot_command_type> plot_command 

// tree_subplot_list
%type <tree_subplot_list_type> plot_command1 plot_command2 plot_options

// tree_plot_limits
%type <tree_plot_limits_type> ranges

// tree_plot_range
%type <tree_plot_range_type> ranges1 

// tree_subplot_using
%type <tree_subplot_using_type> using using1 

// tree_subplot_style
%type <tree_subplot_style_type> style

%token <number> NUM IMAG_NUM
%token <sym_rec> NAME SCREW
%token <string> TEXT STYLE
%token <ettype> END
%token <pttype> PLOT

%left ';' ',' '\n'
%right '='
%left EXPR_AND EXPR_OR
%left EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT
%left ':'
%left '-' '+'
%left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV
%left QUOTE TRANSPOSE
%left UNARY PLUS_PLUS MINUS_MINUS EXPR_NOT
%right POW EPOW

%start input

/*
 * Grammar rules.
 */
%%

input		: '\n'
		  {
		    global_command = NULL_TREE;
		    promptflag = 1;
		    YYACCEPT;
		  }
		| END_OF_INPUT
		  {
		    global_command = NULL_TREE;
		    promptflag = 1;
		    YYABORT;
		  }
		| simple_list '\n'
		  {
		    global_command = $1;
		    promptflag = 1;
		    YYACCEPT;
		  }
		| simple_list END_OF_INPUT
		  {
		    global_command = $1;
		    promptflag = 1;
		    YYACCEPT;
		  }
		| error
		  { ABORT_PARSE; }
		| error '\n'
		  { ABORT_PARSE; }
		| error END_OF_INPUT
		  { ABORT_PARSE; }
		| simple_list error
		  { ABORT_PARSE; }
		| simple_list error END_OF_INPUT
		  { ABORT_PARSE; }
		;

simple_list	: semi_comma
		  { $$ = (tree_command_list *) NULL; }
		| comma_semi
		  { $$ = (tree_command_list *) NULL; }
		| simple_list1
		  { $$ = $1->reverse (); }
		| simple_list1 semi_comma
		  {
		    $1->set_print_flag (0);
		    $$ = $1->reverse ();
		  }
		| simple_list1 comma_semi
		  { $$ = $1->reverse (); }
		;

simple_list1	: command
		  { $$ = new tree_command_list ($1); }
		| semi_comma command
		  { $$ = new tree_command_list ($2); }
		| comma_semi command
		  { $$ = new tree_command_list ($2); }
		| simple_list1 semi_comma command
		  {
		    $1->set_print_flag (0);
		    $$ = $1->chain ($3);
		  }
		| simple_list1 comma_semi command
		  { $$ = $1->chain ($3); }
		;

semi_comma	: ';'
		| semi_comma ','
		| semi_comma ';'
		;

comma_semi	: ','
		| comma_semi ';'
		| comma_semi ','
		;

comma_nl_sep	: ','
		| '\n'
		| comma_nl_sep sep
		;

semi_sep	: ';'
		| semi_sep sep
		;

opt_list	: // empty
		  { $$ = new tree_command_list (); }
		| list
		  { $$ = $1; }

list		: list1
		  { $$ = $1->reverse (); }
		| list1 comma_nl_sep
		  { $$ = $1->reverse (); }
		| list1 semi_sep
		  {
		    $1->set_print_flag (0);
		    $$ = $1->reverse ();
		  }
		;

list1		: command
		  { $$ = new tree_command_list ($1); }
		| list1 comma_nl_sep command
		  { $$ = $1->chain ($3); }
		| list1 semi_sep command
		  {
		    $1->set_print_flag (0);
		    $$ = $1->chain ($3);
		  }
		;

command		: plot_command
		  { $$ = $1; }
		| statement
		  { $$ = $1; }
		| ans_expression
		  { $$ = $1; }
		| func_def
		  { $$ = $1; }
		| global_decl
		  { $$ = NULL_TREE; }
		;

plot_command	: PLOT plot_command1
		  {
		    tree_subplot_list *tmp = $2->reverse ();
		    $$ = new tree_plot_command (tmp, $1);
		    plotting = 0;
		    in_plot_range = 0;
		    in_plot_using = 0;
		    in_plot_style = 0;
		  }
		| PLOT ranges plot_command1
		  {
		    tree_subplot_list *tmp = $3->reverse ();
		    $$ = new tree_plot_command (tmp, $2, $1);
		    plotting = 0;
		    in_plot_range = 0;
		    in_plot_using = 0;
		    in_plot_style = 0;
		  }
		;

ranges		: ranges1
		  { $$ = new tree_plot_limits ($1); }
		| ranges1 ranges1
		  { $$ = new tree_plot_limits ($1, $2); }
		| ranges1 ranges1 ranges1
		  { $$ = new tree_plot_limits ($1, $2, $3); }
		;

ranges1		: OPEN_BRACE expression COLON expression CLOSE_BRACE
		  { $$ = new tree_plot_range ($2, $4); }
		| OPEN_BRACE COLON expression CLOSE_BRACE
		  { $$ = new tree_plot_range (NULL, $3); }
		| OPEN_BRACE expression COLON CLOSE_BRACE
		  { $$ = new tree_plot_range ($2, NULL); }
		| OPEN_BRACE COLON CLOSE_BRACE
		  { $$ = new tree_plot_range (); }
		| OPEN_BRACE CLOSE_BRACE
		  { $$ = new tree_plot_range (); }
		;

plot_command1	: plot_command2
		  { $$ = $1; }
		| plot_command1 ',' plot_command2
		  { $$ = $1->chain ($3); }
		;

plot_command2	: expression
		  { $$ = new tree_subplot_list ($1); }
		| expression plot_options
		  { $$ = $2->set_data ($1); }
		;

plot_options	: using
		  { $$ = new tree_subplot_list ($1, NULL, NULL); }
		| title
		  { $$ = new tree_subplot_list (NULL, $1, NULL); }
		| style
		  { $$ = new tree_subplot_list (NULL, NULL, $1); }
		| using title
		  { $$ = new tree_subplot_list ($1, $2, NULL); }
		| title using
		  { $$ = new tree_subplot_list ($2, $1, NULL); }
		| using style
		  { $$ = new tree_subplot_list ($1, NULL, $2); }
		| style using
		  { $$ = new tree_subplot_list ($2, NULL, $1); }
		| title style
		  { $$ = new tree_subplot_list (NULL, $1, $2); }
		| style title
		  { $$ = new tree_subplot_list (NULL, $2, $1); }
		| using title style
		  { $$ = new tree_subplot_list ($1, $2, $3); }
		| using style title
		  { $$ = new tree_subplot_list ($1, $3, $2); }
		| title using style
		  { $$ = new tree_subplot_list ($2, $1, $3); }
		| title style using
		  { $$ = new tree_subplot_list ($3, $1, $2); }
		| style using title
		  { $$ = new tree_subplot_list ($2, $3, $1); }
		| style title using
		  { $$ = new tree_subplot_list ($3, $2, $1); }
		;

using		: using1
		  {
		    $$ = $1;
		    in_plot_using = 0;
		  }
		| using1 expression
		  {
		    $$ = $1->set_format ($2);
		    in_plot_using = 0;
		  }
		;

using1		: USING expression
		  {
		    tree_subplot_using *tmp = new tree_subplot_using ();
		    $$ = tmp->add_qualifier ($2);
		  }
		| using1 COLON expression
		  { $$ = $1->add_qualifier ($3); }
		;

title		: TITLE expression
		  { $$ = $2; }
		;

style		: WITH STYLE
		  { $$ = new tree_subplot_style ($2); }
		| WITH STYLE expression
		  { $$ = new tree_subplot_style ($2, $3); }
		| WITH STYLE expression bogus_syntax expression
		  { $$ = new tree_subplot_style ($2, $3, $5); }
		;

bogus_syntax	: // empty
		;

ans_expression	: expression
		  { $$ = maybe_convert_to_ans_assign ($1); }
		;

global_decl	: GLOBAL global_decl1
		  { }
		;

global_decl1	: NAME
		  { force_global ($1->name ()); }
		| NAME '=' expression
		  {
		    symbol_record *sr = force_global ($1->name ());
		    tree_identifier *id = new tree_identifier (sr);
		    tree_simple_assignment_expression *expr =
		      new tree_simple_assignment_expression (id, $3);
		    expr->eval (0);
		  }
		| global_decl1 optcomma NAME
		  { force_global ($3->name ()); }
		| global_decl1 optcomma NAME '=' expression
		  {
		    symbol_record *sr = force_global ($3->name ());
		    tree_identifier *id = new tree_identifier (sr);
		    tree_simple_assignment_expression *expr =
		      new tree_simple_assignment_expression (id, $5);
		    expr->eval (0);
		  }
		;

optcomma	: // empty
		| ','
		  {
		    if (user_pref.warn_comma_in_global_decl)
		      warning ("comma in global declaration not\
 interpreted as a command separator");
		  }
		;

statement	: WHILE expression optsep opt_list END
		  {
		    maybe_warn_assign_as_truth_value ($2);
		    if ($5 != while_end && $5 != simple_end)
		      {
			yyerror ("parse error");
			end_error ("while", $5);
			ABORT_PARSE;
		      }
		    looping--;
		    $$ = new tree_while_command ($2, $4);
		  }
		| FOR identifier '=' expression optsep opt_list END
		  {
		    if ($7 != for_end && $7 != simple_end)
		      {
			yyerror ("parse error");
			end_error ("for", $7);
			ABORT_PARSE;
		      }
		    looping--;
		    $$ = new tree_for_command ($2, $4, $6);
		  }
		| IF expression optsep opt_list END
		  {
		    maybe_warn_assign_as_truth_value ($2);
		    if ($5 != if_end && $5 != simple_end)
		      {
			yyerror ("parse error");
			end_error ("if", $5);
			ABORT_PARSE;
		      }
		    iffing--;
		    $$ = new tree_if_command ($2, $4);
		  }
		| IF expression optsep opt_list ELSE optsep opt_list END
		  {
		    maybe_warn_assign_as_truth_value ($2);
		    if ($8 != if_end && $8 != simple_end)
		      {
			yyerror ("parse error");
			end_error ("if", $8);
			ABORT_PARSE;
		      }
		    iffing--;
		    tree_if_command *t1 = new tree_if_command ($7);
		    $$ = t1->chain ($2, $4);
		  }
		| IF expression optsep opt_list elseif END
		  {
		    maybe_warn_assign_as_truth_value ($2);
		    if ($6 != if_end && $6 != simple_end)
		      {
			yyerror ("parse error");
			end_error ("if", $6);
			ABORT_PARSE;
		      }
		    iffing--;
		    tree_if_command *t1 = $5->reverse ();
		    // Add the if list to the new head of the elseif
		    // list, and return the list.
		    $$ = t1->chain ($2, $4);
		  }
		| IF expression optsep opt_list elseif ELSE optsep opt_list END
		  {
		    maybe_warn_assign_as_truth_value ($2);
		    if ($9 != if_end && $9 != simple_end)
		      {
			yyerror ("parse error");
			end_error ("if", $9);
			ABORT_PARSE;
		      }
		    iffing--;
		    // Add the else list to the head of the elseif list,
		    // then reverse the list.
		    tree_if_command *t1 = $5->chain ($8);
		    t1 = t1->reverse ();
		    // Add the if list to the new head of the elseif
		    // list, and return the list.
		    $$ = t1->chain ($2, $4);
		  }
		| BREAK
		  {
		    if (!looping)
		      {
			yyerror ("parse error");
			error ("break: only meaningful within a `for'\
 or `while' loop");
			ABORT_PARSE;
		      }
		    $$ = new tree_break_command ();
		  }
		| CONTINUE
		  {
		    if (!looping)
		      {
			yyerror ("parse error");
			error ("continue: only meaningful within a\
 `for' or `while' loop");
			ABORT_PARSE;
		      }
		    $$ = new tree_break_command ();
		  }
		| FUNC_RET
		  {
		    if (!defining_func)
		      {
			yyerror ("parse error");
			error ("return: only meaningful within a function");
			ABORT_PARSE;
		      }
		    $$ = new tree_return_command ();
		  }
		;

elseif		: ELSEIF optsep expression optsep opt_list
		  {
		    maybe_warn_assign_as_truth_value ($3);
		    $$ = new tree_if_command ($3, $5);
		  }
		| elseif ELSEIF optsep expression optsep opt_list
		  {
		    maybe_warn_assign_as_truth_value ($4);
		    $$ = $1->chain ($4, $6);
		  }
		;

optsep		: // empty
		| sep
		;

sep		: ','
		| ';'
		| '\n'
		| sep ','
		| sep ';'
		| sep '\n'
		;

screwed_again	: // empty
		  { maybe_screwed_again++; }
		;

expression	: variable '=' expression
		  { $$ = new tree_simple_assignment_expression ($1, $3); }
		| '[' screwed_again matrix_row SCREW_TWO '=' expression
		  {

// Will need a way to convert the matrix list to a list of
// identifiers.  If that fails, we can abort here, without losing
// anything -- no other possible syntax is valid if we've seen the
// equals sign as the next token after the `]'.

		    $$ = (tree_multi_assignment_expression *) NULL;
		    maybe_screwed_again--;
		    tree_matrix *tmp = ml.pop ();
		    tmp = tmp->reverse ();
		    tree_return_list *id_list = tmp->to_return_list ();
		    if (id_list == NULL_TREE)
		      {
			yyerror ("parse error");
		        error ("invalid identifier list for assignment");
			$$ = (tree_multi_assignment_expression *) NULL;
			ABORT_PARSE;
		      }
		    else
		      $$ = new tree_multi_assignment_expression (id_list, $6);
		  }
		| NUM '=' expression
		  {
		    yyerror ("parse error");
		    error ("invalid assignment to a number");
		    $$ = (tree_simple_assignment_expression *) NULL;
		    ABORT_PARSE;
		  }
		| simple_expr
		  { $$ = $1; }
		;

simple_expr	: simple_expr1
		  { $$ = $1; }
		| identifier PLUS_PLUS
		  { $$ = new tree_postfix_expression ($1, tree::increment); }
		| identifier MINUS_MINUS
		  { $$ = new tree_postfix_expression ($1, tree::decrement); }
		| simple_expr QUOTE
		  { $$ = new tree_unary_expression ($1, tree::hermitian); }
		| simple_expr TRANSPOSE
		  { $$ = new tree_unary_expression ($1, tree::transpose); }
		| simple_expr POW simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::power); }
		| simple_expr EPOW simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::elem_pow); }
		| simple_expr '+' simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::add); }
		| simple_expr '-' simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::subtract); }
		| simple_expr '*' simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::multiply); }
		| simple_expr '/' simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::divide); }
		| simple_expr EMUL simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::el_mul); }
		| simple_expr EDIV simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::el_div); }
		| simple_expr LEFTDIV simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::leftdiv); }
		| simple_expr ELEFTDIV simple_expr
		  { $$ = new tree_binary_expression ($1, $3,
						     tree::el_leftdiv); }
		| simple_expr EXPR_LT simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::cmp_lt); }
		| simple_expr EXPR_LE simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::cmp_le); }
		| simple_expr EXPR_EQ simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::cmp_eq); }
		| simple_expr EXPR_GE simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::cmp_ge); }
		| simple_expr EXPR_GT simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::cmp_gt); }
		| simple_expr EXPR_NE simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::cmp_ne); }
		| simple_expr EXPR_AND simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::and); }
		| simple_expr EXPR_OR simple_expr
		  { $$ = new tree_binary_expression ($1, $3, tree::or); }
		;

simple_expr1	: NUM
		  { $$ = new tree_constant ($1); }
		| IMAG_NUM
		  { $$ = new tree_constant (Complex (0.0, $1)); }
		| TEXT
		  { $$ = new tree_constant ($1); }
		| word_list_cmd
		  { $$ = $1; }
		| '(' expression ')'
		  {
		    if ($2->is_assignment_expression ())
		      ((tree_assignment_expression *) $2) -> in_parens++;
		    $$ = $2;
		  }
		| variable
		  { $$ = $1; }
		| matrix
		  { $$ = $1; }
		| colon_expr
		  { $$ = $1; }
		| PLUS_PLUS identifier %prec UNARY
		  { $$ = new tree_prefix_expression ($2, tree::increment); }
		| MINUS_MINUS identifier %prec UNARY
		  { $$ = new tree_prefix_expression ($2, tree::decrement); }
		| EXPR_NOT simple_expr
		  { $$ = new tree_unary_expression ($2, tree::not); }
		| '+' simple_expr %prec UNARY
		  { $$ = $2; }
		| '-' simple_expr %prec UNARY
		  { $$ = new tree_unary_expression ($2, tree::uminus); }
		;

colon_expr	: simple_expr ':' simple_expr
		  { $$ = new tree_colon_expression ($1, $3); }
		| colon_expr ':' simple_expr
		  {
		    $$ = $1->chain ($3);
		    if ($$ == (tree_colon_expression *) NULL)
		      {
			yyerror ("parse error");
			ABORT_PARSE;
		      }
		  }
		;

word_list_cmd	: identifier word_list
		  { $$ = new tree_word_list_command ($1, $2); }
		| CLEAR
		  {
		    if (defining_func)
		      {
			yyerror ("parse error");
			error ("clear: invalid within function body");
			ABORT_PARSE;
		      }
		    symbol_record *sr = global_sym_tab->lookup ("clear", 1, 0);
		    assert (sr != (symbol_record *) NULL);
		    tree_identifier *tmp = new tree_identifier (sr);
		    $$ = new tree_word_list_command (tmp,
						     (tree_word_list *) NULL);
		  }
		| CLEAR word_list
		  {
		    if (defining_func)
		      {
			yyerror ("parse error");
			error ("clear: invalid within function body");
			ABORT_PARSE;
		      }
		    symbol_record *sr = global_sym_tab->lookup ("clear", 1, 0);
		    assert (sr != (symbol_record *) NULL);
		    tree_identifier *tmp = new tree_identifier (sr);
		    $$ = new tree_word_list_command (tmp, $2);
		  }
		;

word_list	: word_list1
		  { $$ = $1->reverse (); }
		;

word_list1	: TEXT
		  { $$ = new tree_word_list ($1); }
		| word_list1 TEXT
		  { $$ = $1->chain ($2); }
		;

// This is truly disgusting.

g_symtab	: // empty
		  { curr_sym_tab = global_sym_tab; }
		;

local_symtab	: // empty
		  { curr_sym_tab = tmp_local_sym_tab; }
		;

safe		: // empty
		  { maybe_screwed = 0; }
		;

are_we_screwed	: // empty
		  { maybe_screwed = 1; }
		;

func_def	: FCN g_symtab are_we_screwed func_def1
		  {
		    curr_sym_tab = top_level_sym_tab;
		    defining_func = 0;
		    $$ = (tree_function *) NULL;
		  }
		| FCN g_symtab are_we_screwed func_def2
		  {
		    curr_sym_tab = top_level_sym_tab;
		    defining_func = 0;
		    $$ = (tree_function *) NULL;
		  }
		;

func_def1	: SCREW safe g_symtab '=' func_def2
		  {
		    tree_identifier *tmp = new tree_identifier ($1);
		    tree_parameter_list *tpl = new tree_parameter_list (tmp);
		    tpl = tpl->reverse ();
		    tpl->mark_as_formal_parameters ();
		    $$ = $5->define_ret_list (tpl);
		  }
		| func_def1a ']' g_symtab '=' func_def2
		  {
		    tree_parameter_list *tpl = $1->reverse ();
		    tpl->mark_as_formal_parameters ();
		    $$ = $5->define_ret_list (tpl);
		  }
		;

func_def1a	: '[' safe local_symtab identifier
		  { $$ = new tree_parameter_list ($4); }
		| func_def1a ',' identifier
		  { $$ = $1->chain ($3); }
		;

func_def2	: identifier safe local_symtab func_def3
		  {
		    char *id_name = $1->name ();
//		    if (is_text_function_name (id_name))
//		      {
//			yyerror ("parse error");
//			error ("invalid use of reserved word %s", id_name);
//			ABORT_PARSE;
//		      }

// If input is coming from a file, issue a warning if the name of the
// file does not match the name of the function stated in the file.
// Matlab doesn't provide a diagnostic (it ignores the stated name).

		    if (reading_m_file)
		      {
			if (strcmp (curr_m_file_name, id_name) != 0)
			  warning ("function name `%s' does not agree\
 with M-file name `%s.m'", id_name, curr_m_file_name);

			id_to_define->define ($4);
			id_to_define->document (help_buf);
		      }
		    else
		      {
			if (reading_script_file
			    && strcmp (curr_m_file_name, id_name) == 0)
			  warning ("function `%s' defined within\
 script file `%s.m'", id_name, curr_m_file_name);

			$1->define ($4);
			$1->document (help_buf);
			top_level_sym_tab->clear (id_name);
		      }

		    $$ = $4;
		  }
		;

func_def3	: param_list optsep opt_list fcn_end_or_eof
		  {
		    tree_function *fcn = new tree_function ($3, curr_sym_tab);
		    $$ = fcn->define_param_list ($1);
		  }
		| '(' ')' optsep opt_list fcn_end_or_eof
		  { $$ = new tree_function ($4, curr_sym_tab); }
		| optsep opt_list fcn_end_or_eof
		  { $$ = new tree_function ($2, curr_sym_tab); }
		;

fcn_end_or_eof	: END
		  {
		    if ($1 != function_end && $1 != simple_end)
		      {
			yyerror ("parse error");
			end_error ("function", $1);
			ABORT_PARSE;
		      }

		    if (reading_m_file)
		      check_for_garbage_after_fcn_def ();
		  }
		| END_OF_INPUT
		  {
		    if (! (reading_m_file || reading_script_file))
		      YYABORT;
		  }
		;

variable	: identifier
		  { $$ = new tree_index_expression ($1); }
		| identifier '(' arg_list ')'
		  { $$ = new tree_index_expression ($1, $3); }
		| identifier '(' ')'
		  {
		    $$ = new tree_index_expression
			       ($1, (tree_argument_list *) NULL);
		  }
		| identifier '['
		  {
		    yyerror ("parse error");
		    error ("use `(\' and `)\' as index operators, not\
 `[\' and `]\'"); 
		    $$ = (tree_index_expression *) NULL;
		    ABORT_PARSE;
		  }
		;

param_list	: param_list1 ')'
		  {
		    tree_parameter_list *tmp = $1->reverse ();
		    tmp->mark_as_formal_parameters ();
		    $$ = tmp;
		  }

param_list1	: '(' identifier
		  { $$ = new tree_parameter_list ($2); }
		| param_list1 ',' identifier
		  { $$ = $1->chain ($3); }
		| '(' error
		  {
		    error ("parameter lists may only contain identifiers");
		    $$ = (tree_parameter_list *) NULL;
		  }
		| param_list1 ',' error
		  {
		    error ("parameter lists may only contain identifiers");
		    $$ = (tree_parameter_list *) NULL;
		  }
		;

identifier	: NAME
		  { $$ = new tree_identifier ($1); }

arg_list	: arg_list1
		  { $$ = $1->reverse (); }
		;

arg_list1	: ':'
		  {
		    tree_constant *colon;
		    colon = new tree_constant (tree_constant_rep::magic_colon);
		    $$ = new tree_argument_list (colon);
		  }
		| arg_list1 ',' ':'
		  {
		    tree_constant *colon;
		    colon = new tree_constant (tree_constant_rep::magic_colon);
		    $$ = $1->chain (colon);
		    if ($$ == NULL_TREE)
		      {
			yyerror ("parse error");
			ABORT_PARSE;
		      }
		  }
		| expression
		  { $$ = new tree_argument_list ($1); }
		| arg_list1 ',' expression
		  {
		    $$ = $1->chain ($3);
		    if ($$ == NULL_TREE)
		      {
			yyerror ("parse error");
			ABORT_PARSE;
		      }
		  }
		;

matrix		: '[' ']'
		  {
		    mlnm.pop ();
		    $$ = new tree_matrix ();
		  }
		| '[' ';' ']'
		  {
		    mlnm.pop ();
		    $$ = new tree_matrix ();
		  }
		| '[' screwed_again rows ']'
		  {
		    mlnm.pop ();
		    maybe_screwed_again--;
		    tree_matrix *tmp = ml.pop ();
		    $$ = tmp->reverse ();
		  }
		;

rows		: matrix_row
		| rows ';'	// Ignore trailing semicolon.
		| rows ';' matrix_row
		;

matrix_row	: expression		// First element on row.
		  {
		    if (mlnm.top ())
		      {
			mlnm.pop ();
			mlnm.push (0);
		        tree_matrix *tmp = new tree_matrix ($1, tree::md_none);
			ml.push (tmp);
		      }
		    else
		      {
			tree_matrix *tmp = ml.pop ();
			tmp = tmp->chain ($1, tree::md_down);
			ml.push (tmp);
		      }
		  }
		| matrix_row ','		// Ignore trailing comma.
		| matrix_row ',' expression
		  {
		    tree_matrix *tmp = ml.pop ();
		    tmp = tmp->chain ($3, tree::md_right);
		    ml.push (tmp);
		  }
		;

%%

static void
yyerror (char *s)
{
  char *line = current_input_line;
  int err_col = current_input_column;
  if (err_col == 0)
    err_col = strlen (current_input_line) + 1;

// Print a message like `parse error'.
  fprintf (stderr, "\n%s", s);

// Maybe print the line number and file name.
  if (reading_m_file || reading_script_file)
    fprintf (stderr, " near line %d of file %s.m", input_line_number,
	     curr_m_file_name);

  int len = strlen (line);
  if (line[len-1] == '\n')
    {
      len--;
      line[len] = '\0';
    }

// Print the line, maybe with a pointer near the error token.
  if (err_col > len)
    fprintf (stderr, ":\n\n  %s\n\n", line);
  else
    fprintf (stderr, ":\n\n  %s\n  %*s\n\n", line, err_col, "^");
}

static void
end_error (char *type, end_tok_type ettype)
{
  switch (ettype)
    {
    case simple_end:
      error ("%s command matched by `end'", type);
      break;
    case for_end:
      error ("%s command matched by `endfor'", type);
      break;
    case function_end:
      error ("%s command matched by `endfunction'", type);
      break;
    case if_end:
      error ("%s command matched by `endif'", type);
      break;
    case while_end:
      error ("%s command matched by `endwhile'", type);
      break;
    default:
      panic_impossible ();
      break;
    }
}

/*
 * Need to make sure that the expression isn't already an identifier
 * that has a name, or an assignment expression.
 *
 * Note that an expression can't be just an identifier anymore -- it
 * must at least be an index expression (see the definition of the
 * non-terminal `variable' above).
 */
tree *
maybe_convert_to_ans_assign (tree *expr)
{
  tree *retval = expr;

  symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0);

  assert (sr != (symbol_record *) NULL);

  if (expr->is_index_expression ())
    {
      tree_index_expression *idx_expr = (tree_index_expression *) expr;
      tree_argument_list *args = idx_expr->arg_list ();

      if (args == (tree_argument_list *) NULL)
	{
	  tree_identifier *tmp = idx_expr->ident ();
	  tree *defn = tmp->def ();
	  if (defn != NULL_TREE && ! defn->is_builtin ())
	    {
	      return retval;
	    }
	}
    }
  else if (expr->is_assignment_expression ())
    {
      return retval;
    }

  tree_identifier *ans = new tree_identifier (sr);
  retval = new tree_simple_assignment_expression (ans, expr);

  return retval;
}

void
maybe_warn_assign_as_truth_value (tree *expr)
{
  if (user_pref.warn_assign_as_truth_value
      && expr->is_assignment_expression ()
      && ((tree_assignment_expression *) expr) -> in_parens < 2)
    {
      warning ("suggest parenthesis around assignment used as truth value");
    }
}