Mercurial > octave-nkf
changeset 15085:28f5f4a4a80a
maint: Move parser code and rules to parse-tree/ directory
* src/Makefile.am: Remove rules for parser code.
* parse-tree/module.mk: Add rules for parser code.
* lex.h, lex.ll, oct-parse.yy, parse-private.h, parse.h: Move
files from src/ to parse-tree/ directory.
author | Rik <rik@octave.org> |
---|---|
date | Thu, 02 Aug 2012 17:10:26 -0700 |
parents | ea5e02b14853 |
children | a782752adcf3 |
files | src/Makefile.am src/lex.h src/lex.ll src/oct-parse.yy src/parse-private.h src/parse-tree/lex.h src/parse-tree/lex.ll src/parse-tree/module.mk src/parse-tree/oct-parse.yy src/parse-tree/parse-private.h src/parse-tree/parse.h src/parse.h |
diffstat | 12 files changed, 8986 insertions(+), 9001 deletions(-) [+] |
line wrap: on
line diff
--- a/src/Makefile.am Thu Aug 02 16:33:24 2012 -0700 +++ b/src/Makefile.am Thu Aug 02 17:10:26 2012 -0700 @@ -68,12 +68,12 @@ defaults.h \ graphics.h \ graphics-props.cc \ - lex.cc \ + parse-tree/lex.cc \ mxarray.h \ oct-conf.h \ oct-errno.cc \ oct-gperf.h \ - oct-parse.cc \ + parse-tree/oct-parse.cc \ ops.cc \ version.h \ builtins.cc @@ -122,20 +122,6 @@ version.in.h \ $(BUILT_DISTFILES) -#OPT_HANDLERS = \ -# DASPK-opts.cc \ -# DASRT-opts.cc \ -# DASSL-opts.cc \ -# LSODE-opts.cc \ -# Quad-opts.cc -# -#OPT_INC = \ -# ../liboctave/DASPK-opts.h \ -# ../liboctave/DASRT-opts.h \ -# ../liboctave/DASSL-opts.h \ -# ../liboctave/LSODE-opts.h \ -# ../liboctave/Quad-opts.h - JIT_INCLUDES = \ jit-util.h \ jit-typeinfo.h \ @@ -165,7 +151,6 @@ gripes.h \ help.h \ input.h \ - lex.h \ load-path.h \ load-save.h \ ls-ascii-helper.h \ @@ -196,8 +181,6 @@ octave.h \ ops.h \ pager.h \ - parse.h \ - parse-private.h \ pr-output.h \ procstream.h \ profiler.h \ @@ -256,7 +239,6 @@ gripes.cc \ help.cc \ input.cc \ - lex.ll \ load-path.cc \ load-save.cc \ ls-ascii-helper.cc \ @@ -275,7 +257,6 @@ oct-lvalue.cc \ oct-map.cc \ oct-obj.cc \ - oct-parse.yy \ oct-prcstrm.cc \ oct-procbuf.cc \ oct-stream.cc \ @@ -475,13 +456,6 @@ fi mv $@-t $@ -#$(OPT_HANDLERS) : %.cc : $(top_srcdir)/liboctave/%.in $(top_srcdir)/build-aux/mk-opts.pl -# $(PERL) $(top_srcdir)/build-aux/mk-opts.pl --opt-handler-fcns $< > $@-t -# mv $@-t $@ -# -#$(OPT_INC) : %.h : %.in -# $(MAKE) -C $(@D) $(@F) - if AMCOND_ENABLE_DYNAMIC_LINKING DLDFCN_PKG_ADD_FILE = dldfcn/PKG_ADD @@ -490,9 +464,6 @@ mv $@-t $@ endif -lex.lo lex.o oct-parse.lo oct-parse.o: \ - AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) - __fltk_uigetfile__.lo __fltk_uigetfile__.o: \ AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS))
--- a/src/lex.h Thu Aug 02 16:33:24 2012 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 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/>. - -*/ - -#if !defined (octave_lex_h) -#define octave_lex_h 1 - -#include <list> -#include <stack> - -// FIXME -- these input buffer things should be members of a -// parser input stream class. - -typedef struct yy_buffer_state *YY_BUFFER_STATE; - -// Associate a buffer with a new file to read. -extern OCTINTERP_API YY_BUFFER_STATE create_buffer (FILE *f); - -// Report the current buffer. -extern OCTINTERP_API YY_BUFFER_STATE current_buffer (void); - -// Connect to new buffer buffer. -extern OCTINTERP_API void switch_to_buffer (YY_BUFFER_STATE buf); - -// Delete a buffer. -extern OCTINTERP_API void delete_buffer (YY_BUFFER_STATE buf); - -extern OCTINTERP_API void clear_all_buffers (void); - -extern OCTINTERP_API void cleanup_parser (void); - -// Is the given string a keyword? -extern bool is_keyword (const std::string& s); - -extern void prep_lexer_for_script_file (void); -extern void prep_lexer_for_function_file (void); - -// For communication between the lexer and parser. - -class -lexical_feedback -{ -public: - - lexical_feedback (void) - - : bracketflag (0), braceflag (0), looping (0), - convert_spaces_to_comma (true), at_beginning_of_statement (true), - defining_func (0), looking_at_function_handle (0), - looking_at_anon_fcn_args (true), - looking_at_return_list (false), looking_at_parameter_list (false), - looking_at_decl_list (false), looking_at_initializer_expression (false), - looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), - looking_for_object_index (false), do_comma_insert (false), - looking_at_indirect_ref (false), parsed_function_name (), - parsing_class_method (false), maybe_classdef_get_set_method (false), - parsing_classdef (false), quote_is_transpose (false), - pending_local_variables () - - { - init (); - } - - ~lexical_feedback (void) { } - - void init (void); - - // Square bracket level count. - int bracketflag; - - // Curly brace level count. - int braceflag; - - // TRUE means we're in the middle of defining a loop. - int looping; - - // TRUE means that we should convert spaces to a comma inside a - // matrix definition. - bool convert_spaces_to_comma; - - // TRUE means we are at the beginning of a statement, where a - // command name is possible. - bool at_beginning_of_statement; - - // Nonzero means we're in the middle of defining a function. - int defining_func; - - // Nonzero means we are parsing a function handle. - int looking_at_function_handle; - - // TRUE means we are parsing an anonymous function argument list. - bool looking_at_anon_fcn_args; - - // TRUE means we're parsing the return list for a function. - bool looking_at_return_list; - - // TRUE means we're parsing the parameter list for a function. - bool looking_at_parameter_list; - - // TRUE means we're parsing a declaration list (global or - // persistent). - bool looking_at_decl_list; - - // TRUE means we are looking at the initializer expression for a - // parameter list element. - bool looking_at_initializer_expression; - - // TRUE means we're parsing a matrix or the left hand side of - // multi-value assignment statement. - bool looking_at_matrix_or_assign_lhs; - - // If the front of the list is TRUE, the closest paren, brace, or - // bracket nesting is an index for an object. - std::list<bool> looking_at_object_index; - - // Object index not possible until we've seen something. - bool looking_for_object_index; - - // GAG. Stupid kludge so that [[1,2][3,4]] will work. - bool do_comma_insert; - - // TRUE means we're looking at an indirect reference to a - // structure element. - bool looking_at_indirect_ref; - - // If the top of the stack is TRUE, then we've already seen the name - // of the current function. Should only matter if - // current_function_level > 0 - std::stack<bool> parsed_function_name; - - // TRUE means we are parsing a class method in function or classdef file. - bool parsing_class_method; - - // TRUE means we are parsing a class method declaration line in a - // classdef file and can accept a property get or set method name. - // For example, "get.PropertyName" is recognized as a function name. - bool maybe_classdef_get_set_method; - - // TRUE means we are parsing a classdef file - bool parsing_classdef; - - // Return transpose or start a string? - bool quote_is_transpose; - - // Set of identifiers that might be local variable names. - std::set<std::string> pending_local_variables; - -private: - - lexical_feedback (const lexical_feedback&); - - lexical_feedback& operator = (const lexical_feedback&); -}; - -class -stream_reader -{ -public: - virtual int getc (void) = 0; - virtual int ungetc (int c) = 0; - -protected: - stream_reader (void) { } - ~stream_reader (void) { } - -private: - - // No copying! - stream_reader (const stream_reader&); - stream_reader& operator = (const stream_reader&); -}; - -extern std::string -grab_comment_block (stream_reader& reader, bool at_bol, bool& eof); - -// TRUE means that we have encountered EOF on the input stream. -extern bool parser_end_of_input; - -// Flags that need to be shared between the lexer and parser. -extern lexical_feedback lexer_flags; - -#endif
--- a/src/lex.ll Thu Aug 02 16:33:24 2012 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3822 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 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/>. - -*/ - -%option prefix = "octave_" - -%top { -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -} - -%s COMMAND_START -%s MATRIX_START - -%x SCRIPT_FILE_BEGIN -%x FUNCTION_FILE_BEGIN - -%{ - -#include <cctype> -#include <cstring> - -#include <iostream> -#include <set> -#include <sstream> -#include <string> -#include <stack> - -#include <sys/types.h> -#include <unistd.h> - -#include "cmd-edit.h" -#include "quit.h" -#include "lo-mappers.h" - -// These would be alphabetical, but y.tab.h must be included before -// oct-gperf.h and y.tab.h must be included after token.h and the tree -// class declarations. We can't include y.tab.h in oct-gperf.h -// because it may not be protected to allow it to be included multiple -// times. - -#include "Cell.h" -#include "comment-list.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "lex.h" -#include "ov.h" -#include "parse.h" -#include "parse-private.h" -#include "pt-all.h" -#include "symtab.h" -#include "token.h" -#include "toplev.h" -#include "utils.h" -#include "variables.h" -#include <oct-parse.h> -#include <oct-gperf.h> - -#if defined (GNULIB_NAMESPACE) -// Calls to the following functions appear in the generated output from -// flex without the namespace tag. Redefine them so we will use them -// via the gnulib namespace. -#define fprintf GNULIB_NAMESPACE::fprintf -#define fwrite GNULIB_NAMESPACE::fwrite -#define isatty GNULIB_NAMESPACE::isatty -#define malloc GNULIB_NAMESPACE::malloc -#define realloc GNULIB_NAMESPACE::realloc -#endif - -#if ! (defined (FLEX_SCANNER) \ - && defined (YY_FLEX_MAJOR_VERSION) && YY_FLEX_MAJOR_VERSION >= 2 \ - && defined (YY_FLEX_MINOR_VERSION) && YY_FLEX_MINOR_VERSION >= 5) -#error lex.l requires flex version 2.5.4 or later -#endif - -#define yylval octave_lval - -// Arrange to get input via readline. - -#ifdef YY_INPUT -#undef YY_INPUT -#endif -#define YY_INPUT(buf, result, max_size) \ - if ((result = octave_read (buf, max_size)) < 0) \ - YY_FATAL_ERROR ("octave_read () in flex scanner failed"); - -// Try to avoid crashing out completely on fatal scanner errors. -// The call to yy_fatal_error should never happen, but it avoids a -// `static function defined but not used' warning from gcc. - -#ifdef YY_FATAL_ERROR -#undef YY_FATAL_ERROR -#endif -#define YY_FATAL_ERROR(msg) \ - do \ - { \ - error (msg); \ - OCTAVE_QUIT; \ - yy_fatal_error (msg); \ - } \ - while (0) - -#define DISPLAY_TOK_AND_RETURN(tok) \ - do \ - { \ - int tok_val = tok; \ - if (Vdisplay_tokens) \ - display_token (tok_val); \ - if (lexer_debug_flag) \ - { \ - std::cerr << "R: "; \ - display_token (tok_val); \ - std::cerr << std::endl; \ - } \ - return tok_val; \ - } \ - while (0) - -#define COUNT_TOK_AND_RETURN(tok) \ - do \ - { \ - Vtoken_count++; \ - DISPLAY_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define TOK_RETURN(tok) \ - do \ - { \ - current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = false; \ - lexer_flags.convert_spaces_to_comma = true; \ - COUNT_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define TOK_PUSH_AND_RETURN(name, tok) \ - do \ - { \ - yylval.tok_val = new token (name, input_line_number, \ - current_input_column); \ - token_stack.push (yylval.tok_val); \ - TOK_RETURN (tok); \ - } \ - while (0) - -#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ - do \ - { \ - yylval.tok_val = new token (input_line_number, current_input_column); \ - token_stack.push (yylval.tok_val); \ - current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = qit; \ - lexer_flags.convert_spaces_to_comma = convert; \ - lexer_flags.looking_for_object_index = false; \ - lexer_flags.at_beginning_of_statement = bos; \ - COUNT_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ - do \ - { \ - gripe_matlab_incompatible_operator (yytext); \ - BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ - } \ - while (0) - -#define BIN_OP_RETURN(tok, convert, bos) \ - do \ - { \ - BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ - } \ - while (0) - -#define XBIN_OP_RETURN(tok, convert, bos) \ - do \ - { \ - gripe_matlab_incompatible_operator (yytext); \ - BIN_OP_RETURN (tok, convert, bos); \ - } \ - while (0) - -#define LEXER_DEBUG(pattern) \ - do \ - { \ - if (lexer_debug_flag) \ - lexer_debug (pattern, yytext); \ - } \ - while (0) - -// TRUE means that we have encountered EOF on the input stream. -bool parser_end_of_input = false; - -// Flags that need to be shared between the lexer and parser. -lexical_feedback lexer_flags; - -// Stack to hold tokens so that we can delete them when the parser is -// reset and avoid growing forever just because we are stashing some -// information. This has to appear before lex.h is included, because -// one of the macros defined there uses token_stack. -// -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::stack <token*> token_stack; - -// Did eat_whitespace() eat a space or tab, or a newline, or both? - -typedef int yum_yum; - -const yum_yum ATE_NOTHING = 0; -const yum_yum ATE_SPACE_OR_TAB = 1; -const yum_yum ATE_NEWLINE = 2; - -// Is the closest nesting level a square bracket, squiggly brace or a paren? - -class bracket_brace_paren_nesting_level -{ -public: - - bracket_brace_paren_nesting_level (void) : context () { } - - ~bracket_brace_paren_nesting_level (void) { } - - void bracket (void) { context.push (BRACKET); } - bool is_bracket (void) - { return ! context.empty () && context.top () == BRACKET; } - - void brace (void) { context.push (BRACE); } - bool is_brace (void) - { return ! context.empty () && context.top () == BRACE; } - - void paren (void) { context.push (PAREN); } - bool is_paren (void) - { return ! context.empty () && context.top () == PAREN; } - - bool is_bracket_or_brace (void) - { return (! context.empty () - && (context.top () == BRACKET || context.top () == BRACE)); } - - bool none (void) { return context.empty (); } - - void remove (void) { if (! context.empty ()) context.pop (); } - - void clear (void) { while (! context.empty ()) context.pop (); } - -private: - - std::stack<int> context; - - static const int BRACKET; - static const int BRACE; - static const int PAREN; - - bracket_brace_paren_nesting_level (const bracket_brace_paren_nesting_level&); - - bracket_brace_paren_nesting_level& - operator = (const bracket_brace_paren_nesting_level&); -}; - -const int bracket_brace_paren_nesting_level::BRACKET = 1; -const int bracket_brace_paren_nesting_level::BRACE = 2; -const int bracket_brace_paren_nesting_level::PAREN = 3; - -static bracket_brace_paren_nesting_level nesting_level; - -static bool Vdisplay_tokens = false; - -static unsigned int Vtoken_count = 0; - -// The start state that was in effect when the beginning of a block -// comment was noticed. -static int block_comment_nesting_level = 0; - -// Internal variable for lexer debugging state. -static bool lexer_debug_flag = false; - -// Forward declarations for functions defined at the bottom of this -// file. - -static int text_yyinput (void); -static void xunput (char c, char *buf); -static void fixup_column_count (char *s); -static void do_comma_insert_check (void); -static int is_keyword_token (const std::string& s); -static int process_comment (bool start_in_block, bool& eof); -static bool match_any (char c, const char *s); -static bool next_token_is_sep_op (void); -static bool next_token_is_bin_op (bool spc_prev); -static bool next_token_is_postfix_unary_op (bool spc_prev); -static std::string strip_trailing_whitespace (char *s); -static void handle_number (void); -static int handle_string (char delim); -static int handle_close_bracket (bool spc_gobbled, int bracket_type); -static int handle_superclass_identifier (void); -static int handle_meta_identifier (void); -static int handle_identifier (void); -static bool have_continuation (bool trailing_comments_ok = true); -static bool have_ellipsis_continuation (bool trailing_comments_ok = true); -static void scan_for_comments (const char *); -static yum_yum eat_whitespace (void); -static yum_yum eat_continuation (void); -static void maybe_warn_separator_insert (char sep); -static void gripe_single_quote_string (void); -static void gripe_matlab_incompatible (const std::string& msg); -static void maybe_gripe_matlab_incompatible_comment (char c); -static void gripe_matlab_incompatible_continuation (void); -static void gripe_matlab_incompatible_operator (const std::string& op); -static void display_token (int tok); -static void lexer_debug (const char *pattern, const char *text); - -%} - -D [0-9] -S [ \t] -NL ((\n)|(\r)|(\r\n)) -SNL ({S}|{NL}) -EL (\.\.\.) -BS (\\) -CONT ({EL}|{BS}) -Im [iIjJ] -CCHAR [#%] -COMMENT ({CCHAR}.*{NL}) -SNLCMT ({SNL}|{COMMENT}) -NOT ((\~)|(\!)) -POW ((\*\*)|(\^)) -EPOW (\.{POW}) -IDENT ([_$a-zA-Z][_$a-zA-Z0-9]*) -EXPON ([DdEe][+-]?{D}+) -NUMBER (({D}+\.?{D}*{EXPON}?)|(\.{D}+{EXPON}?)|(0[xX][0-9a-fA-F]+)) -%% - -%{ -// Make script and function files start with a bogus token. This makes -// the parser go down a special path. -%} - -<SCRIPT_FILE_BEGIN>. { - LEXER_DEBUG ("<SCRIPT_FILE_BEGIN>."); - - BEGIN (INITIAL); - xunput (yytext[0], yytext); - COUNT_TOK_AND_RETURN (SCRIPT_FILE); - } - -<FUNCTION_FILE_BEGIN>. { - LEXER_DEBUG ("<FUNCTION_FILE_BEGIN>."); - - BEGIN (INITIAL); - xunput (yytext[0], yytext); - COUNT_TOK_AND_RETURN (FUNCTION_FILE); - } - -%{ -// Help and other command-style functions. -%} - -<COMMAND_START>{NL} { - LEXER_DEBUG ("<COMMAND_START>{NL}"); - - BEGIN (INITIAL); - input_line_number++; - current_input_column = 1; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = true; - - COUNT_TOK_AND_RETURN ('\n'); - } - -<COMMAND_START>[\;\,] { - LEXER_DEBUG ("<COMMAND_START>[\\;\\,]"); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = true; - - BEGIN (INITIAL); - - if (strcmp (yytext, ",") == 0) - TOK_RETURN (','); - else - TOK_RETURN (';'); - } - -<COMMAND_START>[\"\'] { - LEXER_DEBUG ("<COMMAND_START>[\\\"\\']"); - - lexer_flags.at_beginning_of_statement = false; - - current_input_column++; - int tok = handle_string (yytext[0]); - - COUNT_TOK_AND_RETURN (tok); - } - -<COMMAND_START>[^#% \t\r\n\;\,\"\'][^ \t\r\n\;\,]*{S}* { - LEXER_DEBUG ("<COMMAND_START>[^#% \\t\\r\\n\\;\\,\\\"\\'][^ \\t\\r\\n\\;\\,]*{S}*"); - - std::string tok = strip_trailing_whitespace (yytext); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - TOK_PUSH_AND_RETURN (tok, SQ_STRING); - } - -%{ -// For this and the next two rules, we're looking at ']', and we -// need to know if the next token is `=' or `=='. -// -// It would have been so much easier if the delimiters were simply -// different for the expression on the left hand side of the equals -// operator. -// -// It's also a pain in the ass to decide whether to insert a comma -// after seeing a ']' character... - -// FIXME -- we need to handle block comments here. -%} - -<MATRIX_START>{SNLCMT}*\]{S}* { - LEXER_DEBUG ("<MATRIX_START>{SNLCMT}*\\]{S}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - int c = yytext[yyleng-1]; - int cont_is_spc = eat_continuation (); - bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - int tok_to_return = handle_close_bracket (spc_gobbled, ']'); - - if (spc_gobbled) - xunput (' ', yytext); - - COUNT_TOK_AND_RETURN (tok_to_return); - } - -%{ -// FIXME -- we need to handle block comments here. -%} - -<MATRIX_START>{SNLCMT}*\}{S}* { - LEXER_DEBUG ("<MATRIX_START>{SNLCMT}*\\}{S}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - int c = yytext[yyleng-1]; - int cont_is_spc = eat_continuation (); - bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - int tok_to_return = handle_close_bracket (spc_gobbled, '}'); - - if (spc_gobbled) - xunput (' ', yytext); - - COUNT_TOK_AND_RETURN (tok_to_return); - } - -%{ -// Commas are element separators in matrix constants. If we don't -// check for continuations here we can end up inserting too many -// commas. -%} - -<MATRIX_START>{S}*\,{S}* { - LEXER_DEBUG ("<MATRIX_START>{S}*\\,{S}*"); - - current_input_column += yyleng; - - int tmp = eat_continuation (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - if (! lexer_flags.looking_at_object_index.front ()) - { - if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) - { - maybe_warn_separator_insert (';'); - - xunput (';', yytext); - } - } - - COUNT_TOK_AND_RETURN (','); - } - -%{ -// In some cases, spaces in matrix constants can turn into commas. -// If commas are required, spaces are not important in matrix -// constants so we just eat them. If we don't check for continuations -// here we can end up inserting too many commas. -%} - -<MATRIX_START>{S}+ { - LEXER_DEBUG ("<MATRIX_START>{S}+"); - - current_input_column += yyleng; - - lexer_flags.at_beginning_of_statement = false; - - int tmp = eat_continuation (); - - if (! lexer_flags.looking_at_object_index.front ()) - { - bool bin_op = next_token_is_bin_op (true); - bool postfix_un_op = next_token_is_postfix_unary_op (true); - bool sep_op = next_token_is_sep_op (); - - if (! (postfix_un_op || bin_op || sep_op) - && nesting_level.is_bracket_or_brace () - && lexer_flags.convert_spaces_to_comma) - { - if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) - { - maybe_warn_separator_insert (';'); - - xunput (';', yytext); - } - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - - maybe_warn_separator_insert (','); - - COUNT_TOK_AND_RETURN (','); - } - } - } - -%{ -// Semicolons are handled as row seprators in matrix constants. If we -// don't eat whitespace here we can end up inserting too many -// semicolons. - -// FIXME -- we need to handle block comments here. -%} - -<MATRIX_START>{SNLCMT}*;{SNLCMT}* { - LEXER_DEBUG ("<MATRIX_START>{SNLCMT}*;{SNLCMT}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - eat_whitespace (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - COUNT_TOK_AND_RETURN (';'); - } - -%{ -// In some cases, new lines can also become row separators. If we -// don't eat whitespace here we can end up inserting too many -// semicolons. - -// FIXME -- we need to handle block comments here. -%} - -<MATRIX_START>{S}*{COMMENT}{SNLCMT}* | -<MATRIX_START>{S}*{NL}{SNLCMT}* { - LEXER_DEBUG ("<MATRIX_START>{S}*{COMMENT}{SNLCMT}*|<MATRIX_START>{S}*{NL}{SNLCMT}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - eat_whitespace (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.at_beginning_of_statement = false; - - if (nesting_level.none ()) - return LEXICAL_ERROR; - - if (! lexer_flags.looking_at_object_index.front () - && nesting_level.is_bracket_or_brace ()) - { - maybe_warn_separator_insert (';'); - - COUNT_TOK_AND_RETURN (';'); - } - } - -\[{S}* { - LEXER_DEBUG ("\\[{S}*"); - - nesting_level.bracket (); - - lexer_flags.looking_at_object_index.push_front (false); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - if (lexer_flags.defining_func - && ! lexer_flags.parsed_function_name.top ()) - lexer_flags.looking_at_return_list = true; - else - lexer_flags.looking_at_matrix_or_assign_lhs = true; - - promptflag--; - eat_whitespace (); - - lexer_flags.bracketflag++; - BEGIN (MATRIX_START); - COUNT_TOK_AND_RETURN ('['); - } - -\] { - LEXER_DEBUG ("\\]"); - - nesting_level.remove (); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - TOK_RETURN (']'); - } - -%{ -// Imaginary numbers. -%} - -{NUMBER}{Im} { - LEXER_DEBUG ("{NUMBER}{Im}"); - - handle_number (); - COUNT_TOK_AND_RETURN (IMAG_NUM); - } - -%{ -// Real numbers. Don't grab the `.' part of a dot operator as part of -// the constant. -%} - -{D}+/\.[\*/\\^\'] | -{NUMBER} { - LEXER_DEBUG ("{D}+/\\.[\\*/\\^\\']|{NUMBER}"); - handle_number (); - COUNT_TOK_AND_RETURN (NUM); - } - -%{ -// Eat whitespace. Whitespace inside matrix constants is handled by -// the <MATRIX_START> start state code above. -%} - -{S}* { - current_input_column += yyleng; - } - -%{ -// Continuation lines. Allow comments after continuations. -%} - -{CONT}{S}*{NL} | -{CONT}{S}*{COMMENT} { - LEXER_DEBUG ("{CONT}{S}*{NL}|{CONT}{S}*{COMMENT}"); - - if (yytext[0] == '\\') - gripe_matlab_incompatible_continuation (); - scan_for_comments (yytext); - promptflag--; - input_line_number++; - current_input_column = 1; - } - -%{ -// End of file. -%} - -<<EOF>> { - LEXER_DEBUG ("<<EOF>>"); - - if (block_comment_nesting_level != 0) - { - warning ("block comment open at end of input"); - - if ((reading_fcn_file || reading_script_file || reading_classdef_file) - && ! curr_fcn_file_name.empty ()) - warning ("near line %d of file `%s.m'", - input_line_number, curr_fcn_file_name.c_str ()); - } - - TOK_RETURN (END_OF_INPUT); - } - -%{ -// Identifiers. Truncate the token at the first space or tab but -// don't write directly on yytext. -%} - -{IDENT}{S}* { - LEXER_DEBUG ("{IDENT}{S}*"); - - int id_tok = handle_identifier (); - - if (id_tok >= 0) - COUNT_TOK_AND_RETURN (id_tok); - } - -%{ -// Superclass method identifiers. -%} - -{IDENT}@{IDENT}{S}* | -{IDENT}@{IDENT}.{IDENT}{S}* { - LEXER_DEBUG ("{IDENT}@{IDENT}{S}*|{IDENT}@{IDENT}.{IDENT}{S}*"); - - int id_tok = handle_superclass_identifier (); - - if (id_tok >= 0) - { - lexer_flags.looking_for_object_index = true; - - COUNT_TOK_AND_RETURN (SUPERCLASSREF); - } - } - -%{ -// Metaclass query -%} - -\?{IDENT}{S}* | -\?{IDENT}\.{IDENT}{S}* { - LEXER_DEBUG ("\\?{IDENT}{S}*|\\?{IDENT}\\.{IDENT}{S}*"); - - int id_tok = handle_meta_identifier (); - - if (id_tok >= 0) - { - lexer_flags.looking_for_object_index = true; - - COUNT_TOK_AND_RETURN (METAQUERY); - } - } - -%{ -// Function handles and superclass references -%} - -"@" { - LEXER_DEBUG ("@"); - - current_input_column++; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = false; - lexer_flags.looking_at_function_handle++; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - COUNT_TOK_AND_RETURN ('@'); - - } - -%{ -// A new line character. New line characters inside matrix constants -// are handled by the <MATRIX_START> start state code above. If closest -// nesting is inside parentheses, don't return a row separator. -%} - -{NL} { - LEXER_DEBUG ("{NL}"); - - input_line_number++; - current_input_column = 1; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - - if (nesting_level.none ()) - { - lexer_flags.at_beginning_of_statement = true; - COUNT_TOK_AND_RETURN ('\n'); - } - else if (nesting_level.is_paren ()) - { - lexer_flags.at_beginning_of_statement = false; - gripe_matlab_incompatible ("bare newline inside parentheses"); - } - else if (nesting_level.is_bracket_or_brace ()) - return LEXICAL_ERROR; - } - -%{ -// Single quote can either be the beginning of a string or a transpose -// operator. -%} - -"'" { - LEXER_DEBUG ("'"); - - current_input_column++; - lexer_flags.convert_spaces_to_comma = true; - - if (lexer_flags.quote_is_transpose) - { - do_comma_insert_check (); - COUNT_TOK_AND_RETURN (QUOTE); - } - else - { - int tok = handle_string ('\''); - COUNT_TOK_AND_RETURN (tok); - } - } - -%{ -// Double quotes always begin strings. -%} - -\" { - LEXER_DEBUG ("\""); - - current_input_column++; - int tok = handle_string ('"'); - - COUNT_TOK_AND_RETURN (tok); -} - -%{ -// Gobble comments. -%} - -{CCHAR} { - LEXER_DEBUG ("{CCHAR}"); - - lexer_flags.looking_for_object_index = false; - - xunput (yytext[0], yytext); - - bool eof = false; - int tok = process_comment (false, eof); - - if (eof) - TOK_RETURN (END_OF_INPUT); - else if (tok > 0) - COUNT_TOK_AND_RETURN (tok); - } - -%{ -// Block comments. -%} - -^{S}*{CCHAR}\{{S}*{NL} { - LEXER_DEBUG ("^{S}*{CCHAR}\\{{S}*{NL}"); - - lexer_flags.looking_for_object_index = false; - - input_line_number++; - current_input_column = 1; - block_comment_nesting_level++; - promptflag--; - - bool eof = false; - process_comment (true, eof); - } - -%{ -// Other operators. -%} - -":" { LEXER_DEBUG (":"); BIN_OP_RETURN (':', false, false); } - -".+" { LEXER_DEBUG (".+"); XBIN_OP_RETURN (EPLUS, false, false); } -".-" { LEXER_DEBUG (".-"); XBIN_OP_RETURN (EMINUS, false, false); } -".*" { LEXER_DEBUG (".*"); BIN_OP_RETURN (EMUL, false, false); } -"./" { LEXER_DEBUG ("./"); BIN_OP_RETURN (EDIV, false, false); } -".\\" { LEXER_DEBUG (".\\"); BIN_OP_RETURN (ELEFTDIV, false, false); } -".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } -".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } -".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } -"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } -"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } -"<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } -"==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } -"~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } -"!=" { LEXER_DEBUG ("!="); XBIN_OP_RETURN (EXPR_NE, false, false); } -">=" { LEXER_DEBUG (">="); BIN_OP_RETURN (EXPR_GE, false, false); } -"&" { LEXER_DEBUG ("&"); BIN_OP_RETURN (EXPR_AND, false, false); } -"|" { LEXER_DEBUG ("|"); BIN_OP_RETURN (EXPR_OR, false, false); } -"<" { LEXER_DEBUG ("<"); BIN_OP_RETURN (EXPR_LT, false, false); } -">" { LEXER_DEBUG (">"); BIN_OP_RETURN (EXPR_GT, false, false); } -"+" { LEXER_DEBUG ("+"); BIN_OP_RETURN ('+', false, false); } -"-" { LEXER_DEBUG ("-"); BIN_OP_RETURN ('-', false, false); } -"*" { LEXER_DEBUG ("*"); BIN_OP_RETURN ('*', false, false); } -"/" { LEXER_DEBUG ("/"); BIN_OP_RETURN ('/', false, false); } -"\\" { LEXER_DEBUG ("\\"); BIN_OP_RETURN (LEFTDIV, false, false); } -";" { LEXER_DEBUG (";"); BIN_OP_RETURN (';', true, true); } -"," { LEXER_DEBUG (","); BIN_OP_RETURN (',', true, ! lexer_flags.looking_at_object_index.front ()); } -"^" { LEXER_DEBUG ("^"); BIN_OP_RETURN (POW, false, false); } -"**" { LEXER_DEBUG ("**"); XBIN_OP_RETURN (POW, false, false); } -"=" { LEXER_DEBUG ("="); BIN_OP_RETURN ('=', true, false); } -"&&" { LEXER_DEBUG ("&&"); BIN_OP_RETURN (EXPR_AND_AND, false, false); } -"||" { LEXER_DEBUG ("||"); BIN_OP_RETURN (EXPR_OR_OR, false, false); } -"<<" { LEXER_DEBUG ("<<"); XBIN_OP_RETURN (LSHIFT, false, false); } -">>" { LEXER_DEBUG (">>"); XBIN_OP_RETURN (RSHIFT, false, false); } - -{NOT} { - LEXER_DEBUG ("{NOT}"); - - if (yytext[0] == '~') - BIN_OP_RETURN (EXPR_NOT, false, false); - else - XBIN_OP_RETURN (EXPR_NOT, false, false); - } - -"(" { - LEXER_DEBUG ("("); - - // If we are looking for an object index, then push TRUE for - // looking_at_object_index. Otherwise, just push whatever state - // is current (so that we can pop it off the stack when we find - // the matching close paren). - - lexer_flags.looking_at_object_index.push_front - (lexer_flags.looking_for_object_index); - - lexer_flags.looking_at_indirect_ref = false; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - nesting_level.paren (); - promptflag--; - - TOK_RETURN ('('); - } - -")" { - LEXER_DEBUG (")"); - - nesting_level.remove (); - current_input_column++; - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma - = (nesting_level.is_bracket_or_brace () - && ! lexer_flags.looking_at_anon_fcn_args); - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - if (lexer_flags.looking_at_anon_fcn_args) - lexer_flags.looking_at_anon_fcn_args = false; - - do_comma_insert_check (); - - COUNT_TOK_AND_RETURN (')'); - } - -"." { - LEXER_DEBUG ("."); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - TOK_RETURN ('.'); - } - -"+=" { LEXER_DEBUG ("+="); XBIN_OP_RETURN (ADD_EQ, false, false); } -"-=" { LEXER_DEBUG ("-="); XBIN_OP_RETURN (SUB_EQ, false, false); } -"*=" { LEXER_DEBUG ("*="); XBIN_OP_RETURN (MUL_EQ, false, false); } -"/=" { LEXER_DEBUG ("/="); XBIN_OP_RETURN (DIV_EQ, false, false); } -"\\=" { LEXER_DEBUG ("\\="); XBIN_OP_RETURN (LEFTDIV_EQ, false, false); } -".+=" { LEXER_DEBUG (".+="); XBIN_OP_RETURN (ADD_EQ, false, false); } -".-=" { LEXER_DEBUG (".-="); XBIN_OP_RETURN (SUB_EQ, false, false); } -".*=" { LEXER_DEBUG (".*="); XBIN_OP_RETURN (EMUL_EQ, false, false); } -"./=" { LEXER_DEBUG ("./="); XBIN_OP_RETURN (EDIV_EQ, false, false); } -".\\=" { LEXER_DEBUG (".\\="); XBIN_OP_RETURN (ELEFTDIV_EQ, false, false); } -{POW}= { LEXER_DEBUG ("{POW}="); XBIN_OP_RETURN (POW_EQ, false, false); } -{EPOW}= { LEXER_DEBUG ("{EPOW}="); XBIN_OP_RETURN (EPOW_EQ, false, false); } -"&=" { LEXER_DEBUG ("&="); XBIN_OP_RETURN (AND_EQ, false, false); } -"|=" { LEXER_DEBUG ("|="); XBIN_OP_RETURN (OR_EQ, false, false); } -"<<=" { LEXER_DEBUG ("<<="); XBIN_OP_RETURN (LSHIFT_EQ, false, false); } -">>=" { LEXER_DEBUG (">>="); XBIN_OP_RETURN (RSHIFT_EQ, false, false); } - -\{{S}* { - LEXER_DEBUG ("\\{{S}*"); - - nesting_level.brace (); - - lexer_flags.looking_at_object_index.push_front - (lexer_flags.looking_for_object_index); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - promptflag--; - eat_whitespace (); - - lexer_flags.braceflag++; - BEGIN (MATRIX_START); - COUNT_TOK_AND_RETURN ('{'); - } - -"}" { - LEXER_DEBUG ("}"); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - nesting_level.remove (); - - TOK_RETURN ('}'); - } - -%{ -// Unrecognized input is a lexical error. -%} - -. { - LEXER_DEBUG ("."); - - xunput (yytext[0], yytext); - - int c = text_yyinput (); - - if (c != EOF) - { - current_input_column++; - - error ("invalid character `%s' (ASCII %d) near line %d, column %d", - undo_string_escape (static_cast<char> (c)), c, - input_line_number, current_input_column); - - return LEXICAL_ERROR; - } - else - TOK_RETURN (END_OF_INPUT); - } - -%% - -// GAG. -// -// If we're reading a matrix and the next character is '[', make sure -// that we insert a comma ahead of it. - -void -do_comma_insert_check (void) -{ - int spc_gobbled = eat_continuation (); - - int c = text_yyinput (); - - xunput (c, yytext); - - if (spc_gobbled) - xunput (' ', yytext); - - lexer_flags.do_comma_insert = (! lexer_flags.looking_at_object_index.front () - && lexer_flags.bracketflag && c == '['); -} - -// Fix things up for errors or interrupts. The parser is never called -// recursively, so it is always safe to reinitialize its state before -// doing any parsing. - -void -reset_parser (void) -{ - // Start off on the right foot. - BEGIN (INITIAL); - - parser_end_of_input = false; - - parser_symtab_context.clear (); - - // We do want a prompt by default. - promptflag = 1; - - // We are not in a block comment. - block_comment_nesting_level = 0; - - // Error may have occurred inside some brackets, braces, or parentheses. - nesting_level.clear (); - - // Clear out the stack of token info used to track line and column - // numbers. - while (! token_stack.empty ()) - { - delete token_stack.top (); - token_stack.pop (); - } - - // Can be reset by defining a function. - if (! (reading_script_file || reading_fcn_file || reading_classdef_file)) - { - current_input_column = 1; - input_line_number = command_editor::current_command_number (); - } - - // Only ask for input from stdin if we are expecting interactive - // input. - - if (! quitting_gracefully - && (interactive || forced_interactive) - && ! (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file)) - yyrestart (stdin); - - // Clear the buffer for help text. - while (! help_buf.empty ()) - help_buf.pop (); - - // Reset other flags. - lexer_flags.init (); -} - -static void -display_character (char c) -{ - if (isgraph (c)) - std::cerr << c; - else - switch (c) - { - case 0: - std::cerr << "NUL"; - break; - - case 1: - std::cerr << "SOH"; - break; - - case 2: - std::cerr << "STX"; - break; - - case 3: - std::cerr << "ETX"; - break; - - case 4: - std::cerr << "EOT"; - break; - - case 5: - std::cerr << "ENQ"; - break; - - case 6: - std::cerr << "ACK"; - break; - - case 7: - std::cerr << "\\a"; - break; - - case 8: - std::cerr << "\\b"; - break; - - case 9: - std::cerr << "\\t"; - break; - - case 10: - std::cerr << "\\n"; - break; - - case 11: - std::cerr << "\\v"; - break; - - case 12: - std::cerr << "\\f"; - break; - - case 13: - std::cerr << "\\r"; - break; - - case 14: - std::cerr << "SO"; - break; - - case 15: - std::cerr << "SI"; - break; - - case 16: - std::cerr << "DLE"; - break; - - case 17: - std::cerr << "DC1"; - break; - - case 18: - std::cerr << "DC2"; - break; - - case 19: - std::cerr << "DC3"; - break; - - case 20: - std::cerr << "DC4"; - break; - - case 21: - std::cerr << "NAK"; - break; - - case 22: - std::cerr << "SYN"; - break; - - case 23: - std::cerr << "ETB"; - break; - - case 24: - std::cerr << "CAN"; - break; - - case 25: - std::cerr << "EM"; - break; - - case 26: - std::cerr << "SUB"; - break; - - case 27: - std::cerr << "ESC"; - break; - - case 28: - std::cerr << "FS"; - break; - - case 29: - std::cerr << "GS"; - break; - - case 30: - std::cerr << "RS"; - break; - - case 31: - std::cerr << "US"; - break; - - case 32: - std::cerr << "SPACE"; - break; - - case 127: - std::cerr << "DEL"; - break; - } -} - -static int -text_yyinput (void) -{ - int c = yyinput (); - - if (lexer_debug_flag) - { - std::cerr << "I: "; - display_character (c); - std::cerr << std::endl; - } - - // Convert CRLF into just LF and single CR into LF. - - if (c == '\r') - { - c = yyinput (); - - if (lexer_debug_flag) - { - std::cerr << "I: "; - display_character (c); - std::cerr << std::endl; - } - - if (c != '\n') - { - xunput (c, yytext); - c = '\n'; - } - } - - if (c == '\n') - input_line_number++; - - return c; -} - -static void -xunput (char c, char *buf) -{ - if (lexer_debug_flag) - { - std::cerr << "U: "; - display_character (c); - std::cerr << std::endl; - } - - if (c == '\n') - input_line_number--; - - yyunput (c, buf); -} - -// If we read some newlines, we need figure out what column we're -// really looking at. - -static void -fixup_column_count (char *s) -{ - char c; - while ((c = *s++) != '\0') - { - if (c == '\n') - { - input_line_number++; - current_input_column = 1; - } - else - current_input_column++; - } -} - -// Include these so that we don't have to link to libfl.a. - -int -yywrap (void) -{ - return 1; -} - -// Tell us all what the current buffer is. - -YY_BUFFER_STATE -current_buffer (void) -{ - return YY_CURRENT_BUFFER; -} - -// Create a new buffer. - -YY_BUFFER_STATE -create_buffer (FILE *f) -{ - return yy_create_buffer (f, YY_BUF_SIZE); -} - -// Start reading a new buffer. - -void -switch_to_buffer (YY_BUFFER_STATE buf) -{ - yy_switch_to_buffer (buf); -} - -// Delete a buffer. - -void -delete_buffer (YY_BUFFER_STATE buf) -{ - yy_delete_buffer (buf); - - // Prevent invalid yyin from being used by yyrestart. - if (! current_buffer ()) - yyin = 0; -} - -// Delete all buffers from the stack. -void -clear_all_buffers (void) -{ - while (current_buffer ()) - octave_pop_buffer_state (); -} - -void -cleanup_parser (void) -{ - reset_parser (); - - clear_all_buffers (); -} - -// Restore a buffer (for unwind-prot). - -void -restore_input_buffer (void *buf) -{ - switch_to_buffer (static_cast<YY_BUFFER_STATE> (buf)); -} - -// Delete a buffer (for unwind-prot). - -void -delete_input_buffer (void *buf) -{ - delete_buffer (static_cast<YY_BUFFER_STATE> (buf)); -} - -static bool -inside_any_object_index (void) -{ - bool retval = false; - - for (std::list<bool>::const_iterator i = lexer_flags.looking_at_object_index.begin (); - i != lexer_flags.looking_at_object_index.end (); i++) - { - if (*i) - { - retval = true; - break; - } - } - - return retval; -} - -// Handle keywords. Return -1 if the keyword should be ignored. - -static int -is_keyword_token (const std::string& s) -{ - int l = input_line_number; - int c = current_input_column; - - int len = s.length (); - - const octave_kw *kw = octave_kw_hash::in_word_set (s.c_str (), len); - - if (kw) - { - yylval.tok_val = 0; - - switch (kw->kw_id) - { - case break_kw: - case catch_kw: - case continue_kw: - case else_kw: - case otherwise_kw: - case return_kw: - case unwind_protect_cleanup_kw: - lexer_flags.at_beginning_of_statement = true; - break; - - case static_kw: - if ((reading_fcn_file || reading_script_file - || reading_classdef_file) - && ! curr_fcn_file_full_name.empty ()) - warning_with_id ("Octave:deprecated-keyword", - "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d of file `%s'", - input_line_number, - curr_fcn_file_full_name.c_str ()); - else - warning_with_id ("Octave:deprecated-keyword", - "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d", - input_line_number); - // fall through ... - - case persistent_kw: - break; - - case case_kw: - case elseif_kw: - case global_kw: - case until_kw: - break; - - case end_kw: - if (inside_any_object_index () - || (! reading_classdef_file - && (lexer_flags.defining_func - && ! (lexer_flags.looking_at_return_list - || lexer_flags.parsed_function_name.top ())))) - return 0; - - yylval.tok_val = new token (token::simple_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case end_try_catch_kw: - yylval.tok_val = new token (token::try_catch_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case end_unwind_protect_kw: - yylval.tok_val = new token (token::unwind_protect_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endfor_kw: - yylval.tok_val = new token (token::for_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endfunction_kw: - yylval.tok_val = new token (token::function_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endif_kw: - yylval.tok_val = new token (token::if_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endparfor_kw: - yylval.tok_val = new token (token::parfor_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endswitch_kw: - yylval.tok_val = new token (token::switch_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endwhile_kw: - yylval.tok_val = new token (token::while_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endclassdef_kw: - yylval.tok_val = new token (token::classdef_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endenumeration_kw: - yylval.tok_val = new token (token::enumeration_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endevents_kw: - yylval.tok_val = new token (token::events_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endmethods_kw: - yylval.tok_val = new token (token::methods_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endproperties_kw: - yylval.tok_val = new token (token::properties_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - - case for_kw: - case parfor_kw: - case while_kw: - promptflag--; - lexer_flags.looping++; - break; - - case do_kw: - lexer_flags.at_beginning_of_statement = true; - promptflag--; - lexer_flags.looping++; - break; - - case try_kw: - case unwind_protect_kw: - lexer_flags.at_beginning_of_statement = true; - promptflag--; - break; - - case if_kw: - case switch_kw: - promptflag--; - break; - - case get_kw: - case set_kw: - // 'get' and 'set' are keywords in classdef method - // declarations. - if (! lexer_flags.maybe_classdef_get_set_method) - return 0; - break; - - case enumeration_kw: - case events_kw: - case methods_kw: - case properties_kw: - // 'properties', 'methods' and 'events' are keywords for - // classdef blocks. - if (! lexer_flags.parsing_classdef) - return 0; - // fall through ... - - case classdef_kw: - // 'classdef' is always a keyword. - promptflag--; - break; - - case function_kw: - promptflag--; - - lexer_flags.defining_func++; - lexer_flags.parsed_function_name.push (false); - - if (! (reading_fcn_file || reading_script_file - || reading_classdef_file)) - input_line_number = 1; - break; - - case magic_file_kw: - { - if ((reading_fcn_file || reading_script_file - || reading_classdef_file) - && ! curr_fcn_file_full_name.empty ()) - yylval.tok_val = new token (curr_fcn_file_full_name, l, c); - else - yylval.tok_val = new token ("stdin", l, c); - } - break; - - case magic_line_kw: - yylval.tok_val = new token (static_cast<double> (l), "", l, c); - break; - - default: - panic_impossible (); - } - - if (! yylval.tok_val) - yylval.tok_val = new token (l, c); - - token_stack.push (yylval.tok_val); - - return kw->tok; - } - - return 0; -} - -static bool -is_variable (const std::string& name) -{ - return (symbol_table::is_variable (name) - || (lexer_flags.pending_local_variables.find (name) - != lexer_flags.pending_local_variables.end ())); -} - -static std::string -grab_block_comment (stream_reader& reader, bool& eof) -{ - std::string buf; - - bool at_bol = true; - bool look_for_marker = false; - - bool warned_incompatible = false; - - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - current_input_column++; - - if (look_for_marker) - { - at_bol = false; - look_for_marker = false; - - if (c == '{' || c == '}') - { - std::string tmp_buf (1, static_cast<char> (c)); - - int type = c; - - bool done = false; - - while ((c = reader.getc ()) != EOF && ! done) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - tmp_buf += static_cast<char> (c); - break; - - case '\n': - { - current_input_column = 0; - at_bol = true; - done = true; - - if (type == '{') - { - block_comment_nesting_level++; - promptflag--; - } - else - { - block_comment_nesting_level--; - promptflag++; - - if (block_comment_nesting_level == 0) - { - buf += grab_comment_block (reader, true, eof); - - return buf; - } - } - } - break; - - default: - at_bol = false; - tmp_buf += static_cast<char> (c); - buf += tmp_buf; - done = true; - break; - } - } - } - } - - if (at_bol && (c == '%' || c == '#')) - { - if (c == '#' && ! warned_incompatible) - { - warned_incompatible = true; - maybe_gripe_matlab_incompatible_comment (c); - } - - at_bol = false; - look_for_marker = true; - } - else - { - buf += static_cast<char> (c); - - if (c == '\n') - { - current_input_column = 0; - at_bol = true; - } - } - } - - if (c == EOF) - eof = true; - - return buf; -} - -std::string -grab_comment_block (stream_reader& reader, bool at_bol, - bool& eof) -{ - std::string buf; - - // TRUE means we are at the beginning of a comment block. - bool begin_comment = false; - - // TRUE means we are currently reading a comment block. - bool in_comment = false; - - bool warned_incompatible = false; - - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - current_input_column++; - - if (begin_comment) - { - if (c == '%' || c == '#') - { - at_bol = false; - continue; - } - else if (at_bol && c == '{') - { - std::string tmp_buf (1, static_cast<char> (c)); - - bool done = false; - - while ((c = reader.getc ()) != EOF && ! done) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - tmp_buf += static_cast<char> (c); - break; - - case '\n': - { - current_input_column = 0; - at_bol = true; - done = true; - - block_comment_nesting_level++; - promptflag--; - - buf += grab_block_comment (reader, eof); - - in_comment = false; - - if (eof) - goto done; - } - break; - - default: - at_bol = false; - tmp_buf += static_cast<char> (c); - buf += tmp_buf; - done = true; - break; - } - } - } - else - { - at_bol = false; - begin_comment = false; - } - } - - if (in_comment) - { - buf += static_cast<char> (c); - - if (c == '\n') - { - at_bol = true; - current_input_column = 0; - in_comment = false; - - // FIXME -- bailing out here prevents things like - // - // octave> # comment - // octave> x = 1 - // - // from failing at the command line, while still - // allowing blocks of comments to be grabbed properly - // for function doc strings. But only the first line of - // a mult-line doc string will be picked up for - // functions defined on the command line. We need a - // better way of collecting these comments... - if (! (reading_fcn_file || reading_script_file)) - goto done; - } - } - else - { - switch (c) - { - case ' ': - case '\t': - break; - - case '#': - if (! warned_incompatible) - { - warned_incompatible = true; - maybe_gripe_matlab_incompatible_comment (c); - } - // fall through... - - case '%': - in_comment = true; - begin_comment = true; - break; - - default: - current_input_column--; - reader.ungetc (c); - goto done; - } - } - } - - done: - - if (c == EOF) - eof = true; - - return buf; -} - -class -flex_stream_reader : public stream_reader -{ -public: - flex_stream_reader (char *buf_arg) : stream_reader (), buf (buf_arg) { } - - int getc (void) { return ::text_yyinput (); } - int ungetc (int c) { ::xunput (c, buf); return 0; } - -private: - - // No copying! - - flex_stream_reader (const flex_stream_reader&); - - flex_stream_reader& operator = (const flex_stream_reader&); - - char *buf; -}; - -static int -process_comment (bool start_in_block, bool& eof) -{ - eof = false; - - std::string help_txt; - - if (! help_buf.empty ()) - help_txt = help_buf.top (); - - flex_stream_reader flex_reader (yytext); - - // process_comment is only supposed to be called when we are not - // initially looking at a block comment. - - std::string txt = start_in_block - ? grab_block_comment (flex_reader, eof) - : grab_comment_block (flex_reader, false, eof); - - if (lexer_debug_flag) - std::cerr << "C: " << txt << std::endl; - - if (help_txt.empty () && nesting_level.none ()) - { - if (! help_buf.empty ()) - help_buf.pop (); - - help_buf.push (txt); - } - - octave_comment_buffer::append (txt); - - current_input_column = 1; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.at_beginning_of_statement = true; - - if (YY_START == COMMAND_START) - BEGIN (INITIAL); - - if (nesting_level.none ()) - return '\n'; - else if (nesting_level.is_bracket_or_brace ()) - return ';'; - else - return 0; -} - -// Return 1 if the given character matches any character in the given -// string. - -static bool -match_any (char c, const char *s) -{ - char tmp; - while ((tmp = *s++) != '\0') - { - if (c == tmp) - return true; - } - return false; -} - -// Given information about the spacing surrounding an operator, -// return 1 if it looks like it should be treated as a binary -// operator. For example, -// -// [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary -// -// [ 1 +2 ] ==> unary - -static bool -looks_like_bin_op (bool spc_prev, int next_char) -{ - bool spc_next = (next_char == ' ' || next_char == '\t'); - - return ((spc_prev && spc_next) || ! spc_prev); -} - -// Recognize separators. If the separator is a CRLF pair, it is -// replaced by a single LF. - -static bool -next_token_is_sep_op (void) -{ - bool retval = false; - - int c = text_yyinput (); - - retval = match_any (c, ",;\n]"); - - xunput (c, yytext); - - return retval; -} - -// Try to determine if the next token should be treated as a postfix -// unary operator. This is ugly, but it seems to do the right thing. - -static bool -next_token_is_postfix_unary_op (bool spc_prev) -{ - bool un_op = false; - - int c0 = text_yyinput (); - - if (c0 == '\'' && ! spc_prev) - { - un_op = true; - } - else if (c0 == '.') - { - int c1 = text_yyinput (); - un_op = (c1 == '\''); - xunput (c1, yytext); - } - else if (c0 == '+') - { - int c1 = text_yyinput (); - un_op = (c1 == '+'); - xunput (c1, yytext); - } - else if (c0 == '-') - { - int c1 = text_yyinput (); - un_op = (c1 == '-'); - xunput (c1, yytext); - } - - xunput (c0, yytext); - - return un_op; -} - -// Try to determine if the next token should be treated as a binary -// operator. -// -// This kluge exists because whitespace is not always ignored inside -// the square brackets that are used to create matrix objects (though -// spacing only really matters in the cases that can be interpreted -// either as binary ops or prefix unary ops: currently just +, -). -// -// Note that a line continuation directly following a + or - operator -// (e.g., the characters '[' 'a' ' ' '+' '\' LFD 'b' ']') will be -// parsed as a binary operator. - -static bool -next_token_is_bin_op (bool spc_prev) -{ - bool bin_op = false; - - int c0 = text_yyinput (); - - switch (c0) - { - case '+': - case '-': - { - int c1 = text_yyinput (); - - switch (c1) - { - case '+': - case '-': - // Unary ops, spacing doesn't matter. - break; - - case '=': - // Binary ops, spacing doesn't matter. - bin_op = true; - break; - - default: - // Could be either, spacing matters. - bin_op = looks_like_bin_op (spc_prev, c1); - break; - } - - xunput (c1, yytext); - } - break; - - case ':': - case '/': - case '\\': - case '^': - // Always a binary op (may also include /=, \=, and ^=). - bin_op = true; - break; - - // .+ .- ./ .\ .^ .* .** - case '.': - { - int c1 = text_yyinput (); - - if (match_any (c1, "+-/\\^*")) - // Always a binary op (may also include .+=, .-=, ./=, ...). - bin_op = true; - else if (! isdigit (c1) && c1 != ' ' && c1 != '\t' && c1 != '.') - // A structure element reference is a binary op. - bin_op = true; - - xunput (c1, yytext); - } - break; - - // = == & && | || * ** - case '=': - case '&': - case '|': - case '*': - // Always a binary op (may also include ==, &&, ||, **). - bin_op = true; - break; - - // < <= <> > >= - case '<': - case '>': - // Always a binary op (may also include <=, <>, >=). - bin_op = true; - break; - - // ~= != - case '~': - case '!': - { - int c1 = text_yyinput (); - - // ~ and ! can be unary ops, so require following =. - if (c1 == '=') - bin_op = true; - - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return bin_op; -} - -// Used to delete trailing white space from tokens. - -static std::string -strip_trailing_whitespace (char *s) -{ - std::string retval = s; - - size_t pos = retval.find_first_of (" \t"); - - if (pos != std::string::npos) - retval.resize (pos); - - return retval; -} - -// FIXME -- we need to handle block comments here. - -static void -scan_for_comments (const char *text) -{ - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int len = strlen (text); - int i = 0; - - while (i < len) - { - char c = text[i++]; - - switch (c) - { - case '%': - case '#': - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast<char> (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - break; - - case '\n': - if (in_comment) - { - comment_buf += static_cast<char> (c); - octave_comment_buffer::append (comment_buf); - comment_buf.resize (0); - in_comment = false; - beginning_of_comment = false; - } - break; - - default: - if (in_comment) - { - comment_buf += static_cast<char> (c); - beginning_of_comment = false; - } - break; - } - } - - if (! comment_buf.empty ()) - octave_comment_buffer::append (comment_buf); -} - -// Discard whitespace, including comments and continuations. -// -// Return value is logical OR of the following values: -// -// ATE_NOTHING : no spaces to eat -// ATE_SPACE_OR_TAB : space or tab in input -// ATE_NEWLINE : bare new line in input - -// FIXME -- we need to handle block comments here. - -static yum_yum -eat_whitespace (void) -{ - yum_yum retval = ATE_NOTHING; - - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int c = 0; - - while ((c = text_yyinput ()) != EOF) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - if (in_comment) - { - comment_buf += static_cast<char> (c); - beginning_of_comment = false; - } - retval |= ATE_SPACE_OR_TAB; - break; - - case '\n': - retval |= ATE_NEWLINE; - if (in_comment) - { - comment_buf += static_cast<char> (c); - octave_comment_buffer::append (comment_buf); - comment_buf.resize (0); - in_comment = false; - beginning_of_comment = false; - } - current_input_column = 0; - break; - - case '#': - case '%': - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast<char> (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - break; - - case '.': - if (in_comment) - { - comment_buf += static_cast<char> (c); - beginning_of_comment = false; - break; - } - else - { - if (have_ellipsis_continuation ()) - break; - else - goto done; - } - - case '\\': - if (in_comment) - { - comment_buf += static_cast<char> (c); - beginning_of_comment = false; - break; - } - else - { - if (have_continuation ()) - break; - else - goto done; - } - - default: - if (in_comment) - { - comment_buf += static_cast<char> (c); - beginning_of_comment = false; - break; - } - else - goto done; - } - } - - if (! comment_buf.empty ()) - octave_comment_buffer::append (comment_buf); - - done: - xunput (c, yytext); - current_input_column--; - return retval; -} - -static inline bool -looks_like_hex (const char *s, int len) -{ - return (len > 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')); -} - -static void -handle_number (void) -{ - double value = 0.0; - int nread = 0; - - if (looks_like_hex (yytext, strlen (yytext))) - { - unsigned long ival; - - nread = sscanf (yytext, "%lx", &ival); - - value = static_cast<double> (ival); - } - else - { - char *tmp = strsave (yytext); - - char *idx = strpbrk (tmp, "Dd"); - - if (idx) - *idx = 'e'; - - nread = sscanf (tmp, "%lf", &value); - - delete [] tmp; - } - - // If yytext doesn't contain a valid number, we are in deep doo doo. - - assert (nread == 1); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - yylval.tok_val = new token (value, yytext, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - current_input_column += yyleng; - - do_comma_insert_check (); -} - -// We have seen a backslash and need to find out if it should be -// treated as a continuation character. If so, this eats it, up to -// and including the new line character. -// -// Match whitespace only, followed by a comment character or newline. -// Once a comment character is found, discard all input until newline. -// If non-whitespace characters are found before comment -// characters, return 0. Otherwise, return 1. - -// FIXME -- we need to handle block comments here. - -static bool -have_continuation (bool trailing_comments_ok) -{ - std::ostringstream buf; - - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int c = 0; - - while ((c = text_yyinput ()) != EOF) - { - buf << static_cast<char> (c); - - switch (c) - { - case ' ': - case '\t': - if (in_comment) - { - comment_buf += static_cast<char> (c); - beginning_of_comment = false; - } - break; - - case '%': - case '#': - if (trailing_comments_ok) - { - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast<char> (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - } - else - goto cleanup; - break; - - case '\n': - if (in_comment) - { - comment_buf += static_cast<char> (c); - octave_comment_buffer::append (comment_buf); - } - current_input_column = 0; - promptflag--; - gripe_matlab_incompatible_continuation (); - return true; - - default: - if (in_comment) - { - comment_buf += static_cast<char> (c); - beginning_of_comment = false; - } - else - goto cleanup; - break; - } - } - - xunput (c, yytext); - return false; - -cleanup: - - std::string s = buf.str (); - - int len = s.length (); - while (len--) - xunput (s[len], yytext); - - return false; -} - -// We have seen a `.' and need to see if it is the start of a -// continuation. If so, this eats it, up to and including the new -// line character. - -static bool -have_ellipsis_continuation (bool trailing_comments_ok) -{ - char c1 = text_yyinput (); - if (c1 == '.') - { - char c2 = text_yyinput (); - if (c2 == '.' && have_continuation (trailing_comments_ok)) - return true; - else - { - xunput (c2, yytext); - xunput (c1, yytext); - } - } - else - xunput (c1, yytext); - - return false; -} - -// See if we have a continuation line. If so, eat it and the leading -// whitespace on the next line. -// -// Return value is the same as described for eat_whitespace(). - -static yum_yum -eat_continuation (void) -{ - int retval = ATE_NOTHING; - - int c = text_yyinput (); - - if ((c == '.' && have_ellipsis_continuation ()) - || (c == '\\' && have_continuation ())) - retval = eat_whitespace (); - else - xunput (c, yytext); - - return retval; -} - -static int -handle_string (char delim) -{ - std::ostringstream buf; - - int bos_line = input_line_number; - int bos_col = current_input_column; - - int c; - int escape_pending = 0; - - while ((c = text_yyinput ()) != EOF) - { - current_input_column++; - - if (c == '\\') - { - if (delim == '\'' || escape_pending) - { - buf << static_cast<char> (c); - escape_pending = 0; - } - else - { - if (have_continuation (false)) - escape_pending = 0; - else - { - buf << static_cast<char> (c); - escape_pending = 1; - } - } - continue; - } - else if (c == '.') - { - if (delim == '\'' || ! have_ellipsis_continuation (false)) - buf << static_cast<char> (c); - } - else if (c == '\n') - { - error ("unterminated string constant"); - break; - } - else if (c == delim) - { - if (escape_pending) - buf << static_cast<char> (c); - else - { - c = text_yyinput (); - if (c == delim) - { - buf << static_cast<char> (c); - } - else - { - std::string s; - xunput (c, yytext); - - if (delim == '\'') - s = buf.str (); - else - s = do_string_escapes (buf.str ()); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - - yylval.tok_val = new token (s, bos_line, bos_col); - token_stack.push (yylval.tok_val); - - if (delim == '"') - gripe_matlab_incompatible ("\" used as string delimiter"); - else if (delim == '\'') - gripe_single_quote_string (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - return delim == '"' ? DQ_STRING : SQ_STRING; - } - } - } - else - { - buf << static_cast<char> (c); - } - - escape_pending = 0; - } - - return LEXICAL_ERROR; -} - -static bool -next_token_is_assign_op (void) -{ - bool retval = false; - - int c0 = text_yyinput (); - - switch (c0) - { - case '=': - { - int c1 = text_yyinput (); - xunput (c1, yytext); - if (c1 != '=') - retval = true; - } - break; - - case '+': - case '-': - case '*': - case '/': - case '\\': - case '&': - case '|': - { - int c1 = text_yyinput (); - xunput (c1, yytext); - if (c1 == '=') - retval = true; - } - break; - - case '.': - { - int c1 = text_yyinput (); - if (match_any (c1, "+-*/\\")) - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - case '>': - { - int c1 = text_yyinput (); - if (c1 == '>') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - case '<': - { - int c1 = text_yyinput (); - if (c1 == '<') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return retval; -} - -static bool -next_token_is_index_op (void) -{ - int c = text_yyinput (); - xunput (c, yytext); - return c == '(' || c == '{'; -} - -static int -handle_close_bracket (bool spc_gobbled, int bracket_type) -{ - int retval = bracket_type; - - if (! nesting_level.none ()) - { - nesting_level.remove (); - - if (bracket_type == ']') - lexer_flags.bracketflag--; - else if (bracket_type == '}') - lexer_flags.braceflag--; - else - panic_impossible (); - } - - if (lexer_flags.bracketflag == 0 && lexer_flags.braceflag == 0) - BEGIN (INITIAL); - - if (bracket_type == ']' - && next_token_is_assign_op () - && ! lexer_flags.looking_at_return_list) - { - retval = CLOSE_BRACE; - } - else if ((lexer_flags.bracketflag || lexer_flags.braceflag) - && lexer_flags.convert_spaces_to_comma - && (nesting_level.is_bracket () - || (nesting_level.is_brace () - && ! lexer_flags.looking_at_object_index.front ()))) - { - bool index_op = next_token_is_index_op (); - - // Don't insert comma if we are looking at something like - // - // [x{i}{j}] or [x{i}(j)] - // - // but do if we are looking at - // - // [x{i} {j}] or [x{i} (j)] - - if (spc_gobbled || ! (bracket_type == '}' && index_op)) - { - bool bin_op = next_token_is_bin_op (spc_gobbled); - - bool postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); - - bool sep_op = next_token_is_sep_op (); - - if (! (postfix_un_op || bin_op || sep_op)) - { - maybe_warn_separator_insert (','); - - xunput (',', yytext); - return retval; - } - } - } - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - - return retval; -} - -static void -maybe_unput_comma (int spc_gobbled) -{ - if (nesting_level.is_bracket () - || (nesting_level.is_brace () - && ! lexer_flags.looking_at_object_index.front ())) - { - int bin_op = next_token_is_bin_op (spc_gobbled); - - int postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); - - int c1 = text_yyinput (); - int c2 = text_yyinput (); - - xunput (c2, yytext); - xunput (c1, yytext); - - int sep_op = next_token_is_sep_op (); - - int dot_op = (c1 == '.' - && (isalpha (c2) || isspace (c2) || c2 == '_')); - - if (postfix_un_op || bin_op || sep_op || dot_op) - return; - - int index_op = (c1 == '(' || c1 == '{'); - - // If there is no space before the indexing op, we don't insert - // a comma. - - if (index_op && ! spc_gobbled) - return; - - maybe_warn_separator_insert (','); - - xunput (',', yytext); - } -} - -static bool -next_token_can_follow_bin_op (void) -{ - std::stack<char> buf; - - int c = EOF; - - // Skip whitespace in current statement on current line - while (true) - { - c = text_yyinput (); - - buf.push (c); - - if (match_any (c, ",;\n") || (c != ' ' && c != '\t')) - break; - } - - // Restore input. - while (! buf.empty ()) - { - xunput (buf.top (), yytext); - - buf.pop (); - } - - return (isalnum (c) || match_any (c, "!\"'(-[_{~")); -} - -static bool -can_be_command (const std::string& tok) -{ - // Don't allow these names to be treated as commands to avoid - // surprises when parsing things like "NaN ^2". - - return ! (tok == "e" - || tok == "I" || tok == "i" - || tok == "J" || tok == "j" - || tok == "Inf" || tok == "inf" - || tok == "NaN" || tok == "nan"); -} - -static bool -looks_like_command_arg (void) -{ - bool retval = true; - - int c0 = text_yyinput (); - - switch (c0) - { - // = == - case '=': - { - int c1 = text_yyinput (); - - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else - retval = false; - - xunput (c1, yytext); - } - break; - - case '(': - case '{': - // Indexing. - retval = false; - break; - - case '\n': - // EOL. - break; - - case '\'': - case '"': - // Beginning of a character string. - break; - - // + - ++ -- += -= - case '+': - case '-': - { - int c1 = text_yyinput (); - - switch (c1) - { - case '\n': - // EOL. - case '+': - case '-': - // Unary ops, spacing doesn't matter. - break; - - case '\t': - case ' ': - { - if (next_token_can_follow_bin_op ()) - retval = false; - } - break; - - case '=': - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - break; - } - - xunput (c1, yytext); - } - break; - - case ':': - case '/': - case '\\': - case '^': - { - int c1 = text_yyinput (); - - if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // .+ .- ./ .\ .^ .* .** - case '.': - { - int c1 = text_yyinput (); - - if (match_any (c1, "+-/\\^*")) - { - int c2 = text_yyinput (); - - if (c2 == '=') - { - int c3 = text_yyinput (); - - if (! match_any (c3, ",;\n") && (c3 == ' ' || c3 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c3, yytext); - } - else if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") - && (! isdigit (c1) && c1 != ' ' && c1 != '\t' - && c1 != '.')) - { - // Structure reference. FIXME -- is this a complete check? - - retval = false; - } - - xunput (c1, yytext); - } - break; - - // & && | || * ** - case '&': - case '|': - case '*': - { - int c1 = text_yyinput (); - - if (c1 == c0) - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // < <= > >= - case '<': - case '>': - { - int c1 = text_yyinput (); - - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // ~= != - case '~': - case '!': - { - int c1 = text_yyinput (); - - // ~ and ! can be unary ops, so require following =. - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return retval; -} - -static int -handle_superclass_identifier (void) -{ - eat_continuation (); - - std::string pkg; - std::string meth = strip_trailing_whitespace (yytext); - size_t pos = meth.find ("@"); - std::string cls = meth.substr (pos).substr (1); - meth = meth.substr (0, pos - 1); - - pos = cls.find ("."); - if (pos != std::string::npos) - { - pkg = cls.substr (pos).substr (1); - cls = cls.substr (0, pos - 1); - } - - int kw_token = (is_keyword_token (meth) || is_keyword_token (cls) - || is_keyword_token (pkg)); - if (kw_token) - { - error ("method, class and package names may not be keywords"); - return LEXICAL_ERROR; - } - - yylval.tok_val - = new token (meth.empty () ? 0 : &(symbol_table::insert (meth)), - cls.empty () ? 0 : &(symbol_table::insert (cls)), - pkg.empty () ? 0 : &(symbol_table::insert (pkg)), - input_line_number, current_input_column); - token_stack.push (yylval.tok_val); - - lexer_flags.convert_spaces_to_comma = true; - current_input_column += yyleng; - - return SUPERCLASSREF; -} - -static int -handle_meta_identifier (void) -{ - eat_continuation (); - - std::string pkg; - std::string cls = strip_trailing_whitespace (yytext).substr (1); - size_t pos = cls.find ("."); - - if (pos != std::string::npos) - { - pkg = cls.substr (pos).substr (1); - cls = cls.substr (0, pos - 1); - } - - int kw_token = is_keyword_token (cls) || is_keyword_token (pkg); - if (kw_token) - { - error ("class and package names may not be keywords"); - return LEXICAL_ERROR; - } - - yylval.tok_val - = new token (cls.empty () ? 0 : &(symbol_table::insert (cls)), - pkg.empty () ? 0 : &(symbol_table::insert (pkg)), - input_line_number, current_input_column); - - token_stack.push (yylval.tok_val); - - lexer_flags.convert_spaces_to_comma = true; - current_input_column += yyleng; - - return METAQUERY; -} - -// Figure out exactly what kind of token to return when we have seen -// an identifier. Handles keywords. Return -1 if the identifier -// should be ignored. - -static int -handle_identifier (void) -{ - bool at_bos = lexer_flags.at_beginning_of_statement; - - std::string tok = strip_trailing_whitespace (yytext); - - int c = yytext[yyleng-1]; - - int cont_is_spc = eat_continuation (); - - int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - - // If we are expecting a structure element, avoid recognizing - // keywords and other special names and return STRUCT_ELT, which is - // a string that is also a valid identifier. But first, we have to - // decide whether to insert a comma. - - if (lexer_flags.looking_at_indirect_ref) - { - do_comma_insert_check (); - - maybe_unput_comma (spc_gobbled); - - yylval.tok_val = new token (tok, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = true; - - current_input_column += yyleng; - - return STRUCT_ELT; - } - - lexer_flags.at_beginning_of_statement = false; - - // The is_keyword_token may reset - // lexer_flags.at_beginning_of_statement. For example, if it sees - // an else token, then the next token is at the beginning of a - // statement. - - int kw_token = is_keyword_token (tok); - - // If we found a keyword token, then the beginning_of_statement flag - // is already set. Otherwise, we won't be at the beginning of a - // statement. - - if (lexer_flags.looking_at_function_handle) - { - if (kw_token) - { - error ("function handles may not refer to keywords"); - - return LEXICAL_ERROR; - } - else - { - yylval.tok_val = new token (tok, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = true; - - return FCN_HANDLE; - } - } - - // If we have a regular keyword, return it. - // Keywords can be followed by identifiers. - - if (kw_token) - { - if (kw_token >= 0) - { - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - } - - return kw_token; - } - - // See if we have a plot keyword (title, using, with, or clear). - - int c1 = text_yyinput (); - - bool next_tok_is_eq = false; - if (c1 == '=') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - - if (c2 != '=') - next_tok_is_eq = true; - } - - xunput (c1, yytext); - - // Kluge alert. - // - // If we are looking at a text style function, set up to gobble its - // arguments. - // - // If the following token is `=', or if we are parsing a function - // return list or function parameter list, or if we are looking at - // something like [ab,cd] = foo (), force the symbol to be inserted - // as a variable in the current symbol table. - - if (! is_variable (tok)) - { - if (at_bos && spc_gobbled && can_be_command (tok) - && looks_like_command_arg ()) - { - BEGIN (COMMAND_START); - } - else if (next_tok_is_eq - || lexer_flags.looking_at_decl_list - || lexer_flags.looking_at_return_list - || (lexer_flags.looking_at_parameter_list - && ! lexer_flags.looking_at_initializer_expression)) - { - symbol_table::force_variable (tok); - } - else if (lexer_flags.looking_at_matrix_or_assign_lhs) - { - lexer_flags.pending_local_variables.insert (tok); - } - } - - // Find the token in the symbol table. Beware the magic - // transformation of the end keyword... - - if (tok == "end") - tok = "__end__"; - - yylval.tok_val = new token (&(symbol_table::insert (tok)), - input_line_number, current_input_column); - - token_stack.push (yylval.tok_val); - - // After seeing an identifer, it is ok to convert spaces to a comma - // (if needed). - - lexer_flags.convert_spaces_to_comma = true; - - if (! (next_tok_is_eq || YY_START == COMMAND_START)) - { - lexer_flags.quote_is_transpose = true; - - do_comma_insert_check (); - - maybe_unput_comma (spc_gobbled); - } - - current_input_column += yyleng; - - if (tok != "__end__") - lexer_flags.looking_for_object_index = true; - - return NAME; -} - -void -lexical_feedback::init (void) -{ - // Not initially defining a matrix list. - bracketflag = 0; - - // Not initially defining a cell array list. - braceflag = 0; - - // Not initially inside a loop or if statement. - looping = 0; - - // Not initially defining a function. - defining_func = 0; - - // Not parsing an object index. - while (! parsed_function_name.empty ()) - parsed_function_name.pop (); - - parsing_class_method = false; - - // Not initially defining a class with classdef. - maybe_classdef_get_set_method = false; - parsing_classdef = false; - - // Not initiallly looking at a function handle. - looking_at_function_handle = 0; - - // Not initiallly looking at an anonymous function argument list. - looking_at_anon_fcn_args = 0; - - // Not parsing a function return, parameter, or declaration list. - looking_at_return_list = false; - looking_at_parameter_list = false; - looking_at_decl_list = false; - - // Not looking at an argument list initializer expression. - looking_at_initializer_expression = false; - - // Not parsing a matrix or the left hand side of multi-value - // assignment statement. - looking_at_matrix_or_assign_lhs = false; - - // Not parsing an object index. - while (! looking_at_object_index.empty ()) - looking_at_object_index.pop_front (); - - looking_at_object_index.push_front (false); - - // Object index not possible until we've seen something. - looking_for_object_index = false; - - // Yes, we are at the beginning of a statement. - at_beginning_of_statement = true; - - // No need to do comma insert or convert spaces to comma at - // beginning of input. - convert_spaces_to_comma = true; - do_comma_insert = false; - - // Not initially looking at indirect references. - looking_at_indirect_ref = false; - - // Quote marks strings intially. - quote_is_transpose = false; - - // Set of identifiers that might be local variable names is empty. - pending_local_variables.clear (); -} - -bool -is_keyword (const std::string& s) -{ - // Parsing function names like "set.property_name" inside - // classdef-style class definitions is simplified by handling the - // "set" and "get" portions of the names using the same mechanism as - // is used for keywords. However, they are not really keywords in - // the language, so omit them from the list of possible keywords. - - return (octave_kw_hash::in_word_set (s.c_str (), s.length ()) != 0 - && ! (s == "set" || s == "get")); -} - -DEFUN (iskeyword, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iskeyword ()\n\ -@deftypefnx {Built-in Function} {} iskeyword (@var{name})\n\ -Return true if @var{name} is an Octave keyword. If @var{name}\n\ -is omitted, return a list of keywords.\n\ -@seealso{isvarname, exist}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("iskeyword"); - - if (error_state) - return retval; - - if (argc == 1) - { - // Neither set and get are keywords. See the note in the - // is_keyword function for additional details. - - string_vector lst (TOTAL_KEYWORDS); - - int j = 0; - - for (int i = 0; i < TOTAL_KEYWORDS; i++) - { - std::string tmp = wordlist[i].name; - - if (! (tmp == "set" || tmp == "get")) - lst[j++] = tmp; - } - - lst.resize (j); - - retval = Cell (lst.sort ()); - } - else if (argc == 2) - { - retval = is_keyword (argv[1]); - } - else - print_usage (); - - return retval; -} - -/* - -%!assert (iskeyword ("for")) -%!assert (iskeyword ("fort"), false) -%!assert (iskeyword ("fft"), false) - -*/ - -void -prep_lexer_for_script_file (void) -{ - BEGIN (SCRIPT_FILE_BEGIN); -} - -void -prep_lexer_for_function_file (void) -{ - BEGIN (FUNCTION_FILE_BEGIN); -} - -static void -maybe_warn_separator_insert (char sep) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:separator-insert", - "potential auto-insertion of `%c' near line %d", - sep, input_line_number); - else - warning_with_id ("Octave:separator-insert", - "potential auto-insertion of `%c' near line %d of file %s", - sep, input_line_number, nm.c_str ()); -} - -static void -gripe_single_quote_string (void) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:single-quote-string", - "single quote delimited string near line %d", - input_line_number); - else - warning_with_id ("Octave:single-quote-string", - "single quote delimited string near line %d of file %s", - input_line_number, nm.c_str ()); -} - -static void -gripe_matlab_incompatible (const std::string& msg) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:matlab-incompatible", - "potential Matlab compatibility problem: %s", - msg.c_str ()); - else - warning_with_id ("Octave:matlab-incompatible", - "potential Matlab compatibility problem: %s near line %d offile %s", - msg.c_str (), input_line_number, nm.c_str ()); -} - -static void -maybe_gripe_matlab_incompatible_comment (char c) -{ - if (c == '#') - gripe_matlab_incompatible ("# used as comment character"); -} - -static void -gripe_matlab_incompatible_continuation (void) -{ - gripe_matlab_incompatible ("\\ used as line continuation marker"); -} - -static void -gripe_matlab_incompatible_operator (const std::string& op) -{ - std::string t = op; - int n = t.length (); - if (t[n-1] == '\n') - t.resize (n-1); - gripe_matlab_incompatible (t + " used as operator"); -} - -static void -display_token (int tok) -{ - switch (tok) - { - case '=': std::cerr << "'='\n"; break; - case ':': std::cerr << "':'\n"; break; - case '-': std::cerr << "'-'\n"; break; - case '+': std::cerr << "'+'\n"; break; - case '*': std::cerr << "'*'\n"; break; - case '/': std::cerr << "'/'\n"; break; - case ADD_EQ: std::cerr << "ADD_EQ\n"; break; - case SUB_EQ: std::cerr << "SUB_EQ\n"; break; - case MUL_EQ: std::cerr << "MUL_EQ\n"; break; - case DIV_EQ: std::cerr << "DIV_EQ\n"; break; - case LEFTDIV_EQ: std::cerr << "LEFTDIV_EQ\n"; break; - case POW_EQ: std::cerr << "POW_EQ\n"; break; - case EMUL_EQ: std::cerr << "EMUL_EQ\n"; break; - case EDIV_EQ: std::cerr << "EDIV_EQ\n"; break; - case ELEFTDIV_EQ: std::cerr << "ELEFTDIV_EQ\n"; break; - case EPOW_EQ: std::cerr << "EPOW_EQ\n"; break; - case AND_EQ: std::cerr << "AND_EQ\n"; break; - case OR_EQ: std::cerr << "OR_EQ\n"; break; - case LSHIFT_EQ: std::cerr << "LSHIFT_EQ\n"; break; - case RSHIFT_EQ: std::cerr << "RSHIFT_EQ\n"; break; - case LSHIFT: std::cerr << "LSHIFT\n"; break; - case RSHIFT: std::cerr << "RSHIFT\n"; break; - case EXPR_AND_AND: std::cerr << "EXPR_AND_AND\n"; break; - case EXPR_OR_OR: std::cerr << "EXPR_OR_OR\n"; break; - case EXPR_AND: std::cerr << "EXPR_AND\n"; break; - case EXPR_OR: std::cerr << "EXPR_OR\n"; break; - case EXPR_NOT: std::cerr << "EXPR_NOT\n"; break; - case EXPR_LT: std::cerr << "EXPR_LT\n"; break; - case EXPR_LE: std::cerr << "EXPR_LE\n"; break; - case EXPR_EQ: std::cerr << "EXPR_EQ\n"; break; - case EXPR_NE: std::cerr << "EXPR_NE\n"; break; - case EXPR_GE: std::cerr << "EXPR_GE\n"; break; - case EXPR_GT: std::cerr << "EXPR_GT\n"; break; - case LEFTDIV: std::cerr << "LEFTDIV\n"; break; - case EMUL: std::cerr << "EMUL\n"; break; - case EDIV: std::cerr << "EDIV\n"; break; - case ELEFTDIV: std::cerr << "ELEFTDIV\n"; break; - case EPLUS: std::cerr << "EPLUS\n"; break; - case EMINUS: std::cerr << "EMINUS\n"; break; - case QUOTE: std::cerr << "QUOTE\n"; break; - case TRANSPOSE: std::cerr << "TRANSPOSE\n"; break; - case PLUS_PLUS: std::cerr << "PLUS_PLUS\n"; break; - case MINUS_MINUS: std::cerr << "MINUS_MINUS\n"; break; - case POW: std::cerr << "POW\n"; break; - case EPOW: std::cerr << "EPOW\n"; break; - - case NUM: - case IMAG_NUM: - std::cerr << (tok == NUM ? "NUM" : "IMAG_NUM") - << " [" << yylval.tok_val->number () << "]\n"; - break; - - case STRUCT_ELT: - std::cerr << "STRUCT_ELT [" << yylval.tok_val->text () << "]\n"; break; - - case NAME: - { - symbol_table::symbol_record *sr = yylval.tok_val->sym_rec (); - std::cerr << "NAME"; - if (sr) - std::cerr << " [" << sr->name () << "]"; - std::cerr << "\n"; - } - break; - - case END: std::cerr << "END\n"; break; - - case DQ_STRING: - case SQ_STRING: - std::cerr << (tok == DQ_STRING ? "DQ_STRING" : "SQ_STRING") - << " [" << yylval.tok_val->text () << "]\n"; - break; - - case FOR: std::cerr << "FOR\n"; break; - case WHILE: std::cerr << "WHILE\n"; break; - case DO: std::cerr << "DO\n"; break; - case UNTIL: std::cerr << "UNTIL\n"; break; - case IF: std::cerr << "IF\n"; break; - case ELSEIF: std::cerr << "ELSEIF\n"; break; - case ELSE: std::cerr << "ELSE\n"; break; - case SWITCH: std::cerr << "SWITCH\n"; break; - case CASE: std::cerr << "CASE\n"; break; - case OTHERWISE: std::cerr << "OTHERWISE\n"; break; - case BREAK: std::cerr << "BREAK\n"; break; - case CONTINUE: std::cerr << "CONTINUE\n"; break; - case FUNC_RET: std::cerr << "FUNC_RET\n"; break; - case UNWIND: std::cerr << "UNWIND\n"; break; - case CLEANUP: std::cerr << "CLEANUP\n"; break; - case TRY: std::cerr << "TRY\n"; break; - case CATCH: std::cerr << "CATCH\n"; break; - case GLOBAL: std::cerr << "GLOBAL\n"; break; - case PERSISTENT: std::cerr << "PERSISTENT\n"; break; - case FCN_HANDLE: std::cerr << "FCN_HANDLE\n"; break; - case END_OF_INPUT: std::cerr << "END_OF_INPUT\n\n"; break; - case LEXICAL_ERROR: std::cerr << "LEXICAL_ERROR\n\n"; break; - case FCN: std::cerr << "FCN\n"; break; - case CLOSE_BRACE: std::cerr << "CLOSE_BRACE\n"; break; - case SCRIPT_FILE: std::cerr << "SCRIPT_FILE\n"; break; - case FUNCTION_FILE: std::cerr << "FUNCTION_FILE\n"; break; - case SUPERCLASSREF: std::cerr << "SUPERCLASSREF\n"; break; - case METAQUERY: std::cerr << "METAQUERY\n"; break; - case GET: std::cerr << "GET\n"; break; - case SET: std::cerr << "SET\n"; break; - case PROPERTIES: std::cerr << "PROPERTIES\n"; break; - case METHODS: std::cerr << "METHODS\n"; break; - case EVENTS: std::cerr << "EVENTS\n"; break; - case CLASSDEF: std::cerr << "CLASSDEF\n"; break; - case '\n': std::cerr << "\\n\n"; break; - case '\r': std::cerr << "\\r\n"; break; - case '\t': std::cerr << "TAB\n"; break; - default: - { - if (tok < 256) - std::cerr << static_cast<char> (tok) << "\n"; - else - std::cerr << "UNKNOWN(" << tok << ")\n"; - } - break; - } -} - -static void -display_state (void) -{ - std::cerr << "S: "; - - switch (YY_START) - { - case INITIAL: - std::cerr << "INITIAL" << std::endl; - break; - - case COMMAND_START: - std::cerr << "COMMAND_START" << std::endl; - break; - - case MATRIX_START: - std::cerr << "MATRIX_START" << std::endl; - break; - - case SCRIPT_FILE_BEGIN: - std::cerr << "SCRIPT_FILE_BEGIN" << std::endl; - break; - - case FUNCTION_FILE_BEGIN: - std::cerr << "FUNCTION_FILE_BEGIN" << std::endl; - break; - - default: - std::cerr << "UNKNOWN START STATE!" << std::endl; - break; - } -} - -static void -lexer_debug (const char *pattern, const char *text) -{ - std::cerr << std::endl; - - display_state (); - - std::cerr << "P: " << pattern << std::endl; - std::cerr << "T: " << text << std::endl; -} - -DEFUN (__display_tokens__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __display_tokens__ ()\n\ -Query or set the internal variable that determines whether Octave's\n\ -lexer displays tokens as they are read.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (display_tokens); -} - -DEFUN (__token_count__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __token_count__ ()\n\ -Number of language tokens processed since Octave startup.\n\ -@end deftypefn") -{ - return octave_value (Vtoken_count); -} - -DEFUN (__lexer_debug_flag__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{old_val} =} __lexer_debug_flag__ (@var{new_val}))\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - retval = set_internal_variable (lexer_debug_flag, args, nargout, - "__lexer_debug_flag__"); - - return retval; -}
--- a/src/oct-parse.yy Thu Aug 02 16:33:24 2012 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4734 +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" - -#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 - -// The current input line number. -int input_line_number = 1; - -// The column of the current token. -int current_input_column = 1; - -// Buffer for help text snagged from function files. -std::stack<std::string> help_buf; - -// Buffer for comments appearing before a function statement. -static std::string fcn_comment_header; - -// 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; - -// = 0 currently outside any function. -// = 1 inside the primary function or a subfunction. -// > 1 means we are looking at a function definition that seems to be -// inside a function. Note that the function still might not be a -// nested function. -static int current_function_depth = 0; - -// A stack holding the nested function scopes being parsed. -// We don't use std::stack, because we want the clear method. Also, we -// must access one from the top -static std::vector<symbol_table::scope_id> function_scopes; - -// Maximum function depth detected. Just here to determine whether -// we have nested functions or just implicitly ended subfunctions. -static int max_function_depth = 0; - -// FALSE if we are still at the primary function. Subfunctions can -// only be declared inside function files. -static int parsing_subfunctions = false; - -// Have we found an explicit end to a function? -static bool endfunction_found = false; - -// Keep track of symbol table information when parsing functions. -symtab_context parser_symtab_context; - -// Name of the current class when we are parsing class methods or -// constructors. -std::string current_class_name; - -// TRUE means we are in the process of autoloading a function. -static bool autoloading = false; - -// TRUE means the current function file was found in a relative path -// element. -static bool fcn_file_from_relative_lookup = false; - -// Pointer to the primary user function or user script function. -static octave_function *primary_fcn_ptr = 0; - -// Scope where we install all subfunctions and nested functions. Only -// used while reading function files. -static symbol_table::scope_id primary_fcn_scope; - -// 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. - -// Generic error messages. -static void -yyerror (const char *s); - -// Error mesages for mismatched end tokens. -static void -end_error (const char *type, token::end_tok_type ettype, int l, int c); - -// Check to see that end tokens are properly matched. -static bool -end_token_ok (token *tok, token::end_tok_type expected); - -// Maybe print a warning if an assignment expression is used as the -// test in a logical expression. -static void -maybe_warn_assign_as_truth_value (tree_expression *expr); - -// Maybe print a warning about switch labels that aren't constants. -static void -maybe_warn_variable_switch_label (tree_expression *expr); - -// Finish building a range. -static tree_expression * -finish_colon_expression (tree_colon_expression *e); - -// Build a constant. -static tree_constant * -make_constant (int op, token *tok_val); - -// Build a function handle. -static tree_fcn_handle * -make_fcn_handle (token *tok_val); - -// Build an anonymous function handle. -static tree_anon_fcn_handle * -make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); - -// Build a binary expression. -static tree_expression * -make_binary_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2); - -// Build a boolean expression. -static tree_expression * -make_boolean_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2); - -// Build a prefix expression. -static tree_expression * -make_prefix_op (int op, tree_expression *op1, token *tok_val); - -// Build a postfix expression. -static tree_expression * -make_postfix_op (int op, tree_expression *op1, token *tok_val); - -// Build an unwind-protect command. -static tree_command * -make_unwind_command (token *unwind_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc); - -// Build a try-catch command. -static tree_command * -make_try_command (token *try_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc); - -// Build a while command. -static tree_command * -make_while_command (token *while_tok, tree_expression *expr, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc); - -// Build a do-until command. -static tree_command * -make_do_until_command (token *until_tok, tree_statement_list *body, - tree_expression *expr, octave_comment_list *lc); - -// Build a for command. -static tree_command * -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); - -// Build a break command. -static tree_command * -make_break_command (token *break_tok); - -// Build a continue command. -static tree_command * -make_continue_command (token *continue_tok); - -// Build a return command. -static tree_command * -make_return_command (token *return_tok); - -// Start an if command. -static tree_if_command_list * -start_if_command (tree_expression *expr, tree_statement_list *list); - -// Finish an if command. -static tree_if_command * -finish_if_command (token *if_tok, tree_if_command_list *list, - token *end_tok, octave_comment_list *lc); - -// Build an elseif clause. -static tree_if_clause * -make_elseif_clause (token *elseif_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc); - -// Finish a switch command. -static tree_switch_command * -finish_switch_command (token *switch_tok, tree_expression *expr, - tree_switch_case_list *list, token *end_tok, - octave_comment_list *lc); - -// Build a switch case. -static tree_switch_case * -make_switch_case (token *case_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc); - -// Build an assignment to a variable. -static tree_expression * -make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, - tree_expression *rhs); - -// Define a script. -static void -make_script (tree_statement_list *cmds, tree_statement *end_script); - -// Begin defining a function. -static octave_user_function * -start_function (tree_parameter_list *param_list, tree_statement_list *body, - tree_statement *end_function); - -// Create a no-op statement for end_function. -static tree_statement * -make_end (const std::string& type, int l, int c); - -// Do most of the work for defining a function. -static octave_user_function * -frob_function (const std::string& fname, octave_user_function *fcn); - -// Finish defining a function. -static tree_function_def * -finish_function (tree_parameter_list *ret_list, - octave_user_function *fcn, octave_comment_list *lc); - -// Reset state after parsing function. -static void -recover_from_parsing_function (void); - -// Make an index expression. -static tree_index_expression * -make_index_expression (tree_expression *expr, - tree_argument_list *args, char type); - -// Make an indirect reference expression. -static tree_index_expression * -make_indirect_ref (tree_expression *expr, const std::string&); - -// Make an indirect reference expression with dynamic field name. -static tree_index_expression * -make_indirect_ref (tree_expression *expr, tree_expression *field); - -// Make a declaration command. -static tree_decl_command * -make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst); - -// Validate argument list forming a matrix or cell row. -static tree_argument_list * -validate_matrix_row (tree_argument_list *row); - -// Finish building a matrix list. -static tree_expression * -finish_matrix (tree_matrix *m); - -// Finish building a cell list. -static tree_expression * -finish_cell (tree_cell *c); - -// Maybe print a warning. Duh. -static void -maybe_warn_missing_semi (tree_statement_list *); - -// Set the print flag for a statement based on the separator type. -static tree_statement_list * -set_stmt_print_flag (tree_statement_list *, char, bool); - -// Create a statement list. -static tree_statement_list *make_statement_list (tree_statement *stmt); - -// Append a statement to an existing statement list. -static tree_statement_list * -append_statement_list (tree_statement_list *list, char sep, - tree_statement *stmt, bool warn_missing_semi); - -// 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) - -%} - -// 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_" - -%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 - { - parser_end_of_input = 1; - $$ = 0; - } - | simple_list - { $$ = $1; } - | simple_list '\n' - { $$ = $1; } - | simple_list END_OF_INPUT - { $$ = $1; } - ; - -simple_list : simple_list1 opt_sep_no_nl - { $$ = set_stmt_print_flag ($1, $2, false); } - ; - -simple_list1 : statement - { $$ = make_statement_list ($1); } - | simple_list1 sep_no_nl statement - { $$ = append_statement_list ($1, $2, $3, false); } - ; - -opt_list : // empty - { $$ = new tree_statement_list (); } - | list - { $$ = $1; } - ; - -list : list1 opt_sep - { $$ = set_stmt_print_flag ($1, $2, true); } - ; - -list1 : statement - { $$ = make_statement_list ($1); } - | list1 sep statement - { $$ = 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 - { $$ = 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 - { $$ = make_constant (DQ_STRING, $1); } - | SQ_STRING - { $$ = make_constant (SQ_STRING, $1); } - ; - -constant : NUM - { $$ = make_constant (NUM, $1); } - | IMAG_NUM - { $$ = make_constant (IMAG_NUM, $1); } - | string - { $$ = $1; } - ; - -matrix : '[' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' ';' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' ',' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' matrix_rows ']' - { - $$ = finish_matrix ($2); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.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 '}' - { $$ = 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 - { $$ = validate_matrix_row ($1); } - | arg_list ',' // Ignore trailing comma. - { $$ = validate_matrix_row ($1); } - ; - -fcn_handle : '@' FCN_HANDLE - { - $$ = make_fcn_handle ($2); - lexer_flags.looking_at_function_handle--; - } - ; - -anon_fcn_handle : '@' param_list statement - { - lexer_flags.quote_is_transpose = false; - $$ = 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 : '.' - { lexer_flags.looking_at_indirect_ref = true; } - ; - -oper_expr : primary_expr - { $$ = $1; } - | oper_expr PLUS_PLUS - { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } - | oper_expr MINUS_MINUS - { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } - | oper_expr '(' ')' - { $$ = make_index_expression ($1, 0, '('); } - | oper_expr '(' arg_list ')' - { $$ = make_index_expression ($1, $3, '('); } - | oper_expr '{' '}' - { $$ = make_index_expression ($1, 0, '{'); } - | oper_expr '{' arg_list '}' - { $$ = make_index_expression ($1, $3, '{'); } - | oper_expr QUOTE - { $$ = make_postfix_op (QUOTE, $1, $2); } - | oper_expr TRANSPOSE - { $$ = make_postfix_op (TRANSPOSE, $1, $2); } - | oper_expr indirect_ref_op STRUCT_ELT - { $$ = make_indirect_ref ($1, $3->text ()); } - | oper_expr indirect_ref_op '(' expression ')' - { $$ = make_indirect_ref ($1, $4); } - | PLUS_PLUS oper_expr %prec UNARY - { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } - | MINUS_MINUS oper_expr %prec UNARY - { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } - | EXPR_NOT oper_expr %prec UNARY - { $$ = make_prefix_op (EXPR_NOT, $2, $1); } - | '+' oper_expr %prec UNARY - { $$ = make_prefix_op ('+', $2, $1); } - | '-' oper_expr %prec UNARY - { $$ = make_prefix_op ('-', $2, $1); } - | oper_expr POW oper_expr - { $$ = make_binary_op (POW, $1, $2, $3); } - | oper_expr EPOW oper_expr - { $$ = make_binary_op (EPOW, $1, $2, $3); } - | oper_expr '+' oper_expr - { $$ = make_binary_op ('+', $1, $2, $3); } - | oper_expr '-' oper_expr - { $$ = make_binary_op ('-', $1, $2, $3); } - | oper_expr '*' oper_expr - { $$ = make_binary_op ('*', $1, $2, $3); } - | oper_expr '/' oper_expr - { $$ = make_binary_op ('/', $1, $2, $3); } - | oper_expr EPLUS oper_expr - { $$ = make_binary_op ('+', $1, $2, $3); } - | oper_expr EMINUS oper_expr - { $$ = make_binary_op ('-', $1, $2, $3); } - | oper_expr EMUL oper_expr - { $$ = make_binary_op (EMUL, $1, $2, $3); } - | oper_expr EDIV oper_expr - { $$ = make_binary_op (EDIV, $1, $2, $3); } - | oper_expr LEFTDIV oper_expr - { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } - | oper_expr ELEFTDIV oper_expr - { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } - ; - -colon_expr : colon_expr1 - { $$ = 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 - { $$ = make_binary_op (LSHIFT, $1, $2, $3); } - | simple_expr RSHIFT simple_expr - { $$ = make_binary_op (RSHIFT, $1, $2, $3); } - | simple_expr EXPR_LT simple_expr - { $$ = make_binary_op (EXPR_LT, $1, $2, $3); } - | simple_expr EXPR_LE simple_expr - { $$ = make_binary_op (EXPR_LE, $1, $2, $3); } - | simple_expr EXPR_EQ simple_expr - { $$ = make_binary_op (EXPR_EQ, $1, $2, $3); } - | simple_expr EXPR_GE simple_expr - { $$ = make_binary_op (EXPR_GE, $1, $2, $3); } - | simple_expr EXPR_GT simple_expr - { $$ = make_binary_op (EXPR_GT, $1, $2, $3); } - | simple_expr EXPR_NE simple_expr - { $$ = make_binary_op (EXPR_NE, $1, $2, $3); } - | simple_expr EXPR_AND simple_expr - { $$ = make_binary_op (EXPR_AND, $1, $2, $3); } - | simple_expr EXPR_OR simple_expr - { $$ = make_binary_op (EXPR_OR, $1, $2, $3); } - | simple_expr EXPR_AND_AND simple_expr - { $$ = make_boolean_op (EXPR_AND_AND, $1, $2, $3); } - | simple_expr EXPR_OR_OR simple_expr - { $$ = 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; - lexer_flags.looking_at_matrix_or_assign_lhs = false; - for (std::set<std::string>::const_iterator p = lexer_flags.pending_local_variables.begin (); - p != lexer_flags.pending_local_variables.end (); - p++) - { - symbol_table::force_variable (*p); - } - lexer_flags.pending_local_variables.clear (); - } - ; - -assign_expr : assign_lhs '=' expression - { $$ = make_assign_op ('=', $1, $2, $3); } - | assign_lhs ADD_EQ expression - { $$ = make_assign_op (ADD_EQ, $1, $2, $3); } - | assign_lhs SUB_EQ expression - { $$ = make_assign_op (SUB_EQ, $1, $2, $3); } - | assign_lhs MUL_EQ expression - { $$ = make_assign_op (MUL_EQ, $1, $2, $3); } - | assign_lhs DIV_EQ expression - { $$ = make_assign_op (DIV_EQ, $1, $2, $3); } - | assign_lhs LEFTDIV_EQ expression - { $$ = make_assign_op (LEFTDIV_EQ, $1, $2, $3); } - | assign_lhs POW_EQ expression - { $$ = make_assign_op (POW_EQ, $1, $2, $3); } - | assign_lhs LSHIFT_EQ expression - { $$ = make_assign_op (LSHIFT_EQ, $1, $2, $3); } - | assign_lhs RSHIFT_EQ expression - { $$ = make_assign_op (RSHIFT_EQ, $1, $2, $3); } - | assign_lhs EMUL_EQ expression - { $$ = make_assign_op (EMUL_EQ, $1, $2, $3); } - | assign_lhs EDIV_EQ expression - { $$ = make_assign_op (EDIV_EQ, $1, $2, $3); } - | assign_lhs ELEFTDIV_EQ expression - { $$ = make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } - | assign_lhs EPOW_EQ expression - { $$ = make_assign_op (EPOW_EQ, $1, $2, $3); } - | assign_lhs AND_EQ expression - { $$ = make_assign_op (AND_EQ, $1, $2, $3); } - | assign_lhs OR_EQ expression - { $$ = 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 - { lexer_flags.looking_at_decl_list = true; } - -declaration : GLOBAL parsing_decl_list decl1 - { - $$ = make_decl_command (GLOBAL, $1, $3); - lexer_flags.looking_at_decl_list = false; - } - | PERSISTENT parsing_decl_list decl1 - { - $$ = make_decl_command (PERSISTENT, $1, $3); - lexer_flags.looking_at_decl_list = false; - } - ; - -decl1 : decl2 - { $$ = new tree_decl_init_list ($1); } - | decl1 decl2 - { - $1->append ($2); - $$ = $1; - } - ; - -decl_param_init : // empty - { lexer_flags.looking_at_initializer_expression = true; } - -decl2 : identifier - { $$ = new tree_decl_elt ($1); } - | identifier '=' decl_param_init expression - { - lexer_flags.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 (! ($$ = 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); - - $$ = 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); - - $$ = 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 (! ($$ = 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 - { $$ = 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 (! ($$ = make_while_command ($1, $3, $5, $6, $2))) - ABORT_PARSE; - } - | DO stash_comment opt_sep opt_list UNTIL expression - { - if (! ($$ = make_do_until_command ($5, $4, $6, $2))) - ABORT_PARSE; - } - | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END - { - if (! ($$ = 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 (! ($$ = 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 (! ($$ = 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 (! ($$ = make_for_command (PARFOR, $1, $4, $6, - $8, $11, $12, $2))) - ABORT_PARSE; - } - ; - -// ======= -// Jumping -// ======= - -jump_command : BREAK - { - if (! ($$ = make_break_command ($1))) - ABORT_PARSE; - } - | CONTINUE - { - if (! ($$ = make_continue_command ($1))) - ABORT_PARSE; - } - | FUNC_RET - { - if (! ($$ = 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 (! ($$ = 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 (! ($$ = make_try_command ($1, $4, $8, $9, $2, $6))) - ABORT_PARSE; - } - | TRY stash_comment opt_sep opt_list END - { - if (! ($$ = make_try_command ($1, $4, 0, $5, $2, 0))) - ABORT_PARSE; - } - ; - -// =========================================== -// Some `subroutines' for function definitions -// =========================================== - -push_fcn_symtab : // empty - { - current_function_depth++; - - if (max_function_depth < current_function_depth) - max_function_depth = current_function_depth; - - parser_symtab_context.push (); - - symbol_table::set_scope (symbol_table::alloc_scope ()); - - function_scopes.push_back (symbol_table::current_scope ()); - - if (! reading_script_file && current_function_depth == 1 - && ! parsing_subfunctions) - primary_fcn_scope = symbol_table::current_scope (); - - if (reading_script_file && current_function_depth > 1) - yyerror ("nested functions not implemented in this context"); - } - ; - -// =========================== -// List of function parameters -// =========================== - -param_list_beg : '(' - { - lexer_flags.looking_at_parameter_list = true; - - if (lexer_flags.looking_at_function_handle) - { - parser_symtab_context.push (); - symbol_table::set_scope (symbol_table::alloc_scope ()); - lexer_flags.looking_at_function_handle--; - lexer_flags.looking_at_anon_fcn_args = true; - } - } - ; - -param_list_end : ')' - { - lexer_flags.looking_at_parameter_list = false; - lexer_flags.looking_for_object_index = false; - } - ; - -param_list : param_list_beg param_list1 param_list_end - { - lexer_flags.quote_is_transpose = false; - $$ = $2; - } - | param_list_beg error - { - yyerror ("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 : '[' ']' - { - lexer_flags.looking_at_return_list = false; - $$ = new tree_parameter_list (); - } - | return_list1 - { - lexer_flags.looking_at_return_list = false; - if ($1->validate (tree_parameter_list::out)) - $$ = $1; - else - ABORT_PARSE; - } - | '[' return_list1 ']' - { - lexer_flags.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 - = make_end ("endscript", input_line_number, - current_input_column); - - 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 || lexer_flags.parsing_classdef) - lexer_flags.maybe_classdef_get_set_method = true; - } - ; - -function : function_beg function1 - { - $$ = finish_function (0, $2, $1); - recover_from_parsing_function (); - } - | function_beg return_list '=' function1 - { - $$ = finish_function ($2, $4, $1); - recover_from_parsing_function (); - } - ; - -fcn_name : identifier - { - std::string id_name = $1->name (); - - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - - $$ = $1; - } - | GET '.' identifier - { - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - $$ = $3; - } - | SET '.' identifier - { - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - $$ = $3; - } - ; - -function1 : fcn_name function2 - { - std::string fname = $1->name (); - - delete $1; - - if (! ($$ = frob_function (fname, $2))) - ABORT_PARSE; - } - ; - -function2 : param_list opt_sep opt_list function_end - { $$ = start_function ($1, $3, $4); } - | opt_sep opt_list function_end - { $$ = start_function (0, $2, $3); } - ; - -function_end : END - { - endfunction_found = true; - if (end_token_ok ($1, token::function_end)) - $$ = 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) -// { -// yyerror ("function body open at end of script"); -// YYABORT; -// } - - if (endfunction_found) - { - yyerror ("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)) - { - yyerror ("function body open at end of input"); - YYABORT; - } - - if (reading_classdef_file) - { - yyerror ("classdef body open at end of input"); - YYABORT; - } - - $$ = make_end ("endfunction", input_line_number, - current_input_column); - } - ; - -// ======== -// Classdef -// ======== - -classdef_beg : CLASSDEF stash_comment - { - $$ = 0; - lexer_flags.parsing_classdef = true; - } - ; - -classdef_end : END - { - lexer_flags.parsing_classdef = false; - - if (end_token_ok ($1, token::classdef_end)) - $$ = 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 - { yyerror ("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. - -static void -yyerror (const char *s) -{ - int err_col = current_input_column - 1; - - std::ostringstream output_buf; - - if (reading_fcn_file || reading_script_file || reading_classdef_file) - output_buf << "parse error near line " << 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 ()); -} - -// Error mesages for mismatched end tokens. - -static void -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. - -static bool -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; - - yyerror ("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. - -static void -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. - -static void -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. - -static tree_expression * -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. - -static tree_constant * -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. - -static tree_fcn_handle * -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. - -static tree_anon_fcn_handle * -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 = input_line_number; - int c = 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. - -static tree_expression * -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. - -static tree_expression * -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. - -static tree_expression * -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. - -static tree_expression * -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. - -static tree_command * -make_unwind_command (token *unwind_tok, tree_statement_list *body, - tree_statement_list *cleanup, 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, - lc, mc, tc, l, c); - } - - return retval; -} - -// Build a try-catch command. - -static tree_command * -make_try_command (token *try_tok, tree_statement_list *body, - tree_statement_list *cleanup, 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, - lc, mc, tc, l, c); - } - - return retval; -} - -// Build a while command. - -static tree_command * -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 (); - - lexer_flags.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. - -static tree_command * -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 (); - - lexer_flags.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. - -static tree_command * -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 (); - - lexer_flags.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) - yyerror ("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. - -static tree_command * -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. - -static tree_command * -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. - -static tree_command * -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. - -static tree_if_command_list * -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. - -static tree_if_command * -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. - -static tree_if_clause * -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. - -static tree_switch_command * -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. - -static tree_switch_case * -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. - -static tree_expression * -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 - yyerror ("computed multiple assignment not allowed"); - - return retval; -} - -// Define a script. - -static void -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. - -static octave_user_function * -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; -} - -static tree_statement * -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. - -static octave_user_function * -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 - && current_function_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 (current_function_depth > 1 || parsing_subfunctions) - { - fcn->stash_parent_fcn_name (curr_fcn_file_name); - - if (current_function_depth > 1) - fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size ()-2]); - else - fcn->stash_parent_fcn_scope (primary_fcn_scope); - } - - if (lexer_flags.parsing_class_method) - { - if (current_class_name == id_name) - fcn->mark_as_class_constructor (); - else - fcn->mark_as_class_method (); - - fcn->stash_dispatch_class (current_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 (input_line_number, current_input_column); - - if (! help_buf.empty () && current_function_depth == 1 - && ! parsing_subfunctions) - { - fcn->document (help_buf.top ()); - - help_buf.pop (); - } - - if (reading_fcn_file && current_function_depth == 1 - && ! parsing_subfunctions) - primary_fcn_ptr = fcn; - - return fcn; -} - -static tree_function_def * -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 (current_function_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 (current_function_depth == 1 && fcn) - symbol_table::update_nest (fcn->scope ()); - - if (! reading_fcn_file && current_function_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; -} - -static void -recover_from_parsing_function (void) -{ - if (parser_symtab_context.empty ()) - panic_impossible (); - - parser_symtab_context.pop (); - - if (reading_fcn_file && current_function_depth == 1 - && ! parsing_subfunctions) - parsing_subfunctions = true; - - current_function_depth--; - function_scopes.pop_back (); - - lexer_flags.defining_func--; - lexer_flags.parsed_function_name.pop (); - lexer_flags.looking_at_return_list = false; - lexer_flags.looking_at_parameter_list = false; -} - -// Make an index expression. - -static tree_index_expression * -make_index_expression (tree_expression *expr, tree_argument_list *args, - char type) -{ - tree_index_expression *retval = 0; - - if (args && args->has_magic_tilde ()) - { - yyerror ("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. - -static tree_index_expression * -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); - - lexer_flags.looking_at_indirect_ref = false; - - return retval; -} - -// Make an indirect reference expression with dynamic field name. - -static tree_index_expression * -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); - - lexer_flags.looking_at_indirect_ref = false; - - return retval; -} - -// Make a declaration command. - -static tree_decl_command * -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 (current_function_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; -} - -static tree_argument_list * -validate_matrix_row (tree_argument_list *row) -{ - if (row && row->has_magic_tilde ()) - yyerror ("invalid use of tilde (~) in matrix expression"); - return row; -} - -// Finish building a matrix list. - -static tree_expression * -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. - -static tree_expression * -finish_cell (tree_cell *c) -{ - return finish_matrix (c); -} - -static void -maybe_warn_missing_semi (tree_statement_list *t) -{ - if (current_function_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 ()); - } -} - -static tree_statement_list * -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; -} - -static tree_statement_list * -make_statement_list (tree_statement *stmt) -{ - return new tree_statement_list (stmt); -} - -static tree_statement_list * -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; -} - -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'; - } - } - - if (c == '\n') - input_line_number++; - - return c; -} - -class -stdio_stream_reader : public stream_reader -{ -public: - stdio_stream_reader (FILE *f_arg) : stream_reader (), f (f_arg) { } - - int getc (void) { return ::text_getc (f); } - int ungetc (int c) - { - if (c == '\n') - input_line_number--; - - return ::ungetc (c, f); - } - -private: - FILE *f; - - // 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': - current_input_column++; - break; - - case '\n': - current_input_column = 1; - 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) -{ - 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); - - while (true) - { - eof = skip_white_space (stdio_reader); - - if (eof) - break; - - txt = 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 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 force_script = false, bool require_file = true, - const std::string& warn_for = std::string ()) -{ - 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 (input_line_number); - frame.protect_var (current_input_column); - frame.protect_var (reading_fcn_file); - frame.protect_var (line_editing); - frame.protect_var (current_class_name); - frame.protect_var (current_function_depth); - frame.protect_var (function_scopes); - frame.protect_var (max_function_depth); - frame.protect_var (parsing_subfunctions); - frame.protect_var (endfunction_found); - - input_line_number = 1; - current_input_column = 1; - reading_fcn_file = true; - line_editing = false; - current_class_name = dispatch_type; - current_function_depth = 0; - function_scopes.clear (); - max_function_depth = 0; - parsing_subfunctions = false; - endfunction_found = 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; - - std::string help_txt = gobble_leading_white_space (ffile, eof); - - 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 (parser_end_of_input); - 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; - parser_end_of_input = 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; - } - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (ffile); - - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - - frame.protect_var (primary_fcn_ptr); - primary_fcn_ptr = 0; - - reset_parser (); - - // 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) - prep_lexer_for_script_file (); - else - prep_lexer_for_function_file (); - - lexer_flags.parsing_class_method = ! dispatch_type.empty (); - - frame.protect_var (global_command); - - global_command = 0; - - int status = yyparse (); - - // 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 = primary_fcn_ptr; - - if (status != 0) - error ("parse error while reading %s file %s", - file_type.c_str (), ff.c_str ()); - } - else - { - tree_statement *end_of_script - = make_end ("endscript", input_line_number, current_input_column); - - make_script (0, end_of_script); - - fcn_ptr = 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, ""); - - 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; - - frame.protect_var (fcn_file_from_relative_lookup); - - fcn_file_from_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); - } - - if (autoload) - { - frame.protect_var (autoloading); - autoloading = true; - } - - fcn_file_from_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, fcn_file_from_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, autoloading, - false); - - retval = octave_dynamic_loader::load_mex (nm, file, fcn_file_from_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, autoloading); - } - - 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, "", true, - require_file, 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; - - frame.protect_var (input_line_number); - frame.protect_var (current_input_column); - frame.protect_var (get_input_from_eval_string); - frame.protect_var (input_from_eval_string_pending); - frame.protect_var (parser_end_of_input); - frame.protect_var (line_editing); - frame.protect_var (current_eval_string); - frame.protect_var (current_function_depth); - frame.protect_var (function_scopes); - frame.protect_var (max_function_depth); - frame.protect_var (parsing_subfunctions); - frame.protect_var (endfunction_found); - frame.protect_var (reading_fcn_file); - frame.protect_var (reading_script_file); - frame.protect_var (reading_classdef_file); - - input_line_number = 1; - current_input_column = 1; - get_input_from_eval_string = true; - input_from_eval_string_pending = true; - parser_end_of_input = false; - line_editing = false; - current_function_depth = 0; - function_scopes.clear (); - max_function_depth = 0; - parsing_subfunctions = false; - endfunction_found = false; - reading_fcn_file = false; - reading_script_file = false; - reading_classdef_file = false; - - current_eval_string = s; - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (0); - - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - - do - { - reset_parser (); - - 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 = yyparse (); - - tree_statement_list *command_list = global_command; - - // Unmark forced variables. - // Restore previous value of global_command. - frame.run_top (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 (parser_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/src/parse-private.h Thu Aug 02 16:33:24 2012 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -/* - -Copyright (C) 2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 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/>. - -*/ - -#if !defined (octave_parse_private_h) -#define octave_parse_private_h 1 - -#include <stack> - -#include "symtab.h" - -// Keep track of symbol table information when parsing functions. -class symtab_context -{ -private: - - class frame - { - public: - frame (symbol_table::scope_id s, symbol_table::scope_id c) - : m_scope (s), m_context (c) { } - - frame (const frame& f) : m_scope (f.m_scope), m_context (f.m_context) { } - - frame& operator = (const frame& f) - { - if (&f != this) - { - m_scope = f.m_scope; - m_context = f.m_context; - } - - return *this; - } - - ~frame (void) { } - - symbol_table::scope_id scope (void) const { return m_scope; } - symbol_table::scope_id context (void) const { return m_context; } - - private: - - symbol_table::scope_id m_scope; - symbol_table::scope_id m_context; - }; - - std::stack<frame> frame_stack; - -public: - symtab_context (void) : frame_stack () { } - - void clear (void) - { - while (! frame_stack.empty ()) - frame_stack.pop (); - } - - bool empty (void) const { return frame_stack.empty (); } - - void pop (void) - { - frame tmp = frame_stack.top (); - - symbol_table::set_scope_and_context (tmp.scope (), tmp.context ()); - - frame_stack.pop (); - } - - void push (void) - { - frame_stack.push (frame (symbol_table::current_scope (), - symbol_table::current_context ())); - } -}; - -extern symtab_context parser_symtab_context; - -#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/lex.h Thu Aug 02 17:10:26 2012 -0700 @@ -0,0 +1,200 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 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/>. + +*/ + +#if !defined (octave_lex_h) +#define octave_lex_h 1 + +#include <list> +#include <stack> + +// FIXME -- these input buffer things should be members of a +// parser input stream class. + +typedef struct yy_buffer_state *YY_BUFFER_STATE; + +// Associate a buffer with a new file to read. +extern OCTINTERP_API YY_BUFFER_STATE create_buffer (FILE *f); + +// Report the current buffer. +extern OCTINTERP_API YY_BUFFER_STATE current_buffer (void); + +// Connect to new buffer buffer. +extern OCTINTERP_API void switch_to_buffer (YY_BUFFER_STATE buf); + +// Delete a buffer. +extern OCTINTERP_API void delete_buffer (YY_BUFFER_STATE buf); + +extern OCTINTERP_API void clear_all_buffers (void); + +extern OCTINTERP_API void cleanup_parser (void); + +// Is the given string a keyword? +extern bool is_keyword (const std::string& s); + +extern void prep_lexer_for_script_file (void); +extern void prep_lexer_for_function_file (void); + +// For communication between the lexer and parser. + +class +lexical_feedback +{ +public: + + lexical_feedback (void) + + : bracketflag (0), braceflag (0), looping (0), + convert_spaces_to_comma (true), at_beginning_of_statement (true), + defining_func (0), looking_at_function_handle (0), + looking_at_anon_fcn_args (true), + looking_at_return_list (false), looking_at_parameter_list (false), + looking_at_decl_list (false), looking_at_initializer_expression (false), + looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), + looking_for_object_index (false), do_comma_insert (false), + looking_at_indirect_ref (false), parsed_function_name (), + parsing_class_method (false), maybe_classdef_get_set_method (false), + parsing_classdef (false), quote_is_transpose (false), + pending_local_variables () + + { + init (); + } + + ~lexical_feedback (void) { } + + void init (void); + + // Square bracket level count. + int bracketflag; + + // Curly brace level count. + int braceflag; + + // TRUE means we're in the middle of defining a loop. + int looping; + + // TRUE means that we should convert spaces to a comma inside a + // matrix definition. + bool convert_spaces_to_comma; + + // TRUE means we are at the beginning of a statement, where a + // command name is possible. + bool at_beginning_of_statement; + + // Nonzero means we're in the middle of defining a function. + int defining_func; + + // Nonzero means we are parsing a function handle. + int looking_at_function_handle; + + // TRUE means we are parsing an anonymous function argument list. + bool looking_at_anon_fcn_args; + + // TRUE means we're parsing the return list for a function. + bool looking_at_return_list; + + // TRUE means we're parsing the parameter list for a function. + bool looking_at_parameter_list; + + // TRUE means we're parsing a declaration list (global or + // persistent). + bool looking_at_decl_list; + + // TRUE means we are looking at the initializer expression for a + // parameter list element. + bool looking_at_initializer_expression; + + // TRUE means we're parsing a matrix or the left hand side of + // multi-value assignment statement. + bool looking_at_matrix_or_assign_lhs; + + // If the front of the list is TRUE, the closest paren, brace, or + // bracket nesting is an index for an object. + std::list<bool> looking_at_object_index; + + // Object index not possible until we've seen something. + bool looking_for_object_index; + + // GAG. Stupid kludge so that [[1,2][3,4]] will work. + bool do_comma_insert; + + // TRUE means we're looking at an indirect reference to a + // structure element. + bool looking_at_indirect_ref; + + // If the top of the stack is TRUE, then we've already seen the name + // of the current function. Should only matter if + // current_function_level > 0 + std::stack<bool> parsed_function_name; + + // TRUE means we are parsing a class method in function or classdef file. + bool parsing_class_method; + + // TRUE means we are parsing a class method declaration line in a + // classdef file and can accept a property get or set method name. + // For example, "get.PropertyName" is recognized as a function name. + bool maybe_classdef_get_set_method; + + // TRUE means we are parsing a classdef file + bool parsing_classdef; + + // Return transpose or start a string? + bool quote_is_transpose; + + // Set of identifiers that might be local variable names. + std::set<std::string> pending_local_variables; + +private: + + lexical_feedback (const lexical_feedback&); + + lexical_feedback& operator = (const lexical_feedback&); +}; + +class +stream_reader +{ +public: + virtual int getc (void) = 0; + virtual int ungetc (int c) = 0; + +protected: + stream_reader (void) { } + ~stream_reader (void) { } + +private: + + // No copying! + stream_reader (const stream_reader&); + stream_reader& operator = (const stream_reader&); +}; + +extern std::string +grab_comment_block (stream_reader& reader, bool at_bol, bool& eof); + +// TRUE means that we have encountered EOF on the input stream. +extern bool parser_end_of_input; + +// Flags that need to be shared between the lexer and parser. +extern lexical_feedback lexer_flags; + +#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/lex.ll Thu Aug 02 17:10:26 2012 -0700 @@ -0,0 +1,3822 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 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/>. + +*/ + +%option prefix = "octave_" + +%top { +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +} + +%s COMMAND_START +%s MATRIX_START + +%x SCRIPT_FILE_BEGIN +%x FUNCTION_FILE_BEGIN + +%{ + +#include <cctype> +#include <cstring> + +#include <iostream> +#include <set> +#include <sstream> +#include <string> +#include <stack> + +#include <sys/types.h> +#include <unistd.h> + +#include "cmd-edit.h" +#include "quit.h" +#include "lo-mappers.h" + +// These would be alphabetical, but y.tab.h must be included before +// oct-gperf.h and y.tab.h must be included after token.h and the tree +// class declarations. We can't include y.tab.h in oct-gperf.h +// because it may not be protected to allow it to be included multiple +// times. + +#include "Cell.h" +#include "comment-list.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "lex.h" +#include "ov.h" +#include "parse.h" +#include "parse-private.h" +#include "pt-all.h" +#include "symtab.h" +#include "token.h" +#include "toplev.h" +#include "utils.h" +#include "variables.h" +#include <oct-parse.h> +#include <oct-gperf.h> + +#if defined (GNULIB_NAMESPACE) +// Calls to the following functions appear in the generated output from +// flex without the namespace tag. Redefine them so we will use them +// via the gnulib namespace. +#define fprintf GNULIB_NAMESPACE::fprintf +#define fwrite GNULIB_NAMESPACE::fwrite +#define isatty GNULIB_NAMESPACE::isatty +#define malloc GNULIB_NAMESPACE::malloc +#define realloc GNULIB_NAMESPACE::realloc +#endif + +#if ! (defined (FLEX_SCANNER) \ + && defined (YY_FLEX_MAJOR_VERSION) && YY_FLEX_MAJOR_VERSION >= 2 \ + && defined (YY_FLEX_MINOR_VERSION) && YY_FLEX_MINOR_VERSION >= 5) +#error lex.l requires flex version 2.5.4 or later +#endif + +#define yylval octave_lval + +// Arrange to get input via readline. + +#ifdef YY_INPUT +#undef YY_INPUT +#endif +#define YY_INPUT(buf, result, max_size) \ + if ((result = octave_read (buf, max_size)) < 0) \ + YY_FATAL_ERROR ("octave_read () in flex scanner failed"); + +// Try to avoid crashing out completely on fatal scanner errors. +// The call to yy_fatal_error should never happen, but it avoids a +// `static function defined but not used' warning from gcc. + +#ifdef YY_FATAL_ERROR +#undef YY_FATAL_ERROR +#endif +#define YY_FATAL_ERROR(msg) \ + do \ + { \ + error (msg); \ + OCTAVE_QUIT; \ + yy_fatal_error (msg); \ + } \ + while (0) + +#define DISPLAY_TOK_AND_RETURN(tok) \ + do \ + { \ + int tok_val = tok; \ + if (Vdisplay_tokens) \ + display_token (tok_val); \ + if (lexer_debug_flag) \ + { \ + std::cerr << "R: "; \ + display_token (tok_val); \ + std::cerr << std::endl; \ + } \ + return tok_val; \ + } \ + while (0) + +#define COUNT_TOK_AND_RETURN(tok) \ + do \ + { \ + Vtoken_count++; \ + DISPLAY_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define TOK_RETURN(tok) \ + do \ + { \ + current_input_column += yyleng; \ + lexer_flags.quote_is_transpose = false; \ + lexer_flags.convert_spaces_to_comma = true; \ + COUNT_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define TOK_PUSH_AND_RETURN(name, tok) \ + do \ + { \ + yylval.tok_val = new token (name, input_line_number, \ + current_input_column); \ + token_stack.push (yylval.tok_val); \ + TOK_RETURN (tok); \ + } \ + while (0) + +#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + yylval.tok_val = new token (input_line_number, current_input_column); \ + token_stack.push (yylval.tok_val); \ + current_input_column += yyleng; \ + lexer_flags.quote_is_transpose = qit; \ + lexer_flags.convert_spaces_to_comma = convert; \ + lexer_flags.looking_for_object_index = false; \ + lexer_flags.at_beginning_of_statement = bos; \ + COUNT_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ + } \ + while (0) + +#define BIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ + } \ + while (0) + +#define XBIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN (tok, convert, bos); \ + } \ + while (0) + +#define LEXER_DEBUG(pattern) \ + do \ + { \ + if (lexer_debug_flag) \ + lexer_debug (pattern, yytext); \ + } \ + while (0) + +// TRUE means that we have encountered EOF on the input stream. +bool parser_end_of_input = false; + +// Flags that need to be shared between the lexer and parser. +lexical_feedback lexer_flags; + +// Stack to hold tokens so that we can delete them when the parser is +// reset and avoid growing forever just because we are stashing some +// information. This has to appear before lex.h is included, because +// one of the macros defined there uses token_stack. +// +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::stack <token*> token_stack; + +// Did eat_whitespace() eat a space or tab, or a newline, or both? + +typedef int yum_yum; + +const yum_yum ATE_NOTHING = 0; +const yum_yum ATE_SPACE_OR_TAB = 1; +const yum_yum ATE_NEWLINE = 2; + +// Is the closest nesting level a square bracket, squiggly brace or a paren? + +class bracket_brace_paren_nesting_level +{ +public: + + bracket_brace_paren_nesting_level (void) : context () { } + + ~bracket_brace_paren_nesting_level (void) { } + + void bracket (void) { context.push (BRACKET); } + bool is_bracket (void) + { return ! context.empty () && context.top () == BRACKET; } + + void brace (void) { context.push (BRACE); } + bool is_brace (void) + { return ! context.empty () && context.top () == BRACE; } + + void paren (void) { context.push (PAREN); } + bool is_paren (void) + { return ! context.empty () && context.top () == PAREN; } + + bool is_bracket_or_brace (void) + { return (! context.empty () + && (context.top () == BRACKET || context.top () == BRACE)); } + + bool none (void) { return context.empty (); } + + void remove (void) { if (! context.empty ()) context.pop (); } + + void clear (void) { while (! context.empty ()) context.pop (); } + +private: + + std::stack<int> context; + + static const int BRACKET; + static const int BRACE; + static const int PAREN; + + bracket_brace_paren_nesting_level (const bracket_brace_paren_nesting_level&); + + bracket_brace_paren_nesting_level& + operator = (const bracket_brace_paren_nesting_level&); +}; + +const int bracket_brace_paren_nesting_level::BRACKET = 1; +const int bracket_brace_paren_nesting_level::BRACE = 2; +const int bracket_brace_paren_nesting_level::PAREN = 3; + +static bracket_brace_paren_nesting_level nesting_level; + +static bool Vdisplay_tokens = false; + +static unsigned int Vtoken_count = 0; + +// The start state that was in effect when the beginning of a block +// comment was noticed. +static int block_comment_nesting_level = 0; + +// Internal variable for lexer debugging state. +static bool lexer_debug_flag = false; + +// Forward declarations for functions defined at the bottom of this +// file. + +static int text_yyinput (void); +static void xunput (char c, char *buf); +static void fixup_column_count (char *s); +static void do_comma_insert_check (void); +static int is_keyword_token (const std::string& s); +static int process_comment (bool start_in_block, bool& eof); +static bool match_any (char c, const char *s); +static bool next_token_is_sep_op (void); +static bool next_token_is_bin_op (bool spc_prev); +static bool next_token_is_postfix_unary_op (bool spc_prev); +static std::string strip_trailing_whitespace (char *s); +static void handle_number (void); +static int handle_string (char delim); +static int handle_close_bracket (bool spc_gobbled, int bracket_type); +static int handle_superclass_identifier (void); +static int handle_meta_identifier (void); +static int handle_identifier (void); +static bool have_continuation (bool trailing_comments_ok = true); +static bool have_ellipsis_continuation (bool trailing_comments_ok = true); +static void scan_for_comments (const char *); +static yum_yum eat_whitespace (void); +static yum_yum eat_continuation (void); +static void maybe_warn_separator_insert (char sep); +static void gripe_single_quote_string (void); +static void gripe_matlab_incompatible (const std::string& msg); +static void maybe_gripe_matlab_incompatible_comment (char c); +static void gripe_matlab_incompatible_continuation (void); +static void gripe_matlab_incompatible_operator (const std::string& op); +static void display_token (int tok); +static void lexer_debug (const char *pattern, const char *text); + +%} + +D [0-9] +S [ \t] +NL ((\n)|(\r)|(\r\n)) +SNL ({S}|{NL}) +EL (\.\.\.) +BS (\\) +CONT ({EL}|{BS}) +Im [iIjJ] +CCHAR [#%] +COMMENT ({CCHAR}.*{NL}) +SNLCMT ({SNL}|{COMMENT}) +NOT ((\~)|(\!)) +POW ((\*\*)|(\^)) +EPOW (\.{POW}) +IDENT ([_$a-zA-Z][_$a-zA-Z0-9]*) +EXPON ([DdEe][+-]?{D}+) +NUMBER (({D}+\.?{D}*{EXPON}?)|(\.{D}+{EXPON}?)|(0[xX][0-9a-fA-F]+)) +%% + +%{ +// Make script and function files start with a bogus token. This makes +// the parser go down a special path. +%} + +<SCRIPT_FILE_BEGIN>. { + LEXER_DEBUG ("<SCRIPT_FILE_BEGIN>."); + + BEGIN (INITIAL); + xunput (yytext[0], yytext); + COUNT_TOK_AND_RETURN (SCRIPT_FILE); + } + +<FUNCTION_FILE_BEGIN>. { + LEXER_DEBUG ("<FUNCTION_FILE_BEGIN>."); + + BEGIN (INITIAL); + xunput (yytext[0], yytext); + COUNT_TOK_AND_RETURN (FUNCTION_FILE); + } + +%{ +// Help and other command-style functions. +%} + +<COMMAND_START>{NL} { + LEXER_DEBUG ("<COMMAND_START>{NL}"); + + BEGIN (INITIAL); + input_line_number++; + current_input_column = 1; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = true; + + COUNT_TOK_AND_RETURN ('\n'); + } + +<COMMAND_START>[\;\,] { + LEXER_DEBUG ("<COMMAND_START>[\\;\\,]"); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = true; + + BEGIN (INITIAL); + + if (strcmp (yytext, ",") == 0) + TOK_RETURN (','); + else + TOK_RETURN (';'); + } + +<COMMAND_START>[\"\'] { + LEXER_DEBUG ("<COMMAND_START>[\\\"\\']"); + + lexer_flags.at_beginning_of_statement = false; + + current_input_column++; + int tok = handle_string (yytext[0]); + + COUNT_TOK_AND_RETURN (tok); + } + +<COMMAND_START>[^#% \t\r\n\;\,\"\'][^ \t\r\n\;\,]*{S}* { + LEXER_DEBUG ("<COMMAND_START>[^#% \\t\\r\\n\\;\\,\\\"\\'][^ \\t\\r\\n\\;\\,]*{S}*"); + + std::string tok = strip_trailing_whitespace (yytext); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + TOK_PUSH_AND_RETURN (tok, SQ_STRING); + } + +%{ +// For this and the next two rules, we're looking at ']', and we +// need to know if the next token is `=' or `=='. +// +// It would have been so much easier if the delimiters were simply +// different for the expression on the left hand side of the equals +// operator. +// +// It's also a pain in the ass to decide whether to insert a comma +// after seeing a ']' character... + +// FIXME -- we need to handle block comments here. +%} + +<MATRIX_START>{SNLCMT}*\]{S}* { + LEXER_DEBUG ("<MATRIX_START>{SNLCMT}*\\]{S}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + int c = yytext[yyleng-1]; + int cont_is_spc = eat_continuation (); + bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + int tok_to_return = handle_close_bracket (spc_gobbled, ']'); + + if (spc_gobbled) + xunput (' ', yytext); + + COUNT_TOK_AND_RETURN (tok_to_return); + } + +%{ +// FIXME -- we need to handle block comments here. +%} + +<MATRIX_START>{SNLCMT}*\}{S}* { + LEXER_DEBUG ("<MATRIX_START>{SNLCMT}*\\}{S}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + int c = yytext[yyleng-1]; + int cont_is_spc = eat_continuation (); + bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + int tok_to_return = handle_close_bracket (spc_gobbled, '}'); + + if (spc_gobbled) + xunput (' ', yytext); + + COUNT_TOK_AND_RETURN (tok_to_return); + } + +%{ +// Commas are element separators in matrix constants. If we don't +// check for continuations here we can end up inserting too many +// commas. +%} + +<MATRIX_START>{S}*\,{S}* { + LEXER_DEBUG ("<MATRIX_START>{S}*\\,{S}*"); + + current_input_column += yyleng; + + int tmp = eat_continuation (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + if (! lexer_flags.looking_at_object_index.front ()) + { + if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) + { + maybe_warn_separator_insert (';'); + + xunput (';', yytext); + } + } + + COUNT_TOK_AND_RETURN (','); + } + +%{ +// In some cases, spaces in matrix constants can turn into commas. +// If commas are required, spaces are not important in matrix +// constants so we just eat them. If we don't check for continuations +// here we can end up inserting too many commas. +%} + +<MATRIX_START>{S}+ { + LEXER_DEBUG ("<MATRIX_START>{S}+"); + + current_input_column += yyleng; + + lexer_flags.at_beginning_of_statement = false; + + int tmp = eat_continuation (); + + if (! lexer_flags.looking_at_object_index.front ()) + { + bool bin_op = next_token_is_bin_op (true); + bool postfix_un_op = next_token_is_postfix_unary_op (true); + bool sep_op = next_token_is_sep_op (); + + if (! (postfix_un_op || bin_op || sep_op) + && nesting_level.is_bracket_or_brace () + && lexer_flags.convert_spaces_to_comma) + { + if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) + { + maybe_warn_separator_insert (';'); + + xunput (';', yytext); + } + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + + maybe_warn_separator_insert (','); + + COUNT_TOK_AND_RETURN (','); + } + } + } + +%{ +// Semicolons are handled as row seprators in matrix constants. If we +// don't eat whitespace here we can end up inserting too many +// semicolons. + +// FIXME -- we need to handle block comments here. +%} + +<MATRIX_START>{SNLCMT}*;{SNLCMT}* { + LEXER_DEBUG ("<MATRIX_START>{SNLCMT}*;{SNLCMT}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + eat_whitespace (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + COUNT_TOK_AND_RETURN (';'); + } + +%{ +// In some cases, new lines can also become row separators. If we +// don't eat whitespace here we can end up inserting too many +// semicolons. + +// FIXME -- we need to handle block comments here. +%} + +<MATRIX_START>{S}*{COMMENT}{SNLCMT}* | +<MATRIX_START>{S}*{NL}{SNLCMT}* { + LEXER_DEBUG ("<MATRIX_START>{S}*{COMMENT}{SNLCMT}*|<MATRIX_START>{S}*{NL}{SNLCMT}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + eat_whitespace (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.at_beginning_of_statement = false; + + if (nesting_level.none ()) + return LEXICAL_ERROR; + + if (! lexer_flags.looking_at_object_index.front () + && nesting_level.is_bracket_or_brace ()) + { + maybe_warn_separator_insert (';'); + + COUNT_TOK_AND_RETURN (';'); + } + } + +\[{S}* { + LEXER_DEBUG ("\\[{S}*"); + + nesting_level.bracket (); + + lexer_flags.looking_at_object_index.push_front (false); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + if (lexer_flags.defining_func + && ! lexer_flags.parsed_function_name.top ()) + lexer_flags.looking_at_return_list = true; + else + lexer_flags.looking_at_matrix_or_assign_lhs = true; + + promptflag--; + eat_whitespace (); + + lexer_flags.bracketflag++; + BEGIN (MATRIX_START); + COUNT_TOK_AND_RETURN ('['); + } + +\] { + LEXER_DEBUG ("\\]"); + + nesting_level.remove (); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + TOK_RETURN (']'); + } + +%{ +// Imaginary numbers. +%} + +{NUMBER}{Im} { + LEXER_DEBUG ("{NUMBER}{Im}"); + + handle_number (); + COUNT_TOK_AND_RETURN (IMAG_NUM); + } + +%{ +// Real numbers. Don't grab the `.' part of a dot operator as part of +// the constant. +%} + +{D}+/\.[\*/\\^\'] | +{NUMBER} { + LEXER_DEBUG ("{D}+/\\.[\\*/\\^\\']|{NUMBER}"); + handle_number (); + COUNT_TOK_AND_RETURN (NUM); + } + +%{ +// Eat whitespace. Whitespace inside matrix constants is handled by +// the <MATRIX_START> start state code above. +%} + +{S}* { + current_input_column += yyleng; + } + +%{ +// Continuation lines. Allow comments after continuations. +%} + +{CONT}{S}*{NL} | +{CONT}{S}*{COMMENT} { + LEXER_DEBUG ("{CONT}{S}*{NL}|{CONT}{S}*{COMMENT}"); + + if (yytext[0] == '\\') + gripe_matlab_incompatible_continuation (); + scan_for_comments (yytext); + promptflag--; + input_line_number++; + current_input_column = 1; + } + +%{ +// End of file. +%} + +<<EOF>> { + LEXER_DEBUG ("<<EOF>>"); + + if (block_comment_nesting_level != 0) + { + warning ("block comment open at end of input"); + + if ((reading_fcn_file || reading_script_file || reading_classdef_file) + && ! curr_fcn_file_name.empty ()) + warning ("near line %d of file `%s.m'", + input_line_number, curr_fcn_file_name.c_str ()); + } + + TOK_RETURN (END_OF_INPUT); + } + +%{ +// Identifiers. Truncate the token at the first space or tab but +// don't write directly on yytext. +%} + +{IDENT}{S}* { + LEXER_DEBUG ("{IDENT}{S}*"); + + int id_tok = handle_identifier (); + + if (id_tok >= 0) + COUNT_TOK_AND_RETURN (id_tok); + } + +%{ +// Superclass method identifiers. +%} + +{IDENT}@{IDENT}{S}* | +{IDENT}@{IDENT}.{IDENT}{S}* { + LEXER_DEBUG ("{IDENT}@{IDENT}{S}*|{IDENT}@{IDENT}.{IDENT}{S}*"); + + int id_tok = handle_superclass_identifier (); + + if (id_tok >= 0) + { + lexer_flags.looking_for_object_index = true; + + COUNT_TOK_AND_RETURN (SUPERCLASSREF); + } + } + +%{ +// Metaclass query +%} + +\?{IDENT}{S}* | +\?{IDENT}\.{IDENT}{S}* { + LEXER_DEBUG ("\\?{IDENT}{S}*|\\?{IDENT}\\.{IDENT}{S}*"); + + int id_tok = handle_meta_identifier (); + + if (id_tok >= 0) + { + lexer_flags.looking_for_object_index = true; + + COUNT_TOK_AND_RETURN (METAQUERY); + } + } + +%{ +// Function handles and superclass references +%} + +"@" { + LEXER_DEBUG ("@"); + + current_input_column++; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = false; + lexer_flags.looking_at_function_handle++; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + COUNT_TOK_AND_RETURN ('@'); + + } + +%{ +// A new line character. New line characters inside matrix constants +// are handled by the <MATRIX_START> start state code above. If closest +// nesting is inside parentheses, don't return a row separator. +%} + +{NL} { + LEXER_DEBUG ("{NL}"); + + input_line_number++; + current_input_column = 1; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + + if (nesting_level.none ()) + { + lexer_flags.at_beginning_of_statement = true; + COUNT_TOK_AND_RETURN ('\n'); + } + else if (nesting_level.is_paren ()) + { + lexer_flags.at_beginning_of_statement = false; + gripe_matlab_incompatible ("bare newline inside parentheses"); + } + else if (nesting_level.is_bracket_or_brace ()) + return LEXICAL_ERROR; + } + +%{ +// Single quote can either be the beginning of a string or a transpose +// operator. +%} + +"'" { + LEXER_DEBUG ("'"); + + current_input_column++; + lexer_flags.convert_spaces_to_comma = true; + + if (lexer_flags.quote_is_transpose) + { + do_comma_insert_check (); + COUNT_TOK_AND_RETURN (QUOTE); + } + else + { + int tok = handle_string ('\''); + COUNT_TOK_AND_RETURN (tok); + } + } + +%{ +// Double quotes always begin strings. +%} + +\" { + LEXER_DEBUG ("\""); + + current_input_column++; + int tok = handle_string ('"'); + + COUNT_TOK_AND_RETURN (tok); +} + +%{ +// Gobble comments. +%} + +{CCHAR} { + LEXER_DEBUG ("{CCHAR}"); + + lexer_flags.looking_for_object_index = false; + + xunput (yytext[0], yytext); + + bool eof = false; + int tok = process_comment (false, eof); + + if (eof) + TOK_RETURN (END_OF_INPUT); + else if (tok > 0) + COUNT_TOK_AND_RETURN (tok); + } + +%{ +// Block comments. +%} + +^{S}*{CCHAR}\{{S}*{NL} { + LEXER_DEBUG ("^{S}*{CCHAR}\\{{S}*{NL}"); + + lexer_flags.looking_for_object_index = false; + + input_line_number++; + current_input_column = 1; + block_comment_nesting_level++; + promptflag--; + + bool eof = false; + process_comment (true, eof); + } + +%{ +// Other operators. +%} + +":" { LEXER_DEBUG (":"); BIN_OP_RETURN (':', false, false); } + +".+" { LEXER_DEBUG (".+"); XBIN_OP_RETURN (EPLUS, false, false); } +".-" { LEXER_DEBUG (".-"); XBIN_OP_RETURN (EMINUS, false, false); } +".*" { LEXER_DEBUG (".*"); BIN_OP_RETURN (EMUL, false, false); } +"./" { LEXER_DEBUG ("./"); BIN_OP_RETURN (EDIV, false, false); } +".\\" { LEXER_DEBUG (".\\"); BIN_OP_RETURN (ELEFTDIV, false, false); } +".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } +".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } +".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } +"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } +"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } +"<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } +"==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } +"~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } +"!=" { LEXER_DEBUG ("!="); XBIN_OP_RETURN (EXPR_NE, false, false); } +">=" { LEXER_DEBUG (">="); BIN_OP_RETURN (EXPR_GE, false, false); } +"&" { LEXER_DEBUG ("&"); BIN_OP_RETURN (EXPR_AND, false, false); } +"|" { LEXER_DEBUG ("|"); BIN_OP_RETURN (EXPR_OR, false, false); } +"<" { LEXER_DEBUG ("<"); BIN_OP_RETURN (EXPR_LT, false, false); } +">" { LEXER_DEBUG (">"); BIN_OP_RETURN (EXPR_GT, false, false); } +"+" { LEXER_DEBUG ("+"); BIN_OP_RETURN ('+', false, false); } +"-" { LEXER_DEBUG ("-"); BIN_OP_RETURN ('-', false, false); } +"*" { LEXER_DEBUG ("*"); BIN_OP_RETURN ('*', false, false); } +"/" { LEXER_DEBUG ("/"); BIN_OP_RETURN ('/', false, false); } +"\\" { LEXER_DEBUG ("\\"); BIN_OP_RETURN (LEFTDIV, false, false); } +";" { LEXER_DEBUG (";"); BIN_OP_RETURN (';', true, true); } +"," { LEXER_DEBUG (","); BIN_OP_RETURN (',', true, ! lexer_flags.looking_at_object_index.front ()); } +"^" { LEXER_DEBUG ("^"); BIN_OP_RETURN (POW, false, false); } +"**" { LEXER_DEBUG ("**"); XBIN_OP_RETURN (POW, false, false); } +"=" { LEXER_DEBUG ("="); BIN_OP_RETURN ('=', true, false); } +"&&" { LEXER_DEBUG ("&&"); BIN_OP_RETURN (EXPR_AND_AND, false, false); } +"||" { LEXER_DEBUG ("||"); BIN_OP_RETURN (EXPR_OR_OR, false, false); } +"<<" { LEXER_DEBUG ("<<"); XBIN_OP_RETURN (LSHIFT, false, false); } +">>" { LEXER_DEBUG (">>"); XBIN_OP_RETURN (RSHIFT, false, false); } + +{NOT} { + LEXER_DEBUG ("{NOT}"); + + if (yytext[0] == '~') + BIN_OP_RETURN (EXPR_NOT, false, false); + else + XBIN_OP_RETURN (EXPR_NOT, false, false); + } + +"(" { + LEXER_DEBUG ("("); + + // If we are looking for an object index, then push TRUE for + // looking_at_object_index. Otherwise, just push whatever state + // is current (so that we can pop it off the stack when we find + // the matching close paren). + + lexer_flags.looking_at_object_index.push_front + (lexer_flags.looking_for_object_index); + + lexer_flags.looking_at_indirect_ref = false; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + nesting_level.paren (); + promptflag--; + + TOK_RETURN ('('); + } + +")" { + LEXER_DEBUG (")"); + + nesting_level.remove (); + current_input_column++; + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma + = (nesting_level.is_bracket_or_brace () + && ! lexer_flags.looking_at_anon_fcn_args); + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + if (lexer_flags.looking_at_anon_fcn_args) + lexer_flags.looking_at_anon_fcn_args = false; + + do_comma_insert_check (); + + COUNT_TOK_AND_RETURN (')'); + } + +"." { + LEXER_DEBUG ("."); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + TOK_RETURN ('.'); + } + +"+=" { LEXER_DEBUG ("+="); XBIN_OP_RETURN (ADD_EQ, false, false); } +"-=" { LEXER_DEBUG ("-="); XBIN_OP_RETURN (SUB_EQ, false, false); } +"*=" { LEXER_DEBUG ("*="); XBIN_OP_RETURN (MUL_EQ, false, false); } +"/=" { LEXER_DEBUG ("/="); XBIN_OP_RETURN (DIV_EQ, false, false); } +"\\=" { LEXER_DEBUG ("\\="); XBIN_OP_RETURN (LEFTDIV_EQ, false, false); } +".+=" { LEXER_DEBUG (".+="); XBIN_OP_RETURN (ADD_EQ, false, false); } +".-=" { LEXER_DEBUG (".-="); XBIN_OP_RETURN (SUB_EQ, false, false); } +".*=" { LEXER_DEBUG (".*="); XBIN_OP_RETURN (EMUL_EQ, false, false); } +"./=" { LEXER_DEBUG ("./="); XBIN_OP_RETURN (EDIV_EQ, false, false); } +".\\=" { LEXER_DEBUG (".\\="); XBIN_OP_RETURN (ELEFTDIV_EQ, false, false); } +{POW}= { LEXER_DEBUG ("{POW}="); XBIN_OP_RETURN (POW_EQ, false, false); } +{EPOW}= { LEXER_DEBUG ("{EPOW}="); XBIN_OP_RETURN (EPOW_EQ, false, false); } +"&=" { LEXER_DEBUG ("&="); XBIN_OP_RETURN (AND_EQ, false, false); } +"|=" { LEXER_DEBUG ("|="); XBIN_OP_RETURN (OR_EQ, false, false); } +"<<=" { LEXER_DEBUG ("<<="); XBIN_OP_RETURN (LSHIFT_EQ, false, false); } +">>=" { LEXER_DEBUG (">>="); XBIN_OP_RETURN (RSHIFT_EQ, false, false); } + +\{{S}* { + LEXER_DEBUG ("\\{{S}*"); + + nesting_level.brace (); + + lexer_flags.looking_at_object_index.push_front + (lexer_flags.looking_for_object_index); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + promptflag--; + eat_whitespace (); + + lexer_flags.braceflag++; + BEGIN (MATRIX_START); + COUNT_TOK_AND_RETURN ('{'); + } + +"}" { + LEXER_DEBUG ("}"); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + nesting_level.remove (); + + TOK_RETURN ('}'); + } + +%{ +// Unrecognized input is a lexical error. +%} + +. { + LEXER_DEBUG ("."); + + xunput (yytext[0], yytext); + + int c = text_yyinput (); + + if (c != EOF) + { + current_input_column++; + + error ("invalid character `%s' (ASCII %d) near line %d, column %d", + undo_string_escape (static_cast<char> (c)), c, + input_line_number, current_input_column); + + return LEXICAL_ERROR; + } + else + TOK_RETURN (END_OF_INPUT); + } + +%% + +// GAG. +// +// If we're reading a matrix and the next character is '[', make sure +// that we insert a comma ahead of it. + +void +do_comma_insert_check (void) +{ + int spc_gobbled = eat_continuation (); + + int c = text_yyinput (); + + xunput (c, yytext); + + if (spc_gobbled) + xunput (' ', yytext); + + lexer_flags.do_comma_insert = (! lexer_flags.looking_at_object_index.front () + && lexer_flags.bracketflag && c == '['); +} + +// Fix things up for errors or interrupts. The parser is never called +// recursively, so it is always safe to reinitialize its state before +// doing any parsing. + +void +reset_parser (void) +{ + // Start off on the right foot. + BEGIN (INITIAL); + + parser_end_of_input = false; + + parser_symtab_context.clear (); + + // We do want a prompt by default. + promptflag = 1; + + // We are not in a block comment. + block_comment_nesting_level = 0; + + // Error may have occurred inside some brackets, braces, or parentheses. + nesting_level.clear (); + + // Clear out the stack of token info used to track line and column + // numbers. + while (! token_stack.empty ()) + { + delete token_stack.top (); + token_stack.pop (); + } + + // Can be reset by defining a function. + if (! (reading_script_file || reading_fcn_file || reading_classdef_file)) + { + current_input_column = 1; + input_line_number = command_editor::current_command_number (); + } + + // Only ask for input from stdin if we are expecting interactive + // input. + + if (! quitting_gracefully + && (interactive || forced_interactive) + && ! (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file)) + yyrestart (stdin); + + // Clear the buffer for help text. + while (! help_buf.empty ()) + help_buf.pop (); + + // Reset other flags. + lexer_flags.init (); +} + +static void +display_character (char c) +{ + if (isgraph (c)) + std::cerr << c; + else + switch (c) + { + case 0: + std::cerr << "NUL"; + break; + + case 1: + std::cerr << "SOH"; + break; + + case 2: + std::cerr << "STX"; + break; + + case 3: + std::cerr << "ETX"; + break; + + case 4: + std::cerr << "EOT"; + break; + + case 5: + std::cerr << "ENQ"; + break; + + case 6: + std::cerr << "ACK"; + break; + + case 7: + std::cerr << "\\a"; + break; + + case 8: + std::cerr << "\\b"; + break; + + case 9: + std::cerr << "\\t"; + break; + + case 10: + std::cerr << "\\n"; + break; + + case 11: + std::cerr << "\\v"; + break; + + case 12: + std::cerr << "\\f"; + break; + + case 13: + std::cerr << "\\r"; + break; + + case 14: + std::cerr << "SO"; + break; + + case 15: + std::cerr << "SI"; + break; + + case 16: + std::cerr << "DLE"; + break; + + case 17: + std::cerr << "DC1"; + break; + + case 18: + std::cerr << "DC2"; + break; + + case 19: + std::cerr << "DC3"; + break; + + case 20: + std::cerr << "DC4"; + break; + + case 21: + std::cerr << "NAK"; + break; + + case 22: + std::cerr << "SYN"; + break; + + case 23: + std::cerr << "ETB"; + break; + + case 24: + std::cerr << "CAN"; + break; + + case 25: + std::cerr << "EM"; + break; + + case 26: + std::cerr << "SUB"; + break; + + case 27: + std::cerr << "ESC"; + break; + + case 28: + std::cerr << "FS"; + break; + + case 29: + std::cerr << "GS"; + break; + + case 30: + std::cerr << "RS"; + break; + + case 31: + std::cerr << "US"; + break; + + case 32: + std::cerr << "SPACE"; + break; + + case 127: + std::cerr << "DEL"; + break; + } +} + +static int +text_yyinput (void) +{ + int c = yyinput (); + + if (lexer_debug_flag) + { + std::cerr << "I: "; + display_character (c); + std::cerr << std::endl; + } + + // Convert CRLF into just LF and single CR into LF. + + if (c == '\r') + { + c = yyinput (); + + if (lexer_debug_flag) + { + std::cerr << "I: "; + display_character (c); + std::cerr << std::endl; + } + + if (c != '\n') + { + xunput (c, yytext); + c = '\n'; + } + } + + if (c == '\n') + input_line_number++; + + return c; +} + +static void +xunput (char c, char *buf) +{ + if (lexer_debug_flag) + { + std::cerr << "U: "; + display_character (c); + std::cerr << std::endl; + } + + if (c == '\n') + input_line_number--; + + yyunput (c, buf); +} + +// If we read some newlines, we need figure out what column we're +// really looking at. + +static void +fixup_column_count (char *s) +{ + char c; + while ((c = *s++) != '\0') + { + if (c == '\n') + { + input_line_number++; + current_input_column = 1; + } + else + current_input_column++; + } +} + +// Include these so that we don't have to link to libfl.a. + +int +yywrap (void) +{ + return 1; +} + +// Tell us all what the current buffer is. + +YY_BUFFER_STATE +current_buffer (void) +{ + return YY_CURRENT_BUFFER; +} + +// Create a new buffer. + +YY_BUFFER_STATE +create_buffer (FILE *f) +{ + return yy_create_buffer (f, YY_BUF_SIZE); +} + +// Start reading a new buffer. + +void +switch_to_buffer (YY_BUFFER_STATE buf) +{ + yy_switch_to_buffer (buf); +} + +// Delete a buffer. + +void +delete_buffer (YY_BUFFER_STATE buf) +{ + yy_delete_buffer (buf); + + // Prevent invalid yyin from being used by yyrestart. + if (! current_buffer ()) + yyin = 0; +} + +// Delete all buffers from the stack. +void +clear_all_buffers (void) +{ + while (current_buffer ()) + octave_pop_buffer_state (); +} + +void +cleanup_parser (void) +{ + reset_parser (); + + clear_all_buffers (); +} + +// Restore a buffer (for unwind-prot). + +void +restore_input_buffer (void *buf) +{ + switch_to_buffer (static_cast<YY_BUFFER_STATE> (buf)); +} + +// Delete a buffer (for unwind-prot). + +void +delete_input_buffer (void *buf) +{ + delete_buffer (static_cast<YY_BUFFER_STATE> (buf)); +} + +static bool +inside_any_object_index (void) +{ + bool retval = false; + + for (std::list<bool>::const_iterator i = lexer_flags.looking_at_object_index.begin (); + i != lexer_flags.looking_at_object_index.end (); i++) + { + if (*i) + { + retval = true; + break; + } + } + + return retval; +} + +// Handle keywords. Return -1 if the keyword should be ignored. + +static int +is_keyword_token (const std::string& s) +{ + int l = input_line_number; + int c = current_input_column; + + int len = s.length (); + + const octave_kw *kw = octave_kw_hash::in_word_set (s.c_str (), len); + + if (kw) + { + yylval.tok_val = 0; + + switch (kw->kw_id) + { + case break_kw: + case catch_kw: + case continue_kw: + case else_kw: + case otherwise_kw: + case return_kw: + case unwind_protect_cleanup_kw: + lexer_flags.at_beginning_of_statement = true; + break; + + case static_kw: + if ((reading_fcn_file || reading_script_file + || reading_classdef_file) + && ! curr_fcn_file_full_name.empty ()) + warning_with_id ("Octave:deprecated-keyword", + "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d of file `%s'", + input_line_number, + curr_fcn_file_full_name.c_str ()); + else + warning_with_id ("Octave:deprecated-keyword", + "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d", + input_line_number); + // fall through ... + + case persistent_kw: + break; + + case case_kw: + case elseif_kw: + case global_kw: + case until_kw: + break; + + case end_kw: + if (inside_any_object_index () + || (! reading_classdef_file + && (lexer_flags.defining_func + && ! (lexer_flags.looking_at_return_list + || lexer_flags.parsed_function_name.top ())))) + return 0; + + yylval.tok_val = new token (token::simple_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case end_try_catch_kw: + yylval.tok_val = new token (token::try_catch_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case end_unwind_protect_kw: + yylval.tok_val = new token (token::unwind_protect_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endfor_kw: + yylval.tok_val = new token (token::for_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endfunction_kw: + yylval.tok_val = new token (token::function_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endif_kw: + yylval.tok_val = new token (token::if_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endparfor_kw: + yylval.tok_val = new token (token::parfor_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endswitch_kw: + yylval.tok_val = new token (token::switch_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endwhile_kw: + yylval.tok_val = new token (token::while_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endclassdef_kw: + yylval.tok_val = new token (token::classdef_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endenumeration_kw: + yylval.tok_val = new token (token::enumeration_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endevents_kw: + yylval.tok_val = new token (token::events_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endmethods_kw: + yylval.tok_val = new token (token::methods_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endproperties_kw: + yylval.tok_val = new token (token::properties_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + + case for_kw: + case parfor_kw: + case while_kw: + promptflag--; + lexer_flags.looping++; + break; + + case do_kw: + lexer_flags.at_beginning_of_statement = true; + promptflag--; + lexer_flags.looping++; + break; + + case try_kw: + case unwind_protect_kw: + lexer_flags.at_beginning_of_statement = true; + promptflag--; + break; + + case if_kw: + case switch_kw: + promptflag--; + break; + + case get_kw: + case set_kw: + // 'get' and 'set' are keywords in classdef method + // declarations. + if (! lexer_flags.maybe_classdef_get_set_method) + return 0; + break; + + case enumeration_kw: + case events_kw: + case methods_kw: + case properties_kw: + // 'properties', 'methods' and 'events' are keywords for + // classdef blocks. + if (! lexer_flags.parsing_classdef) + return 0; + // fall through ... + + case classdef_kw: + // 'classdef' is always a keyword. + promptflag--; + break; + + case function_kw: + promptflag--; + + lexer_flags.defining_func++; + lexer_flags.parsed_function_name.push (false); + + if (! (reading_fcn_file || reading_script_file + || reading_classdef_file)) + input_line_number = 1; + break; + + case magic_file_kw: + { + if ((reading_fcn_file || reading_script_file + || reading_classdef_file) + && ! curr_fcn_file_full_name.empty ()) + yylval.tok_val = new token (curr_fcn_file_full_name, l, c); + else + yylval.tok_val = new token ("stdin", l, c); + } + break; + + case magic_line_kw: + yylval.tok_val = new token (static_cast<double> (l), "", l, c); + break; + + default: + panic_impossible (); + } + + if (! yylval.tok_val) + yylval.tok_val = new token (l, c); + + token_stack.push (yylval.tok_val); + + return kw->tok; + } + + return 0; +} + +static bool +is_variable (const std::string& name) +{ + return (symbol_table::is_variable (name) + || (lexer_flags.pending_local_variables.find (name) + != lexer_flags.pending_local_variables.end ())); +} + +static std::string +grab_block_comment (stream_reader& reader, bool& eof) +{ + std::string buf; + + bool at_bol = true; + bool look_for_marker = false; + + bool warned_incompatible = false; + + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + current_input_column++; + + if (look_for_marker) + { + at_bol = false; + look_for_marker = false; + + if (c == '{' || c == '}') + { + std::string tmp_buf (1, static_cast<char> (c)); + + int type = c; + + bool done = false; + + while ((c = reader.getc ()) != EOF && ! done) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + tmp_buf += static_cast<char> (c); + break; + + case '\n': + { + current_input_column = 0; + at_bol = true; + done = true; + + if (type == '{') + { + block_comment_nesting_level++; + promptflag--; + } + else + { + block_comment_nesting_level--; + promptflag++; + + if (block_comment_nesting_level == 0) + { + buf += grab_comment_block (reader, true, eof); + + return buf; + } + } + } + break; + + default: + at_bol = false; + tmp_buf += static_cast<char> (c); + buf += tmp_buf; + done = true; + break; + } + } + } + } + + if (at_bol && (c == '%' || c == '#')) + { + if (c == '#' && ! warned_incompatible) + { + warned_incompatible = true; + maybe_gripe_matlab_incompatible_comment (c); + } + + at_bol = false; + look_for_marker = true; + } + else + { + buf += static_cast<char> (c); + + if (c == '\n') + { + current_input_column = 0; + at_bol = true; + } + } + } + + if (c == EOF) + eof = true; + + return buf; +} + +std::string +grab_comment_block (stream_reader& reader, bool at_bol, + bool& eof) +{ + std::string buf; + + // TRUE means we are at the beginning of a comment block. + bool begin_comment = false; + + // TRUE means we are currently reading a comment block. + bool in_comment = false; + + bool warned_incompatible = false; + + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + current_input_column++; + + if (begin_comment) + { + if (c == '%' || c == '#') + { + at_bol = false; + continue; + } + else if (at_bol && c == '{') + { + std::string tmp_buf (1, static_cast<char> (c)); + + bool done = false; + + while ((c = reader.getc ()) != EOF && ! done) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + tmp_buf += static_cast<char> (c); + break; + + case '\n': + { + current_input_column = 0; + at_bol = true; + done = true; + + block_comment_nesting_level++; + promptflag--; + + buf += grab_block_comment (reader, eof); + + in_comment = false; + + if (eof) + goto done; + } + break; + + default: + at_bol = false; + tmp_buf += static_cast<char> (c); + buf += tmp_buf; + done = true; + break; + } + } + } + else + { + at_bol = false; + begin_comment = false; + } + } + + if (in_comment) + { + buf += static_cast<char> (c); + + if (c == '\n') + { + at_bol = true; + current_input_column = 0; + in_comment = false; + + // FIXME -- bailing out here prevents things like + // + // octave> # comment + // octave> x = 1 + // + // from failing at the command line, while still + // allowing blocks of comments to be grabbed properly + // for function doc strings. But only the first line of + // a mult-line doc string will be picked up for + // functions defined on the command line. We need a + // better way of collecting these comments... + if (! (reading_fcn_file || reading_script_file)) + goto done; + } + } + else + { + switch (c) + { + case ' ': + case '\t': + break; + + case '#': + if (! warned_incompatible) + { + warned_incompatible = true; + maybe_gripe_matlab_incompatible_comment (c); + } + // fall through... + + case '%': + in_comment = true; + begin_comment = true; + break; + + default: + current_input_column--; + reader.ungetc (c); + goto done; + } + } + } + + done: + + if (c == EOF) + eof = true; + + return buf; +} + +class +flex_stream_reader : public stream_reader +{ +public: + flex_stream_reader (char *buf_arg) : stream_reader (), buf (buf_arg) { } + + int getc (void) { return ::text_yyinput (); } + int ungetc (int c) { ::xunput (c, buf); return 0; } + +private: + + // No copying! + + flex_stream_reader (const flex_stream_reader&); + + flex_stream_reader& operator = (const flex_stream_reader&); + + char *buf; +}; + +static int +process_comment (bool start_in_block, bool& eof) +{ + eof = false; + + std::string help_txt; + + if (! help_buf.empty ()) + help_txt = help_buf.top (); + + flex_stream_reader flex_reader (yytext); + + // process_comment is only supposed to be called when we are not + // initially looking at a block comment. + + std::string txt = start_in_block + ? grab_block_comment (flex_reader, eof) + : grab_comment_block (flex_reader, false, eof); + + if (lexer_debug_flag) + std::cerr << "C: " << txt << std::endl; + + if (help_txt.empty () && nesting_level.none ()) + { + if (! help_buf.empty ()) + help_buf.pop (); + + help_buf.push (txt); + } + + octave_comment_buffer::append (txt); + + current_input_column = 1; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.at_beginning_of_statement = true; + + if (YY_START == COMMAND_START) + BEGIN (INITIAL); + + if (nesting_level.none ()) + return '\n'; + else if (nesting_level.is_bracket_or_brace ()) + return ';'; + else + return 0; +} + +// Return 1 if the given character matches any character in the given +// string. + +static bool +match_any (char c, const char *s) +{ + char tmp; + while ((tmp = *s++) != '\0') + { + if (c == tmp) + return true; + } + return false; +} + +// Given information about the spacing surrounding an operator, +// return 1 if it looks like it should be treated as a binary +// operator. For example, +// +// [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary +// +// [ 1 +2 ] ==> unary + +static bool +looks_like_bin_op (bool spc_prev, int next_char) +{ + bool spc_next = (next_char == ' ' || next_char == '\t'); + + return ((spc_prev && spc_next) || ! spc_prev); +} + +// Recognize separators. If the separator is a CRLF pair, it is +// replaced by a single LF. + +static bool +next_token_is_sep_op (void) +{ + bool retval = false; + + int c = text_yyinput (); + + retval = match_any (c, ",;\n]"); + + xunput (c, yytext); + + return retval; +} + +// Try to determine if the next token should be treated as a postfix +// unary operator. This is ugly, but it seems to do the right thing. + +static bool +next_token_is_postfix_unary_op (bool spc_prev) +{ + bool un_op = false; + + int c0 = text_yyinput (); + + if (c0 == '\'' && ! spc_prev) + { + un_op = true; + } + else if (c0 == '.') + { + int c1 = text_yyinput (); + un_op = (c1 == '\''); + xunput (c1, yytext); + } + else if (c0 == '+') + { + int c1 = text_yyinput (); + un_op = (c1 == '+'); + xunput (c1, yytext); + } + else if (c0 == '-') + { + int c1 = text_yyinput (); + un_op = (c1 == '-'); + xunput (c1, yytext); + } + + xunput (c0, yytext); + + return un_op; +} + +// Try to determine if the next token should be treated as a binary +// operator. +// +// This kluge exists because whitespace is not always ignored inside +// the square brackets that are used to create matrix objects (though +// spacing only really matters in the cases that can be interpreted +// either as binary ops or prefix unary ops: currently just +, -). +// +// Note that a line continuation directly following a + or - operator +// (e.g., the characters '[' 'a' ' ' '+' '\' LFD 'b' ']') will be +// parsed as a binary operator. + +static bool +next_token_is_bin_op (bool spc_prev) +{ + bool bin_op = false; + + int c0 = text_yyinput (); + + switch (c0) + { + case '+': + case '-': + { + int c1 = text_yyinput (); + + switch (c1) + { + case '+': + case '-': + // Unary ops, spacing doesn't matter. + break; + + case '=': + // Binary ops, spacing doesn't matter. + bin_op = true; + break; + + default: + // Could be either, spacing matters. + bin_op = looks_like_bin_op (spc_prev, c1); + break; + } + + xunput (c1, yytext); + } + break; + + case ':': + case '/': + case '\\': + case '^': + // Always a binary op (may also include /=, \=, and ^=). + bin_op = true; + break; + + // .+ .- ./ .\ .^ .* .** + case '.': + { + int c1 = text_yyinput (); + + if (match_any (c1, "+-/\\^*")) + // Always a binary op (may also include .+=, .-=, ./=, ...). + bin_op = true; + else if (! isdigit (c1) && c1 != ' ' && c1 != '\t' && c1 != '.') + // A structure element reference is a binary op. + bin_op = true; + + xunput (c1, yytext); + } + break; + + // = == & && | || * ** + case '=': + case '&': + case '|': + case '*': + // Always a binary op (may also include ==, &&, ||, **). + bin_op = true; + break; + + // < <= <> > >= + case '<': + case '>': + // Always a binary op (may also include <=, <>, >=). + bin_op = true; + break; + + // ~= != + case '~': + case '!': + { + int c1 = text_yyinput (); + + // ~ and ! can be unary ops, so require following =. + if (c1 == '=') + bin_op = true; + + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return bin_op; +} + +// Used to delete trailing white space from tokens. + +static std::string +strip_trailing_whitespace (char *s) +{ + std::string retval = s; + + size_t pos = retval.find_first_of (" \t"); + + if (pos != std::string::npos) + retval.resize (pos); + + return retval; +} + +// FIXME -- we need to handle block comments here. + +static void +scan_for_comments (const char *text) +{ + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int len = strlen (text); + int i = 0; + + while (i < len) + { + char c = text[i++]; + + switch (c) + { + case '%': + case '#': + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast<char> (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + break; + + case '\n': + if (in_comment) + { + comment_buf += static_cast<char> (c); + octave_comment_buffer::append (comment_buf); + comment_buf.resize (0); + in_comment = false; + beginning_of_comment = false; + } + break; + + default: + if (in_comment) + { + comment_buf += static_cast<char> (c); + beginning_of_comment = false; + } + break; + } + } + + if (! comment_buf.empty ()) + octave_comment_buffer::append (comment_buf); +} + +// Discard whitespace, including comments and continuations. +// +// Return value is logical OR of the following values: +// +// ATE_NOTHING : no spaces to eat +// ATE_SPACE_OR_TAB : space or tab in input +// ATE_NEWLINE : bare new line in input + +// FIXME -- we need to handle block comments here. + +static yum_yum +eat_whitespace (void) +{ + yum_yum retval = ATE_NOTHING; + + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int c = 0; + + while ((c = text_yyinput ()) != EOF) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + if (in_comment) + { + comment_buf += static_cast<char> (c); + beginning_of_comment = false; + } + retval |= ATE_SPACE_OR_TAB; + break; + + case '\n': + retval |= ATE_NEWLINE; + if (in_comment) + { + comment_buf += static_cast<char> (c); + octave_comment_buffer::append (comment_buf); + comment_buf.resize (0); + in_comment = false; + beginning_of_comment = false; + } + current_input_column = 0; + break; + + case '#': + case '%': + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast<char> (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + break; + + case '.': + if (in_comment) + { + comment_buf += static_cast<char> (c); + beginning_of_comment = false; + break; + } + else + { + if (have_ellipsis_continuation ()) + break; + else + goto done; + } + + case '\\': + if (in_comment) + { + comment_buf += static_cast<char> (c); + beginning_of_comment = false; + break; + } + else + { + if (have_continuation ()) + break; + else + goto done; + } + + default: + if (in_comment) + { + comment_buf += static_cast<char> (c); + beginning_of_comment = false; + break; + } + else + goto done; + } + } + + if (! comment_buf.empty ()) + octave_comment_buffer::append (comment_buf); + + done: + xunput (c, yytext); + current_input_column--; + return retval; +} + +static inline bool +looks_like_hex (const char *s, int len) +{ + return (len > 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')); +} + +static void +handle_number (void) +{ + double value = 0.0; + int nread = 0; + + if (looks_like_hex (yytext, strlen (yytext))) + { + unsigned long ival; + + nread = sscanf (yytext, "%lx", &ival); + + value = static_cast<double> (ival); + } + else + { + char *tmp = strsave (yytext); + + char *idx = strpbrk (tmp, "Dd"); + + if (idx) + *idx = 'e'; + + nread = sscanf (tmp, "%lf", &value); + + delete [] tmp; + } + + // If yytext doesn't contain a valid number, we are in deep doo doo. + + assert (nread == 1); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + yylval.tok_val = new token (value, yytext, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + current_input_column += yyleng; + + do_comma_insert_check (); +} + +// We have seen a backslash and need to find out if it should be +// treated as a continuation character. If so, this eats it, up to +// and including the new line character. +// +// Match whitespace only, followed by a comment character or newline. +// Once a comment character is found, discard all input until newline. +// If non-whitespace characters are found before comment +// characters, return 0. Otherwise, return 1. + +// FIXME -- we need to handle block comments here. + +static bool +have_continuation (bool trailing_comments_ok) +{ + std::ostringstream buf; + + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int c = 0; + + while ((c = text_yyinput ()) != EOF) + { + buf << static_cast<char> (c); + + switch (c) + { + case ' ': + case '\t': + if (in_comment) + { + comment_buf += static_cast<char> (c); + beginning_of_comment = false; + } + break; + + case '%': + case '#': + if (trailing_comments_ok) + { + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast<char> (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + } + else + goto cleanup; + break; + + case '\n': + if (in_comment) + { + comment_buf += static_cast<char> (c); + octave_comment_buffer::append (comment_buf); + } + current_input_column = 0; + promptflag--; + gripe_matlab_incompatible_continuation (); + return true; + + default: + if (in_comment) + { + comment_buf += static_cast<char> (c); + beginning_of_comment = false; + } + else + goto cleanup; + break; + } + } + + xunput (c, yytext); + return false; + +cleanup: + + std::string s = buf.str (); + + int len = s.length (); + while (len--) + xunput (s[len], yytext); + + return false; +} + +// We have seen a `.' and need to see if it is the start of a +// continuation. If so, this eats it, up to and including the new +// line character. + +static bool +have_ellipsis_continuation (bool trailing_comments_ok) +{ + char c1 = text_yyinput (); + if (c1 == '.') + { + char c2 = text_yyinput (); + if (c2 == '.' && have_continuation (trailing_comments_ok)) + return true; + else + { + xunput (c2, yytext); + xunput (c1, yytext); + } + } + else + xunput (c1, yytext); + + return false; +} + +// See if we have a continuation line. If so, eat it and the leading +// whitespace on the next line. +// +// Return value is the same as described for eat_whitespace(). + +static yum_yum +eat_continuation (void) +{ + int retval = ATE_NOTHING; + + int c = text_yyinput (); + + if ((c == '.' && have_ellipsis_continuation ()) + || (c == '\\' && have_continuation ())) + retval = eat_whitespace (); + else + xunput (c, yytext); + + return retval; +} + +static int +handle_string (char delim) +{ + std::ostringstream buf; + + int bos_line = input_line_number; + int bos_col = current_input_column; + + int c; + int escape_pending = 0; + + while ((c = text_yyinput ()) != EOF) + { + current_input_column++; + + if (c == '\\') + { + if (delim == '\'' || escape_pending) + { + buf << static_cast<char> (c); + escape_pending = 0; + } + else + { + if (have_continuation (false)) + escape_pending = 0; + else + { + buf << static_cast<char> (c); + escape_pending = 1; + } + } + continue; + } + else if (c == '.') + { + if (delim == '\'' || ! have_ellipsis_continuation (false)) + buf << static_cast<char> (c); + } + else if (c == '\n') + { + error ("unterminated string constant"); + break; + } + else if (c == delim) + { + if (escape_pending) + buf << static_cast<char> (c); + else + { + c = text_yyinput (); + if (c == delim) + { + buf << static_cast<char> (c); + } + else + { + std::string s; + xunput (c, yytext); + + if (delim == '\'') + s = buf.str (); + else + s = do_string_escapes (buf.str ()); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + + yylval.tok_val = new token (s, bos_line, bos_col); + token_stack.push (yylval.tok_val); + + if (delim == '"') + gripe_matlab_incompatible ("\" used as string delimiter"); + else if (delim == '\'') + gripe_single_quote_string (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + return delim == '"' ? DQ_STRING : SQ_STRING; + } + } + } + else + { + buf << static_cast<char> (c); + } + + escape_pending = 0; + } + + return LEXICAL_ERROR; +} + +static bool +next_token_is_assign_op (void) +{ + bool retval = false; + + int c0 = text_yyinput (); + + switch (c0) + { + case '=': + { + int c1 = text_yyinput (); + xunput (c1, yytext); + if (c1 != '=') + retval = true; + } + break; + + case '+': + case '-': + case '*': + case '/': + case '\\': + case '&': + case '|': + { + int c1 = text_yyinput (); + xunput (c1, yytext); + if (c1 == '=') + retval = true; + } + break; + + case '.': + { + int c1 = text_yyinput (); + if (match_any (c1, "+-*/\\")) + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + case '>': + { + int c1 = text_yyinput (); + if (c1 == '>') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + case '<': + { + int c1 = text_yyinput (); + if (c1 == '<') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return retval; +} + +static bool +next_token_is_index_op (void) +{ + int c = text_yyinput (); + xunput (c, yytext); + return c == '(' || c == '{'; +} + +static int +handle_close_bracket (bool spc_gobbled, int bracket_type) +{ + int retval = bracket_type; + + if (! nesting_level.none ()) + { + nesting_level.remove (); + + if (bracket_type == ']') + lexer_flags.bracketflag--; + else if (bracket_type == '}') + lexer_flags.braceflag--; + else + panic_impossible (); + } + + if (lexer_flags.bracketflag == 0 && lexer_flags.braceflag == 0) + BEGIN (INITIAL); + + if (bracket_type == ']' + && next_token_is_assign_op () + && ! lexer_flags.looking_at_return_list) + { + retval = CLOSE_BRACE; + } + else if ((lexer_flags.bracketflag || lexer_flags.braceflag) + && lexer_flags.convert_spaces_to_comma + && (nesting_level.is_bracket () + || (nesting_level.is_brace () + && ! lexer_flags.looking_at_object_index.front ()))) + { + bool index_op = next_token_is_index_op (); + + // Don't insert comma if we are looking at something like + // + // [x{i}{j}] or [x{i}(j)] + // + // but do if we are looking at + // + // [x{i} {j}] or [x{i} (j)] + + if (spc_gobbled || ! (bracket_type == '}' && index_op)) + { + bool bin_op = next_token_is_bin_op (spc_gobbled); + + bool postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); + + bool sep_op = next_token_is_sep_op (); + + if (! (postfix_un_op || bin_op || sep_op)) + { + maybe_warn_separator_insert (','); + + xunput (',', yytext); + return retval; + } + } + } + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + + return retval; +} + +static void +maybe_unput_comma (int spc_gobbled) +{ + if (nesting_level.is_bracket () + || (nesting_level.is_brace () + && ! lexer_flags.looking_at_object_index.front ())) + { + int bin_op = next_token_is_bin_op (spc_gobbled); + + int postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); + + int c1 = text_yyinput (); + int c2 = text_yyinput (); + + xunput (c2, yytext); + xunput (c1, yytext); + + int sep_op = next_token_is_sep_op (); + + int dot_op = (c1 == '.' + && (isalpha (c2) || isspace (c2) || c2 == '_')); + + if (postfix_un_op || bin_op || sep_op || dot_op) + return; + + int index_op = (c1 == '(' || c1 == '{'); + + // If there is no space before the indexing op, we don't insert + // a comma. + + if (index_op && ! spc_gobbled) + return; + + maybe_warn_separator_insert (','); + + xunput (',', yytext); + } +} + +static bool +next_token_can_follow_bin_op (void) +{ + std::stack<char> buf; + + int c = EOF; + + // Skip whitespace in current statement on current line + while (true) + { + c = text_yyinput (); + + buf.push (c); + + if (match_any (c, ",;\n") || (c != ' ' && c != '\t')) + break; + } + + // Restore input. + while (! buf.empty ()) + { + xunput (buf.top (), yytext); + + buf.pop (); + } + + return (isalnum (c) || match_any (c, "!\"'(-[_{~")); +} + +static bool +can_be_command (const std::string& tok) +{ + // Don't allow these names to be treated as commands to avoid + // surprises when parsing things like "NaN ^2". + + return ! (tok == "e" + || tok == "I" || tok == "i" + || tok == "J" || tok == "j" + || tok == "Inf" || tok == "inf" + || tok == "NaN" || tok == "nan"); +} + +static bool +looks_like_command_arg (void) +{ + bool retval = true; + + int c0 = text_yyinput (); + + switch (c0) + { + // = == + case '=': + { + int c1 = text_yyinput (); + + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else + retval = false; + + xunput (c1, yytext); + } + break; + + case '(': + case '{': + // Indexing. + retval = false; + break; + + case '\n': + // EOL. + break; + + case '\'': + case '"': + // Beginning of a character string. + break; + + // + - ++ -- += -= + case '+': + case '-': + { + int c1 = text_yyinput (); + + switch (c1) + { + case '\n': + // EOL. + case '+': + case '-': + // Unary ops, spacing doesn't matter. + break; + + case '\t': + case ' ': + { + if (next_token_can_follow_bin_op ()) + retval = false; + } + break; + + case '=': + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + break; + } + + xunput (c1, yytext); + } + break; + + case ':': + case '/': + case '\\': + case '^': + { + int c1 = text_yyinput (); + + if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // .+ .- ./ .\ .^ .* .** + case '.': + { + int c1 = text_yyinput (); + + if (match_any (c1, "+-/\\^*")) + { + int c2 = text_yyinput (); + + if (c2 == '=') + { + int c3 = text_yyinput (); + + if (! match_any (c3, ",;\n") && (c3 == ' ' || c3 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c3, yytext); + } + else if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") + && (! isdigit (c1) && c1 != ' ' && c1 != '\t' + && c1 != '.')) + { + // Structure reference. FIXME -- is this a complete check? + + retval = false; + } + + xunput (c1, yytext); + } + break; + + // & && | || * ** + case '&': + case '|': + case '*': + { + int c1 = text_yyinput (); + + if (c1 == c0) + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // < <= > >= + case '<': + case '>': + { + int c1 = text_yyinput (); + + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // ~= != + case '~': + case '!': + { + int c1 = text_yyinput (); + + // ~ and ! can be unary ops, so require following =. + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return retval; +} + +static int +handle_superclass_identifier (void) +{ + eat_continuation (); + + std::string pkg; + std::string meth = strip_trailing_whitespace (yytext); + size_t pos = meth.find ("@"); + std::string cls = meth.substr (pos).substr (1); + meth = meth.substr (0, pos - 1); + + pos = cls.find ("."); + if (pos != std::string::npos) + { + pkg = cls.substr (pos).substr (1); + cls = cls.substr (0, pos - 1); + } + + int kw_token = (is_keyword_token (meth) || is_keyword_token (cls) + || is_keyword_token (pkg)); + if (kw_token) + { + error ("method, class and package names may not be keywords"); + return LEXICAL_ERROR; + } + + yylval.tok_val + = new token (meth.empty () ? 0 : &(symbol_table::insert (meth)), + cls.empty () ? 0 : &(symbol_table::insert (cls)), + pkg.empty () ? 0 : &(symbol_table::insert (pkg)), + input_line_number, current_input_column); + token_stack.push (yylval.tok_val); + + lexer_flags.convert_spaces_to_comma = true; + current_input_column += yyleng; + + return SUPERCLASSREF; +} + +static int +handle_meta_identifier (void) +{ + eat_continuation (); + + std::string pkg; + std::string cls = strip_trailing_whitespace (yytext).substr (1); + size_t pos = cls.find ("."); + + if (pos != std::string::npos) + { + pkg = cls.substr (pos).substr (1); + cls = cls.substr (0, pos - 1); + } + + int kw_token = is_keyword_token (cls) || is_keyword_token (pkg); + if (kw_token) + { + error ("class and package names may not be keywords"); + return LEXICAL_ERROR; + } + + yylval.tok_val + = new token (cls.empty () ? 0 : &(symbol_table::insert (cls)), + pkg.empty () ? 0 : &(symbol_table::insert (pkg)), + input_line_number, current_input_column); + + token_stack.push (yylval.tok_val); + + lexer_flags.convert_spaces_to_comma = true; + current_input_column += yyleng; + + return METAQUERY; +} + +// Figure out exactly what kind of token to return when we have seen +// an identifier. Handles keywords. Return -1 if the identifier +// should be ignored. + +static int +handle_identifier (void) +{ + bool at_bos = lexer_flags.at_beginning_of_statement; + + std::string tok = strip_trailing_whitespace (yytext); + + int c = yytext[yyleng-1]; + + int cont_is_spc = eat_continuation (); + + int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + + // If we are expecting a structure element, avoid recognizing + // keywords and other special names and return STRUCT_ELT, which is + // a string that is also a valid identifier. But first, we have to + // decide whether to insert a comma. + + if (lexer_flags.looking_at_indirect_ref) + { + do_comma_insert_check (); + + maybe_unput_comma (spc_gobbled); + + yylval.tok_val = new token (tok, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = true; + + current_input_column += yyleng; + + return STRUCT_ELT; + } + + lexer_flags.at_beginning_of_statement = false; + + // The is_keyword_token may reset + // lexer_flags.at_beginning_of_statement. For example, if it sees + // an else token, then the next token is at the beginning of a + // statement. + + int kw_token = is_keyword_token (tok); + + // If we found a keyword token, then the beginning_of_statement flag + // is already set. Otherwise, we won't be at the beginning of a + // statement. + + if (lexer_flags.looking_at_function_handle) + { + if (kw_token) + { + error ("function handles may not refer to keywords"); + + return LEXICAL_ERROR; + } + else + { + yylval.tok_val = new token (tok, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = true; + + return FCN_HANDLE; + } + } + + // If we have a regular keyword, return it. + // Keywords can be followed by identifiers. + + if (kw_token) + { + if (kw_token >= 0) + { + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + } + + return kw_token; + } + + // See if we have a plot keyword (title, using, with, or clear). + + int c1 = text_yyinput (); + + bool next_tok_is_eq = false; + if (c1 == '=') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + + if (c2 != '=') + next_tok_is_eq = true; + } + + xunput (c1, yytext); + + // Kluge alert. + // + // If we are looking at a text style function, set up to gobble its + // arguments. + // + // If the following token is `=', or if we are parsing a function + // return list or function parameter list, or if we are looking at + // something like [ab,cd] = foo (), force the symbol to be inserted + // as a variable in the current symbol table. + + if (! is_variable (tok)) + { + if (at_bos && spc_gobbled && can_be_command (tok) + && looks_like_command_arg ()) + { + BEGIN (COMMAND_START); + } + else if (next_tok_is_eq + || lexer_flags.looking_at_decl_list + || lexer_flags.looking_at_return_list + || (lexer_flags.looking_at_parameter_list + && ! lexer_flags.looking_at_initializer_expression)) + { + symbol_table::force_variable (tok); + } + else if (lexer_flags.looking_at_matrix_or_assign_lhs) + { + lexer_flags.pending_local_variables.insert (tok); + } + } + + // Find the token in the symbol table. Beware the magic + // transformation of the end keyword... + + if (tok == "end") + tok = "__end__"; + + yylval.tok_val = new token (&(symbol_table::insert (tok)), + input_line_number, current_input_column); + + token_stack.push (yylval.tok_val); + + // After seeing an identifer, it is ok to convert spaces to a comma + // (if needed). + + lexer_flags.convert_spaces_to_comma = true; + + if (! (next_tok_is_eq || YY_START == COMMAND_START)) + { + lexer_flags.quote_is_transpose = true; + + do_comma_insert_check (); + + maybe_unput_comma (spc_gobbled); + } + + current_input_column += yyleng; + + if (tok != "__end__") + lexer_flags.looking_for_object_index = true; + + return NAME; +} + +void +lexical_feedback::init (void) +{ + // Not initially defining a matrix list. + bracketflag = 0; + + // Not initially defining a cell array list. + braceflag = 0; + + // Not initially inside a loop or if statement. + looping = 0; + + // Not initially defining a function. + defining_func = 0; + + // Not parsing an object index. + while (! parsed_function_name.empty ()) + parsed_function_name.pop (); + + parsing_class_method = false; + + // Not initially defining a class with classdef. + maybe_classdef_get_set_method = false; + parsing_classdef = false; + + // Not initiallly looking at a function handle. + looking_at_function_handle = 0; + + // Not initiallly looking at an anonymous function argument list. + looking_at_anon_fcn_args = 0; + + // Not parsing a function return, parameter, or declaration list. + looking_at_return_list = false; + looking_at_parameter_list = false; + looking_at_decl_list = false; + + // Not looking at an argument list initializer expression. + looking_at_initializer_expression = false; + + // Not parsing a matrix or the left hand side of multi-value + // assignment statement. + looking_at_matrix_or_assign_lhs = false; + + // Not parsing an object index. + while (! looking_at_object_index.empty ()) + looking_at_object_index.pop_front (); + + looking_at_object_index.push_front (false); + + // Object index not possible until we've seen something. + looking_for_object_index = false; + + // Yes, we are at the beginning of a statement. + at_beginning_of_statement = true; + + // No need to do comma insert or convert spaces to comma at + // beginning of input. + convert_spaces_to_comma = true; + do_comma_insert = false; + + // Not initially looking at indirect references. + looking_at_indirect_ref = false; + + // Quote marks strings intially. + quote_is_transpose = false; + + // Set of identifiers that might be local variable names is empty. + pending_local_variables.clear (); +} + +bool +is_keyword (const std::string& s) +{ + // Parsing function names like "set.property_name" inside + // classdef-style class definitions is simplified by handling the + // "set" and "get" portions of the names using the same mechanism as + // is used for keywords. However, they are not really keywords in + // the language, so omit them from the list of possible keywords. + + return (octave_kw_hash::in_word_set (s.c_str (), s.length ()) != 0 + && ! (s == "set" || s == "get")); +} + +DEFUN (iskeyword, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iskeyword ()\n\ +@deftypefnx {Built-in Function} {} iskeyword (@var{name})\n\ +Return true if @var{name} is an Octave keyword. If @var{name}\n\ +is omitted, return a list of keywords.\n\ +@seealso{isvarname, exist}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("iskeyword"); + + if (error_state) + return retval; + + if (argc == 1) + { + // Neither set and get are keywords. See the note in the + // is_keyword function for additional details. + + string_vector lst (TOTAL_KEYWORDS); + + int j = 0; + + for (int i = 0; i < TOTAL_KEYWORDS; i++) + { + std::string tmp = wordlist[i].name; + + if (! (tmp == "set" || tmp == "get")) + lst[j++] = tmp; + } + + lst.resize (j); + + retval = Cell (lst.sort ()); + } + else if (argc == 2) + { + retval = is_keyword (argv[1]); + } + else + print_usage (); + + return retval; +} + +/* + +%!assert (iskeyword ("for")) +%!assert (iskeyword ("fort"), false) +%!assert (iskeyword ("fft"), false) + +*/ + +void +prep_lexer_for_script_file (void) +{ + BEGIN (SCRIPT_FILE_BEGIN); +} + +void +prep_lexer_for_function_file (void) +{ + BEGIN (FUNCTION_FILE_BEGIN); +} + +static void +maybe_warn_separator_insert (char sep) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:separator-insert", + "potential auto-insertion of `%c' near line %d", + sep, input_line_number); + else + warning_with_id ("Octave:separator-insert", + "potential auto-insertion of `%c' near line %d of file %s", + sep, input_line_number, nm.c_str ()); +} + +static void +gripe_single_quote_string (void) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:single-quote-string", + "single quote delimited string near line %d", + input_line_number); + else + warning_with_id ("Octave:single-quote-string", + "single quote delimited string near line %d of file %s", + input_line_number, nm.c_str ()); +} + +static void +gripe_matlab_incompatible (const std::string& msg) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:matlab-incompatible", + "potential Matlab compatibility problem: %s", + msg.c_str ()); + else + warning_with_id ("Octave:matlab-incompatible", + "potential Matlab compatibility problem: %s near line %d offile %s", + msg.c_str (), input_line_number, nm.c_str ()); +} + +static void +maybe_gripe_matlab_incompatible_comment (char c) +{ + if (c == '#') + gripe_matlab_incompatible ("# used as comment character"); +} + +static void +gripe_matlab_incompatible_continuation (void) +{ + gripe_matlab_incompatible ("\\ used as line continuation marker"); +} + +static void +gripe_matlab_incompatible_operator (const std::string& op) +{ + std::string t = op; + int n = t.length (); + if (t[n-1] == '\n') + t.resize (n-1); + gripe_matlab_incompatible (t + " used as operator"); +} + +static void +display_token (int tok) +{ + switch (tok) + { + case '=': std::cerr << "'='\n"; break; + case ':': std::cerr << "':'\n"; break; + case '-': std::cerr << "'-'\n"; break; + case '+': std::cerr << "'+'\n"; break; + case '*': std::cerr << "'*'\n"; break; + case '/': std::cerr << "'/'\n"; break; + case ADD_EQ: std::cerr << "ADD_EQ\n"; break; + case SUB_EQ: std::cerr << "SUB_EQ\n"; break; + case MUL_EQ: std::cerr << "MUL_EQ\n"; break; + case DIV_EQ: std::cerr << "DIV_EQ\n"; break; + case LEFTDIV_EQ: std::cerr << "LEFTDIV_EQ\n"; break; + case POW_EQ: std::cerr << "POW_EQ\n"; break; + case EMUL_EQ: std::cerr << "EMUL_EQ\n"; break; + case EDIV_EQ: std::cerr << "EDIV_EQ\n"; break; + case ELEFTDIV_EQ: std::cerr << "ELEFTDIV_EQ\n"; break; + case EPOW_EQ: std::cerr << "EPOW_EQ\n"; break; + case AND_EQ: std::cerr << "AND_EQ\n"; break; + case OR_EQ: std::cerr << "OR_EQ\n"; break; + case LSHIFT_EQ: std::cerr << "LSHIFT_EQ\n"; break; + case RSHIFT_EQ: std::cerr << "RSHIFT_EQ\n"; break; + case LSHIFT: std::cerr << "LSHIFT\n"; break; + case RSHIFT: std::cerr << "RSHIFT\n"; break; + case EXPR_AND_AND: std::cerr << "EXPR_AND_AND\n"; break; + case EXPR_OR_OR: std::cerr << "EXPR_OR_OR\n"; break; + case EXPR_AND: std::cerr << "EXPR_AND\n"; break; + case EXPR_OR: std::cerr << "EXPR_OR\n"; break; + case EXPR_NOT: std::cerr << "EXPR_NOT\n"; break; + case EXPR_LT: std::cerr << "EXPR_LT\n"; break; + case EXPR_LE: std::cerr << "EXPR_LE\n"; break; + case EXPR_EQ: std::cerr << "EXPR_EQ\n"; break; + case EXPR_NE: std::cerr << "EXPR_NE\n"; break; + case EXPR_GE: std::cerr << "EXPR_GE\n"; break; + case EXPR_GT: std::cerr << "EXPR_GT\n"; break; + case LEFTDIV: std::cerr << "LEFTDIV\n"; break; + case EMUL: std::cerr << "EMUL\n"; break; + case EDIV: std::cerr << "EDIV\n"; break; + case ELEFTDIV: std::cerr << "ELEFTDIV\n"; break; + case EPLUS: std::cerr << "EPLUS\n"; break; + case EMINUS: std::cerr << "EMINUS\n"; break; + case QUOTE: std::cerr << "QUOTE\n"; break; + case TRANSPOSE: std::cerr << "TRANSPOSE\n"; break; + case PLUS_PLUS: std::cerr << "PLUS_PLUS\n"; break; + case MINUS_MINUS: std::cerr << "MINUS_MINUS\n"; break; + case POW: std::cerr << "POW\n"; break; + case EPOW: std::cerr << "EPOW\n"; break; + + case NUM: + case IMAG_NUM: + std::cerr << (tok == NUM ? "NUM" : "IMAG_NUM") + << " [" << yylval.tok_val->number () << "]\n"; + break; + + case STRUCT_ELT: + std::cerr << "STRUCT_ELT [" << yylval.tok_val->text () << "]\n"; break; + + case NAME: + { + symbol_table::symbol_record *sr = yylval.tok_val->sym_rec (); + std::cerr << "NAME"; + if (sr) + std::cerr << " [" << sr->name () << "]"; + std::cerr << "\n"; + } + break; + + case END: std::cerr << "END\n"; break; + + case DQ_STRING: + case SQ_STRING: + std::cerr << (tok == DQ_STRING ? "DQ_STRING" : "SQ_STRING") + << " [" << yylval.tok_val->text () << "]\n"; + break; + + case FOR: std::cerr << "FOR\n"; break; + case WHILE: std::cerr << "WHILE\n"; break; + case DO: std::cerr << "DO\n"; break; + case UNTIL: std::cerr << "UNTIL\n"; break; + case IF: std::cerr << "IF\n"; break; + case ELSEIF: std::cerr << "ELSEIF\n"; break; + case ELSE: std::cerr << "ELSE\n"; break; + case SWITCH: std::cerr << "SWITCH\n"; break; + case CASE: std::cerr << "CASE\n"; break; + case OTHERWISE: std::cerr << "OTHERWISE\n"; break; + case BREAK: std::cerr << "BREAK\n"; break; + case CONTINUE: std::cerr << "CONTINUE\n"; break; + case FUNC_RET: std::cerr << "FUNC_RET\n"; break; + case UNWIND: std::cerr << "UNWIND\n"; break; + case CLEANUP: std::cerr << "CLEANUP\n"; break; + case TRY: std::cerr << "TRY\n"; break; + case CATCH: std::cerr << "CATCH\n"; break; + case GLOBAL: std::cerr << "GLOBAL\n"; break; + case PERSISTENT: std::cerr << "PERSISTENT\n"; break; + case FCN_HANDLE: std::cerr << "FCN_HANDLE\n"; break; + case END_OF_INPUT: std::cerr << "END_OF_INPUT\n\n"; break; + case LEXICAL_ERROR: std::cerr << "LEXICAL_ERROR\n\n"; break; + case FCN: std::cerr << "FCN\n"; break; + case CLOSE_BRACE: std::cerr << "CLOSE_BRACE\n"; break; + case SCRIPT_FILE: std::cerr << "SCRIPT_FILE\n"; break; + case FUNCTION_FILE: std::cerr << "FUNCTION_FILE\n"; break; + case SUPERCLASSREF: std::cerr << "SUPERCLASSREF\n"; break; + case METAQUERY: std::cerr << "METAQUERY\n"; break; + case GET: std::cerr << "GET\n"; break; + case SET: std::cerr << "SET\n"; break; + case PROPERTIES: std::cerr << "PROPERTIES\n"; break; + case METHODS: std::cerr << "METHODS\n"; break; + case EVENTS: std::cerr << "EVENTS\n"; break; + case CLASSDEF: std::cerr << "CLASSDEF\n"; break; + case '\n': std::cerr << "\\n\n"; break; + case '\r': std::cerr << "\\r\n"; break; + case '\t': std::cerr << "TAB\n"; break; + default: + { + if (tok < 256) + std::cerr << static_cast<char> (tok) << "\n"; + else + std::cerr << "UNKNOWN(" << tok << ")\n"; + } + break; + } +} + +static void +display_state (void) +{ + std::cerr << "S: "; + + switch (YY_START) + { + case INITIAL: + std::cerr << "INITIAL" << std::endl; + break; + + case COMMAND_START: + std::cerr << "COMMAND_START" << std::endl; + break; + + case MATRIX_START: + std::cerr << "MATRIX_START" << std::endl; + break; + + case SCRIPT_FILE_BEGIN: + std::cerr << "SCRIPT_FILE_BEGIN" << std::endl; + break; + + case FUNCTION_FILE_BEGIN: + std::cerr << "FUNCTION_FILE_BEGIN" << std::endl; + break; + + default: + std::cerr << "UNKNOWN START STATE!" << std::endl; + break; + } +} + +static void +lexer_debug (const char *pattern, const char *text) +{ + std::cerr << std::endl; + + display_state (); + + std::cerr << "P: " << pattern << std::endl; + std::cerr << "T: " << text << std::endl; +} + +DEFUN (__display_tokens__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __display_tokens__ ()\n\ +Query or set the internal variable that determines whether Octave's\n\ +lexer displays tokens as they are read.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (display_tokens); +} + +DEFUN (__token_count__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __token_count__ ()\n\ +Number of language tokens processed since Octave startup.\n\ +@end deftypefn") +{ + return octave_value (Vtoken_count); +} + +DEFUN (__lexer_debug_flag__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{old_val} =} __lexer_debug_flag__ (@var{new_val}))\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + retval = set_internal_variable (lexer_debug_flag, args, nargout, + "__lexer_debug_flag__"); + + return retval; +}
--- a/src/parse-tree/module.mk Thu Aug 02 16:33:24 2012 -0700 +++ b/src/parse-tree/module.mk Thu Aug 02 17:10:26 2012 -0700 @@ -1,6 +1,18 @@ EXTRA_DIST += \ parse-tree/module.mk +PARSER_INCLUDES = \ + parse-tree/lex.h \ + parse.h \ + parse-private.h + +PARSER_SRC = \ + parse-tree/lex.ll \ + parse-tree/oct-parse.yy + +lex.lo lex.o oct-parse.lo oct-parse.o: \ + AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) + PT_INCLUDES = \ parse-tree/pt-all.h \ parse-tree/pt-arg-list.h \ @@ -29,7 +41,8 @@ parse-tree/pt-stmt.h \ parse-tree/pt-unop.h \ parse-tree/pt-walk.h \ - parse-tree/pt.h + parse-tree/pt.h \ + $(PARSER_INCLUDES) PARSE_TREE_SRC = \ parse-tree/pt-arg-list.cc \ @@ -57,5 +70,6 @@ parse-tree/pt-select.cc \ parse-tree/pt-stmt.cc \ parse-tree/pt-unop.cc \ - parse-tree/pt.cc + parse-tree/pt.cc \ + $(PARSER_SRC)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/oct-parse.yy Thu Aug 02 17:10:26 2012 -0700 @@ -0,0 +1,4734 @@ +/* + +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" + +#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 + +// The current input line number. +int input_line_number = 1; + +// The column of the current token. +int current_input_column = 1; + +// Buffer for help text snagged from function files. +std::stack<std::string> help_buf; + +// Buffer for comments appearing before a function statement. +static std::string fcn_comment_header; + +// 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; + +// = 0 currently outside any function. +// = 1 inside the primary function or a subfunction. +// > 1 means we are looking at a function definition that seems to be +// inside a function. Note that the function still might not be a +// nested function. +static int current_function_depth = 0; + +// A stack holding the nested function scopes being parsed. +// We don't use std::stack, because we want the clear method. Also, we +// must access one from the top +static std::vector<symbol_table::scope_id> function_scopes; + +// Maximum function depth detected. Just here to determine whether +// we have nested functions or just implicitly ended subfunctions. +static int max_function_depth = 0; + +// FALSE if we are still at the primary function. Subfunctions can +// only be declared inside function files. +static int parsing_subfunctions = false; + +// Have we found an explicit end to a function? +static bool endfunction_found = false; + +// Keep track of symbol table information when parsing functions. +symtab_context parser_symtab_context; + +// Name of the current class when we are parsing class methods or +// constructors. +std::string current_class_name; + +// TRUE means we are in the process of autoloading a function. +static bool autoloading = false; + +// TRUE means the current function file was found in a relative path +// element. +static bool fcn_file_from_relative_lookup = false; + +// Pointer to the primary user function or user script function. +static octave_function *primary_fcn_ptr = 0; + +// Scope where we install all subfunctions and nested functions. Only +// used while reading function files. +static symbol_table::scope_id primary_fcn_scope; + +// 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. + +// Generic error messages. +static void +yyerror (const char *s); + +// Error mesages for mismatched end tokens. +static void +end_error (const char *type, token::end_tok_type ettype, int l, int c); + +// Check to see that end tokens are properly matched. +static bool +end_token_ok (token *tok, token::end_tok_type expected); + +// Maybe print a warning if an assignment expression is used as the +// test in a logical expression. +static void +maybe_warn_assign_as_truth_value (tree_expression *expr); + +// Maybe print a warning about switch labels that aren't constants. +static void +maybe_warn_variable_switch_label (tree_expression *expr); + +// Finish building a range. +static tree_expression * +finish_colon_expression (tree_colon_expression *e); + +// Build a constant. +static tree_constant * +make_constant (int op, token *tok_val); + +// Build a function handle. +static tree_fcn_handle * +make_fcn_handle (token *tok_val); + +// Build an anonymous function handle. +static tree_anon_fcn_handle * +make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); + +// Build a binary expression. +static tree_expression * +make_binary_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2); + +// Build a boolean expression. +static tree_expression * +make_boolean_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2); + +// Build a prefix expression. +static tree_expression * +make_prefix_op (int op, tree_expression *op1, token *tok_val); + +// Build a postfix expression. +static tree_expression * +make_postfix_op (int op, tree_expression *op1, token *tok_val); + +// Build an unwind-protect command. +static tree_command * +make_unwind_command (token *unwind_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc); + +// Build a try-catch command. +static tree_command * +make_try_command (token *try_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc); + +// Build a while command. +static tree_command * +make_while_command (token *while_tok, tree_expression *expr, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc); + +// Build a do-until command. +static tree_command * +make_do_until_command (token *until_tok, tree_statement_list *body, + tree_expression *expr, octave_comment_list *lc); + +// Build a for command. +static tree_command * +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); + +// Build a break command. +static tree_command * +make_break_command (token *break_tok); + +// Build a continue command. +static tree_command * +make_continue_command (token *continue_tok); + +// Build a return command. +static tree_command * +make_return_command (token *return_tok); + +// Start an if command. +static tree_if_command_list * +start_if_command (tree_expression *expr, tree_statement_list *list); + +// Finish an if command. +static tree_if_command * +finish_if_command (token *if_tok, tree_if_command_list *list, + token *end_tok, octave_comment_list *lc); + +// Build an elseif clause. +static tree_if_clause * +make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); + +// Finish a switch command. +static tree_switch_command * +finish_switch_command (token *switch_tok, tree_expression *expr, + tree_switch_case_list *list, token *end_tok, + octave_comment_list *lc); + +// Build a switch case. +static tree_switch_case * +make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); + +// Build an assignment to a variable. +static tree_expression * +make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, + tree_expression *rhs); + +// Define a script. +static void +make_script (tree_statement_list *cmds, tree_statement *end_script); + +// Begin defining a function. +static octave_user_function * +start_function (tree_parameter_list *param_list, tree_statement_list *body, + tree_statement *end_function); + +// Create a no-op statement for end_function. +static tree_statement * +make_end (const std::string& type, int l, int c); + +// Do most of the work for defining a function. +static octave_user_function * +frob_function (const std::string& fname, octave_user_function *fcn); + +// Finish defining a function. +static tree_function_def * +finish_function (tree_parameter_list *ret_list, + octave_user_function *fcn, octave_comment_list *lc); + +// Reset state after parsing function. +static void +recover_from_parsing_function (void); + +// Make an index expression. +static tree_index_expression * +make_index_expression (tree_expression *expr, + tree_argument_list *args, char type); + +// Make an indirect reference expression. +static tree_index_expression * +make_indirect_ref (tree_expression *expr, const std::string&); + +// Make an indirect reference expression with dynamic field name. +static tree_index_expression * +make_indirect_ref (tree_expression *expr, tree_expression *field); + +// Make a declaration command. +static tree_decl_command * +make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst); + +// Validate argument list forming a matrix or cell row. +static tree_argument_list * +validate_matrix_row (tree_argument_list *row); + +// Finish building a matrix list. +static tree_expression * +finish_matrix (tree_matrix *m); + +// Finish building a cell list. +static tree_expression * +finish_cell (tree_cell *c); + +// Maybe print a warning. Duh. +static void +maybe_warn_missing_semi (tree_statement_list *); + +// Set the print flag for a statement based on the separator type. +static tree_statement_list * +set_stmt_print_flag (tree_statement_list *, char, bool); + +// Create a statement list. +static tree_statement_list *make_statement_list (tree_statement *stmt); + +// Append a statement to an existing statement list. +static tree_statement_list * +append_statement_list (tree_statement_list *list, char sep, + tree_statement *stmt, bool warn_missing_semi); + +// 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) + +%} + +// 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_" + +%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 + { + parser_end_of_input = 1; + $$ = 0; + } + | simple_list + { $$ = $1; } + | simple_list '\n' + { $$ = $1; } + | simple_list END_OF_INPUT + { $$ = $1; } + ; + +simple_list : simple_list1 opt_sep_no_nl + { $$ = set_stmt_print_flag ($1, $2, false); } + ; + +simple_list1 : statement + { $$ = make_statement_list ($1); } + | simple_list1 sep_no_nl statement + { $$ = append_statement_list ($1, $2, $3, false); } + ; + +opt_list : // empty + { $$ = new tree_statement_list (); } + | list + { $$ = $1; } + ; + +list : list1 opt_sep + { $$ = set_stmt_print_flag ($1, $2, true); } + ; + +list1 : statement + { $$ = make_statement_list ($1); } + | list1 sep statement + { $$ = 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 + { $$ = 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 + { $$ = make_constant (DQ_STRING, $1); } + | SQ_STRING + { $$ = make_constant (SQ_STRING, $1); } + ; + +constant : NUM + { $$ = make_constant (NUM, $1); } + | IMAG_NUM + { $$ = make_constant (IMAG_NUM, $1); } + | string + { $$ = $1; } + ; + +matrix : '[' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' ';' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' ',' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' matrix_rows ']' + { + $$ = finish_matrix ($2); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.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 '}' + { $$ = 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 + { $$ = validate_matrix_row ($1); } + | arg_list ',' // Ignore trailing comma. + { $$ = validate_matrix_row ($1); } + ; + +fcn_handle : '@' FCN_HANDLE + { + $$ = make_fcn_handle ($2); + lexer_flags.looking_at_function_handle--; + } + ; + +anon_fcn_handle : '@' param_list statement + { + lexer_flags.quote_is_transpose = false; + $$ = 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 : '.' + { lexer_flags.looking_at_indirect_ref = true; } + ; + +oper_expr : primary_expr + { $$ = $1; } + | oper_expr PLUS_PLUS + { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } + | oper_expr MINUS_MINUS + { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } + | oper_expr '(' ')' + { $$ = make_index_expression ($1, 0, '('); } + | oper_expr '(' arg_list ')' + { $$ = make_index_expression ($1, $3, '('); } + | oper_expr '{' '}' + { $$ = make_index_expression ($1, 0, '{'); } + | oper_expr '{' arg_list '}' + { $$ = make_index_expression ($1, $3, '{'); } + | oper_expr QUOTE + { $$ = make_postfix_op (QUOTE, $1, $2); } + | oper_expr TRANSPOSE + { $$ = make_postfix_op (TRANSPOSE, $1, $2); } + | oper_expr indirect_ref_op STRUCT_ELT + { $$ = make_indirect_ref ($1, $3->text ()); } + | oper_expr indirect_ref_op '(' expression ')' + { $$ = make_indirect_ref ($1, $4); } + | PLUS_PLUS oper_expr %prec UNARY + { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } + | MINUS_MINUS oper_expr %prec UNARY + { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } + | EXPR_NOT oper_expr %prec UNARY + { $$ = make_prefix_op (EXPR_NOT, $2, $1); } + | '+' oper_expr %prec UNARY + { $$ = make_prefix_op ('+', $2, $1); } + | '-' oper_expr %prec UNARY + { $$ = make_prefix_op ('-', $2, $1); } + | oper_expr POW oper_expr + { $$ = make_binary_op (POW, $1, $2, $3); } + | oper_expr EPOW oper_expr + { $$ = make_binary_op (EPOW, $1, $2, $3); } + | oper_expr '+' oper_expr + { $$ = make_binary_op ('+', $1, $2, $3); } + | oper_expr '-' oper_expr + { $$ = make_binary_op ('-', $1, $2, $3); } + | oper_expr '*' oper_expr + { $$ = make_binary_op ('*', $1, $2, $3); } + | oper_expr '/' oper_expr + { $$ = make_binary_op ('/', $1, $2, $3); } + | oper_expr EPLUS oper_expr + { $$ = make_binary_op ('+', $1, $2, $3); } + | oper_expr EMINUS oper_expr + { $$ = make_binary_op ('-', $1, $2, $3); } + | oper_expr EMUL oper_expr + { $$ = make_binary_op (EMUL, $1, $2, $3); } + | oper_expr EDIV oper_expr + { $$ = make_binary_op (EDIV, $1, $2, $3); } + | oper_expr LEFTDIV oper_expr + { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } + | oper_expr ELEFTDIV oper_expr + { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } + ; + +colon_expr : colon_expr1 + { $$ = 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 + { $$ = make_binary_op (LSHIFT, $1, $2, $3); } + | simple_expr RSHIFT simple_expr + { $$ = make_binary_op (RSHIFT, $1, $2, $3); } + | simple_expr EXPR_LT simple_expr + { $$ = make_binary_op (EXPR_LT, $1, $2, $3); } + | simple_expr EXPR_LE simple_expr + { $$ = make_binary_op (EXPR_LE, $1, $2, $3); } + | simple_expr EXPR_EQ simple_expr + { $$ = make_binary_op (EXPR_EQ, $1, $2, $3); } + | simple_expr EXPR_GE simple_expr + { $$ = make_binary_op (EXPR_GE, $1, $2, $3); } + | simple_expr EXPR_GT simple_expr + { $$ = make_binary_op (EXPR_GT, $1, $2, $3); } + | simple_expr EXPR_NE simple_expr + { $$ = make_binary_op (EXPR_NE, $1, $2, $3); } + | simple_expr EXPR_AND simple_expr + { $$ = make_binary_op (EXPR_AND, $1, $2, $3); } + | simple_expr EXPR_OR simple_expr + { $$ = make_binary_op (EXPR_OR, $1, $2, $3); } + | simple_expr EXPR_AND_AND simple_expr + { $$ = make_boolean_op (EXPR_AND_AND, $1, $2, $3); } + | simple_expr EXPR_OR_OR simple_expr + { $$ = 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; + lexer_flags.looking_at_matrix_or_assign_lhs = false; + for (std::set<std::string>::const_iterator p = lexer_flags.pending_local_variables.begin (); + p != lexer_flags.pending_local_variables.end (); + p++) + { + symbol_table::force_variable (*p); + } + lexer_flags.pending_local_variables.clear (); + } + ; + +assign_expr : assign_lhs '=' expression + { $$ = make_assign_op ('=', $1, $2, $3); } + | assign_lhs ADD_EQ expression + { $$ = make_assign_op (ADD_EQ, $1, $2, $3); } + | assign_lhs SUB_EQ expression + { $$ = make_assign_op (SUB_EQ, $1, $2, $3); } + | assign_lhs MUL_EQ expression + { $$ = make_assign_op (MUL_EQ, $1, $2, $3); } + | assign_lhs DIV_EQ expression + { $$ = make_assign_op (DIV_EQ, $1, $2, $3); } + | assign_lhs LEFTDIV_EQ expression + { $$ = make_assign_op (LEFTDIV_EQ, $1, $2, $3); } + | assign_lhs POW_EQ expression + { $$ = make_assign_op (POW_EQ, $1, $2, $3); } + | assign_lhs LSHIFT_EQ expression + { $$ = make_assign_op (LSHIFT_EQ, $1, $2, $3); } + | assign_lhs RSHIFT_EQ expression + { $$ = make_assign_op (RSHIFT_EQ, $1, $2, $3); } + | assign_lhs EMUL_EQ expression + { $$ = make_assign_op (EMUL_EQ, $1, $2, $3); } + | assign_lhs EDIV_EQ expression + { $$ = make_assign_op (EDIV_EQ, $1, $2, $3); } + | assign_lhs ELEFTDIV_EQ expression + { $$ = make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } + | assign_lhs EPOW_EQ expression + { $$ = make_assign_op (EPOW_EQ, $1, $2, $3); } + | assign_lhs AND_EQ expression + { $$ = make_assign_op (AND_EQ, $1, $2, $3); } + | assign_lhs OR_EQ expression + { $$ = 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 + { lexer_flags.looking_at_decl_list = true; } + +declaration : GLOBAL parsing_decl_list decl1 + { + $$ = make_decl_command (GLOBAL, $1, $3); + lexer_flags.looking_at_decl_list = false; + } + | PERSISTENT parsing_decl_list decl1 + { + $$ = make_decl_command (PERSISTENT, $1, $3); + lexer_flags.looking_at_decl_list = false; + } + ; + +decl1 : decl2 + { $$ = new tree_decl_init_list ($1); } + | decl1 decl2 + { + $1->append ($2); + $$ = $1; + } + ; + +decl_param_init : // empty + { lexer_flags.looking_at_initializer_expression = true; } + +decl2 : identifier + { $$ = new tree_decl_elt ($1); } + | identifier '=' decl_param_init expression + { + lexer_flags.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 (! ($$ = 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); + + $$ = 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); + + $$ = 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 (! ($$ = 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 + { $$ = 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 (! ($$ = make_while_command ($1, $3, $5, $6, $2))) + ABORT_PARSE; + } + | DO stash_comment opt_sep opt_list UNTIL expression + { + if (! ($$ = make_do_until_command ($5, $4, $6, $2))) + ABORT_PARSE; + } + | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = 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 (! ($$ = 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 (! ($$ = 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 (! ($$ = make_for_command (PARFOR, $1, $4, $6, + $8, $11, $12, $2))) + ABORT_PARSE; + } + ; + +// ======= +// Jumping +// ======= + +jump_command : BREAK + { + if (! ($$ = make_break_command ($1))) + ABORT_PARSE; + } + | CONTINUE + { + if (! ($$ = make_continue_command ($1))) + ABORT_PARSE; + } + | FUNC_RET + { + if (! ($$ = 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 (! ($$ = 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 (! ($$ = make_try_command ($1, $4, $8, $9, $2, $6))) + ABORT_PARSE; + } + | TRY stash_comment opt_sep opt_list END + { + if (! ($$ = make_try_command ($1, $4, 0, $5, $2, 0))) + ABORT_PARSE; + } + ; + +// =========================================== +// Some `subroutines' for function definitions +// =========================================== + +push_fcn_symtab : // empty + { + current_function_depth++; + + if (max_function_depth < current_function_depth) + max_function_depth = current_function_depth; + + parser_symtab_context.push (); + + symbol_table::set_scope (symbol_table::alloc_scope ()); + + function_scopes.push_back (symbol_table::current_scope ()); + + if (! reading_script_file && current_function_depth == 1 + && ! parsing_subfunctions) + primary_fcn_scope = symbol_table::current_scope (); + + if (reading_script_file && current_function_depth > 1) + yyerror ("nested functions not implemented in this context"); + } + ; + +// =========================== +// List of function parameters +// =========================== + +param_list_beg : '(' + { + lexer_flags.looking_at_parameter_list = true; + + if (lexer_flags.looking_at_function_handle) + { + parser_symtab_context.push (); + symbol_table::set_scope (symbol_table::alloc_scope ()); + lexer_flags.looking_at_function_handle--; + lexer_flags.looking_at_anon_fcn_args = true; + } + } + ; + +param_list_end : ')' + { + lexer_flags.looking_at_parameter_list = false; + lexer_flags.looking_for_object_index = false; + } + ; + +param_list : param_list_beg param_list1 param_list_end + { + lexer_flags.quote_is_transpose = false; + $$ = $2; + } + | param_list_beg error + { + yyerror ("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 : '[' ']' + { + lexer_flags.looking_at_return_list = false; + $$ = new tree_parameter_list (); + } + | return_list1 + { + lexer_flags.looking_at_return_list = false; + if ($1->validate (tree_parameter_list::out)) + $$ = $1; + else + ABORT_PARSE; + } + | '[' return_list1 ']' + { + lexer_flags.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 + = make_end ("endscript", input_line_number, + current_input_column); + + 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 || lexer_flags.parsing_classdef) + lexer_flags.maybe_classdef_get_set_method = true; + } + ; + +function : function_beg function1 + { + $$ = finish_function (0, $2, $1); + recover_from_parsing_function (); + } + | function_beg return_list '=' function1 + { + $$ = finish_function ($2, $4, $1); + recover_from_parsing_function (); + } + ; + +fcn_name : identifier + { + std::string id_name = $1->name (); + + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + + $$ = $1; + } + | GET '.' identifier + { + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + $$ = $3; + } + | SET '.' identifier + { + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + $$ = $3; + } + ; + +function1 : fcn_name function2 + { + std::string fname = $1->name (); + + delete $1; + + if (! ($$ = frob_function (fname, $2))) + ABORT_PARSE; + } + ; + +function2 : param_list opt_sep opt_list function_end + { $$ = start_function ($1, $3, $4); } + | opt_sep opt_list function_end + { $$ = start_function (0, $2, $3); } + ; + +function_end : END + { + endfunction_found = true; + if (end_token_ok ($1, token::function_end)) + $$ = 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) +// { +// yyerror ("function body open at end of script"); +// YYABORT; +// } + + if (endfunction_found) + { + yyerror ("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)) + { + yyerror ("function body open at end of input"); + YYABORT; + } + + if (reading_classdef_file) + { + yyerror ("classdef body open at end of input"); + YYABORT; + } + + $$ = make_end ("endfunction", input_line_number, + current_input_column); + } + ; + +// ======== +// Classdef +// ======== + +classdef_beg : CLASSDEF stash_comment + { + $$ = 0; + lexer_flags.parsing_classdef = true; + } + ; + +classdef_end : END + { + lexer_flags.parsing_classdef = false; + + if (end_token_ok ($1, token::classdef_end)) + $$ = 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 + { yyerror ("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. + +static void +yyerror (const char *s) +{ + int err_col = current_input_column - 1; + + std::ostringstream output_buf; + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + output_buf << "parse error near line " << 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 ()); +} + +// Error mesages for mismatched end tokens. + +static void +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. + +static bool +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; + + yyerror ("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. + +static void +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. + +static void +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. + +static tree_expression * +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. + +static tree_constant * +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. + +static tree_fcn_handle * +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. + +static tree_anon_fcn_handle * +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 = input_line_number; + int c = 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. + +static tree_expression * +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. + +static tree_expression * +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. + +static tree_expression * +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. + +static tree_expression * +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. + +static tree_command * +make_unwind_command (token *unwind_tok, tree_statement_list *body, + tree_statement_list *cleanup, 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, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a try-catch command. + +static tree_command * +make_try_command (token *try_tok, tree_statement_list *body, + tree_statement_list *cleanup, 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, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a while command. + +static tree_command * +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 (); + + lexer_flags.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. + +static tree_command * +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 (); + + lexer_flags.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. + +static tree_command * +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 (); + + lexer_flags.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) + yyerror ("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. + +static tree_command * +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. + +static tree_command * +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. + +static tree_command * +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. + +static tree_if_command_list * +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. + +static tree_if_command * +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. + +static tree_if_clause * +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. + +static tree_switch_command * +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. + +static tree_switch_case * +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. + +static tree_expression * +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 + yyerror ("computed multiple assignment not allowed"); + + return retval; +} + +// Define a script. + +static void +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. + +static octave_user_function * +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; +} + +static tree_statement * +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. + +static octave_user_function * +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 + && current_function_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 (current_function_depth > 1 || parsing_subfunctions) + { + fcn->stash_parent_fcn_name (curr_fcn_file_name); + + if (current_function_depth > 1) + fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size ()-2]); + else + fcn->stash_parent_fcn_scope (primary_fcn_scope); + } + + if (lexer_flags.parsing_class_method) + { + if (current_class_name == id_name) + fcn->mark_as_class_constructor (); + else + fcn->mark_as_class_method (); + + fcn->stash_dispatch_class (current_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 (input_line_number, current_input_column); + + if (! help_buf.empty () && current_function_depth == 1 + && ! parsing_subfunctions) + { + fcn->document (help_buf.top ()); + + help_buf.pop (); + } + + if (reading_fcn_file && current_function_depth == 1 + && ! parsing_subfunctions) + primary_fcn_ptr = fcn; + + return fcn; +} + +static tree_function_def * +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 (current_function_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 (current_function_depth == 1 && fcn) + symbol_table::update_nest (fcn->scope ()); + + if (! reading_fcn_file && current_function_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; +} + +static void +recover_from_parsing_function (void) +{ + if (parser_symtab_context.empty ()) + panic_impossible (); + + parser_symtab_context.pop (); + + if (reading_fcn_file && current_function_depth == 1 + && ! parsing_subfunctions) + parsing_subfunctions = true; + + current_function_depth--; + function_scopes.pop_back (); + + lexer_flags.defining_func--; + lexer_flags.parsed_function_name.pop (); + lexer_flags.looking_at_return_list = false; + lexer_flags.looking_at_parameter_list = false; +} + +// Make an index expression. + +static tree_index_expression * +make_index_expression (tree_expression *expr, tree_argument_list *args, + char type) +{ + tree_index_expression *retval = 0; + + if (args && args->has_magic_tilde ()) + { + yyerror ("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. + +static tree_index_expression * +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); + + lexer_flags.looking_at_indirect_ref = false; + + return retval; +} + +// Make an indirect reference expression with dynamic field name. + +static tree_index_expression * +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); + + lexer_flags.looking_at_indirect_ref = false; + + return retval; +} + +// Make a declaration command. + +static tree_decl_command * +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 (current_function_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; +} + +static tree_argument_list * +validate_matrix_row (tree_argument_list *row) +{ + if (row && row->has_magic_tilde ()) + yyerror ("invalid use of tilde (~) in matrix expression"); + return row; +} + +// Finish building a matrix list. + +static tree_expression * +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. + +static tree_expression * +finish_cell (tree_cell *c) +{ + return finish_matrix (c); +} + +static void +maybe_warn_missing_semi (tree_statement_list *t) +{ + if (current_function_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 ()); + } +} + +static tree_statement_list * +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; +} + +static tree_statement_list * +make_statement_list (tree_statement *stmt) +{ + return new tree_statement_list (stmt); +} + +static tree_statement_list * +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; +} + +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'; + } + } + + if (c == '\n') + input_line_number++; + + return c; +} + +class +stdio_stream_reader : public stream_reader +{ +public: + stdio_stream_reader (FILE *f_arg) : stream_reader (), f (f_arg) { } + + int getc (void) { return ::text_getc (f); } + int ungetc (int c) + { + if (c == '\n') + input_line_number--; + + return ::ungetc (c, f); + } + +private: + FILE *f; + + // 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': + current_input_column++; + break; + + case '\n': + current_input_column = 1; + 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) +{ + 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); + + while (true) + { + eof = skip_white_space (stdio_reader); + + if (eof) + break; + + txt = 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 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 force_script = false, bool require_file = true, + const std::string& warn_for = std::string ()) +{ + 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 (input_line_number); + frame.protect_var (current_input_column); + frame.protect_var (reading_fcn_file); + frame.protect_var (line_editing); + frame.protect_var (current_class_name); + frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); + frame.protect_var (max_function_depth); + frame.protect_var (parsing_subfunctions); + frame.protect_var (endfunction_found); + + input_line_number = 1; + current_input_column = 1; + reading_fcn_file = true; + line_editing = false; + current_class_name = dispatch_type; + current_function_depth = 0; + function_scopes.clear (); + max_function_depth = 0; + parsing_subfunctions = false; + endfunction_found = 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; + + std::string help_txt = gobble_leading_white_space (ffile, eof); + + 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 (parser_end_of_input); + 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; + parser_end_of_input = 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; + } + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (ffile); + + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + + frame.protect_var (primary_fcn_ptr); + primary_fcn_ptr = 0; + + reset_parser (); + + // 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) + prep_lexer_for_script_file (); + else + prep_lexer_for_function_file (); + + lexer_flags.parsing_class_method = ! dispatch_type.empty (); + + frame.protect_var (global_command); + + global_command = 0; + + int status = yyparse (); + + // 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 = primary_fcn_ptr; + + if (status != 0) + error ("parse error while reading %s file %s", + file_type.c_str (), ff.c_str ()); + } + else + { + tree_statement *end_of_script + = make_end ("endscript", input_line_number, current_input_column); + + make_script (0, end_of_script); + + fcn_ptr = 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, ""); + + 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; + + frame.protect_var (fcn_file_from_relative_lookup); + + fcn_file_from_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); + } + + if (autoload) + { + frame.protect_var (autoloading); + autoloading = true; + } + + fcn_file_from_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, fcn_file_from_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, autoloading, + false); + + retval = octave_dynamic_loader::load_mex (nm, file, fcn_file_from_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, autoloading); + } + + 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, "", true, + require_file, 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; + + frame.protect_var (input_line_number); + frame.protect_var (current_input_column); + frame.protect_var (get_input_from_eval_string); + frame.protect_var (input_from_eval_string_pending); + frame.protect_var (parser_end_of_input); + frame.protect_var (line_editing); + frame.protect_var (current_eval_string); + frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); + frame.protect_var (max_function_depth); + frame.protect_var (parsing_subfunctions); + frame.protect_var (endfunction_found); + frame.protect_var (reading_fcn_file); + frame.protect_var (reading_script_file); + frame.protect_var (reading_classdef_file); + + input_line_number = 1; + current_input_column = 1; + get_input_from_eval_string = true; + input_from_eval_string_pending = true; + parser_end_of_input = false; + line_editing = false; + current_function_depth = 0; + function_scopes.clear (); + max_function_depth = 0; + parsing_subfunctions = false; + endfunction_found = false; + reading_fcn_file = false; + reading_script_file = false; + reading_classdef_file = false; + + current_eval_string = s; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (0); + + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + + do + { + reset_parser (); + + 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 = yyparse (); + + tree_statement_list *command_list = global_command; + + // Unmark forced variables. + // Restore previous value of global_command. + frame.run_top (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 (parser_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; +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/parse-private.h Thu Aug 02 17:10:26 2012 -0700 @@ -0,0 +1,96 @@ +/* + +Copyright (C) 2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 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/>. + +*/ + +#if !defined (octave_parse_private_h) +#define octave_parse_private_h 1 + +#include <stack> + +#include "symtab.h" + +// Keep track of symbol table information when parsing functions. +class symtab_context +{ +private: + + class frame + { + public: + frame (symbol_table::scope_id s, symbol_table::scope_id c) + : m_scope (s), m_context (c) { } + + frame (const frame& f) : m_scope (f.m_scope), m_context (f.m_context) { } + + frame& operator = (const frame& f) + { + if (&f != this) + { + m_scope = f.m_scope; + m_context = f.m_context; + } + + return *this; + } + + ~frame (void) { } + + symbol_table::scope_id scope (void) const { return m_scope; } + symbol_table::scope_id context (void) const { return m_context; } + + private: + + symbol_table::scope_id m_scope; + symbol_table::scope_id m_context; + }; + + std::stack<frame> frame_stack; + +public: + symtab_context (void) : frame_stack () { } + + void clear (void) + { + while (! frame_stack.empty ()) + frame_stack.pop (); + } + + bool empty (void) const { return frame_stack.empty (); } + + void pop (void) + { + frame tmp = frame_stack.top (); + + symbol_table::set_scope_and_context (tmp.scope (), tmp.context ()); + + frame_stack.pop (); + } + + void push (void) + { + frame_stack.push (frame (symbol_table::current_scope (), + symbol_table::current_context ())); + } +}; + +extern symtab_context parser_symtab_context; + +#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/parse.h Thu Aug 02 17:10:26 2012 -0700 @@ -0,0 +1,116 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 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/>. + +*/ + +#if !defined (octave_parse_h) +#define octave_parse_h 1 + +#include <cstdio> + +#include <string> + +#include <stack> + +extern void reset_parser (void); +extern int octave_lex (void); +extern int octave_parse (void); + +class tree; +class tree_matrix; +class tree_identifier; +class tree_statement_list; +class octave_function; + +#include "oct-obj.h" + +// Nonzero means print parser debugging info (-d). +extern int octave_debug; + +// The current input line number. +extern int input_line_number; + +// The column of the current token. +extern int current_input_column; + +// Buffer for help text snagged from function files. +extern std::stack<std::string> help_buf; + +// TRUE means we are using readline. +extern bool line_editing; + +// TRUE means we printed messages about reading startup files. +extern bool reading_startup_message_printed; + +// TRUE means input is coming from startup file. +extern bool input_from_startup_file; + +// Name of the current class when we are parsing class methods or +// constructors. +extern std::string current_class_name; + +extern OCTINTERP_API std::string +get_help_from_file (const std::string& nm, bool& symbol_found, + std::string& file); + +extern OCTINTERP_API std::string +get_help_from_file (const std::string& nm, bool& symbol_found); + +extern OCTINTERP_API std::string lookup_autoload (const std::string& nm); + +extern OCTINTERP_API string_vector autoloaded_functions (void); + +extern OCTINTERP_API string_vector reverse_lookup_autoload (const std::string& nm); + +extern OCTINTERP_API octave_function * +load_fcn_from_file (const std::string& file_name, + const std::string& dir_name = std::string (), + const std::string& dispatch_type = std::string (), + const std::string& fcn_name = std::string (), + bool autoload = false); + +extern OCTINTERP_API void +source_file (const std::string& file_name, + const std::string& context = std::string (), + bool verbose = false, bool require_file = true, + const std::string& warn_for = std::string ()); + +extern OCTINTERP_API octave_value_list +feval (const std::string& name, + const octave_value_list& args = octave_value_list (), + int nargout = 0); + +extern OCTINTERP_API octave_value_list +feval (octave_function *fcn, + const octave_value_list& args = octave_value_list (), + int nargout = 0); + +extern OCTINTERP_API octave_value_list +feval (const octave_value_list& args, int nargout = 0); + +extern OCTINTERP_API octave_value_list +eval_string (const std::string&, bool silent, int& parse_status, int hargout); + +extern OCTINTERP_API octave_value +eval_string (const std::string&, bool silent, int& parse_status); + +extern OCTINTERP_API void cleanup_statement_list (tree_statement_list **lst); + +#endif
--- a/src/parse.h Thu Aug 02 16:33:24 2012 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,116 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 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/>. - -*/ - -#if !defined (octave_parse_h) -#define octave_parse_h 1 - -#include <cstdio> - -#include <string> - -#include <stack> - -extern void reset_parser (void); -extern int octave_lex (void); -extern int octave_parse (void); - -class tree; -class tree_matrix; -class tree_identifier; -class tree_statement_list; -class octave_function; - -#include "oct-obj.h" - -// Nonzero means print parser debugging info (-d). -extern int octave_debug; - -// The current input line number. -extern int input_line_number; - -// The column of the current token. -extern int current_input_column; - -// Buffer for help text snagged from function files. -extern std::stack<std::string> help_buf; - -// TRUE means we are using readline. -extern bool line_editing; - -// TRUE means we printed messages about reading startup files. -extern bool reading_startup_message_printed; - -// TRUE means input is coming from startup file. -extern bool input_from_startup_file; - -// Name of the current class when we are parsing class methods or -// constructors. -extern std::string current_class_name; - -extern OCTINTERP_API std::string -get_help_from_file (const std::string& nm, bool& symbol_found, - std::string& file); - -extern OCTINTERP_API std::string -get_help_from_file (const std::string& nm, bool& symbol_found); - -extern OCTINTERP_API std::string lookup_autoload (const std::string& nm); - -extern OCTINTERP_API string_vector autoloaded_functions (void); - -extern OCTINTERP_API string_vector reverse_lookup_autoload (const std::string& nm); - -extern OCTINTERP_API octave_function * -load_fcn_from_file (const std::string& file_name, - const std::string& dir_name = std::string (), - const std::string& dispatch_type = std::string (), - const std::string& fcn_name = std::string (), - bool autoload = false); - -extern OCTINTERP_API void -source_file (const std::string& file_name, - const std::string& context = std::string (), - bool verbose = false, bool require_file = true, - const std::string& warn_for = std::string ()); - -extern OCTINTERP_API octave_value_list -feval (const std::string& name, - const octave_value_list& args = octave_value_list (), - int nargout = 0); - -extern OCTINTERP_API octave_value_list -feval (octave_function *fcn, - const octave_value_list& args = octave_value_list (), - int nargout = 0); - -extern OCTINTERP_API octave_value_list -feval (const octave_value_list& args, int nargout = 0); - -extern OCTINTERP_API octave_value_list -eval_string (const std::string&, bool silent, int& parse_status, int hargout); - -extern OCTINTERP_API octave_value -eval_string (const std::string&, bool silent, int& parse_status); - -extern OCTINTERP_API void cleanup_statement_list (tree_statement_list **lst); - -#endif