Mercurial > octave-antonio
diff libinterp/parse-tree/oct-parse.in.yy @ 16174:39096b290a2f
check syntax used to enable bison push/pull parser
* acinclude.m4 (OCTAVE_PROG_BISON): Check for syntax used to enable
push/pull parser.
* common.mk (BISON_PUSH_PULL_DECL_STYLE): New variable.
* libinterp/Makefile.am (BUILT_DISTFILES): Include oct-parse.yy in the
list.
(EXTRA_DIST): Include oct-pase.in.yy in the list.
(ULT_DIST_SRC): New variable.
(SRC_DEF_FILES, TST_FILES_SRC): Use $(ULT_DIST_SRC) instead of
$(DIST_SRC).
* find-defun-files.sh: Transform .in.yy instead of .yy.
* libinterp/parse-tree/module.mk (parse-tree/oct-parse.yy):
New target and rule to substitute push-pull decl.
* oct-parse.in.yy: Rename from oct-parse.yy
Substitute %PUSH_PULL_DECL%.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Sat, 02 Mar 2013 12:26:42 -0500 |
parents | libinterp/parse-tree/oct-parse.yy@22bb3aa9f025 |
children | a7669b4d27f6 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libinterp/parse-tree/oct-parse.in.yy Sat Mar 02 12:26:42 2013 -0500 @@ -0,0 +1,4589 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 David Grundberg +Copyright (C) 2009-2010 VZLU Prague + +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 3 of the License, 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, see +<http://www.gnu.org/licenses/>. + +*/ + +// Parser for Octave. + +// C decarations. + +%{ +#define YYDEBUG 1 + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <cassert> +#include <cstdio> +#include <cstdlib> + +#include <iostream> +#include <map> +#include <sstream> + +#include "Cell.h" +#include "Matrix.h" +#include "cmd-edit.h" +#include "cmd-hist.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" + +#include "comment-list.h" +#include "defaults.h" +#include "defun.h" +#include "dirfns.h" +#include "dynamic-ld.h" +#include "error.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-hist.h" +#include "oct-map.h" +#include "ov-fcn-handle.h" +#include "ov-usr-fcn.h" +#include "ov-null-mat.h" +#include "toplev.h" +#include "pager.h" +#include "parse.h" +#include "parse-private.h" +#include "pt-all.h" +#include "pt-eval.h" +#include "symtab.h" +#include "token.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// oct-parse.h must be included after pt-all.h +#include <oct-parse.h> + +extern int octave_lex (YYSTYPE *, void *); + +// Global access to currently active lexer. +// FIXME -- to be removed after more parser+lexer refactoring. +octave_lexer *CURR_LEXER = 0; + +#if defined (GNULIB_NAMESPACE) +// Calls to the following functions appear in the generated output from +// Bison without the namespace tag. Redefine them so we will use them +// via the gnulib namespace. +#define fclose GNULIB_NAMESPACE::fclose +#define fprintf GNULIB_NAMESPACE::fprintf +#define malloc GNULIB_NAMESPACE::malloc +#endif + +// Buffer for help text snagged from function files. +std::stack<std::string> help_buf; + +// TRUE means we are using readline. +// (--no-line-editing) +bool line_editing = true; + +// TRUE means we printed messages about reading startup files. +bool reading_startup_message_printed = false; + +// TRUE means input is coming from startup file. +bool input_from_startup_file = false; + +// Keep track of symbol table information when parsing functions. +symtab_context parser_symtab_context; + +// List of autoloads (function -> file mapping). +static std::map<std::string, std::string> autoload_map; + +// Forward declarations for some functions defined at the bottom of +// the file. + +static void yyerror (octave_parser *curr_parser, const char *s); + +// Finish building a statement. +template <class T> +static tree_statement * +make_statement (T *arg) +{ + octave_comment_list *comment = octave_comment_buffer::get_comment (); + + return new tree_statement (arg, comment); +} + +#define ABORT_PARSE \ + do \ + { \ + global_command = 0; \ + yyerrok; \ + if (! parser_symtab_context.empty ()) \ + parser_symtab_context.pop (); \ + if ((interactive || forced_interactive) \ + && ! get_input_from_eval_string) \ + YYACCEPT; \ + else \ + YYABORT; \ + } \ + while (0) + +#define curr_lexer curr_parser->curr_lexer +#define scanner curr_lexer->scanner + +%} + +// Bison declarations. + +// Don't add spaces around the = here; it causes some versions of +// bison to fail to properly recognize the directive. + +%name-prefix="octave_" + +// We are using the pure parser interface and the reentrant lexer +// interface but the Octave parser and lexer are NOT properly +// reentrant because both still use many global variables. It should be +// safe to create a parser object and call it while anotehr parser +// object is active (to parse a callback function while the main +// interactive parser is waiting for input, for example) if you take +// care to properly save and restore (typically with an unwind_protect +// object) relevant global values before and after the nested call. + +%define api.pure +%PUSH_PULL_DECL% +%parse-param { octave_parser *curr_parser } +%lex-param { void *scanner } + +%union +{ + // The type of the basic tokens returned by the lexer. + token *tok_val; + + // Comment strings that we need to deal with mid-rule. + octave_comment_list *comment_type; + + // Types for the nonterminals we generate. + char sep_type; + tree *tree_type; + tree_matrix *tree_matrix_type; + tree_cell *tree_cell_type; + tree_expression *tree_expression_type; + tree_constant *tree_constant_type; + tree_fcn_handle *tree_fcn_handle_type; + tree_anon_fcn_handle *tree_anon_fcn_handle_type; + tree_identifier *tree_identifier_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_command *tree_command_type; + tree_if_command *tree_if_command_type; + tree_if_clause *tree_if_clause_type; + tree_if_command_list *tree_if_command_list_type; + tree_switch_command *tree_switch_command_type; + tree_switch_case *tree_switch_case_type; + tree_switch_case_list *tree_switch_case_list_type; + tree_decl_elt *tree_decl_elt_type; + tree_decl_init_list *tree_decl_init_list_type; + tree_decl_command *tree_decl_command_type; + tree_statement *tree_statement_type; + tree_statement_list *tree_statement_list_type; + octave_user_function *octave_user_function_type; + void *dummy_type; +} + +// Tokens with line and column information. +%token <tok_val> '=' ':' '-' '+' '*' '/' +%token <tok_val> ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ +%token <tok_val> EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ AND_EQ OR_EQ +%token <tok_val> LSHIFT_EQ RSHIFT_EQ LSHIFT RSHIFT +%token <tok_val> EXPR_AND_AND EXPR_OR_OR +%token <tok_val> EXPR_AND EXPR_OR EXPR_NOT +%token <tok_val> EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT +%token <tok_val> LEFTDIV EMUL EDIV ELEFTDIV EPLUS EMINUS +%token <tok_val> QUOTE TRANSPOSE +%token <tok_val> PLUS_PLUS MINUS_MINUS POW EPOW +%token <tok_val> NUM IMAG_NUM +%token <tok_val> STRUCT_ELT +%token <tok_val> NAME +%token <tok_val> END +%token <tok_val> DQ_STRING SQ_STRING +%token <tok_val> FOR PARFOR WHILE DO UNTIL +%token <tok_val> IF ELSEIF ELSE +%token <tok_val> SWITCH CASE OTHERWISE +%token <tok_val> BREAK CONTINUE FUNC_RET +%token <tok_val> UNWIND CLEANUP +%token <tok_val> TRY CATCH +%token <tok_val> GLOBAL PERSISTENT +%token <tok_val> FCN_HANDLE +%token <tok_val> PROPERTIES METHODS EVENTS ENUMERATION +%token <tok_val> METAQUERY +%token <tok_val> SUPERCLASSREF +%token <tok_val> GET SET + +// Other tokens. +%token END_OF_INPUT LEXICAL_ERROR +%token FCN SCRIPT_FILE FUNCTION_FILE CLASSDEF +// %token VARARGIN VARARGOUT +%token CLOSE_BRACE + +// Nonterminals we construct. +%type <comment_type> stash_comment function_beg classdef_beg +%type <comment_type> properties_beg methods_beg events_beg enum_beg +%type <sep_type> sep_no_nl opt_sep_no_nl sep opt_sep opt_comma +%type <tree_type> input +%type <tree_constant_type> string constant magic_colon +%type <tree_anon_fcn_handle_type> anon_fcn_handle +%type <tree_fcn_handle_type> fcn_handle +%type <tree_matrix_type> matrix_rows matrix_rows1 +%type <tree_cell_type> cell_rows cell_rows1 +%type <tree_expression_type> matrix cell +%type <tree_expression_type> primary_expr oper_expr +%type <tree_expression_type> simple_expr colon_expr assign_expr expression +%type <tree_identifier_type> identifier fcn_name magic_tilde +%type <tree_identifier_type> superclass_identifier meta_identifier +%type <octave_user_function_type> function1 function2 classdef1 +%type <tree_index_expression_type> word_list_cmd +%type <tree_colon_expression_type> colon_expr1 +%type <tree_argument_list_type> arg_list word_list assign_lhs +%type <tree_argument_list_type> cell_or_matrix_row +%type <tree_parameter_list_type> param_list param_list1 param_list2 +%type <tree_parameter_list_type> return_list return_list1 +%type <tree_parameter_list_type> superclasses opt_superclasses +%type <tree_command_type> command select_command loop_command +%type <tree_command_type> jump_command except_command function +%type <tree_command_type> script_file classdef +%type <tree_command_type> function_file function_list +%type <tree_if_command_type> if_command +%type <tree_if_clause_type> elseif_clause else_clause +%type <tree_if_command_list_type> if_cmd_list1 if_cmd_list +%type <tree_switch_command_type> switch_command +%type <tree_switch_case_type> switch_case default_case +%type <tree_switch_case_list_type> case_list1 case_list +%type <tree_decl_elt_type> decl2 +%type <tree_decl_init_list_type> decl1 +%type <tree_decl_command_type> declaration +%type <tree_statement_type> statement function_end classdef_end +%type <tree_statement_list_type> simple_list simple_list1 list list1 +%type <tree_statement_list_type> opt_list input1 +// These types need to be specified. +%type <dummy_type> attr +%type <dummy_type> class_event +%type <dummy_type> class_enum +%type <dummy_type> class_property +%type <dummy_type> properties_list +%type <dummy_type> properties_block +%type <dummy_type> methods_list +%type <dummy_type> methods_block +%type <dummy_type> opt_attr_list +%type <dummy_type> attr_list +%type <dummy_type> events_list +%type <dummy_type> events_block +%type <dummy_type> enum_list +%type <dummy_type> enum_block +%type <dummy_type> class_body + +// Precedence and associativity. +%right '=' ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ OR_EQ AND_EQ LSHIFT_EQ RSHIFT_EQ +%left EXPR_OR_OR +%left EXPR_AND_AND +%left EXPR_OR +%left EXPR_AND +%left EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT +%left LSHIFT RSHIFT +%left ':' +%left '-' '+' EPLUS EMINUS +%left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV +%right UNARY EXPR_NOT +%left POW EPOW QUOTE TRANSPOSE +%right PLUS_PLUS MINUS_MINUS +%left '(' '.' '{' + +// Where to start. +%start input + +%% + +// ============================== +// Statements and statement lists +// ============================== + +input : input1 + { + global_command = $1; + promptflag = 1; + YYACCEPT; + } + | function_file + { YYACCEPT; } + | simple_list parse_error + { ABORT_PARSE; } + | parse_error + { ABORT_PARSE; } + ; + +input1 : '\n' + { $$ = 0; } + | END_OF_INPUT + { + curr_lexer->end_of_input = true; + $$ = 0; + } + | simple_list + { $$ = $1; } + | simple_list '\n' + { $$ = $1; } + | simple_list END_OF_INPUT + { $$ = $1; } + ; + +simple_list : simple_list1 opt_sep_no_nl + { $$ = curr_parser->set_stmt_print_flag ($1, $2, false); } + ; + +simple_list1 : statement + { $$ = curr_parser->make_statement_list ($1); } + | simple_list1 sep_no_nl statement + { $$ = curr_parser->append_statement_list ($1, $2, $3, false); } + ; + +opt_list : // empty + { $$ = new tree_statement_list (); } + | list + { $$ = $1; } + ; + +list : list1 opt_sep + { $$ = curr_parser->set_stmt_print_flag ($1, $2, true); } + ; + +list1 : statement + { $$ = curr_parser->make_statement_list ($1); } + | list1 sep statement + { $$ = curr_parser->append_statement_list ($1, $2, $3, true); } + ; + +statement : expression + { $$ = make_statement ($1); } + | command + { $$ = make_statement ($1); } + | word_list_cmd + { $$ = make_statement ($1); } + ; + +// ================= +// Word-list command +// ================= + +// These are not really like expressions since they can't appear on +// the RHS of an assignment. But they are also not like commands (IF, +// WHILE, etc. + +word_list_cmd : identifier word_list + { $$ = curr_parser->make_index_expression ($1, $2, '('); } + ; + +word_list : string + { $$ = new tree_argument_list ($1); } + | word_list string + { + $1->append ($2); + $$ = $1; + } + ; + +// =========== +// Expressions +// =========== + +identifier : NAME + { + symbol_table::symbol_record *sr = $1->sym_rec (); + $$ = new tree_identifier (*sr, $1->line (), $1->column ()); + } + ; + +superclass_identifier + : SUPERCLASSREF + { $$ = new tree_identifier ($1->line (), $1->column ()); } + ; + +meta_identifier : METAQUERY + { $$ = new tree_identifier ($1->line (), $1->column ()); } + ; + +string : DQ_STRING + { $$ = curr_parser->make_constant (DQ_STRING, $1); } + | SQ_STRING + { $$ = curr_parser->make_constant (SQ_STRING, $1); } + ; + +constant : NUM + { $$ = curr_parser->make_constant (NUM, $1); } + | IMAG_NUM + { $$ = curr_parser->make_constant (IMAG_NUM, $1); } + | string + { $$ = $1; } + ; + +matrix : '[' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + curr_lexer->looking_at_matrix_or_assign_lhs = false; + curr_lexer->pending_local_variables.clear (); + } + | '[' ';' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + curr_lexer->looking_at_matrix_or_assign_lhs = false; + curr_lexer->pending_local_variables.clear (); + } + | '[' ',' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + curr_lexer->looking_at_matrix_or_assign_lhs = false; + curr_lexer->pending_local_variables.clear (); + } + | '[' matrix_rows ']' + { + $$ = curr_parser->finish_matrix ($2); + curr_lexer->looking_at_matrix_or_assign_lhs = false; + curr_lexer->pending_local_variables.clear (); + } + ; + +matrix_rows : matrix_rows1 + { $$ = $1; } + | matrix_rows1 ';' // Ignore trailing semicolon. + { $$ = $1; } + ; + +matrix_rows1 : cell_or_matrix_row + { $$ = new tree_matrix ($1); } + | matrix_rows1 ';' cell_or_matrix_row + { + $1->append ($3); + $$ = $1; + } + ; + +cell : '{' '}' + { $$ = new tree_constant (octave_value (Cell ())); } + | '{' ';' '}' + { $$ = new tree_constant (octave_value (Cell ())); } + | '{' cell_rows '}' + { $$ = curr_parser->finish_cell ($2); } + ; + +cell_rows : cell_rows1 + { $$ = $1; } + | cell_rows1 ';' // Ignore trailing semicolon. + { $$ = $1; } + ; + +cell_rows1 : cell_or_matrix_row + { $$ = new tree_cell ($1); } + | cell_rows1 ';' cell_or_matrix_row + { + $1->append ($3); + $$ = $1; + } + ; + +cell_or_matrix_row + : arg_list + { $$ = curr_parser->validate_matrix_row ($1); } + | arg_list ',' // Ignore trailing comma. + { $$ = curr_parser->validate_matrix_row ($1); } + ; + +fcn_handle : '@' FCN_HANDLE + { + $$ = curr_parser->make_fcn_handle ($2); + curr_lexer->looking_at_function_handle--; + } + ; + +anon_fcn_handle : '@' param_list statement + { + curr_lexer->quote_is_transpose = false; + $$ = curr_parser->make_anon_fcn_handle ($2, $3); + } + ; + +primary_expr : identifier + { $$ = $1; } + | constant + { $$ = $1; } + | fcn_handle + { $$ = $1; } + | matrix + { $$ = $1; } + | cell + { $$ = $1; } + | meta_identifier + { $$ = $1; } + | superclass_identifier + { $$ = $1; } + | '(' expression ')' + { $$ = $2->mark_in_parens (); } + ; + +magic_colon : ':' + { + octave_value tmp (octave_value::magic_colon_t); + $$ = new tree_constant (tmp); + } + ; + +magic_tilde : EXPR_NOT + { + $$ = new tree_black_hole (); + } + ; + +arg_list : expression + { $$ = new tree_argument_list ($1); } + | magic_colon + { $$ = new tree_argument_list ($1); } + | magic_tilde + { $$ = new tree_argument_list ($1); } + | arg_list ',' magic_colon + { + $1->append ($3); + $$ = $1; + } + | arg_list ',' magic_tilde + { + $1->append ($3); + $$ = $1; + } + | arg_list ',' expression + { + $1->append ($3); + $$ = $1; + } + ; + +indirect_ref_op : '.' + { curr_lexer->looking_at_indirect_ref = true; } + ; + +oper_expr : primary_expr + { $$ = $1; } + | oper_expr PLUS_PLUS + { $$ = curr_parser->make_postfix_op (PLUS_PLUS, $1, $2); } + | oper_expr MINUS_MINUS + { $$ = curr_parser->make_postfix_op (MINUS_MINUS, $1, $2); } + | oper_expr '(' ')' + { $$ = curr_parser->make_index_expression ($1, 0, '('); } + | oper_expr '(' arg_list ')' + { $$ = curr_parser->make_index_expression ($1, $3, '('); } + | oper_expr '{' '}' + { $$ = curr_parser->make_index_expression ($1, 0, '{'); } + | oper_expr '{' arg_list '}' + { $$ = curr_parser->make_index_expression ($1, $3, '{'); } + | oper_expr QUOTE + { $$ = curr_parser->make_postfix_op (QUOTE, $1, $2); } + | oper_expr TRANSPOSE + { $$ = curr_parser->make_postfix_op (TRANSPOSE, $1, $2); } + | oper_expr indirect_ref_op STRUCT_ELT + { $$ = curr_parser->make_indirect_ref ($1, $3->text ()); } + | oper_expr indirect_ref_op '(' expression ')' + { $$ = curr_parser->make_indirect_ref ($1, $4); } + | PLUS_PLUS oper_expr %prec UNARY + { $$ = curr_parser->make_prefix_op (PLUS_PLUS, $2, $1); } + | MINUS_MINUS oper_expr %prec UNARY + { $$ = curr_parser->make_prefix_op (MINUS_MINUS, $2, $1); } + | EXPR_NOT oper_expr %prec UNARY + { $$ = curr_parser->make_prefix_op (EXPR_NOT, $2, $1); } + | '+' oper_expr %prec UNARY + { $$ = curr_parser->make_prefix_op ('+', $2, $1); } + | '-' oper_expr %prec UNARY + { $$ = curr_parser->make_prefix_op ('-', $2, $1); } + | oper_expr POW oper_expr + { $$ = curr_parser->make_binary_op (POW, $1, $2, $3); } + | oper_expr EPOW oper_expr + { $$ = curr_parser->make_binary_op (EPOW, $1, $2, $3); } + | oper_expr '+' oper_expr + { $$ = curr_parser->make_binary_op ('+', $1, $2, $3); } + | oper_expr '-' oper_expr + { $$ = curr_parser->make_binary_op ('-', $1, $2, $3); } + | oper_expr '*' oper_expr + { $$ = curr_parser->make_binary_op ('*', $1, $2, $3); } + | oper_expr '/' oper_expr + { $$ = curr_parser->make_binary_op ('/', $1, $2, $3); } + | oper_expr EPLUS oper_expr + { $$ = curr_parser->make_binary_op ('+', $1, $2, $3); } + | oper_expr EMINUS oper_expr + { $$ = curr_parser->make_binary_op ('-', $1, $2, $3); } + | oper_expr EMUL oper_expr + { $$ = curr_parser->make_binary_op (EMUL, $1, $2, $3); } + | oper_expr EDIV oper_expr + { $$ = curr_parser->make_binary_op (EDIV, $1, $2, $3); } + | oper_expr LEFTDIV oper_expr + { $$ = curr_parser->make_binary_op (LEFTDIV, $1, $2, $3); } + | oper_expr ELEFTDIV oper_expr + { $$ = curr_parser->make_binary_op (ELEFTDIV, $1, $2, $3); } + ; + +colon_expr : colon_expr1 + { $$ = curr_parser->finish_colon_expression ($1); } + ; + +colon_expr1 : oper_expr + { $$ = new tree_colon_expression ($1); } + | colon_expr1 ':' oper_expr + { + if (! ($$ = $1->append ($3))) + ABORT_PARSE; + } + ; + +simple_expr : colon_expr + { $$ = $1; } + | simple_expr LSHIFT simple_expr + { $$ = curr_parser->make_binary_op (LSHIFT, $1, $2, $3); } + | simple_expr RSHIFT simple_expr + { $$ = curr_parser->make_binary_op (RSHIFT, $1, $2, $3); } + | simple_expr EXPR_LT simple_expr + { $$ = curr_parser->make_binary_op (EXPR_LT, $1, $2, $3); } + | simple_expr EXPR_LE simple_expr + { $$ = curr_parser->make_binary_op (EXPR_LE, $1, $2, $3); } + | simple_expr EXPR_EQ simple_expr + { $$ = curr_parser->make_binary_op (EXPR_EQ, $1, $2, $3); } + | simple_expr EXPR_GE simple_expr + { $$ = curr_parser->make_binary_op (EXPR_GE, $1, $2, $3); } + | simple_expr EXPR_GT simple_expr + { $$ = curr_parser->make_binary_op (EXPR_GT, $1, $2, $3); } + | simple_expr EXPR_NE simple_expr + { $$ = curr_parser->make_binary_op (EXPR_NE, $1, $2, $3); } + | simple_expr EXPR_AND simple_expr + { $$ = curr_parser->make_binary_op (EXPR_AND, $1, $2, $3); } + | simple_expr EXPR_OR simple_expr + { $$ = curr_parser->make_binary_op (EXPR_OR, $1, $2, $3); } + | simple_expr EXPR_AND_AND simple_expr + { $$ = curr_parser->make_boolean_op (EXPR_AND_AND, $1, $2, $3); } + | simple_expr EXPR_OR_OR simple_expr + { $$ = curr_parser->make_boolean_op (EXPR_OR_OR, $1, $2, $3); } + ; + +// Arrange for the lexer to return CLOSE_BRACE for ']' by looking ahead +// one token for an assignment op. + +assign_lhs : simple_expr + { + $$ = new tree_argument_list ($1); + $$->mark_as_simple_assign_lhs (); + } + | '[' arg_list opt_comma CLOSE_BRACE + { + $$ = $2; + curr_lexer->looking_at_matrix_or_assign_lhs = false; + for (std::set<std::string>::const_iterator p = curr_lexer->pending_local_variables.begin (); + p != curr_lexer->pending_local_variables.end (); + p++) + { + symbol_table::force_variable (*p); + } + curr_lexer->pending_local_variables.clear (); + } + ; + +assign_expr : assign_lhs '=' expression + { $$ = curr_parser->make_assign_op ('=', $1, $2, $3); } + | assign_lhs ADD_EQ expression + { $$ = curr_parser->make_assign_op (ADD_EQ, $1, $2, $3); } + | assign_lhs SUB_EQ expression + { $$ = curr_parser->make_assign_op (SUB_EQ, $1, $2, $3); } + | assign_lhs MUL_EQ expression + { $$ = curr_parser->make_assign_op (MUL_EQ, $1, $2, $3); } + | assign_lhs DIV_EQ expression + { $$ = curr_parser->make_assign_op (DIV_EQ, $1, $2, $3); } + | assign_lhs LEFTDIV_EQ expression + { $$ = curr_parser->make_assign_op (LEFTDIV_EQ, $1, $2, $3); } + | assign_lhs POW_EQ expression + { $$ = curr_parser->make_assign_op (POW_EQ, $1, $2, $3); } + | assign_lhs LSHIFT_EQ expression + { $$ = curr_parser->make_assign_op (LSHIFT_EQ, $1, $2, $3); } + | assign_lhs RSHIFT_EQ expression + { $$ = curr_parser->make_assign_op (RSHIFT_EQ, $1, $2, $3); } + | assign_lhs EMUL_EQ expression + { $$ = curr_parser->make_assign_op (EMUL_EQ, $1, $2, $3); } + | assign_lhs EDIV_EQ expression + { $$ = curr_parser->make_assign_op (EDIV_EQ, $1, $2, $3); } + | assign_lhs ELEFTDIV_EQ expression + { $$ = curr_parser->make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } + | assign_lhs EPOW_EQ expression + { $$ = curr_parser->make_assign_op (EPOW_EQ, $1, $2, $3); } + | assign_lhs AND_EQ expression + { $$ = curr_parser->make_assign_op (AND_EQ, $1, $2, $3); } + | assign_lhs OR_EQ expression + { $$ = curr_parser->make_assign_op (OR_EQ, $1, $2, $3); } + ; + +expression : simple_expr + { $$ = $1; } + | assign_expr + { $$ = $1; } + | anon_fcn_handle + { $$ = $1; } + ; + +// ================================================ +// Commands, declarations, and function definitions +// ================================================ + +command : declaration + { $$ = $1; } + | select_command + { $$ = $1; } + | loop_command + { $$ = $1; } + | jump_command + { $$ = $1; } + | except_command + { $$ = $1; } + | function + { $$ = $1; } + | script_file + { $$ = $1; } + | classdef + { $$ = $1; } + ; + +// ===================== +// Declaration statemnts +// ===================== + +parsing_decl_list + : // empty + { curr_lexer->looking_at_decl_list = true; } + +declaration : GLOBAL parsing_decl_list decl1 + { + $$ = curr_parser->make_decl_command (GLOBAL, $1, $3); + curr_lexer->looking_at_decl_list = false; + } + | PERSISTENT parsing_decl_list decl1 + { + $$ = curr_parser->make_decl_command (PERSISTENT, $1, $3); + curr_lexer->looking_at_decl_list = false; + } + ; + +decl1 : decl2 + { $$ = new tree_decl_init_list ($1); } + | decl1 decl2 + { + $1->append ($2); + $$ = $1; + } + ; + +decl_param_init : // empty + { curr_lexer->looking_at_initializer_expression = true; } + +decl2 : identifier + { $$ = new tree_decl_elt ($1); } + | identifier '=' decl_param_init expression + { + curr_lexer->looking_at_initializer_expression = false; + $$ = new tree_decl_elt ($1, $4); + } + | magic_tilde + { + $$ = new tree_decl_elt ($1); + } + ; + +// ==================== +// Selection statements +// ==================== + +select_command : if_command + { $$ = $1; } + | switch_command + { $$ = $1; } + ; + +// ============ +// If statement +// ============ + +if_command : IF stash_comment if_cmd_list END + { + if (! ($$ = curr_parser->finish_if_command ($1, $3, $4, $2))) + ABORT_PARSE; + } + ; + +if_cmd_list : if_cmd_list1 + { $$ = $1; } + | if_cmd_list1 else_clause + { + $1->append ($2); + $$ = $1; + } + ; + +if_cmd_list1 : expression opt_sep opt_list + { + $1->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + $$ = curr_parser->start_if_command ($1, $3); + } + | if_cmd_list1 elseif_clause + { + $1->append ($2); + $$ = $1; + } + ; + +elseif_clause : ELSEIF stash_comment opt_sep expression opt_sep opt_list + { + $4->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + $$ = curr_parser->make_elseif_clause ($1, $4, $6, $2); + } + ; + +else_clause : ELSE stash_comment opt_sep opt_list + { $$ = new tree_if_clause ($4, $2); } + ; + +// ================ +// Switch statement +// ================ + +switch_command : SWITCH stash_comment expression opt_sep case_list END + { + if (! ($$ = curr_parser->finish_switch_command ($1, $3, $5, $6, $2))) + ABORT_PARSE; + } + ; + +case_list : // empty + { $$ = new tree_switch_case_list (); } + | default_case + { $$ = new tree_switch_case_list ($1); } + | case_list1 + { $$ = $1; } + | case_list1 default_case + { + $1->append ($2); + $$ = $1; + } + ; + +case_list1 : switch_case + { $$ = new tree_switch_case_list ($1); } + | case_list1 switch_case + { + $1->append ($2); + $$ = $1; + } + ; + +switch_case : CASE stash_comment opt_sep expression opt_sep opt_list + { $$ = curr_parser->make_switch_case ($1, $4, $6, $2); } + ; + +default_case : OTHERWISE stash_comment opt_sep opt_list + { + $$ = new tree_switch_case ($4, $2); + } + ; + +// ======= +// Looping +// ======= + +loop_command : WHILE stash_comment expression opt_sep opt_list END + { + $3->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + if (! ($$ = curr_parser->make_while_command ($1, $3, $5, $6, $2))) + ABORT_PARSE; + } + | DO stash_comment opt_sep opt_list UNTIL expression + { + if (! ($$ = curr_parser->make_do_until_command ($5, $4, $6, $2))) + ABORT_PARSE; + } + | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = curr_parser->make_for_command (FOR, $1, $3, $5, 0, + $7, $8, $2))) + ABORT_PARSE; + } + | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END + { + if (! ($$ = curr_parser->make_for_command (FOR, $1, $4, $6, 0, + $9, $10, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = curr_parser->make_for_command (PARFOR, $1, $3, $5, + 0, $7, $8, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment '(' assign_lhs '=' expression ',' expression ')' opt_sep opt_list END + { + if (! ($$ = curr_parser->make_for_command (PARFOR, $1, $4, $6, + $8, $11, $12, $2))) + ABORT_PARSE; + } + ; + +// ======= +// Jumping +// ======= + +jump_command : BREAK + { + if (! ($$ = curr_parser->make_break_command ($1))) + ABORT_PARSE; + } + | CONTINUE + { + if (! ($$ = curr_parser->make_continue_command ($1))) + ABORT_PARSE; + } + | FUNC_RET + { + if (! ($$ = curr_parser->make_return_command ($1))) + ABORT_PARSE; + } + ; + +// ========== +// Exceptions +// ========== + +except_command : UNWIND stash_comment opt_sep opt_list CLEANUP + stash_comment opt_sep opt_list END + { + if (! ($$ = curr_parser->make_unwind_command ($1, $4, $8, $9, $2, $6))) + ABORT_PARSE; + } + | TRY stash_comment opt_sep opt_list CATCH + stash_comment opt_sep opt_list END + { + if (! ($$ = curr_parser->make_try_command ($1, $4, $8, $9, $2, $6))) + ABORT_PARSE; + } + | TRY stash_comment opt_sep opt_list END + { + if (! ($$ = curr_parser->make_try_command ($1, $4, 0, $5, $2, 0))) + ABORT_PARSE; + } + ; + +// =========================================== +// Some 'subroutines' for function definitions +// =========================================== + +push_fcn_symtab : // empty + { + curr_parser->curr_fcn_depth++; + + if (curr_parser->max_fcn_depth < curr_parser->curr_fcn_depth) + curr_parser->max_fcn_depth = curr_parser->curr_fcn_depth; + + parser_symtab_context.push (); + + symbol_table::set_scope (symbol_table::alloc_scope ()); + + curr_parser->function_scopes.push_back (symbol_table::current_scope ()); + + if (! reading_script_file && curr_parser->curr_fcn_depth == 1 + && ! curr_parser->parsing_subfunctions) + curr_parser->primary_fcn_scope = symbol_table::current_scope (); + + if (reading_script_file && curr_parser->curr_fcn_depth > 1) + curr_parser->bison_error ("nested functions not implemented in this context"); + } + ; + +// =========================== +// List of function parameters +// =========================== + +param_list_beg : '(' + { + curr_lexer->looking_at_parameter_list = true; + + if (curr_lexer->looking_at_function_handle) + { + parser_symtab_context.push (); + symbol_table::set_scope (symbol_table::alloc_scope ()); + curr_lexer->looking_at_function_handle--; + curr_lexer->looking_at_anon_fcn_args = true; + } + } + ; + +param_list_end : ')' + { + curr_lexer->looking_at_parameter_list = false; + curr_lexer->looking_for_object_index = false; + } + ; + +param_list : param_list_beg param_list1 param_list_end + { + curr_lexer->quote_is_transpose = false; + $$ = $2; + } + | param_list_beg error + { + curr_parser->bison_error ("invalid parameter list"); + $$ = 0; + ABORT_PARSE; + } + ; + +param_list1 : // empty + { $$ = 0; } + | param_list2 + { + $1->mark_as_formal_parameters (); + if ($1->validate (tree_parameter_list::in)) + $$ = $1; + else + ABORT_PARSE; + } + ; + +param_list2 : decl2 + { $$ = new tree_parameter_list ($1); } + | param_list2 ',' decl2 + { + $1->append ($3); + $$ = $1; + } + ; + +// =================================== +// List of function return value names +// =================================== + +return_list : '[' ']' + { + curr_lexer->looking_at_return_list = false; + $$ = new tree_parameter_list (); + } + | return_list1 + { + curr_lexer->looking_at_return_list = false; + if ($1->validate (tree_parameter_list::out)) + $$ = $1; + else + ABORT_PARSE; + } + | '[' return_list1 ']' + { + curr_lexer->looking_at_return_list = false; + if ($2->validate (tree_parameter_list::out)) + $$ = $2; + else + ABORT_PARSE; + } + ; + +return_list1 : identifier + { $$ = new tree_parameter_list (new tree_decl_elt ($1)); } + | return_list1 ',' identifier + { + $1->append (new tree_decl_elt ($3)); + $$ = $1; + } + ; + +// =========== +// Script file +// =========== + +script_file : SCRIPT_FILE opt_list END_OF_INPUT + { + tree_statement *end_of_script + = curr_parser->make_end ("endscript", + curr_lexer->input_line_number, + curr_lexer->current_input_column); + + curr_parser->make_script ($2, end_of_script); + + $$ = 0; + } + ; + +// ============= +// Function file +// ============= + +function_file : FUNCTION_FILE function_list opt_sep END_OF_INPUT + { $$ = 0; } + ; + +function_list : function + | function_list sep function + ; + +// =================== +// Function definition +// =================== + +function_beg : push_fcn_symtab FCN stash_comment + { + $$ = $3; + + if (reading_classdef_file || curr_lexer->parsing_classdef) + curr_lexer->maybe_classdef_get_set_method = true; + } + ; + +function : function_beg function1 + { + $$ = curr_parser->finish_function (0, $2, $1); + curr_parser->recover_from_parsing_function (); + } + | function_beg return_list '=' function1 + { + $$ = curr_parser->finish_function ($2, $4, $1); + curr_parser->recover_from_parsing_function (); + } + ; + +fcn_name : identifier + { + std::string id_name = $1->name (); + + curr_lexer->parsed_function_name.top () = true; + curr_lexer->maybe_classdef_get_set_method = false; + + $$ = $1; + } + | GET '.' identifier + { + curr_lexer->parsed_function_name.top () = true; + curr_lexer->maybe_classdef_get_set_method = false; + $$ = $3; + } + | SET '.' identifier + { + curr_lexer->parsed_function_name.top () = true; + curr_lexer->maybe_classdef_get_set_method = false; + $$ = $3; + } + ; + +function1 : fcn_name function2 + { + std::string fname = $1->name (); + + delete $1; + + if (! ($$ = curr_parser->frob_function (fname, $2))) + ABORT_PARSE; + } + ; + +function2 : param_list opt_sep opt_list function_end + { $$ = curr_parser->start_function ($1, $3, $4); } + | opt_sep opt_list function_end + { $$ = curr_parser->start_function (0, $2, $3); } + ; + +function_end : END + { + curr_parser->endfunction_found = true; + if (curr_parser->end_token_ok ($1, token::function_end)) + $$ = curr_parser->make_end ("endfunction", $1->line (), $1->column ()); + else + ABORT_PARSE; + } + | END_OF_INPUT + { +// A lot of tests are based on the assumption that this is OK +// if (reading_script_file) +// { +// curr_parser->bison_error ("function body open at end of script"); +// YYABORT; +// } + + if (curr_parser->endfunction_found) + { + curr_parser->bison_error ("inconsistent function endings -- " + "if one function is explicitly ended, " + "so must all the others"); + YYABORT; + } + + if (! (reading_fcn_file || reading_script_file + || get_input_from_eval_string)) + { + curr_parser->bison_error ("function body open at end of input"); + YYABORT; + } + + if (reading_classdef_file) + { + curr_parser->bison_error ("classdef body open at end of input"); + YYABORT; + } + + $$ = curr_parser->make_end ("endfunction", + curr_lexer->input_line_number, + curr_lexer->current_input_column); + } + ; + +// ======== +// Classdef +// ======== + +classdef_beg : CLASSDEF stash_comment + { + $$ = 0; + curr_lexer->parsing_classdef = true; + } + ; + +classdef_end : END + { + curr_lexer->parsing_classdef = false; + + if (curr_parser->end_token_ok ($1, token::classdef_end)) + $$ = curr_parser->make_end ("endclassdef", $1->line (), $1->column ()); + else + ABORT_PARSE; + } + ; + +classdef1 : classdef_beg opt_attr_list identifier opt_superclasses + { $$ = 0; } + ; + +classdef : classdef1 opt_sep class_body opt_sep stash_comment classdef_end + { $$ = 0; } + ; + +opt_attr_list : // empty + { $$ = 0; } + | '(' attr_list ')' + { $$ = 0; } + ; + +attr_list : attr + { $$ = 0; } + | attr_list ',' attr + { $$ = 0; } + ; + +attr : identifier + { $$ = 0; } + | identifier '=' decl_param_init expression + { $$ = 0; } + | EXPR_NOT identifier + { $$ = 0; } + ; + +opt_superclasses + : // empty + { $$ = 0; } + | superclasses + { $$ = 0; } + ; + +superclasses : EXPR_LT identifier '.' identifier + { $$ = 0; } + | EXPR_LT identifier + { $$ = 0; } + | superclasses EXPR_AND identifier '.' identifier + { $$ = 0; } + | superclasses EXPR_AND identifier + { $$ = 0; } + ; + +class_body : properties_block + { $$ = 0; } + | methods_block + { $$ = 0; } + | events_block + { $$ = 0; } + | enum_block + { $$ = 0; } + | class_body opt_sep properties_block + { $$ = 0; } + | class_body opt_sep methods_block + { $$ = 0; } + | class_body opt_sep events_block + { $$ = 0; } + | class_body opt_sep enum_block + { $$ = 0; } + ; + +properties_beg : PROPERTIES stash_comment + { $$ = 0; } + ; + +properties_block + : properties_beg opt_attr_list opt_sep properties_list opt_sep END + { $$ = 0; } + ; + +properties_list + : class_property + { $$ = 0; } + | properties_list opt_sep class_property + { $$ = 0; } + ; + +class_property : identifier + { $$ = 0; } + | identifier '=' decl_param_init expression ';' + { $$ = 0; } + ; + +methods_beg : METHODS stash_comment + { $$ = 0; } + ; + +methods_block : methods_beg opt_attr_list opt_sep methods_list opt_sep END + { $$ = 0; } + ; + +methods_list : function + { $$ = 0; } + | methods_list opt_sep function + { $$ = 0; } + ; + +events_beg : EVENTS stash_comment + { $$ = 0; } + ; + +events_block : events_beg opt_attr_list opt_sep events_list opt_sep END + { $$ = 0; } + ; + +events_list : class_event + { $$ = 0; } + | events_list opt_sep class_event + { $$ = 0; } + ; + +class_event : identifier + { $$ = 0; } + ; + +enum_beg : ENUMERATION stash_comment + { $$ = 0; } + ; + +enum_block : enum_beg opt_attr_list opt_sep enum_list opt_sep END + { $$ = 0; } + ; + +enum_list : class_enum + { $$ = 0; } + | enum_list opt_sep class_enum + { $$ = 0; } + ; + +class_enum : identifier '(' expression ')' + { $$ = 0; } + ; + +// ============= +// Miscellaneous +// ============= + +stash_comment : // empty + { $$ = octave_comment_buffer::get_comment (); } + ; + +parse_error : LEXICAL_ERROR + { curr_parser->bison_error ("parse error"); } + | error + ; + +sep_no_nl : ',' + { $$ = ','; } + | ';' + { $$ = ';'; } + | sep_no_nl ',' + { $$ = $1; } + | sep_no_nl ';' + { $$ = $1; } + ; + +opt_sep_no_nl : // empty + { $$ = 0; } + | sep_no_nl + { $$ = $1; } + ; + +sep : ',' + { $$ = ','; } + | ';' + { $$ = ';'; } + | '\n' + { $$ = '\n'; } + | sep ',' + { $$ = $1; } + | sep ';' + { $$ = $1; } + | sep '\n' + { $$ = $1; } + ; + +opt_sep : // empty + { $$ = 0; } + | sep + { $$ = $1; } + ; + +opt_comma : // empty + { $$ = 0; } + | ',' + { $$ = ','; } + ; + +%% + +// Generic error messages. + +#undef curr_lexer + +static void +yyerror (octave_parser *curr_parser, const char *s) +{ + curr_parser->bison_error (s); +} + +octave_parser::~octave_parser (void) +{ +#if defined (OCTAVE_USE_PUSH_PARSER) + yypstate_delete (static_cast<yypstate *> (parser_state)); +#endif + +delete curr_lexer; +} +void octave_parser::init (void) +{ +#if defined (OCTAVE_USE_PUSH_PARSER) + parser_state = yypstate_new (); +#endif + + CURR_LEXER = curr_lexer; +} + +int +octave_parser::run (void) +{ + int status = 0; + +#if defined (OCTAVE_USE_PUSH_PARSER) + + do + { + YYSTYPE lval; + + int token = octave_lex (&lval, scanner); + + yypstate *pstate = static_cast<yypstate *> (parser_state); + + status = octave_push_parse (pstate, token, &lval, this); + } + while (status == YYPUSH_MORE); + +#else + + status = octave_parse (this); + +#endif + + return status; +} + +// Error mesages for mismatched end tokens. + +void +octave_parser::end_error (const char *type, token::end_tok_type ettype, + int l, int c) +{ + static const char *fmt + = "'%s' command matched by '%s' near line %d column %d"; + + switch (ettype) + { + case token::simple_end: + error (fmt, type, "end", l, c); + break; + + case token::for_end: + error (fmt, type, "endfor", l, c); + break; + + case token::function_end: + error (fmt, type, "endfunction", l, c); + break; + + case token::classdef_end: + error (fmt, type, "endclassdef", l, c); + break; + + case token::if_end: + error (fmt, type, "endif", l, c); + break; + + case token::switch_end: + error (fmt, type, "endswitch", l, c); + break; + + case token::while_end: + error (fmt, type, "endwhile", l, c); + break; + + case token::try_catch_end: + error (fmt, type, "end_try_catch", l, c); + break; + + case token::unwind_protect_end: + error (fmt, type, "end_unwind_protect", l, c); + break; + + default: + panic_impossible (); + break; + } +} + +// Check to see that end tokens are properly matched. + +bool +octave_parser::end_token_ok (token *tok, token::end_tok_type expected) +{ + bool retval = true; + + token::end_tok_type ettype = tok->ettype (); + + if (ettype != expected && ettype != token::simple_end) + { + retval = false; + + bison_error ("parse error"); + + int l = tok->line (); + int c = tok->column (); + + switch (expected) + { + case token::classdef_end: + end_error ("classdef", ettype, l, c); + break; + + case token::for_end: + end_error ("for", ettype, l, c); + break; + + case token::enumeration_end: + end_error ("enumeration", ettype, l, c); + break; + + case token::function_end: + end_error ("function", ettype, l, c); + break; + + case token::if_end: + end_error ("if", ettype, l, c); + break; + + case token::parfor_end: + end_error ("parfor", ettype, l, c); + break; + + case token::try_catch_end: + end_error ("try", ettype, l, c); + break; + + case token::switch_end: + end_error ("switch", ettype, l, c); + break; + + case token::unwind_protect_end: + end_error ("unwind_protect", ettype, l, c); + break; + + case token::while_end: + end_error ("while", ettype, l, c); + break; + + default: + panic_impossible (); + break; + } + } + + return retval; +} + +// Maybe print a warning if an assignment expression is used as the +// test in a logical expression. + +void +octave_parser::maybe_warn_assign_as_truth_value (tree_expression *expr) +{ + if (expr->is_assignment_expression () + && expr->paren_count () < 2) + { + if (curr_fcn_file_full_name.empty ()) + warning_with_id + ("Octave:assign-as-truth-value", + "suggest parenthesis around assignment used as truth value"); + else + warning_with_id + ("Octave:assign-as-truth-value", + "suggest parenthesis around assignment used as truth value near line %d, column %d in file '%s'", + expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); + } +} + +// Maybe print a warning about switch labels that aren't constants. + +void +octave_parser::maybe_warn_variable_switch_label (tree_expression *expr) +{ + if (! expr->is_constant ()) + { + if (curr_fcn_file_full_name.empty ()) + warning_with_id ("Octave:variable-switch-label", + "variable switch label"); + else + warning_with_id + ("Octave:variable-switch-label", + "variable switch label near line %d, column %d in file '%s'", + expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); + } +} + +static tree_expression * +fold (tree_binary_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *op1 = e->lhs (); + tree_expression *op2 = e->rhs (); + + if (op1->is_constant () && op2->is_constant ()) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, op1->line (), op1->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + + return retval; +} + +static tree_expression * +fold (tree_unary_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *op = e->operand (); + + if (op->is_constant ()) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, op->line (), op->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + + return retval; +} + +// Finish building a range. + +tree_expression * +octave_parser::finish_colon_expression (tree_colon_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *base = e->base (); + tree_expression *limit = e->limit (); + tree_expression *incr = e->increment (); + + if (base) + { + if (limit) + { + if (base->is_constant () && limit->is_constant () + && (! incr || (incr && incr->is_constant ()))) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, base->line (), base->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + } + else + { + e->preserve_base (); + delete e; + + // FIXME -- need to attempt constant folding here + // too (we need a generic way to do that). + retval = base; + } + } + + return retval; +} + +// Make a constant. + +tree_constant * +octave_parser::make_constant (int op, token *tok_val) +{ + int l = tok_val->line (); + int c = tok_val->column (); + + tree_constant *retval = 0; + + switch (op) + { + case NUM: + { + octave_value tmp (tok_val->number ()); + retval = new tree_constant (tmp, l, c); + retval->stash_original_text (tok_val->text_rep ()); + } + break; + + case IMAG_NUM: + { + octave_value tmp (Complex (0.0, tok_val->number ())); + retval = new tree_constant (tmp, l, c); + retval->stash_original_text (tok_val->text_rep ()); + } + break; + + case DQ_STRING: + case SQ_STRING: + { + std::string txt = tok_val->text (); + + char delim = op == DQ_STRING ? '"' : '\''; + octave_value tmp (txt, delim); + + if (txt.empty ()) + { + if (op == DQ_STRING) + tmp = octave_null_str::instance; + else + tmp = octave_null_sq_str::instance; + } + + retval = new tree_constant (tmp, l, c); + + if (op == DQ_STRING) + txt = undo_string_escapes (txt); + + // FIXME -- maybe this should also be handled by + // tok_val->text_rep () for character strings? + retval->stash_original_text (delim + txt + delim); + } + break; + + default: + panic_impossible (); + break; + } + + return retval; +} + +// Make a function handle. + +tree_fcn_handle * +octave_parser::make_fcn_handle (token *tok_val) +{ + int l = tok_val->line (); + int c = tok_val->column (); + + tree_fcn_handle *retval = new tree_fcn_handle (tok_val->text (), l, c); + + return retval; +} + +// Make an anonymous function handle. + +tree_anon_fcn_handle * +octave_parser::make_anon_fcn_handle (tree_parameter_list *param_list, + tree_statement *stmt) +{ + // FIXME -- need to get these from the location of the @ symbol. + int l = curr_lexer->input_line_number; + int c = curr_lexer->current_input_column; + + tree_parameter_list *ret_list = 0; + + symbol_table::scope_id fcn_scope = symbol_table::current_scope (); + + if (parser_symtab_context.empty ()) + panic_impossible (); + + parser_symtab_context.pop (); + + stmt->set_print_flag (false); + + tree_statement_list *body = new tree_statement_list (stmt); + + body->mark_as_anon_function_body (); + + tree_anon_fcn_handle *retval + = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); + // FIXME: Stash the filename. This does not work and produces + // errors when executed. + //retval->stash_file_name (curr_fcn_file_name); + + return retval; +} + +// Build a binary expression. + +tree_expression * +octave_parser::make_binary_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2) +{ + octave_value::binary_op t = octave_value::unknown_binary_op; + + switch (op) + { + case POW: + t = octave_value::op_pow; + break; + + case EPOW: + t = octave_value::op_el_pow; + break; + + case '+': + t = octave_value::op_add; + break; + + case '-': + t = octave_value::op_sub; + break; + + case '*': + t = octave_value::op_mul; + break; + + case '/': + t = octave_value::op_div; + break; + + case EMUL: + t = octave_value::op_el_mul; + break; + + case EDIV: + t = octave_value::op_el_div; + break; + + case LEFTDIV: + t = octave_value::op_ldiv; + break; + + case ELEFTDIV: + t = octave_value::op_el_ldiv; + break; + + case LSHIFT: + t = octave_value::op_lshift; + break; + + case RSHIFT: + t = octave_value::op_rshift; + break; + + case EXPR_LT: + t = octave_value::op_lt; + break; + + case EXPR_LE: + t = octave_value::op_le; + break; + + case EXPR_EQ: + t = octave_value::op_eq; + break; + + case EXPR_GE: + t = octave_value::op_ge; + break; + + case EXPR_GT: + t = octave_value::op_gt; + break; + + case EXPR_NE: + t = octave_value::op_ne; + break; + + case EXPR_AND: + t = octave_value::op_el_and; + break; + + case EXPR_OR: + t = octave_value::op_el_or; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_binary_expression *e + = maybe_compound_binary_expression (op1, op2, l, c, t); + + return fold (e); +} + +// Build a boolean expression. + +tree_expression * +octave_parser::make_boolean_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2) +{ + tree_boolean_expression::type t; + + switch (op) + { + case EXPR_AND_AND: + t = tree_boolean_expression::bool_and; + break; + + case EXPR_OR_OR: + t = tree_boolean_expression::bool_or; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_boolean_expression *e + = new tree_boolean_expression (op1, op2, l, c, t); + + return fold (e); +} + +// Build a prefix expression. + +tree_expression * +octave_parser::make_prefix_op (int op, tree_expression *op1, token *tok_val) +{ + octave_value::unary_op t = octave_value::unknown_unary_op; + + switch (op) + { + case EXPR_NOT: + t = octave_value::op_not; + break; + + case '+': + t = octave_value::op_uplus; + break; + + case '-': + t = octave_value::op_uminus; + break; + + case PLUS_PLUS: + t = octave_value::op_incr; + break; + + case MINUS_MINUS: + t = octave_value::op_decr; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_prefix_expression *e + = new tree_prefix_expression (op1, l, c, t); + + return fold (e); +} + +// Build a postfix expression. + +tree_expression * +octave_parser::make_postfix_op (int op, tree_expression *op1, token *tok_val) +{ + octave_value::unary_op t = octave_value::unknown_unary_op; + + switch (op) + { + case QUOTE: + t = octave_value::op_hermitian; + break; + + case TRANSPOSE: + t = octave_value::op_transpose; + break; + + case PLUS_PLUS: + t = octave_value::op_incr; + break; + + case MINUS_MINUS: + t = octave_value::op_decr; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_postfix_expression *e + = new tree_postfix_expression (op1, l, c, t); + + return fold (e); +} + +// Build an unwind-protect command. + +tree_command * +octave_parser::make_unwind_command (token *unwind_tok, + tree_statement_list *body, + tree_statement_list *cleanup_stmts, + token *end_tok, + octave_comment_list *lc, + octave_comment_list *mc) +{ + tree_command *retval = 0; + + if (end_token_ok (end_tok, token::unwind_protect_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = unwind_tok->line (); + int c = unwind_tok->column (); + + retval = new tree_unwind_protect_command (body, cleanup_stmts, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a try-catch command. + +tree_command * +octave_parser::make_try_command (token *try_tok, tree_statement_list *body, + tree_statement_list *cleanup_stmts, + token *end_tok, + octave_comment_list *lc, + octave_comment_list *mc) +{ + tree_command *retval = 0; + + if (end_token_ok (end_tok, token::try_catch_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = try_tok->line (); + int c = try_tok->column (); + + retval = new tree_try_catch_command (body, cleanup_stmts, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a while command. + +tree_command * +octave_parser::make_while_command (token *while_tok, tree_expression *expr, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) +{ + tree_command *retval = 0; + + maybe_warn_assign_as_truth_value (expr); + + if (end_token_ok (end_tok, token::while_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + curr_lexer->looping--; + + int l = while_tok->line (); + int c = while_tok->column (); + + retval = new tree_while_command (expr, body, lc, tc, l, c); + } + + return retval; +} + +// Build a do-until command. + +tree_command * +octave_parser::make_do_until_command (token *until_tok, + tree_statement_list *body, + tree_expression *expr, + octave_comment_list *lc) +{ + tree_command *retval = 0; + + maybe_warn_assign_as_truth_value (expr); + + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + curr_lexer->looping--; + + int l = until_tok->line (); + int c = until_tok->column (); + + retval = new tree_do_until_command (expr, body, lc, tc, l, c); + + return retval; +} + +// Build a for command. + +tree_command * +octave_parser::make_for_command (int tok_id, token *for_tok, + tree_argument_list *lhs, + tree_expression *expr, + tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) +{ + tree_command *retval = 0; + + bool parfor = tok_id == PARFOR; + + if (end_token_ok (end_tok, parfor ? token::parfor_end : token::for_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + curr_lexer->looping--; + + int l = for_tok->line (); + int c = for_tok->column (); + + if (lhs->length () == 1) + { + tree_expression *tmp = lhs->remove_front (); + + retval = new tree_simple_for_command (parfor, tmp, expr, maxproc, + body, lc, tc, l, c); + + delete lhs; + } + else + { + if (parfor) + bison_error ("invalid syntax for parfor statement"); + else + retval = new tree_complex_for_command (lhs, expr, body, + lc, tc, l, c); + } + } + + return retval; +} + +// Build a break command. + +tree_command * +octave_parser::make_break_command (token *break_tok) +{ + tree_command *retval = 0; + + int l = break_tok->line (); + int c = break_tok->column (); + + retval = new tree_break_command (l, c); + + return retval; +} + +// Build a continue command. + +tree_command * +octave_parser::make_continue_command (token *continue_tok) +{ + tree_command *retval = 0; + + int l = continue_tok->line (); + int c = continue_tok->column (); + + retval = new tree_continue_command (l, c); + + return retval; +} + +// Build a return command. + +tree_command * +octave_parser::make_return_command (token *return_tok) +{ + tree_command *retval = 0; + + int l = return_tok->line (); + int c = return_tok->column (); + + retval = new tree_return_command (l, c); + + return retval; +} + +// Start an if command. + +tree_if_command_list * +octave_parser::start_if_command (tree_expression *expr, + tree_statement_list *list) +{ + maybe_warn_assign_as_truth_value (expr); + + tree_if_clause *t = new tree_if_clause (expr, list); + + return new tree_if_command_list (t); +} + +// Finish an if command. + +tree_if_command * +octave_parser::finish_if_command (token *if_tok, tree_if_command_list *list, + token *end_tok, octave_comment_list *lc) +{ + tree_if_command *retval = 0; + + if (end_token_ok (end_tok, token::if_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = if_tok->line (); + int c = if_tok->column (); + + if (list && ! list->empty ()) + { + tree_if_clause *elt = list->front (); + + if (elt) + { + elt->line (l); + elt->column (c); + } + } + + retval = new tree_if_command (list, lc, tc, l, c); + } + + return retval; +} + +// Build an elseif clause. + +tree_if_clause * +octave_parser::make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, + octave_comment_list *lc) +{ + maybe_warn_assign_as_truth_value (expr); + + int l = elseif_tok->line (); + int c = elseif_tok->column (); + + return new tree_if_clause (expr, list, lc, l, c); +} + +// Finish a switch command. + +tree_switch_command * +octave_parser::finish_switch_command (token *switch_tok, tree_expression *expr, + tree_switch_case_list *list, + token *end_tok, octave_comment_list *lc) +{ + tree_switch_command *retval = 0; + + if (end_token_ok (end_tok, token::switch_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = switch_tok->line (); + int c = switch_tok->column (); + + if (list && ! list->empty ()) + { + tree_switch_case *elt = list->front (); + + if (elt) + { + elt->line (l); + elt->column (c); + } + } + + retval = new tree_switch_command (expr, list, lc, tc, l, c); + } + + return retval; +} + +// Build a switch case. + +tree_switch_case * +octave_parser::make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, + octave_comment_list *lc) +{ + maybe_warn_variable_switch_label (expr); + + int l = case_tok->line (); + int c = case_tok->column (); + + return new tree_switch_case (expr, list, lc, l, c); +} + +// Build an assignment to a variable. + +tree_expression * +octave_parser::make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, + tree_expression *rhs) +{ + tree_expression *retval = 0; + + octave_value::assign_op t = octave_value::unknown_assign_op; + + switch (op) + { + case '=': + t = octave_value::op_asn_eq; + break; + + case ADD_EQ: + t = octave_value::op_add_eq; + break; + + case SUB_EQ: + t = octave_value::op_sub_eq; + break; + + case MUL_EQ: + t = octave_value::op_mul_eq; + break; + + case DIV_EQ: + t = octave_value::op_div_eq; + break; + + case LEFTDIV_EQ: + t = octave_value::op_ldiv_eq; + break; + + case POW_EQ: + t = octave_value::op_pow_eq; + break; + + case LSHIFT_EQ: + t = octave_value::op_lshift_eq; + break; + + case RSHIFT_EQ: + t = octave_value::op_rshift_eq; + break; + + case EMUL_EQ: + t = octave_value::op_el_mul_eq; + break; + + case EDIV_EQ: + t = octave_value::op_el_div_eq; + break; + + case ELEFTDIV_EQ: + t = octave_value::op_el_ldiv_eq; + break; + + case EPOW_EQ: + t = octave_value::op_el_pow_eq; + break; + + case AND_EQ: + t = octave_value::op_el_and_eq; + break; + + case OR_EQ: + t = octave_value::op_el_or_eq; + break; + + default: + panic_impossible (); + break; + } + + int l = eq_tok->line (); + int c = eq_tok->column (); + + if (lhs->is_simple_assign_lhs ()) + { + tree_expression *tmp = lhs->remove_front (); + + retval = new tree_simple_assignment (tmp, rhs, false, l, c, t); + + delete lhs; + } + else if (t == octave_value::op_asn_eq) + return new tree_multi_assignment (lhs, rhs, false, l, c); + else + bison_error ("computed multiple assignment not allowed"); + + return retval; +} + +// Define a script. + +void +octave_parser::make_script (tree_statement_list *cmds, + tree_statement *end_script) +{ + std::string doc_string; + + if (! help_buf.empty ()) + { + doc_string = help_buf.top (); + help_buf.pop (); + } + + if (! cmds) + cmds = new tree_statement_list (); + + cmds->append (end_script); + + octave_user_script *script + = new octave_user_script (curr_fcn_file_full_name, curr_fcn_file_name, + cmds, doc_string); + + octave_time now; + + script->stash_fcn_file_time (now); + + primary_fcn_ptr = script; + + // Unmark any symbols that may have been tagged as local variables + // while parsing (for example, by force_local_variable in lex.l). + + symbol_table::unmark_forced_variables (); +} + +// Begin defining a function. + +octave_user_function * +octave_parser::start_function (tree_parameter_list *param_list, + tree_statement_list *body, + tree_statement *end_fcn_stmt) +{ + // We'll fill in the return list later. + + if (! body) + body = new tree_statement_list (); + + body->append (end_fcn_stmt); + + octave_user_function *fcn + = new octave_user_function (symbol_table::current_scope (), + param_list, 0, body); + + if (fcn) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + fcn->stash_trailing_comment (tc); + } + + return fcn; +} + +tree_statement * +octave_parser::make_end (const std::string& type, int l, int c) +{ + return make_statement (new tree_no_op_command (type, l, c)); +} + +// Do most of the work for defining a function. + +octave_user_function * +octave_parser::frob_function (const std::string& fname, + octave_user_function *fcn) +{ + std::string id_name = fname; + + // 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 (! autoloading && reading_fcn_file + && curr_fcn_depth == 1 && ! parsing_subfunctions) + { + // FIXME -- should curr_fcn_file_name already be + // preprocessed when we get here? It seems to only be a + // problem with relative file names. + + std::string nm = curr_fcn_file_name; + + size_t pos = nm.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + nm = curr_fcn_file_name.substr (pos+1); + + if (nm != id_name) + { + warning_with_id + ("Octave:function-name-clash", + "function name '%s' does not agree with function file name '%s'", + id_name.c_str (), curr_fcn_file_full_name.c_str ()); + + id_name = nm; + } + } + + if (reading_fcn_file || reading_classdef_file || autoloading) + { + octave_time now; + + fcn->stash_fcn_file_name (curr_fcn_file_full_name); + fcn->stash_fcn_file_time (now); + fcn->mark_as_system_fcn_file (); + + if (fcn_file_from_relative_lookup) + fcn->mark_relative (); + + if (curr_fcn_depth > 1 || parsing_subfunctions) + { + fcn->stash_parent_fcn_name (curr_fcn_file_name); + + if (curr_fcn_depth > 1) + fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size ()-2]); + else + fcn->stash_parent_fcn_scope (primary_fcn_scope); + } + + if (curr_lexer->parsing_class_method) + { + if (curr_class_name == id_name) + fcn->mark_as_class_constructor (); + else + fcn->mark_as_class_method (); + + fcn->stash_dispatch_class (curr_class_name); + } + + std::string nm = fcn->fcn_file_name (); + + file_stat fs (nm); + + if (fs && fs.is_newer (now)) + warning_with_id ("Octave:future-time-stamp", + "time stamp for '%s' is in the future", nm.c_str ()); + } + else if (! (input_from_tmp_history_file || input_from_startup_file) + && reading_script_file + && curr_fcn_file_name == id_name) + { + warning ("function '%s' defined within script file '%s'", + id_name.c_str (), curr_fcn_file_full_name.c_str ()); + } + + fcn->stash_function_name (id_name); + fcn->stash_fcn_location (curr_lexer->input_line_number, + curr_lexer->current_input_column); + + if (! help_buf.empty () && curr_fcn_depth == 1 + && ! parsing_subfunctions) + { + fcn->document (help_buf.top ()); + + help_buf.pop (); + } + + if (reading_fcn_file && curr_fcn_depth == 1 + && ! parsing_subfunctions) + primary_fcn_ptr = fcn; + + return fcn; +} + +tree_function_def * +octave_parser::finish_function (tree_parameter_list *ret_list, + octave_user_function *fcn, + octave_comment_list *lc) +{ + tree_function_def *retval = 0; + + if (ret_list) + ret_list->mark_as_formal_parameters (); + + if (fcn) + { + std::string nm = fcn->name (); + std::string file = fcn->fcn_file_name (); + + std::string tmp = nm; + if (! file.empty ()) + tmp += ": " + file; + + symbol_table::cache_name (fcn->scope (), tmp); + + if (lc) + fcn->stash_leading_comment (lc); + + fcn->define_ret_list (ret_list); + + if (curr_fcn_depth > 1 || parsing_subfunctions) + { + fcn->mark_as_subfunction (); + + if (endfunction_found && function_scopes.size () > 1) + { + symbol_table::scope_id pscope + = function_scopes[function_scopes.size ()-2]; + + symbol_table::install_nestfunction (nm, octave_value (fcn), + pscope); + } + else + symbol_table::install_subfunction (nm, octave_value (fcn), + primary_fcn_scope); + } + + if (curr_fcn_depth == 1 && fcn) + symbol_table::update_nest (fcn->scope ()); + + if (! reading_fcn_file && curr_fcn_depth == 1) + { + // We are either reading a script file or defining a function + // at the command line, so this definition creates a + // tree_function object that is placed in the parse tree. + // Otherwise, it is just inserted in the symbol table, + // either as a subfunction or nested function (see above), + // or as the primary function for the file, via + // primary_fcn_ptr (see also load_fcn_from_file,, + // parse_fcn_file, and + // symbol_table::fcn_info::fcn_info_rep::find_user_function). + + retval = new tree_function_def (fcn); + } + + // Unmark any symbols that may have been tagged as local + // variables while parsing (for example, by force_local_variable + // in lex.l). + + symbol_table::unmark_forced_variables (fcn->scope ()); + } + + return retval; +} + +void +octave_parser::recover_from_parsing_function (void) +{ + if (parser_symtab_context.empty ()) + panic_impossible (); + + parser_symtab_context.pop (); + + if (reading_fcn_file && curr_fcn_depth == 1 + && ! parsing_subfunctions) + parsing_subfunctions = true; + + curr_fcn_depth--; + function_scopes.pop_back (); + + curr_lexer->defining_func--; + curr_lexer->parsed_function_name.pop (); + curr_lexer->looking_at_return_list = false; + curr_lexer->looking_at_parameter_list = false; +} + +// Make an index expression. + +tree_index_expression * +octave_parser::make_index_expression (tree_expression *expr, + tree_argument_list *args, char type) +{ + tree_index_expression *retval = 0; + + if (args && args->has_magic_tilde ()) + { + bison_error ("invalid use of empty argument (~) in index expression"); + return retval; + } + + int l = expr->line (); + int c = expr->column (); + + expr->mark_postfix_indexed (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast<tree_index_expression *> (expr); + + tmp->append (args, type); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, args, l, c, type); + + return retval; +} + +// Make an indirect reference expression. + +tree_index_expression * +octave_parser::make_indirect_ref (tree_expression *expr, + const std::string& elt) +{ + tree_index_expression *retval = 0; + + int l = expr->line (); + int c = expr->column (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast<tree_index_expression *> (expr); + + tmp->append (elt); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, elt, l, c); + + curr_lexer->looking_at_indirect_ref = false; + + return retval; +} + +// Make an indirect reference expression with dynamic field name. + +tree_index_expression * +octave_parser::make_indirect_ref (tree_expression *expr, tree_expression *elt) +{ + tree_index_expression *retval = 0; + + int l = expr->line (); + int c = expr->column (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast<tree_index_expression *> (expr); + + tmp->append (elt); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, elt, l, c); + + curr_lexer->looking_at_indirect_ref = false; + + return retval; +} + +// Make a declaration command. + +tree_decl_command * +octave_parser::make_decl_command (int tok, token *tok_val, + tree_decl_init_list *lst) +{ + tree_decl_command *retval = 0; + + int l = tok_val->line (); + int c = tok_val->column (); + + switch (tok) + { + case GLOBAL: + retval = new tree_global_command (lst, l, c); + break; + + case PERSISTENT: + if (curr_fcn_depth > 0) + retval = new tree_persistent_command (lst, l, c); + else + { + if (reading_script_file) + warning ("ignoring persistent declaration near line %d of file '%s'", + l, curr_fcn_file_full_name.c_str ()); + else + warning ("ignoring persistent declaration near line %d", l); + } + break; + + default: + panic_impossible (); + break; + } + + return retval; +} + +tree_argument_list * +octave_parser::validate_matrix_row (tree_argument_list *row) +{ + if (row && row->has_magic_tilde ()) + bison_error ("invalid use of tilde (~) in matrix expression"); + return row; +} + +// Finish building a matrix list. + +tree_expression * +octave_parser::finish_matrix (tree_matrix *m) +{ + tree_expression *retval = m; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + if (m->all_elements_are_constant ()) + { + octave_value tmp = m->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, m->line (), m->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + m->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete m; + + retval = tc_retval; + } + } + + return retval; +} + +// Finish building a cell list. + +tree_expression * +octave_parser::finish_cell (tree_cell *c) +{ + return finish_matrix (c); +} + +void +octave_parser::maybe_warn_missing_semi (tree_statement_list *t) +{ + if (curr_fcn_depth > 0) + { + tree_statement *tmp = t->back (); + + if (tmp->is_expression ()) + warning_with_id + ("Octave:missing-semicolon", + "missing semicolon near line %d, column %d in file '%s'", + tmp->line (), tmp->column (), curr_fcn_file_full_name.c_str ()); + } +} + +tree_statement_list * +octave_parser::set_stmt_print_flag (tree_statement_list *list, char sep, + bool warn_missing_semi) +{ + tree_statement *tmp = list->back (); + + switch (sep) + { + case ';': + tmp->set_print_flag (false); + break; + + case 0: + case ',': + case '\n': + tmp->set_print_flag (true); + if (warn_missing_semi) + maybe_warn_missing_semi (list); + break; + + default: + warning ("unrecognized separator type!"); + break; + } + + // Even if a statement is null, we add it to the list then remove it + // here so that the print flag is applied to the correct statement. + + if (tmp->is_null_statement ()) + { + list->pop_back (); + delete tmp; + } + + return list; +} + +tree_statement_list * +octave_parser::make_statement_list (tree_statement *stmt) +{ + return new tree_statement_list (stmt); +} + +tree_statement_list * +octave_parser::append_statement_list (tree_statement_list *list, char sep, + tree_statement *stmt, + bool warn_missing_semi) +{ + set_stmt_print_flag (list, sep, warn_missing_semi); + + list->append (stmt); + + return list; +} + +void +octave_parser::bison_error (const char *s) +{ + int err_col = curr_lexer->current_input_column - 1; + + std::ostringstream output_buf; + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + output_buf << "parse error near line " << curr_lexer->input_line_number + << " of file " << curr_fcn_file_full_name; + else + output_buf << "parse error:"; + + if (s && strcmp (s, "parse error") != 0) + output_buf << "\n\n " << s; + + output_buf << "\n\n"; + + if (! current_input_line.empty ()) + { + size_t len = current_input_line.length (); + + if (current_input_line[len-1] == '\n') + current_input_line.resize (len-1); + + // Print the line, maybe with a pointer near the error token. + + output_buf << ">>> " << current_input_line << "\n"; + + if (err_col == 0) + err_col = len; + + for (int i = 0; i < err_col + 3; i++) + output_buf << " "; + + output_buf << "^"; + } + + output_buf << "\n"; + + std::string msg = output_buf.str (); + + parse_error ("%s", msg.c_str ()); +} + +static void +safe_fclose (FILE *f) +{ + // FIXME -- comments at the end of an input file are + // discarded (otherwise, they would be appended to the next + // statement, possibly from the command line or another file, which + // can be quite confusing). + + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + delete tc; + + if (f) + fclose (static_cast<FILE *> (f)); +} + +static bool +looks_like_copyright (const std::string& s) +{ + bool retval = false; + + if (! s.empty ()) + { + size_t offset = s.find_first_not_of (" \t"); + + retval = (s.substr (offset, 9) == "Copyright" || s.substr (offset, 6) == "Author"); + } + + return retval; +} + +static int +text_getc (FILE *f) +{ + int c = gnulib::getc (f); + + // Convert CRLF into just LF and single CR into LF. + + if (c == '\r') + { + c = gnulib::getc (f); + + if (c != '\n') + { + ungetc (c, f); + c = '\n'; + } + } + + return c; +} + +class +stdio_stream_reader : public stream_reader +{ +public: + + stdio_stream_reader (FILE *f_arg, int& l, int& c) + : stream_reader (), f (f_arg), line_num (l), column_num (c) + { } + + int getc (void) + { + char c = ::text_getc (f); + + if (c == '\n') + { + line_num++; + column_num = 0; + } + else + { + // FIXME -- try to be smarter about tabs? + column_num++; + } + + return c; + } + + int ungetc (int c) + { + if (c == '\n') + { + line_num--; + column_num = 0; + } + else + { + // FIXME -- try to be smarter about tabs? + column_num--; + } + + return ::ungetc (c, f); + } + +private: + + FILE *f; + + int& line_num; + + int& column_num; + + // No copying! + + stdio_stream_reader (const stdio_stream_reader&); + + stdio_stream_reader & operator = (const stdio_stream_reader&); +}; + +static bool +skip_white_space (stream_reader& reader) +{ + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + switch (c) + { + case ' ': + case '\t': + case '\n': + break; + + default: + reader.ungetc (c); + goto done; + } + } + + done: + + return (c == EOF); +} + +static bool +looking_at_classdef_keyword (FILE *ffile) +{ + bool status = false; + + long pos = gnulib::ftell (ffile); + + char buf [10]; + gnulib::fgets (buf, 10, ffile); + size_t len = strlen (buf); + if (len > 8 && strncmp (buf, "classdef", 8) == 0 + && ! (isalnum (buf[8]) || buf[8] == '_')) + status = true; + + gnulib::fseek (ffile, pos, SEEK_SET); + + return status; + } + +static std::string +gobble_leading_white_space (FILE *ffile, bool& eof, int& line_num, + int& column_num) +{ + std::string help_txt; + + eof = false; + + // TRUE means we have already cached the help text. + bool have_help_text = false; + + std::string txt; + + stdio_stream_reader stdio_reader (ffile, line_num, column_num); + + while (true) + { + eof = skip_white_space (stdio_reader); + + if (eof) + break; + + txt = CURR_LEXER->grab_comment_block (stdio_reader, true, eof); + + if (txt.empty ()) + break; + + if (! (have_help_text || looks_like_copyright (txt))) + { + help_txt = txt; + have_help_text = true; + } + + octave_comment_buffer::append (txt); + + if (eof) + break; + } + + return help_txt; +} + +static std::string +gobble_leading_white_space (FILE *ffile, bool& eof) +{ + int line_num = 1; + int column_num = 1; + + return gobble_leading_white_space (ffile, eof, line_num, column_num); +} + +static bool +looking_at_function_keyword (FILE *ffile) +{ + bool status = false; + + long pos = gnulib::ftell (ffile); + + char buf [10]; + gnulib::fgets (buf, 10, ffile); + size_t len = strlen (buf); + if (len > 8 && strncmp (buf, "function", 8) == 0 + && ! (isalnum (buf[8]) || buf[8] == '_')) + status = true; + + gnulib::fseek (ffile, pos, SEEK_SET); + + return status; +} + +static octave_function * +parse_fcn_file (const std::string& ff, const std::string& dispatch_type, + bool require_file, bool force_script, bool autoload, + bool relative_lookup, const std::string& warn_for) +{ + unwind_protect frame; + + octave_function *fcn_ptr = 0; + + // Open function file and parse. + + FILE *in_stream = command_editor::get_input_stream (); + + frame.add_fcn (command_editor::set_input_stream, in_stream); + + frame.protect_var (ff_instream); + + frame.protect_var (reading_fcn_file); + frame.protect_var (line_editing); + + reading_fcn_file = true; + line_editing = false; + + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + + command_history::ignore_entries (); + + FILE *ffile = get_input_from_file (ff, 0); + + frame.add_fcn (safe_fclose, ffile); + + if (ffile) + { + bool eof; + + // octave_parser constructor sets this for us. + frame.protect_var (CURR_LEXER); + + octave_parser *curr_parser = new octave_parser (); + frame.add_fcn (octave_parser::cleanup, curr_parser); + + curr_parser->curr_class_name = dispatch_type; + curr_parser->autoloading = autoload; + curr_parser->fcn_file_from_relative_lookup = relative_lookup; + + std::string help_txt + = gobble_leading_white_space + (ffile, eof, + curr_parser->curr_lexer->input_line_number, + curr_parser->curr_lexer->current_input_column); + + if (! help_txt.empty ()) + help_buf.push (help_txt); + + if (! eof) + { + std::string file_type; + + frame.protect_var (get_input_from_eval_string); + frame.protect_var (reading_fcn_file); + frame.protect_var (reading_script_file); + frame.protect_var (reading_classdef_file); + frame.protect_var (Vecho_executing_commands); + + get_input_from_eval_string = false; + + if (! force_script && looking_at_function_keyword (ffile)) + { + file_type = "function"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = false; + reading_fcn_file = true; + reading_script_file = false; + } + else if (! force_script && looking_at_classdef_keyword (ffile)) + { + file_type = "classdef"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = true; + reading_fcn_file = false; + // FIXME -- Should classdef files be handled as + // scripts or separately? Currently, without setting up + // for reading script files, parsing classdef files + // fails. + reading_script_file = true; + } + else + { + file_type = "script"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = false; + reading_fcn_file = false; + reading_script_file = true; + } + + // Do this with an unwind-protect cleanup function so that + // the forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + if (! help_txt.empty ()) + help_buf.push (help_txt); + + if (reading_script_file) + curr_parser->curr_lexer->prep_for_script_file (); + else + curr_parser->curr_lexer->prep_for_function_file (); + + curr_parser->curr_lexer->parsing_class_method = ! dispatch_type.empty (); + + frame.protect_var (global_command); + + global_command = 0; + + int status = curr_parser->run (); + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + frame.add_fcn (cleanup_statement_list, &global_command); + + fcn_ptr = curr_parser->primary_fcn_ptr; + + if (status != 0) + error ("parse error while reading %s file %s", + file_type.c_str (), ff.c_str ()); + } + else + { + int l = curr_parser->curr_lexer->input_line_number; + int c = curr_parser->curr_lexer->current_input_column; + + tree_statement *end_of_script + = curr_parser->make_end ("endscript", l, c); + + curr_parser->make_script (0, end_of_script); + + fcn_ptr = curr_parser->primary_fcn_ptr; + } + } + else if (require_file) + error ("no such file, '%s'", ff.c_str ()); + else if (! warn_for.empty ()) + error ("%s: unable to open file '%s'", warn_for.c_str (), ff.c_str ()); + + return fcn_ptr; +} + +std::string +get_help_from_file (const std::string& nm, bool& symbol_found, + std::string& file) +{ + std::string retval; + + file = fcn_file_in_path (nm); + + if (! file.empty ()) + { + symbol_found = true; + + FILE *fptr = gnulib::fopen (file.c_str (), "r"); + + if (fptr) + { + unwind_protect frame; + frame.add_fcn (safe_fclose, fptr); + + bool eof; + retval = gobble_leading_white_space (fptr, eof); + + if (retval.empty ()) + { + octave_function *fcn = parse_fcn_file (file, "", true, + false, false, + false, ""); + + if (fcn) + { + retval = fcn->doc_string (); + + delete fcn; + } + } + } + } + + return retval; +} + +std::string +get_help_from_file (const std::string& nm, bool& symbol_found) +{ + std::string file; + return get_help_from_file (nm, symbol_found, file); +} + +std::string +lookup_autoload (const std::string& nm) +{ + std::string retval; + + typedef std::map<std::string, std::string>::const_iterator am_iter; + + am_iter p = autoload_map.find (nm); + + if (p != autoload_map.end ()) + retval = load_path::find_file (p->second); + + return retval; +} + +string_vector +autoloaded_functions (void) +{ + string_vector names (autoload_map.size ()); + + octave_idx_type i = 0; + typedef std::map<std::string, std::string>::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + names[i++] = p->first; + + return names; +} + +string_vector +reverse_lookup_autoload (const std::string& nm) +{ + string_vector names; + + typedef std::map<std::string, std::string>::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + if (nm == p->second) + names.append (p->first); + + return names; +} + +octave_function * +load_fcn_from_file (const std::string& file_name, const std::string& dir_name, + const std::string& dispatch_type, + const std::string& fcn_name, bool autoload) +{ + octave_function *retval = 0; + + unwind_protect frame; + + std::string nm = file_name; + + size_t nm_len = nm.length (); + + std::string file; + + bool relative_lookup = false; + + file = nm; + + if ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") + || (nm_len > 4 && nm.substr (nm_len-4) == ".mex") + || (nm_len > 2 && nm.substr (nm_len-2) == ".m")) + { + nm = octave_env::base_pathname (file); + nm = nm.substr (0, nm.find_last_of ('.')); + + size_t pos = nm.find_last_of (file_ops::dir_sep_str ()); + if (pos != std::string::npos) + nm = nm.substr (pos+1); + } + + relative_lookup = ! octave_env::absolute_pathname (file); + + file = octave_env::make_absolute (file); + + int len = file.length (); + + if (len > 4 && file.substr (len-4, len-1) == ".oct") + { + if (autoload && ! fcn_name.empty ()) + nm = fcn_name; + + retval = octave_dynamic_loader::load_oct (nm, file, relative_lookup); + } + else if (len > 4 && file.substr (len-4, len-1) == ".mex") + { + // Temporarily load m-file version of mex-file, if it exists, + // to get the help-string to use. + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = nm; + curr_fcn_file_full_name = file.substr (0, len - 2); + + octave_function *tmpfcn = parse_fcn_file (file.substr (0, len - 2), + dispatch_type, false, + autoload, autoload, + relative_lookup, ""); + + retval = octave_dynamic_loader::load_mex (nm, file, relative_lookup); + + if (tmpfcn) + retval->document (tmpfcn->doc_string ()); + delete tmpfcn; + } + else if (len > 2) + { + // These are needed by yyparse. + + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = nm; + curr_fcn_file_full_name = file; + + retval = parse_fcn_file (file, dispatch_type, true, autoload, + autoload, relative_lookup, ""); + } + + if (retval) + { + retval->stash_dir_name (dir_name); + + if (retval->is_user_function ()) + { + symbol_table::scope_id id = retval->scope (); + + symbol_table::stash_dir_name_for_subfunctions (id, dir_name); + } + } + + return retval; +} + +DEFUN (autoload, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} autoload (@var{function}, @var{file})\n\ +Define @var{function} to autoload from @var{file}.\n\ +\n\ +The second argument, @var{file}, should be an absolute file name or\n\ +a file name in the same directory as the function or script from which\n\ +the autoload command was run. @var{file} should not depend on the\n\ +Octave load path.\n\ +\n\ +Normally, calls to @code{autoload} appear in PKG_ADD script files that\n\ +are evaluated when a directory is added to the Octave's load path. To\n\ +avoid having to hardcode directory names in @var{file}, if @var{file}\n\ +is in the same directory as the PKG_ADD script then\n\ +\n\ +@example\n\ +autoload (\"foo\", \"bar.oct\");\n\ +@end example\n\ +\n\ +@noindent\n\ +will load the function @code{foo} from the file @code{bar.oct}. The above\n\ +when @code{bar.oct} is not in the same directory or uses like\n\ +\n\ +@example\n\ +autoload (\"foo\", file_in_loadpath (\"bar.oct\"))\n\ +@end example\n\ +\n\ +@noindent\n\ +are strongly discouraged, as their behavior might be unpredictable.\n\ +\n\ +With no arguments, return a structure containing the current autoload map.\n\ +@seealso{PKG_ADD}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + { + Cell func_names (dim_vector (autoload_map.size (), 1)); + Cell file_names (dim_vector (autoload_map.size (), 1)); + + octave_idx_type i = 0; + typedef std::map<std::string, std::string>::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + { + func_names(i) = p->first; + file_names(i) = p->second; + + i++; + } + + octave_map m; + + m.assign ("function", func_names); + m.assign ("file", file_names); + + retval = m; + } + else if (nargin == 2) + { + string_vector argv = args.make_argv ("autoload"); + + if (! error_state) + { + std::string nm = argv[2]; + + if (! octave_env::absolute_pathname (nm)) + { + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + bool found = false; + + if (fcn) + { + std::string fname = fcn->fcn_file_name (); + + if (! fname.empty ()) + { + fname = octave_env::make_absolute (fname); + fname = fname.substr (0, fname.find_last_of (file_ops::dir_sep_str ()) + 1); + + file_stat fs (fname + nm); + + if (fs.exists ()) + { + nm = fname + nm; + found = true; + } + } + } + if (! found) + warning_with_id ("Octave:autoload-relative-file-name", + "autoload: '%s' is not an absolute file name", + nm.c_str ()); + } + autoload_map[argv[1]] = nm; + } + } + else + print_usage (); + + return retval; +} + +void +source_file (const std::string& file_name, const std::string& context, + bool verbose, bool require_file, const std::string& warn_for) +{ + // Map from absolute name of script file to recursion level. We + // use a map instead of simply placing a limit on recursion in the + // source_file function so that two mutually recursive scripts + // written as + // + // foo1.m: + // ------ + // foo2 + // + // foo2.m: + // ------ + // foo1 + // + // and called with + // + // foo1 + // + // (for example) will behave the same if they are written as + // + // foo1.m: + // ------ + // source ("foo2.m") + // + // foo2.m: + // ------ + // source ("foo1.m") + // + // and called with + // + // source ("foo1.m") + // + // (for example). + + static std::map<std::string, int> source_call_depth; + + std::string file_full_name = file_ops::tilde_expand (file_name); + + file_full_name = octave_env::make_absolute (file_full_name); + + unwind_protect frame; + + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = file_name; + curr_fcn_file_full_name = file_full_name; + + if (source_call_depth.find (file_full_name) == source_call_depth.end ()) + source_call_depth[file_full_name] = -1; + + frame.protect_var (source_call_depth[file_full_name]); + + source_call_depth[file_full_name]++; + + if (source_call_depth[file_full_name] >= Vmax_recursion_depth) + { + error ("max_recursion_depth exceeded"); + return; + } + + if (! context.empty ()) + { + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("source: context must be \"caller\" or \"base\""); + + if (! error_state) + frame.add_fcn (octave_call_stack::pop); + } + + if (! error_state) + { + octave_function *fcn = parse_fcn_file (file_full_name, "", + require_file, true, false, + false, warn_for); + + if (! error_state) + { + if (fcn && fcn->is_user_script ()) + { + octave_value_list args; + + if (verbose) + { + std::cout << "executing commands from " << file_full_name << " ... "; + reading_startup_message_printed = true; + std::cout.flush (); + } + + fcn->do_multi_index_op (0, args); + + if (verbose) + std::cout << "done." << std::endl; + + delete fcn; + } + } + else + error ("source: error sourcing file '%s'", + file_full_name.c_str ()); + } +} + +DEFUN (mfilename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mfilename ()\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpath\")\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpathext\")\n\ +Return the name of the currently executing file. At the top-level,\n\ +return the empty string. Given the argument @code{\"fullpath\"},\n\ +include the directory part of the file name, but not the extension.\n\ +Given the argument @code{\"fullpathext\"}, include the directory part\n\ +of the file name and the extension.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin > 1) + { + print_usage (); + return retval; + } + + std::string arg; + + if (nargin == 1) + { + arg = args(0).string_value (); + + if (error_state) + { + error ("mfilename: expecting argument to be a character string"); + return retval; + } + } + + std::string fname; + + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + if (fcn) + { + fname = fcn->fcn_file_name (); + + if (fname.empty ()) + fname = fcn->name (); + } + + if (arg == "fullpathext") + retval = fname; + else + { + size_t dpos = fname.rfind (file_ops::dir_sep_char ()); + size_t epos = fname.rfind ('.'); + + if (epos <= dpos) + epos = std::string::npos; + + fname = (epos != std::string::npos) ? fname.substr (0, epos) : fname; + + if (arg == "fullpath") + retval = fname; + else + retval = (dpos != std::string::npos) ? fname.substr (dpos+1) : fname; + } + + return retval; +} + + +DEFUN (source, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} source (@var{file})\n\ +Parse and execute the contents of @var{file}. This is equivalent to\n\ +executing commands from a script file, but without requiring the file to\n\ +be named @file{@var{file}.m}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string file_name = args(0).string_value (); + + if (! error_state) + { + std::string context; + + if (nargin == 2) + context = args(1).string_value (); + + if (! error_state) + source_file (file_name, context); + else + error ("source: expecting context to be character string"); + } + else + error ("source: expecting file name as argument"); + } + else + print_usage (); + + return retval; +} + +// Evaluate an Octave function (built-in or interpreted) and return +// the list of result values. NAME is the name of the function to +// call. ARGS are the arguments to the function. NARGOUT is the +// number of output arguments expected. + +octave_value_list +feval (const std::string& name, const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + octave_value fcn = symbol_table::find_function (name, args); + + if (fcn.is_defined ()) + retval = fcn.do_multi_index_op (nargout, args); + else + { + maybe_missing_function_hook (name); + if (! error_state) + error ("feval: function '%s' not found", name.c_str ()); + } + + return retval; +} + +octave_value_list +feval (octave_function *fcn, const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + if (fcn) + retval = fcn->do_multi_index_op (nargout, args); + + return retval; +} + +static octave_value_list +get_feval_args (const octave_value_list& args) +{ + return args.slice (1, args.length () - 1, true); +} + + +// Evaluate an Octave function (built-in or interpreted) and return +// the list of result values. The first element of ARGS should be a +// string containing the name of the function to call, then the rest +// are the actual arguments to the function. NARGOUT is the number of +// output arguments expected. + +octave_value_list +feval (const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + octave_value f_arg = args(0); + + if (f_arg.is_string ()) + { + std::string name = f_arg.string_value (); + + if (! error_state) + { + octave_value_list tmp_args = get_feval_args (args); + + retval = feval (name, tmp_args, nargout); + } + } + else if (f_arg.is_function_handle () + || f_arg.is_anonymous_function () + || f_arg.is_inline_function ()) + { + const octave_value_list tmp_args = get_feval_args (args); + + retval = f_arg.do_multi_index_op (nargout, tmp_args); + } + else + error ("feval: first argument must be a string, inline function or a function handle"); + } + + return retval; +} + +DEFUN (feval, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} feval (@var{name}, @dots{})\n\ +Evaluate the function named @var{name}. Any arguments after the first\n\ +are passed on to the named function. For example,\n\ +\n\ +@example\n\ +@group\n\ +feval (\"acos\", -1)\n\ + @result{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +calls the function @code{acos} with the argument @samp{-1}.\n\ +\n\ +The function @code{feval} can also be used with function handles of\n\ +any sort (@pxref{Function Handles}). Historically, @code{feval} was\n\ +the only way to call user-supplied functions in strings, but\n\ +function handles are now preferred due to the cleaner syntax they\n\ +offer. For example,\n\ +\n\ +@example\n\ +@group\n\ +@var{f} = @@exp;\n\ +feval (@var{f}, 1)\n\ + @result{} 2.7183\n\ +@var{f} (1)\n\ + @result{} 2.7183\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +are equivalent ways to call the function referred to by @var{f}. If it\n\ +cannot be predicted beforehand that @var{f} is a function handle or the\n\ +function name in a string, @code{feval} can be used instead.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + retval = feval (args, nargout); + else + print_usage (); + + return retval; +} + +DEFUN (builtin, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@dots{}]} builtin (@var{f}, @dots{})\n\ +Call the base function @var{f} even if @var{f} is overloaded to\n\ +another function for the given type signature.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + const std::string name (args(0).string_value ()); + + if (! error_state) + { + octave_value fcn = symbol_table::builtin_find (name); + + if (fcn.is_defined ()) + retval = feval (fcn.function_value (), args.splice (0, 1), + nargout); + else + error ("builtin: lookup for symbol '%s' failed", name.c_str ()); + } + else + error ("builtin: function name (F) must be a string"); + } + else + print_usage (); + + return retval; +} + +octave_value_list +eval_string (const std::string& s, bool silent, int& parse_status, int nargout) +{ + octave_value_list retval; + + unwind_protect frame; + + // octave_parser constructor sets this for us. + frame.protect_var (CURR_LEXER); + + octave_parser *curr_parser = new octave_parser (); + frame.add_fcn (octave_parser::cleanup, curr_parser); + + frame.protect_var (get_input_from_eval_string); + frame.protect_var (line_editing); + frame.protect_var (current_eval_string); + frame.protect_var (reading_fcn_file); + frame.protect_var (reading_script_file); + frame.protect_var (reading_classdef_file); + + get_input_from_eval_string = true; + line_editing = false; + reading_fcn_file = false; + reading_script_file = false; + reading_classdef_file = false; + + current_eval_string = s; + + do + { + curr_parser->reset (); + + frame.protect_var (global_command); + + global_command = 0; + + // Do this with an unwind-protect cleanup function so that the + // forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + parse_status = curr_parser->run (); + + tree_statement_list *command_list = global_command; + + // Unmark forced variables. + // Restore previous value of global_command. + frame.run (2); + + if (parse_status == 0) + { + if (command_list) + { + unwind_protect inner_frame; + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + inner_frame.add_fcn (cleanup_statement_list, &command_list); + + tree_statement *stmt = 0; + + if (command_list->length () == 1 + && (stmt = command_list->front ()) + && stmt->is_expression ()) + { + tree_expression *expr = stmt->expression (); + + if (silent) + expr->set_print_flag (false); + + bool do_bind_ans = false; + + if (expr->is_identifier ()) + { + tree_identifier *id + = dynamic_cast<tree_identifier *> (expr); + + do_bind_ans = (! id->is_variable ()); + } + else + do_bind_ans = (! expr->is_assignment_expression ()); + + retval = expr->rvalue (nargout); + + if (do_bind_ans && ! (error_state || retval.empty ())) + bind_ans (retval(0), expr->print_result ()); + + if (nargout == 0) + retval = octave_value_list (); + } + else if (nargout == 0) + command_list->accept (*current_evaluator); + else + error ("eval: invalid use of statement list"); + + if (error_state + || tree_return_command::returning + || tree_break_command::breaking + || tree_continue_command::continuing) + break; + } + else if (curr_parser->curr_lexer->end_of_input) + break; + } + } + while (parse_status == 0); + + return retval; +} + +octave_value +eval_string (const std::string& s, bool silent, int& parse_status) +{ + octave_value retval; + + octave_value_list tmp = eval_string (s, silent, parse_status, 1); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +static octave_value_list +eval_string (const octave_value& arg, bool silent, int& parse_status, + int nargout) +{ + std::string s = arg.string_value (); + + if (error_state) + { + error ("eval: expecting std::string argument"); + return octave_value (-1); + } + + return eval_string (s, silent, parse_status, nargout); +} + +void +cleanup_statement_list (tree_statement_list **lst) +{ + if (*lst) + { + delete *lst; + *lst = 0; + } +} + +DEFUN (eval, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eval (@var{try})\n\ +@deftypefnx {Built-in Function} {} eval (@var{try}, @var{catch})\n\ +Parse the string @var{try} and evaluate it as if it were an Octave\n\ +program. If that fails, evaluate the optional string @var{catch}.\n\ +The string @var{try} is evaluated in the current context,\n\ +so any results remain available after @code{eval} returns.\n\ +\n\ +The following example makes the variable @var{a} with the approximate\n\ +value 3.1416 available.\n\ +\n\ +@example\n\ +eval (\"a = acos(-1);\");\n\ +@end example\n\ +\n\ +If an error occurs during the evaluation of @var{try} the @var{catch}\n\ +string is evaluated, as the following example shows:\n\ +\n\ +@example\n\ +@group\n\ +eval ('error (\"This is a bad example\");',\n\ + 'printf (\"This error occurred:\\n%s\\n\", lasterr ());');\n\ + @print{} This error occurred:\n\ + This is a bad example\n\ +@end group\n\ +@end example\n\ +\n\ +Consider using try/catch blocks instead if you are only using @code{eval}\n\ +as an error-capturing mechanism rather than for the execution of arbitrary\n\ +code strings.\n\ +@seealso{evalin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + unwind_protect frame; + + if (nargin > 1) + { + frame.protect_var (buffer_error_messages); + buffer_error_messages++; + } + + int parse_status = 0; + + octave_value_list tmp = eval_string (args(0), nargout > 0, + parse_status, nargout); + + if (nargin > 1 && (parse_status != 0 || error_state)) + { + error_state = 0; + + // Set up for letting the user print any messages from + // errors that occurred in the first part of this eval(). + + buffer_error_messages--; + + tmp = eval_string (args(1), nargout > 0, parse_status, nargout); + + if (nargout > 0) + retval = tmp; + } + else if (nargout > 0) + retval = tmp; + } + else + print_usage (); + + return retval; +} + +/* + +%!shared x +%! x = 1; + +%!assert (eval ("x"), 1) +%!assert (eval ("x;")) +%!assert (eval ("x;"), 1); + +%!test +%! y = eval ("x"); +%! assert (y, 1); + +%!test +%! y = eval ("x;"); +%! assert (y, 1); + +%!test +%! eval ("x = 1;") +%! assert (x,1); + +%!test +%! eval ("flipud = 2;"); +%! assert (flipud, 2); + +%!function y = __f () +%! eval ("flipud = 2;"); +%! y = flipud; +%!endfunction +%!assert (__f(), 2) + +% bug #35645 +%!test +%! [a,] = gcd (1,2); +%! [a,b,] = gcd (1, 2); + +*/ + +DEFUN (assignin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} assignin (@var{context}, @var{varname}, @var{value})\n\ +Assign @var{value} to @var{varname} in context @var{context}, which\n\ +may be either @code{\"base\"} or @code{\"caller\"}.\n\ +@seealso{evalin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3) + { + std::string context = args(0).string_value (); + + if (! error_state) + { + unwind_protect frame; + + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("assignin: CONTEXT must be \"caller\" or \"base\""); + + if (! error_state) + { + frame.add_fcn (octave_call_stack::pop); + + std::string nm = args(1).string_value (); + + if (! error_state) + { + if (valid_identifier (nm)) + symbol_table::varref (nm) = args(2); + else + error ("assignin: invalid variable name in argument VARNAME"); + } + else + error ("assignin: VARNAME must be a string"); + } + } + else + error ("assignin: CONTEXT must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (evalin, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} evalin (@var{context}, @var{try})\n\ +@deftypefnx {Built-in Function} {} evalin (@var{context}, @var{try}, @var{catch})\n\ +Like @code{eval}, except that the expressions are evaluated in the\n\ +context @var{context}, which may be either @code{\"caller\"} or\n\ +@code{\"base\"}.\n\ +@seealso{eval, assignin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 1) + { + std::string context = args(0).string_value (); + + if (! error_state) + { + unwind_protect frame; + + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("evalin: CONTEXT must be \"caller\" or \"base\""); + + if (! error_state) + { + frame.add_fcn (octave_call_stack::pop); + + if (nargin > 2) + { + frame.protect_var (buffer_error_messages); + buffer_error_messages++; + } + + int parse_status = 0; + + octave_value_list tmp = eval_string (args(1), nargout > 0, + parse_status, nargout); + + if (nargout > 0) + retval = tmp; + + if (nargin > 2 && (parse_status != 0 || error_state)) + { + error_state = 0; + + // Set up for letting the user print any messages from + // errors that occurred in the first part of this eval(). + + buffer_error_messages--; + + tmp = eval_string (args(2), nargout > 0, + parse_status, nargout); + + retval = (nargout > 0) ? tmp : octave_value_list (); + } + } + } + else + error ("evalin: CONTEXT must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__parser_debug_flag__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{old_val} =} __parser_debug_flag__ (@var{new_val}))\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + bool debug_flag = octave_debug; + + retval = set_internal_variable (debug_flag, args, nargout, + "__parser_debug_flag__"); + + octave_debug = debug_flag; + + return retval; +}