Mercurial > octave-nkf
changeset 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 | 40a9a4e0d12a |
children | 6f83158c714c |
files | build-aux/common.mk libinterp/Makefile.am libinterp/find-defun-files.sh libinterp/parse-tree/module.mk libinterp/parse-tree/oct-parse.in.yy libinterp/parse-tree/oct-parse.yy m4/acinclude.m4 |
diffstat | 7 files changed, 4668 insertions(+), 4593 deletions(-) [+] |
line wrap: on
line diff
--- a/build-aux/common.mk Sat Mar 02 07:59:25 2013 -0800 +++ b/build-aux/common.mk Sat Mar 02 12:26:42 2013 -0500 @@ -44,6 +44,7 @@ YACC = @YACC@ AM_YFLAGS = -dv +BISON_PUSH_PULL_DECL_STYLE = @BISON_PUSH_PULL_DECL_STYLE@ GPERF = @GPERF@
--- a/libinterp/Makefile.am Sat Mar 02 07:59:25 2013 -0800 +++ b/libinterp/Makefile.am Sat Mar 02 12:26:42 2013 -0500 @@ -65,7 +65,8 @@ BUILT_DISTFILES = \ parse-tree/oct-gperf.h \ - parse-tree/oct-parse.h + parse-tree/oct-parse.h \ + parse-tree/oct-parse.yy ## Files that are created during build process and installed, ## BUT not distributed in tarball. @@ -97,6 +98,7 @@ mkdefs \ mkops \ oct-conf.in.h \ + oct-parse.in.yy \ version.in.h \ $(BUILT_DISTFILES) @@ -196,7 +198,11 @@ $(LIBOCTINTERP_LINK_OPTS) ## Section for defining and creating DEF_FILES -SRC_DEF_FILES := $(shell $(srcdir)/find-defun-files.sh "$(srcdir)" $(DIST_SRC)) + +ULT_DIST_SRC := \ + $(filter-out parse-tree/oct-parse.yy, $(DIST_SRC)) parse-tree/oct-parse.in.yy + +SRC_DEF_FILES := $(shell $(srcdir)/find-defun-files.sh "$(srcdir)" $(ULT_DIST_SRC)) DLDFCN_DEF_FILES = $(DLDFCN_SRC:.cc=.df) @@ -236,7 +242,7 @@ ## Rules to build test files -TST_FILES_SRC := $(shell $(top_srcdir)/build-aux/find-files-with-tests.sh "$(srcdir)" $(DIST_SRC) $(DLDFCN_SRC)) +TST_FILES_SRC := $(shell $(top_srcdir)/build-aux/find-files-with-tests.sh "$(srcdir)" $(ULT_DIST_SRC) $(DLDFCN_SRC)) TST_FILES := $(addsuffix -tst,$(TST_FILES_SRC))
--- a/libinterp/find-defun-files.sh Sat Mar 02 07:59:25 2013 -0800 +++ b/libinterp/find-defun-files.sh Sat Mar 02 12:26:42 2013 -0500 @@ -21,6 +21,6 @@ file="$srcdir/$arg" fi if [ "`$EGREP -l "$DEFUN_PATTERN" $file`" ]; then - echo "$file" | $SED "s,\\$srcdir/,," | $SED 's/\.cc$/.df/; s/\.ll$/.df/; s/\.yy$/.df/'; + echo "$file" | $SED "s,\\$srcdir/,," | $SED 's/\.cc$/.df/; s/\.ll$/.df/; s/\.in.yy$/.df/'; fi done
--- a/libinterp/parse-tree/module.mk Sat Mar 02 07:59:25 2013 -0800 +++ b/libinterp/parse-tree/module.mk Sat Mar 02 12:26:42 2013 -0500 @@ -92,6 +92,18 @@ mv $@-t $@ rm -f $@-t1 +parse-tree/oct-parse.yy: parse-tree/oct-parse.in.yy + case "$(BISON_PUSH_PULL_DECL_STYLE)" in \ + *quote*) quote='"' ;; \ + *) quote="" ;; \ + esac; \ + case "$(BISON_PUSH_PULL_DECL_STYLE)" in \ + *dash*) decl="%define api.push-pull $${quote}both$${quote}"; ;; \ + *underscore*) decl="%define api.push_pull $${quote}both$${quote}"; ;; \ + esac; \ + $(SED) "s/%PUSH_PULL_DECL%/$$decl/" $< > $@-t + mv $@-t $@ + noinst_LTLIBRARIES += parse-tree/libparse-tree.la parse_tree_libparse_tree_la_SOURCES = $(PARSE_TREE_SRC)
--- /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; +}
--- a/libinterp/parse-tree/oct-parse.yy Sat Mar 02 07:59:25 2013 -0800 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4589 +0,0 @@ -/* - -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 -%define api.push-pull both -%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; -}
--- a/m4/acinclude.m4 Sat Mar 02 07:59:25 2013 -0800 +++ b/m4/acinclude.m4 Sat Mar 02 12:26:42 2013 -0500 @@ -1405,6 +1405,62 @@ AC_PROG_YACC case "$YACC" in bison*) + AC_CACHE_CHECK([syntax of bison push/pull declaration], + [octave_cv_bison_push_pull_decl_style], [ + style="dash underscore" + quote="noquote quote" + for s in $style; do + for q in $quote; do + if test $s = "dash"; then + def="%define api.push-pull" + else + def="%define api.push_pull" + fi + if test $q = "quote"; then + def="$def \"both\"" + else + def="$def both" + fi + cat << EOF > conftest.yy +$def +%start input +%% +input:; +%% +EOF + $YACC conftest.yy > /dev/null 2>&1 + ac_status=$? + if test $ac_status -eq 0; then + if test $q = noquote; then + q= + fi + octave_cv_bison_push_pull_decl_style="$s $q" + break + fi + done + if test $ac_status -eq 0; then + break + fi + done + rm -f conftest.yy y.tab.h + ]) + ;; + esac + + AC_SUBST(BISON_PUSH_PULL_DECL_STYLE, $octave_cv_bison_push_pull_decl_style) + + if test -z "$octave_cv_bison_push_pull_decl_style"; then + YACC= + warn_bison_push_pull_decl_style=" + +I wasn't able to find a suitable style for declaring a push-pull +parser in a bison input file so I'm disabling bison. +" + OCTAVE_CONFIGURE_WARNING([warn_bison_push_pull_decl_style]) + fi + + case "$YACC" in + bison*) ;; *) YACC='$(top_srcdir)/build-aux/missing bison'