Mercurial > hg > octave-lyh
annotate src/parse.y @ 7562:c827f5673321
move tests to individual source files
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Thu, 06 Mar 2008 02:27:55 -0500 |
| parents | 8470a6b0b769 |
| children | 1f662945c2be |
| rev | line source |
|---|---|
| 1829 | 1 /* |
| 1 | 2 |
| 7017 | 3 Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, |
| 7351 | 4 2002, 2003, 2004, 2005, 2006, 2007, 2008 John W. Eaton |
| 1 | 5 |
| 6 This file is part of Octave. | |
| 7 | |
| 8 Octave is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
| 11 option) any later version. | |
| 1 | 12 |
| 13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 7016 | 19 along with Octave; see the file COPYING. If not, see |
| 20 <http://www.gnu.org/licenses/>. | |
| 1 | 21 |
| 22 */ | |
| 23 | |
| 24 // Parser for Octave. | |
| 25 | |
| 767 | 26 // C decarations. |
| 27 | |
| 1 | 28 %{ |
| 29 #define YYDEBUG 1 | |
| 30 | |
| 240 | 31 #ifdef HAVE_CONFIG_H |
| 1229 | 32 #include <config.h> |
| 240 | 33 #endif |
| 34 | |
| 3178 | 35 #include <cassert> |
| 3156 | 36 #include <cstdio> |
| 37 | |
| 2427 | 38 #ifdef YYBYACC |
| 39 #include <cstdlib> | |
| 40 #endif | |
| 41 | |
| 5484 | 42 #include <map> |
| 5765 | 43 #include <sstream> |
| 5484 | 44 |
| 3928 | 45 #include "Cell.h" |
| 1 | 46 #include "Matrix.h" |
| 3021 | 47 #include "cmd-edit.h" |
| 48 #include "cmd-hist.h" | |
| 49 #include "file-ops.h" | |
| 50 #include "file-stat.h" | |
| 4243 | 51 #include "oct-env.h" |
| 3712 | 52 #include "oct-time.h" |
| 4171 | 53 #include "quit.h" |
| 1 | 54 |
| 3665 | 55 #include "comment-list.h" |
| 4243 | 56 #include "defaults.h" |
| 2166 | 57 #include "defun.h" |
| 4243 | 58 #include "dirfns.h" |
| 3021 | 59 #include "dynamic-ld.h" |
| 1351 | 60 #include "error.h" |
| 61 #include "input.h" | |
| 62 #include "lex.h" | |
| 5832 | 63 #include "load-path.h" |
| 1743 | 64 #include "oct-hist.h" |
| 5626 | 65 #include "oct-map.h" |
| 4935 | 66 #include "ov-fcn-handle.h" |
| 2970 | 67 #include "ov-usr-fcn.h" |
| 1670 | 68 #include "toplev.h" |
| 1351 | 69 #include "pager.h" |
| 70 #include "parse.h" | |
| 2987 | 71 #include "pt-all.h" |
| 1351 | 72 #include "symtab.h" |
| 73 #include "token.h" | |
| 3021 | 74 #include "unwind-prot.h" |
| 1 | 75 #include "utils.h" |
| 1351 | 76 #include "variables.h" |
| 1 | 77 |
| 78 // The current input line number. | |
| 79 int input_line_number = 0; | |
| 80 | |
| 81 // The column of the current token. | |
| 143 | 82 int current_input_column = 1; |
| 1 | 83 |
| 338 | 84 // Buffer for help text snagged from function files. |
| 4426 | 85 std::stack<std::string> help_buf; |
| 1 | 86 |
| 3665 | 87 // Buffer for comments appearing before a function statement. |
| 88 static std::string fcn_comment_header; | |
| 89 | |
| 3021 | 90 // TRUE means we are using readline. |
| 91 // (--no-line-editing) | |
| 92 bool line_editing = true; | |
| 93 | |
| 94 // TRUE means we printed messages about reading startup files. | |
| 95 bool reading_startup_message_printed = false; | |
| 96 | |
| 97 // TRUE means input is coming from startup file. | |
| 98 bool input_from_startup_file = false; | |
| 99 | |
| 3489 | 100 // TRUE means that we are in the process of evaluating a function |
| 101 // body. The parser might be called in that case if we are looking at | |
| 102 // an eval() statement. | |
| 103 bool evaluating_function_body = false; | |
| 104 | |
| 4238 | 105 // Keep a count of how many END tokens we expect. |
| 106 int end_tokens_expected = 0; | |
| 107 | |
| 3903 | 108 // Keep track of symbol table information when parsing functions. |
| 7336 | 109 std::stack<symbol_table::scope_id> symtab_context; |
| 4238 | 110 |
| 111 // Name of parent function when parsing function files that might | |
| 112 // contain nested functions. | |
| 113 std::string parent_function_name; | |
| 3903 | 114 |
| 7336 | 115 // Name of the current class when we are parsing class methods or |
| 116 // constructors. | |
| 117 std::string current_class_name; | |
| 118 | |
| 5484 | 119 // TRUE means we are in the process of autoloading a function. |
| 120 static bool autoloading = false; | |
| 121 | |
| 6323 | 122 // TRUE means the current function file was found in a relative path |
| 123 // element. | |
| 124 static bool fcn_file_from_relative_lookup = false; | |
| 125 | |
| 7336 | 126 // If nonzero, this is a pointer to the function we just finished |
| 127 // parsing. | |
| 128 static octave_function *curr_fcn_ptr = 0; | |
| 129 | |
| 5484 | 130 // List of autoloads (function -> file mapping). |
| 131 static std::map<std::string, std::string> autoload_map; | |
| 132 | |
| 496 | 133 // Forward declarations for some functions defined at the bottom of |
| 134 // the file. | |
| 135 | |
| 136 // Generic error messages. | |
| 2970 | 137 static void |
| 138 yyerror (const char *s); | |
| 1 | 139 |
| 578 | 140 // Error mesages for mismatched end tokens. |
| 2970 | 141 static void |
| 142 end_error (const char *type, token::end_tok_type ettype, int l, int c); | |
| 1 | 143 |
| 578 | 144 // Check to see that end tokens are properly matched. |
| 2970 | 145 static bool |
| 146 end_token_ok (token *tok, token::end_tok_type expected); | |
| 496 | 147 |
| 148 // Maybe print a warning if an assignment expression is used as the | |
| 149 // test in a logical expression. | |
| 2970 | 150 static void |
| 151 maybe_warn_assign_as_truth_value (tree_expression *expr); | |
| 1 | 152 |
| 2764 | 153 // Maybe print a warning about switch labels that aren't constants. |
| 2970 | 154 static void |
| 155 maybe_warn_variable_switch_label (tree_expression *expr); | |
| 2764 | 156 |
| 1623 | 157 // Finish building a range. |
| 2970 | 158 static tree_expression * |
| 159 finish_colon_expression (tree_colon_expression *e); | |
| 1623 | 160 |
| 1607 | 161 // Build a constant. |
| 2970 | 162 static tree_constant * |
| 163 make_constant (int op, token *tok_val); | |
| 1607 | 164 |
| 4342 | 165 // Build a function handle. |
| 166 static tree_fcn_handle * | |
| 167 make_fcn_handle (token *tok_val); | |
| 168 | |
| 4935 | 169 // Build an anonymous function handle. |
| 5861 | 170 static tree_anon_fcn_handle * |
| 4935 | 171 make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); |
| 172 | |
| 578 | 173 // Build a binary expression. |
| 2970 | 174 static tree_expression * |
| 175 make_binary_op (int op, tree_expression *op1, token *tok_val, | |
| 176 tree_expression *op2); | |
| 578 | 177 |
| 2375 | 178 // Build a boolean expression. |
| 2970 | 179 static tree_expression * |
| 180 make_boolean_op (int op, tree_expression *op1, token *tok_val, | |
| 181 tree_expression *op2); | |
| 2375 | 182 |
| 578 | 183 // Build a prefix expression. |
| 2970 | 184 static tree_expression * |
| 185 make_prefix_op (int op, tree_expression *op1, token *tok_val); | |
| 578 | 186 |
| 187 // Build a postfix expression. | |
| 2970 | 188 static tree_expression * |
| 189 make_postfix_op (int op, tree_expression *op1, token *tok_val); | |
| 578 | 190 |
| 1623 | 191 // Build an unwind-protect command. |
| 2970 | 192 static tree_command * |
| 193 make_unwind_command (token *unwind_tok, tree_statement_list *body, | |
| 3665 | 194 tree_statement_list *cleanup, token *end_tok, |
| 195 octave_comment_list *lc, octave_comment_list *mc); | |
| 1623 | 196 |
| 197 // Build a try-catch command. | |
| 2970 | 198 static tree_command * |
| 199 make_try_command (token *try_tok, tree_statement_list *body, | |
| 3665 | 200 tree_statement_list *cleanup, token *end_tok, |
| 201 octave_comment_list *lc, octave_comment_list *mc); | |
| 1623 | 202 |
| 203 // Build a while command. | |
| 2970 | 204 static tree_command * |
| 205 make_while_command (token *while_tok, tree_expression *expr, | |
| 3665 | 206 tree_statement_list *body, token *end_tok, |
| 207 octave_comment_list *lc); | |
| 1623 | 208 |
| 3484 | 209 // Build a do-until command. |
| 210 static tree_command * | |
| 211 make_do_until_command (token *do_tok, tree_statement_list *body, | |
| 3665 | 212 tree_expression *expr, octave_comment_list *lc); |
| 3484 | 213 |
| 1623 | 214 // Build a for command. |
| 2970 | 215 static tree_command * |
| 216 make_for_command (token *for_tok, tree_argument_list *lhs, | |
| 217 tree_expression *expr, tree_statement_list *body, | |
| 3665 | 218 token *end_tok, octave_comment_list *lc); |
| 1623 | 219 |
| 4207 | 220 // Build a break command. |
| 221 static tree_command * | |
| 222 make_break_command (token *break_tok); | |
| 223 | |
| 224 // Build a continue command. | |
| 225 static tree_command * | |
| 226 make_continue_command (token *continue_tok); | |
| 227 | |
| 228 // Build a return command. | |
| 229 static tree_command * | |
| 230 make_return_command (token *return_tok); | |
| 1623 | 231 |
| 232 // Start an if command. | |
| 2970 | 233 static tree_if_command_list * |
| 234 start_if_command (tree_expression *expr, tree_statement_list *list); | |
| 1623 | 235 |
| 236 // Finish an if command. | |
| 2970 | 237 static tree_if_command * |
| 3665 | 238 finish_if_command (token *if_tok, tree_if_command_list *list, |
| 239 token *end_tok, octave_comment_list *lc); | |
| 1623 | 240 |
| 241 // Build an elseif clause. | |
| 2970 | 242 static tree_if_clause * |
| 3665 | 243 make_elseif_clause (tree_expression *expr, tree_statement_list *list, |
| 244 octave_comment_list *lc); | |
| 1623 | 245 |
| 2764 | 246 // Finish a switch command. |
| 2970 | 247 static tree_switch_command * |
| 248 finish_switch_command (token *switch_tok, tree_expression *expr, | |
| 3665 | 249 tree_switch_case_list *list, token *end_tok, |
| 250 octave_comment_list *lc); | |
| 2764 | 251 |
| 252 // Build a switch case. | |
| 2970 | 253 static tree_switch_case * |
| 3665 | 254 make_switch_case (tree_expression *expr, tree_statement_list *list, |
| 255 octave_comment_list *lc); | |
| 2764 | 256 |
| 1623 | 257 // Build an assignment to a variable. |
| 2970 | 258 static tree_expression * |
| 259 make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, | |
| 260 tree_expression *rhs); | |
| 1623 | 261 |
| 262 // Begin defining a function. | |
| 2970 | 263 static octave_user_function * |
| 264 start_function (tree_parameter_list *param_list, tree_statement_list *body); | |
| 1623 | 265 |
| 266 // Do most of the work for defining a function. | |
| 2970 | 267 static octave_user_function * |
| 4872 | 268 frob_function (const std::string& fname, octave_user_function *fcn); |
| 1623 | 269 |
| 270 // Finish defining a function. | |
| 7336 | 271 static void |
| 3665 | 272 finish_function (tree_parameter_list *ret_list, |
| 273 octave_user_function *fcn, octave_comment_list *lc); | |
| 751 | 274 |
| 2883 | 275 // Reset state after parsing function. |
| 2970 | 276 static void |
| 277 recover_from_parsing_function (void); | |
| 2883 | 278 |
| 751 | 279 // Make an index expression. |
| 2970 | 280 static tree_index_expression * |
| 3933 | 281 make_index_expression (tree_expression *expr, |
| 282 tree_argument_list *args, char type); | |
| 2970 | 283 |
| 284 // Make an indirect reference expression. | |
| 3930 | 285 static tree_index_expression * |
| 3523 | 286 make_indirect_ref (tree_expression *expr, const std::string&); |
| 666 | 287 |
| 4131 | 288 // Make an indirect reference expression with dynamic field name. |
| 289 static tree_index_expression * | |
| 290 make_indirect_ref (tree_expression *expr, tree_expression *field); | |
| 291 | |
| 2846 | 292 // Make a declaration command. |
| 2970 | 293 static tree_decl_command * |
| 294 make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst); | |
| 2846 | 295 |
| 1623 | 296 // Finish building a matrix list. |
| 2970 | 297 static tree_expression * |
| 298 finish_matrix (tree_matrix *m); | |
| 1623 | 299 |
| 3351 | 300 // Finish building a cell list. |
| 301 static tree_expression * | |
| 302 finish_cell (tree_cell *c); | |
| 303 | |
| 1511 | 304 // Maybe print a warning. Duh. |
| 2970 | 305 static void |
| 306 maybe_warn_missing_semi (tree_statement_list *); | |
| 1511 | 307 |
| 2525 | 308 // Set the print flag for a statement based on the separator type. |
| 2970 | 309 static void |
| 310 set_stmt_print_flag (tree_statement_list *, char, bool); | |
| 2525 | 311 |
| 1 | 312 #define ABORT_PARSE \ |
| 313 do \ | |
| 314 { \ | |
| 522 | 315 global_command = 0; \ |
| 1 | 316 yyerrok; \ |
| 4238 | 317 if (! symtab_context.empty ()) \ |
| 3929 | 318 { \ |
| 7336 | 319 symbol_table::set_scope (symtab_context.top ()); \ |
| 4238 | 320 symtab_context.pop (); \ |
| 3929 | 321 } \ |
| 2865 | 322 if (interactive || forced_interactive) \ |
| 1 | 323 YYACCEPT; \ |
| 324 else \ | |
| 325 YYABORT; \ | |
| 326 } \ | |
| 327 while (0) | |
| 328 | |
| 329 %} | |
| 330 | |
| 666 | 331 // Bison declarations. |
| 332 | |
| 4813 | 333 // Don't add spaces around the = here; it causes some versions of |
| 334 // bison to fail to properly recognize the directive. | |
| 335 | |
| 336 %name-prefix="octave_" | |
| 4753 | 337 |
| 1 | 338 %union |
| 339 { | |
| 2891 | 340 // The type of the basic tokens returned by the lexer. |
| 143 | 341 token *tok_val; |
| 342 | |
| 3665 | 343 // Comment strings that we need to deal with mid-rule. |
| 344 octave_comment_list *comment_type; | |
| 345 | |
| 2891 | 346 // Types for the nonterminals we generate. |
| 2525 | 347 char sep_type; |
| 1 | 348 tree *tree_type; |
| 1829 | 349 tree_matrix *tree_matrix_type; |
| 3351 | 350 tree_cell *tree_cell_type; |
| 496 | 351 tree_expression *tree_expression_type; |
| 2375 | 352 tree_constant *tree_constant_type; |
| 4342 | 353 tree_fcn_handle *tree_fcn_handle_type; |
| 5861 | 354 tree_anon_fcn_handle *tree_anon_fcn_handle_type; |
| 1 | 355 tree_identifier *tree_identifier_type; |
| 356 tree_index_expression *tree_index_expression_type; | |
| 357 tree_colon_expression *tree_colon_expression_type; | |
| 358 tree_argument_list *tree_argument_list_type; | |
| 359 tree_parameter_list *tree_parameter_list_type; | |
| 360 tree_command *tree_command_type; | |
| 361 tree_if_command *tree_if_command_type; | |
| 578 | 362 tree_if_clause *tree_if_clause_type; |
| 363 tree_if_command_list *tree_if_command_list_type; | |
| 2764 | 364 tree_switch_command *tree_switch_command_type; |
| 365 tree_switch_case *tree_switch_case_type; | |
| 366 tree_switch_case_list *tree_switch_case_list_type; | |
| 2846 | 367 tree_decl_elt *tree_decl_elt_type; |
| 368 tree_decl_init_list *tree_decl_init_list_type; | |
| 369 tree_decl_command *tree_decl_command_type; | |
| 578 | 370 tree_statement *tree_statement_type; |
| 371 tree_statement_list *tree_statement_list_type; | |
| 2891 | 372 octave_user_function *octave_user_function_type; |
| 1 | 373 } |
| 374 | |
| 143 | 375 // Tokens with line and column information. |
| 376 %token <tok_val> '=' ':' '-' '+' '*' '/' | |
| 4018 | 377 %token <tok_val> ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ |
| 378 %token <tok_val> EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ AND_EQ OR_EQ | |
| 2899 | 379 %token <tok_val> LSHIFT_EQ RSHIFT_EQ LSHIFT RSHIFT |
| 428 | 380 %token <tok_val> EXPR_AND_AND EXPR_OR_OR |
| 143 | 381 %token <tok_val> EXPR_AND EXPR_OR EXPR_NOT |
| 382 %token <tok_val> EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT | |
| 1276 | 383 %token <tok_val> LEFTDIV EMUL EDIV ELEFTDIV EPLUS EMINUS |
| 384 %token <tok_val> QUOTE TRANSPOSE | |
| 143 | 385 %token <tok_val> PLUS_PLUS MINUS_MINUS POW EPOW |
| 386 %token <tok_val> NUM IMAG_NUM | |
| 2970 | 387 %token <tok_val> STRUCT_ELT |
| 2883 | 388 %token <tok_val> NAME |
| 143 | 389 %token <tok_val> END |
| 5279 | 390 %token <tok_val> DQ_STRING SQ_STRING |
| 3484 | 391 %token <tok_val> FOR WHILE DO UNTIL |
| 1491 | 392 %token <tok_val> IF ELSEIF ELSE |
| 2764 | 393 %token <tok_val> SWITCH CASE OTHERWISE |
| 1491 | 394 %token <tok_val> BREAK CONTINUE FUNC_RET |
| 924 | 395 %token <tok_val> UNWIND CLEANUP |
| 1489 | 396 %token <tok_val> TRY CATCH |
| 2846 | 397 %token <tok_val> GLOBAL STATIC |
| 4342 | 398 %token <tok_val> FCN_HANDLE |
| 1 | 399 |
| 143 | 400 // Other tokens. |
| 2970 | 401 %token END_OF_INPUT LEXICAL_ERROR |
| 5848 | 402 %token FCN VARARGIN VARARGOUT |
| 5296 | 403 %token CLOSE_BRACE |
| 1 | 404 |
| 143 | 405 // Nonterminals we construct. |
| 3665 | 406 %type <comment_type> stash_comment function_beg |
| 2525 | 407 %type <sep_type> sep_no_nl opt_sep_no_nl sep opt_sep |
| 578 | 408 %type <tree_type> input |
| 5861 | 409 %type <tree_constant_type> string constant magic_colon |
| 410 %type <tree_anon_fcn_handle_type> anon_fcn_handle | |
| 4342 | 411 %type <tree_fcn_handle_type> fcn_handle |
| 3351 | 412 %type <tree_matrix_type> matrix_rows matrix_rows1 |
| 413 %type <tree_cell_type> cell_rows cell_rows1 | |
| 5102 | 414 %type <tree_expression_type> matrix cell |
| 4207 | 415 %type <tree_expression_type> primary_expr postfix_expr prefix_expr binary_expr |
| 416 %type <tree_expression_type> simple_expr colon_expr assign_expr expression | |
| 4238 | 417 %type <tree_identifier_type> identifier fcn_name |
| 7336 | 418 %type <octave_user_function_type> function1 function2 |
| 2970 | 419 %type <tree_index_expression_type> word_list_cmd |
| 420 %type <tree_colon_expression_type> colon_expr1 | |
| 3351 | 421 %type <tree_argument_list_type> arg_list word_list assign_lhs |
| 422 %type <tree_argument_list_type> cell_or_matrix_row | |
| 4935 | 423 %type <tree_parameter_list_type> param_list param_list1 param_list2 |
| 723 | 424 %type <tree_parameter_list_type> return_list return_list1 |
| 2970 | 425 %type <tree_command_type> command select_command loop_command |
| 4207 | 426 %type <tree_command_type> jump_command except_command function |
| 578 | 427 %type <tree_if_command_type> if_command |
| 428 %type <tree_if_clause_type> elseif_clause else_clause | |
| 429 %type <tree_if_command_list_type> if_cmd_list1 if_cmd_list | |
| 2764 | 430 %type <tree_switch_command_type> switch_command |
| 431 %type <tree_switch_case_type> switch_case default_case | |
| 432 %type <tree_switch_case_list_type> case_list1 case_list | |
| 2846 | 433 %type <tree_decl_elt_type> decl2 |
| 434 %type <tree_decl_init_list_type> decl1 | |
| 435 %type <tree_decl_command_type> declaration | |
| 578 | 436 %type <tree_statement_type> statement |
| 627 | 437 %type <tree_statement_list_type> simple_list simple_list1 list list1 |
| 7336 | 438 %type <tree_statement_list_type> opt_list input1 |
| 1 | 439 |
| 143 | 440 // Precedence and associativity. |
| 1 | 441 %left ';' ',' '\n' |
| 4018 | 442 %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 |
| 4023 | 443 %left EXPR_OR_OR |
| 444 %left EXPR_AND_AND | |
| 445 %left EXPR_OR | |
| 446 %left EXPR_AND | |
| 1 | 447 %left EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT |
| 2899 | 448 %left LSHIFT RSHIFT |
| 1 | 449 %left ':' |
| 1276 | 450 %left '-' '+' EPLUS EMINUS |
| 1 | 451 %left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV |
| 452 %left UNARY PLUS_PLUS MINUS_MINUS EXPR_NOT | |
| 5667 | 453 %left POW EPOW QUOTE TRANSPOSE |
| 3351 | 454 %left '(' '.' '{' |
| 1 | 455 |
| 143 | 456 // Where to start. |
| 1 | 457 %start input |
| 458 | |
| 459 %% | |
| 460 | |
| 2970 | 461 // ============================== |
| 462 // Statements and statement lists | |
| 463 // ============================== | |
| 464 | |
| 627 | 465 input : input1 |
| 1 | 466 { |
| 627 | 467 global_command = $1; |
| 1 | 468 promptflag = 1; |
| 469 YYACCEPT; | |
| 470 } | |
| 627 | 471 | simple_list parse_error |
| 1091 | 472 { ABORT_PARSE; } |
| 627 | 473 | parse_error |
| 1091 | 474 { ABORT_PARSE; } |
| 627 | 475 ; |
| 476 | |
| 477 input1 : '\n' | |
| 478 { $$ = 0; } | |
| 3883 | 479 | END_OF_INPUT |
| 480 { | |
| 481 parser_end_of_input = 1; | |
| 482 $$ = 0; | |
| 483 } | |
| 327 | 484 | simple_list |
| 627 | 485 { $$ = $1; } |
| 1 | 486 | simple_list '\n' |
| 627 | 487 { $$ = $1; } |
| 1 | 488 | simple_list END_OF_INPUT |
| 627 | 489 { $$ = $1; } |
| 490 ; | |
| 491 | |
| 2525 | 492 simple_list : simple_list1 opt_sep_no_nl |
| 1 | 493 { |
| 2525 | 494 set_stmt_print_flag ($1, $2, false); |
| 1511 | 495 $$ = $1; |
| 1 | 496 } |
| 497 ; | |
| 498 | |
| 578 | 499 simple_list1 : statement |
| 500 { $$ = new tree_statement_list ($1); } | |
| 2525 | 501 | simple_list1 sep_no_nl statement |
| 1 | 502 { |
| 2525 | 503 set_stmt_print_flag ($1, $2, false); |
| 578 | 504 $1->append ($3); |
| 1511 | 505 $$ = $1; |
| 1 | 506 } |
| 507 ; | |
| 508 | |
| 509 opt_list : // empty | |
| 578 | 510 { $$ = new tree_statement_list (); } |
| 1 | 511 | list |
| 512 { $$ = $1; } | |
| 496 | 513 ; |
| 1 | 514 |
| 2525 | 515 list : list1 opt_sep |
| 1511 | 516 { |
| 2525 | 517 set_stmt_print_flag ($1, $2, true); |
| 1829 | 518 $$ = $1; |
| 1 | 519 } |
| 520 ; | |
| 521 | |
| 578 | 522 list1 : statement |
| 440 | 523 { |
| 2857 | 524 lexer_flags.beginning_of_function = false; |
| 578 | 525 $$ = new tree_statement_list ($1); |
| 440 | 526 } |
| 2525 | 527 | list1 sep statement |
| 1511 | 528 { |
| 2525 | 529 set_stmt_print_flag ($1, $2, true); |
| 578 | 530 $1->append ($3); |
| 1511 | 531 $$ = $1; |
| 1 | 532 } |
| 533 ; | |
| 534 | |
| 2970 | 535 statement : expression |
| 3665 | 536 { |
| 537 octave_comment_list *comment | |
| 538 = octave_comment_buffer::get_comment (); | |
| 539 | |
| 540 $$ = new tree_statement ($1, comment); | |
| 541 } | |
| 2970 | 542 | command |
| 3665 | 543 { |
| 544 octave_comment_list *comment | |
| 545 = octave_comment_buffer::get_comment (); | |
| 546 | |
| 547 $$ = new tree_statement ($1, comment); | |
| 548 } | |
| 1 | 549 ; |
| 550 | |
| 2970 | 551 // =========== |
| 552 // Expressions | |
| 553 // =========== | |
| 554 | |
| 555 identifier : NAME | |
| 556 { | |
| 7336 | 557 symbol_table::symbol_record *sr = $1->sym_rec (); |
| 558 $$ = new tree_identifier (*sr, $1->line (), $1->column ()); | |
| 2970 | 559 } |
| 560 ; | |
| 561 | |
| 5279 | 562 string : DQ_STRING |
| 563 { $$ = make_constant (DQ_STRING, $1); } | |
| 564 | SQ_STRING | |
| 565 { $$ = make_constant (SQ_STRING, $1); } | |
| 566 ; | |
| 567 | |
| 2970 | 568 constant : NUM |
| 569 { $$ = make_constant (NUM, $1); } | |
| 570 | IMAG_NUM | |
| 571 { $$ = make_constant (IMAG_NUM, $1); } | |
| 5279 | 572 | string |
| 573 { $$ = $1; } | |
| 2970 | 574 ; |
| 575 | |
| 576 matrix : '[' ']' | |
| 5615 | 577 { |
| 578 $$ = new tree_constant (octave_value (Matrix ())); | |
| 579 lexer_flags.looking_at_matrix_or_assign_lhs = false; | |
| 580 } | |
| 2970 | 581 | '[' ';' ']' |
| 3203 | 582 { |
| 5615 | 583 $$ = new tree_constant (octave_value (Matrix ())); |
| 584 lexer_flags.looking_at_matrix_or_assign_lhs = false; | |
| 585 } | |
| 586 | '[' matrix_rows ']' | |
| 587 { | |
| 588 $$ = finish_matrix ($2); | |
| 3203 | 589 lexer_flags.looking_at_matrix_or_assign_lhs = false; |
| 590 } | |
| 2970 | 591 ; |
| 592 | |
| 3351 | 593 matrix_rows : matrix_rows1 |
| 2970 | 594 { $$ = $1; } |
| 3351 | 595 | matrix_rows1 ';' // Ignore trailing semicolon. |
| 2970 | 596 { $$ = $1; } |
| 597 ; | |
| 598 | |
| 3351 | 599 matrix_rows1 : cell_or_matrix_row |
| 2970 | 600 { $$ = new tree_matrix ($1); } |
| 3351 | 601 | matrix_rows1 ';' cell_or_matrix_row |
| 2970 | 602 { |
| 603 $1->append ($3); | |
| 604 $$ = $1; | |
| 605 } | |
| 606 ; | |
| 607 | |
| 3351 | 608 cell : '{' '}' |
| 3928 | 609 { $$ = new tree_constant (octave_value (Cell ())); } |
| 3351 | 610 | '{' ';' '}' |
| 3928 | 611 { $$ = new tree_constant (octave_value (Cell ())); } |
| 3351 | 612 | '{' cell_rows '}' |
| 613 { $$ = finish_cell ($2); } | |
| 614 ; | |
| 615 | |
| 616 cell_rows : cell_rows1 | |
| 617 { $$ = $1; } | |
| 618 | cell_rows1 ';' // Ignore trailing semicolon. | |
| 619 { $$ = $1; } | |
| 620 ; | |
| 621 | |
| 622 cell_rows1 : cell_or_matrix_row | |
| 623 { $$ = new tree_cell ($1); } | |
| 624 | cell_rows1 ';' cell_or_matrix_row | |
| 625 { | |
| 626 $1->append ($3); | |
| 627 $$ = $1; | |
| 628 } | |
| 629 ; | |
| 630 | |
| 631 cell_or_matrix_row | |
| 632 : arg_list | |
| 2970 | 633 { $$ = $1; } |
| 634 | arg_list ',' // Ignore trailing comma. | |
| 635 { $$ = $1; } | |
| 636 ; | |
| 637 | |
| 4930 | 638 fcn_handle : '@' FCN_HANDLE |
| 639 { | |
| 640 $$ = make_fcn_handle ($2); | |
| 641 lexer_flags.looking_at_function_handle--; | |
| 642 } | |
| 643 ; | |
| 644 | |
| 4935 | 645 anon_fcn_handle : '@' param_list statement |
| 646 { $$ = make_anon_fcn_handle ($2, $3); } | |
| 4342 | 647 ; |
| 648 | |
| 2970 | 649 primary_expr : identifier |
| 650 { $$ = $1; } | |
| 651 | constant | |
| 652 { $$ = $1; } | |
| 4342 | 653 | fcn_handle |
| 654 { $$ = $1; } | |
| 2970 | 655 | matrix |
| 656 { $$ = $1; } | |
| 3351 | 657 | cell |
| 658 { $$ = $1; } | |
| 2970 | 659 | '(' expression ')' |
| 660 { $$ = $2->mark_in_parens (); } | |
| 661 ; | |
| 662 | |
| 663 magic_colon : ':' | |
| 664 { | |
| 665 octave_value tmp (octave_value::magic_colon_t); | |
| 666 $$ = new tree_constant (tmp); | |
| 667 } | |
| 668 ; | |
| 669 | |
| 670 arg_list : expression | |
| 671 { $$ = new tree_argument_list ($1); } | |
| 672 | magic_colon | |
| 673 { $$ = new tree_argument_list ($1); } | |
| 674 | arg_list ',' magic_colon | |
| 675 { | |
| 676 $1->append ($3); | |
| 677 $$ = $1; | |
| 678 } | |
| 679 | arg_list ',' expression | |
| 680 { | |
| 681 $1->append ($3); | |
| 682 $$ = $1; | |
| 683 } | |
| 684 ; | |
| 685 | |
| 4131 | 686 indirect_ref_op : '.' |
| 2970 | 687 { lexer_flags.looking_at_indirect_ref = true; } |
| 688 ; | |
| 689 | |
| 4615 | 690 // Two more rules for lexical feedback. To avoid reduce/reduce |
| 691 // conflicts, We use begin_obj_idx after every postfix_expr on the RHS | |
| 692 // of a rule, then cancel that as soon as possible for cases when we | |
| 693 // are not actually parsing an index expression. Since all of those | |
| 694 // cases are simple tokens that don't involve examining the value of | |
| 695 // lexer_flags.looking_at_object_index, I think we should be OK. | |
| 696 | |
| 4234 | 697 begin_obj_idx : // empty |
| 4237 | 698 { lexer_flags.looking_at_object_index++; } |
| 4234 | 699 ; |
| 700 | |
| 4615 | 701 cancel_obj_idx : // empty |
| 702 { lexer_flags.looking_at_object_index--; } | |
| 703 ; | |
| 704 | |
| 2970 | 705 postfix_expr : primary_expr |
| 706 { $$ = $1; } | |
| 4613 | 707 | postfix_expr begin_obj_idx '(' ')' |
| 4236 | 708 { |
| 709 $$ = make_index_expression ($1, 0, '('); | |
| 4237 | 710 lexer_flags.looking_at_object_index--; |
| 4236 | 711 } |
| 4613 | 712 | postfix_expr begin_obj_idx '(' arg_list ')' |
| 4234 | 713 { |
| 714 $$ = make_index_expression ($1, $4, '('); | |
| 4237 | 715 lexer_flags.looking_at_object_index--; |
| 4234 | 716 } |
| 4613 | 717 | postfix_expr begin_obj_idx '{' '}' |
| 4236 | 718 { |
| 719 $$ = make_index_expression ($1, 0, '{'); | |
| 4237 | 720 lexer_flags.looking_at_object_index--; |
| 4236 | 721 } |
| 4613 | 722 | postfix_expr begin_obj_idx '{' arg_list '}' |
| 4234 | 723 { |
| 724 $$ = make_index_expression ($1, $4, '{'); | |
| 4237 | 725 lexer_flags.looking_at_object_index--; |
| 4234 | 726 } |
| 4615 | 727 | postfix_expr begin_obj_idx PLUS_PLUS cancel_obj_idx |
| 728 { $$ = make_postfix_op (PLUS_PLUS, $1, $3); } | |
| 729 | postfix_expr begin_obj_idx MINUS_MINUS cancel_obj_idx | |
| 730 { $$ = make_postfix_op (MINUS_MINUS, $1, $3); } | |
| 731 | postfix_expr begin_obj_idx QUOTE cancel_obj_idx | |
| 732 { $$ = make_postfix_op (QUOTE, $1, $3); } | |
| 733 | postfix_expr begin_obj_idx TRANSPOSE cancel_obj_idx | |
| 734 { $$ = make_postfix_op (TRANSPOSE, $1, $3); } | |
| 735 | postfix_expr begin_obj_idx indirect_ref_op cancel_obj_idx STRUCT_ELT | |
| 736 { $$ = make_indirect_ref ($1, $5->text ()); } | |
| 737 | postfix_expr begin_obj_idx indirect_ref_op cancel_obj_idx '(' expression ')' | |
| 738 { $$ = make_indirect_ref ($1, $6); } | |
| 2970 | 739 ; |
| 740 | |
| 4615 | 741 prefix_expr : postfix_expr begin_obj_idx cancel_obj_idx |
| 2970 | 742 { $$ = $1; } |
| 3178 | 743 | binary_expr |
| 744 { $$ = $1; } | |
| 2970 | 745 | PLUS_PLUS prefix_expr %prec UNARY |
| 746 { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } | |
| 747 | MINUS_MINUS prefix_expr %prec UNARY | |
| 748 { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } | |
| 749 | EXPR_NOT prefix_expr %prec UNARY | |
| 750 { $$ = make_prefix_op (EXPR_NOT, $2, $1); } | |
| 751 | '+' prefix_expr %prec UNARY | |
| 4965 | 752 { $$ = make_prefix_op ('+', $2, $1); } |
| 2970 | 753 | '-' prefix_expr %prec UNARY |
| 754 { $$ = make_prefix_op ('-', $2, $1); } | |
| 755 ; | |
| 756 | |
| 3178 | 757 binary_expr : prefix_expr POW prefix_expr |
| 2970 | 758 { $$ = make_binary_op (POW, $1, $2, $3); } |
| 3178 | 759 | prefix_expr EPOW prefix_expr |
| 2970 | 760 { $$ = make_binary_op (EPOW, $1, $2, $3); } |
| 3178 | 761 | prefix_expr '+' prefix_expr |
| 2970 | 762 { $$ = make_binary_op ('+', $1, $2, $3); } |
| 3178 | 763 | prefix_expr '-' prefix_expr |
| 2970 | 764 { $$ = make_binary_op ('-', $1, $2, $3); } |
| 3178 | 765 | prefix_expr '*' prefix_expr |
| 2970 | 766 { $$ = make_binary_op ('*', $1, $2, $3); } |
| 3178 | 767 | prefix_expr '/' prefix_expr |
| 2970 | 768 { $$ = make_binary_op ('/', $1, $2, $3); } |
| 3178 | 769 | prefix_expr EPLUS prefix_expr |
| 2970 | 770 { $$ = make_binary_op ('+', $1, $2, $3); } |
| 3178 | 771 | prefix_expr EMINUS prefix_expr |
| 2970 | 772 { $$ = make_binary_op ('-', $1, $2, $3); } |
| 3178 | 773 | prefix_expr EMUL prefix_expr |
| 2970 | 774 { $$ = make_binary_op (EMUL, $1, $2, $3); } |
| 3178 | 775 | prefix_expr EDIV prefix_expr |
| 2970 | 776 { $$ = make_binary_op (EDIV, $1, $2, $3); } |
| 3178 | 777 | prefix_expr LEFTDIV prefix_expr |
| 2970 | 778 { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } |
| 3178 | 779 | prefix_expr ELEFTDIV prefix_expr |
| 2970 | 780 { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } |
| 781 ; | |
| 782 | |
| 783 colon_expr : colon_expr1 | |
| 784 { $$ = finish_colon_expression ($1); } | |
| 785 ; | |
| 786 | |
| 3178 | 787 colon_expr1 : prefix_expr |
| 2970 | 788 { $$ = new tree_colon_expression ($1); } |
| 3178 | 789 | colon_expr1 ':' prefix_expr |
| 2970 | 790 { |
| 791 if (! ($$ = $1->append ($3))) | |
| 792 ABORT_PARSE; | |
| 793 } | |
| 794 ; | |
| 795 | |
| 796 simple_expr : colon_expr | |
| 797 { $$ = $1; } | |
| 798 | simple_expr LSHIFT simple_expr | |
| 799 { $$ = make_binary_op (LSHIFT, $1, $2, $3); } | |
| 800 | simple_expr RSHIFT simple_expr | |
| 801 { $$ = make_binary_op (RSHIFT, $1, $2, $3); } | |
| 802 | simple_expr EXPR_LT simple_expr | |
| 803 { $$ = make_binary_op (EXPR_LT, $1, $2, $3); } | |
| 804 | simple_expr EXPR_LE simple_expr | |
| 805 { $$ = make_binary_op (EXPR_LE, $1, $2, $3); } | |
| 806 | simple_expr EXPR_EQ simple_expr | |
| 807 { $$ = make_binary_op (EXPR_EQ, $1, $2, $3); } | |
| 808 | simple_expr EXPR_GE simple_expr | |
| 809 { $$ = make_binary_op (EXPR_GE, $1, $2, $3); } | |
| 810 | simple_expr EXPR_GT simple_expr | |
| 811 { $$ = make_binary_op (EXPR_GT, $1, $2, $3); } | |
| 812 | simple_expr EXPR_NE simple_expr | |
| 813 { $$ = make_binary_op (EXPR_NE, $1, $2, $3); } | |
| 814 | simple_expr EXPR_AND simple_expr | |
| 815 { $$ = make_binary_op (EXPR_AND, $1, $2, $3); } | |
| 816 | simple_expr EXPR_OR simple_expr | |
| 817 { $$ = make_binary_op (EXPR_OR, $1, $2, $3); } | |
| 818 | simple_expr EXPR_AND_AND simple_expr | |
| 819 { $$ = make_boolean_op (EXPR_AND_AND, $1, $2, $3); } | |
| 820 | simple_expr EXPR_OR_OR simple_expr | |
| 821 { $$ = make_boolean_op (EXPR_OR_OR, $1, $2, $3); } | |
| 822 ; | |
| 823 | |
| 824 // Arrange for the lexer to return CLOSE_BRACE for `]' by looking ahead | |
| 825 // one token for an assignment op. | |
| 826 | |
| 827 assign_lhs : simple_expr | |
| 5841 | 828 { |
| 829 $$ = new tree_argument_list ($1); | |
| 830 $$->mark_as_simple_assign_lhs (); | |
| 831 } | |
| 5615 | 832 | '[' arg_list CLOSE_BRACE |
| 3189 | 833 { |
| 5615 | 834 $$ = $2; |
| 3189 | 835 lexer_flags.looking_at_matrix_or_assign_lhs = false; |
| 836 } | |
| 2970 | 837 ; |
| 838 | |
| 839 assign_expr : assign_lhs '=' expression | |
| 840 { $$ = make_assign_op ('=', $1, $2, $3); } | |
| 841 | assign_lhs ADD_EQ expression | |
| 842 { $$ = make_assign_op (ADD_EQ, $1, $2, $3); } | |
| 843 | assign_lhs SUB_EQ expression | |
| 844 { $$ = make_assign_op (SUB_EQ, $1, $2, $3); } | |
| 845 | assign_lhs MUL_EQ expression | |
| 846 { $$ = make_assign_op (MUL_EQ, $1, $2, $3); } | |
| 847 | assign_lhs DIV_EQ expression | |
| 848 { $$ = make_assign_op (DIV_EQ, $1, $2, $3); } | |
| 3204 | 849 | assign_lhs LEFTDIV_EQ expression |
| 850 { $$ = make_assign_op (LEFTDIV_EQ, $1, $2, $3); } | |
| 4018 | 851 | assign_lhs POW_EQ expression |
| 852 { $$ = make_assign_op (POW_EQ, $1, $2, $3); } | |
| 2970 | 853 | assign_lhs LSHIFT_EQ expression |
| 854 { $$ = make_assign_op (LSHIFT_EQ, $1, $2, $3); } | |
| 855 | assign_lhs RSHIFT_EQ expression | |
| 856 { $$ = make_assign_op (RSHIFT_EQ, $1, $2, $3); } | |
| 857 | assign_lhs EMUL_EQ expression | |
| 858 { $$ = make_assign_op (EMUL_EQ, $1, $2, $3); } | |
| 859 | assign_lhs EDIV_EQ expression | |
| 860 { $$ = make_assign_op (EDIV_EQ, $1, $2, $3); } | |
| 3204 | 861 | assign_lhs ELEFTDIV_EQ expression |
| 862 { $$ = make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } | |
| 4018 | 863 | assign_lhs EPOW_EQ expression |
| 864 { $$ = make_assign_op (EPOW_EQ, $1, $2, $3); } | |
| 2970 | 865 | assign_lhs AND_EQ expression |
| 866 { $$ = make_assign_op (AND_EQ, $1, $2, $3); } | |
| 867 | assign_lhs OR_EQ expression | |
| 868 { $$ = make_assign_op (OR_EQ, $1, $2, $3); } | |
| 869 ; | |
| 870 | |
| 871 word_list_cmd : identifier word_list | |
| 3933 | 872 { $$ = make_index_expression ($1, $2, '('); } |
| 2970 | 873 ; |
| 874 | |
| 5279 | 875 word_list : string |
| 876 { $$ = new tree_argument_list ($1); } | |
| 877 | word_list string | |
| 2970 | 878 { |
| 5279 | 879 $1->append ($2); |
| 2970 | 880 $$ = $1; |
| 881 } | |
| 882 ; | |
| 883 | |
| 884 expression : simple_expr | |
| 885 { $$ = $1; } | |
| 886 | word_list_cmd | |
| 887 { $$ = $1; } | |
| 888 | assign_expr | |
| 889 { $$ = $1; } | |
| 4935 | 890 | anon_fcn_handle |
| 891 { $$ = $1; } | |
| 2970 | 892 ; |
| 893 | |
| 894 // ================================================ | |
| 895 // Commands, declarations, and function definitions | |
| 896 // ================================================ | |
| 897 | |
| 898 command : declaration | |
| 899 { $$ = $1; } | |
| 900 | select_command | |
| 901 { $$ = $1; } | |
| 902 | loop_command | |
| 903 { $$ = $1; } | |
| 4207 | 904 | jump_command |
| 905 { $$ = $1; } | |
| 2970 | 906 | except_command |
| 907 { $$ = $1; } | |
| 908 | function | |
| 909 { $$ = $1; } | |
| 910 ; | |
| 911 | |
| 912 // ===================== | |
| 913 // Declaration statemnts | |
| 914 // ===================== | |
| 915 | |
| 916 declaration : GLOBAL decl1 | |
| 917 { $$ = make_decl_command (GLOBAL, $1, $2); } | |
| 918 | STATIC decl1 | |
| 919 { $$ = make_decl_command (STATIC, $1, $2); } | |
| 920 ; | |
| 921 | |
| 922 decl1 : decl2 | |
| 923 { $$ = new tree_decl_init_list ($1); } | |
| 924 | decl1 decl2 | |
| 925 { | |
| 926 $1->append ($2); | |
| 927 $$ = $1; | |
| 928 } | |
| 929 ; | |
| 930 | |
| 931 decl2 : identifier | |
| 932 { $$ = new tree_decl_elt ($1); } | |
| 933 | identifier '=' expression | |
| 934 { $$ = new tree_decl_elt ($1, $3); } | |
| 935 ; | |
| 936 | |
| 937 // ==================== | |
| 938 // Selection statements | |
| 939 // ==================== | |
| 940 | |
| 941 select_command : if_command | |
| 942 { $$ = $1; } | |
| 943 | switch_command | |
| 944 { $$ = $1; } | |
| 945 ; | |
| 946 | |
| 947 // ============ | |
| 948 // If statement | |
| 949 // ============ | |
| 950 | |
| 3665 | 951 if_command : IF stash_comment if_cmd_list END |
| 2970 | 952 { |
| 3665 | 953 if (! ($$ = finish_if_command ($1, $3, $4, $2))) |
| 2970 | 954 ABORT_PARSE; |
| 955 } | |
| 956 ; | |
| 957 | |
| 958 if_cmd_list : if_cmd_list1 | |
| 959 { $$ = $1; } | |
| 960 | if_cmd_list1 else_clause | |
| 961 { | |
| 962 $1->append ($2); | |
| 963 $$ = $1; | |
| 964 } | |
| 965 ; | |
| 966 | |
| 967 if_cmd_list1 : expression opt_sep opt_list | |
| 968 { $$ = start_if_command ($1, $3); } | |
| 969 | if_cmd_list1 elseif_clause | |
| 970 { | |
| 971 $1->append ($2); | |
| 972 $$ = $1; | |
| 973 } | |
| 974 ; | |
| 975 | |
| 3665 | 976 elseif_clause : ELSEIF stash_comment opt_sep expression opt_sep opt_list |
| 977 { $$ = make_elseif_clause ($4, $6, $2); } | |
| 2970 | 978 ; |
| 979 | |
| 3665 | 980 else_clause : ELSE stash_comment opt_sep opt_list |
| 981 { | |
| 982 $$ = new tree_if_clause ($4, $2); | |
| 983 } | |
| 2970 | 984 ; |
| 985 | |
| 986 // ================ | |
| 987 // Switch statement | |
| 988 // ================ | |
| 989 | |
| 3665 | 990 switch_command : SWITCH stash_comment expression opt_sep case_list END |
| 2970 | 991 { |
| 3665 | 992 if (! ($$ = finish_switch_command ($1, $3, $5, $6, $2))) |
| 2970 | 993 ABORT_PARSE; |
| 994 } | |
| 995 ; | |
| 996 | |
| 4044 | 997 case_list : // empty |
| 998 { $$ = new tree_switch_case_list (); } | |
| 999 | case_list1 | |
| 2970 | 1000 { $$ = $1; } |
| 1001 | case_list1 default_case | |
| 1002 { | |
| 1003 $1->append ($2); | |
| 1004 $$ = $1; | |
| 1005 } | |
| 1006 ; | |
| 1007 | |
| 1008 case_list1 : switch_case | |
| 1009 { $$ = new tree_switch_case_list ($1); } | |
| 1010 | case_list1 switch_case | |
| 1011 { | |
| 1012 $1->append ($2); | |
| 1013 $$ = $1; | |
| 1014 } | |
| 1015 ; | |
| 1016 | |
| 4025 | 1017 switch_case : CASE stash_comment opt_sep expression opt_sep opt_list |
| 3665 | 1018 { $$ = make_switch_case ($4, $6, $2); } |
| 2970 | 1019 ; |
| 1020 | |
| 3665 | 1021 default_case : OTHERWISE stash_comment opt_sep opt_list |
| 1022 { | |
| 1023 $$ = new tree_switch_case ($4, $2); | |
| 1024 } | |
| 2970 | 1025 ; |
| 1026 | |
| 1027 // ======= | |
| 1028 // Looping | |
| 1029 // ======= | |
| 1030 | |
| 3665 | 1031 loop_command : WHILE stash_comment expression opt_sep opt_list END |
| 2970 | 1032 { |
| 3665 | 1033 if (! ($$ = make_while_command ($1, $3, $5, $6, $2))) |
| 2970 | 1034 ABORT_PARSE; |
| 1035 } | |
| 3665 | 1036 | DO stash_comment opt_sep opt_list UNTIL expression |
| 3484 | 1037 { |
| 3665 | 1038 if (! ($$ = make_do_until_command ($1, $4, $6, $2))) |
| 3484 | 1039 ABORT_PARSE; |
| 1040 } | |
| 3665 | 1041 | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END |
| 2970 | 1042 { |
| 3665 | 1043 if (! ($$ = make_for_command ($1, $3, $5, $7, $8, $2))) |
| 2970 | 1044 ABORT_PARSE; |
| 1045 } | |
| 5127 | 1046 | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END |
| 1047 { | |
| 1048 if (! ($$ = make_for_command ($1, $4, $6, $9, $10, $2))) | |
| 1049 ABORT_PARSE; | |
| 1050 } | |
| 2970 | 1051 ; |
| 1052 | |
| 1053 // ======= | |
| 1054 // Jumping | |
| 1055 // ======= | |
| 1056 | |
| 4207 | 1057 jump_command : BREAK |
| 2970 | 1058 { |
| 4207 | 1059 if (! ($$ = make_break_command ($1))) |
| 2970 | 1060 ABORT_PARSE; |
| 1061 } | |
| 1062 | CONTINUE | |
| 1063 { | |
| 4207 | 1064 if (! ($$ = make_continue_command ($1))) |
| 2970 | 1065 ABORT_PARSE; |
| 1066 } | |
| 1067 | FUNC_RET | |
| 1068 { | |
| 4207 | 1069 if (! ($$ = make_return_command ($1))) |
| 2970 | 1070 ABORT_PARSE; |
| 1071 } | |
| 1072 ; | |
| 1073 | |
| 1074 // ========== | |
| 1075 // Exceptions | |
| 1076 // ========== | |
| 1077 | |
| 3665 | 1078 except_command : UNWIND stash_comment opt_sep opt_list CLEANUP |
| 1079 stash_comment opt_sep opt_list END | |
| 2970 | 1080 { |
| 3665 | 1081 if (! ($$ = make_unwind_command ($1, $4, $8, $9, $2, $6))) |
| 2970 | 1082 ABORT_PARSE; |
| 1083 } | |
| 3665 | 1084 | TRY stash_comment opt_sep opt_list CATCH |
| 1085 stash_comment opt_sep opt_list END | |
| 2970 | 1086 { |
| 3665 | 1087 if (! ($$ = make_try_command ($1, $4, $8, $9, $2, $6))) |
| 2970 | 1088 ABORT_PARSE; |
| 1089 } | |
| 5344 | 1090 | TRY stash_comment opt_sep opt_list END |
| 1091 { | |
| 1092 if (! ($$ = make_try_command ($1, $4, 0, $5, $2, 0))) | |
| 1093 ABORT_PARSE; | |
| 1094 } | |
| 2970 | 1095 ; |
| 1096 | |
| 1097 // =========================================== | |
| 1098 // Some `subroutines' for function definitions | |
| 1099 // =========================================== | |
| 1100 | |
| 7336 | 1101 push_fcn_symtab : // empty |
| 1102 { | |
| 1103 symtab_context.push (symbol_table::current_scope ()); | |
| 1104 symbol_table::set_scope (symbol_table::alloc_scope ()); | |
| 1105 | |
| 1106 if (! lexer_flags.parsing_nested_function) | |
| 1107 symbol_table::set_parent_scope (symbol_table::current_scope ()); | |
| 1108 } | |
| 2970 | 1109 ; |
| 1110 | |
| 1111 // =========================== | |
| 1112 // List of function parameters | |
| 1113 // =========================== | |
| 1114 | |
| 1115 param_list_beg : '(' | |
| 4935 | 1116 { |
| 1117 lexer_flags.looking_at_parameter_list = true; | |
| 1118 | |
| 1119 if (lexer_flags.looking_at_function_handle) | |
| 1120 { | |
| 7336 | 1121 symtab_context.push (symbol_table::current_scope ()); |
| 1122 symbol_table::set_scope (symbol_table::alloc_scope ()); | |
| 4935 | 1123 lexer_flags.looking_at_function_handle--; |
| 1124 } | |
| 1125 } | |
| 2970 | 1126 ; |
| 1127 | |
| 1128 param_list_end : ')' | |
| 1129 { lexer_flags.looking_at_parameter_list = false; } | |
| 1130 ; | |
| 1131 | |
| 4935 | 1132 param_list : param_list_beg param_list1 param_list_end |
| 2970 | 1133 { |
| 1134 lexer_flags.quote_is_transpose = false; | |
| 4935 | 1135 $$ = $2; |
| 2970 | 1136 } |
| 1137 | param_list_beg error | |
| 1138 { | |
| 1139 yyerror ("invalid parameter list"); | |
| 1140 $$ = 0; | |
| 1141 ABORT_PARSE; | |
| 1142 } | |
| 4935 | 1143 ; |
| 1144 | |
| 1145 param_list1 : // empty | |
| 1146 { $$ = 0; } | |
| 1147 | param_list2 | |
| 1148 { | |
| 1149 $1->mark_as_formal_parameters (); | |
| 1150 $$ = $1; | |
| 1151 } | |
| 1152 | VARARGIN | |
| 2970 | 1153 { |
| 4935 | 1154 tree_parameter_list *tmp = new tree_parameter_list (); |
| 1155 tmp->mark_varargs_only (); | |
| 1156 $$ = tmp; | |
| 1157 } | |
| 1158 | param_list2 ',' VARARGIN | |
| 1159 { | |
| 1160 $1->mark_as_formal_parameters (); | |
| 1161 $1->mark_varargs (); | |
| 1162 $$ = $1; | |
| 1163 } | |
| 1164 ; | |
| 1165 | |
| 6215 | 1166 param_list2 : decl2 |
| 4935 | 1167 { $$ = new tree_parameter_list ($1); } |
| 6215 | 1168 | param_list2 ',' decl2 |
| 4935 | 1169 { |
| 1170 $1->append ($3); | |
| 1171 $$ = $1; | |
| 2970 | 1172 } |
| 1173 ; | |
| 1174 | |
| 1175 // =================================== | |
| 1176 // List of function return value names | |
| 1177 // =================================== | |
| 1178 | |
| 7336 | 1179 return_list : '[' ']' |
| 2970 | 1180 { |
| 1181 lexer_flags.looking_at_return_list = false; | |
| 1182 $$ = new tree_parameter_list (); | |
| 1183 } | |
| 7336 | 1184 | '[' VARARGOUT ']' |
| 2970 | 1185 { |
| 1186 lexer_flags.looking_at_return_list = false; | |
| 1187 tree_parameter_list *tmp = new tree_parameter_list (); | |
| 1188 tmp->mark_varargs_only (); | |
| 1189 $$ = tmp; | |
| 1190 } | |
| 4678 | 1191 | VARARGOUT |
| 1192 { | |
| 1193 lexer_flags.looking_at_return_list = false; | |
| 1194 tree_parameter_list *tmp = new tree_parameter_list (); | |
| 1195 tmp->mark_varargs_only (); | |
| 1196 $$ = tmp; | |
| 1197 } | |
| 7336 | 1198 | return_list1 |
| 1199 { | |
| 1200 lexer_flags.looking_at_return_list = false; | |
| 1201 $$ = $1; | |
| 1202 } | |
| 1203 | '[' return_list1 ']' | |
| 2970 | 1204 { |
| 1205 lexer_flags.looking_at_return_list = false; | |
| 1206 $$ = $2; | |
| 1207 } | |
| 7336 | 1208 | '[' return_list1 ',' VARARGOUT ']' |
| 2970 | 1209 { |
| 1210 lexer_flags.looking_at_return_list = false; | |
| 1211 $2->mark_varargs (); | |
| 1212 $$ = $2; | |
| 1213 } | |
| 1214 ; | |
| 1215 | |
| 1216 return_list1 : identifier | |
| 6215 | 1217 { $$ = new tree_parameter_list (new tree_decl_elt ($1)); } |
| 2970 | 1218 | return_list1 ',' identifier |
| 1219 { | |
| 6215 | 1220 $1->append (new tree_decl_elt ($3)); |
| 2970 | 1221 $$ = $1; |
| 1222 } | |
| 1223 ; | |
| 1224 | |
| 1225 // =================== | |
| 1226 // Function definition | |
| 1227 // =================== | |
| 1228 | |
| 7336 | 1229 function_beg : push_fcn_symtab FCN stash_comment |
| 1230 { $$ = $3; } | |
| 2970 | 1231 ; |
| 1232 | |
| 7336 | 1233 function : function_beg function1 |
| 2970 | 1234 { |
| 3665 | 1235 $2->stash_leading_comment ($1); |
| 2970 | 1236 recover_from_parsing_function (); |
| 1237 $$ = 0; | |
| 1238 } | |
| 7336 | 1239 | function_beg return_list '=' function1 |
| 2970 | 1240 { |
| 7336 | 1241 finish_function ($2, $4, $1); |
| 2970 | 1242 recover_from_parsing_function (); |
| 1243 $$ = 0; | |
| 1244 } | |
| 1245 ; | |
| 1246 | |
| 7336 | 1247 fcn_name : identifier |
| 2970 | 1248 { |
| 4238 | 1249 std::string id_name = $1->name (); |
| 1250 | |
| 1251 if (reading_fcn_file | |
| 1252 && ! lexer_flags.parsing_nested_function) | |
| 1253 parent_function_name = (curr_fcn_file_name == id_name) | |
| 1254 ? id_name : curr_fcn_file_name; | |
| 1255 | |
| 1256 lexer_flags.parsed_function_name = true; | |
| 1257 | |
| 1258 $$ = $1; | |
| 1259 } | |
| 1260 ; | |
| 1261 | |
| 7336 | 1262 function1 : fcn_name function2 |
| 4238 | 1263 { |
| 4872 | 1264 std::string fname = $1->name (); |
| 1265 | |
| 1266 delete $1; | |
| 1267 | |
| 1268 if (! ($$ = frob_function (fname, $2))) | |
| 2970 | 1269 ABORT_PARSE; |
| 1270 } | |
| 1271 ; | |
| 1272 | |
| 7336 | 1273 function2 : param_list opt_sep opt_list function_end |
| 1274 { $$ = start_function ($1, $3); } | |
| 1275 | opt_sep opt_list function_end | |
| 1276 { $$ = start_function (0, $2); } | |
| 2970 | 1277 ; |
| 1278 | |
| 1279 function_end : END | |
| 1280 { | |
| 4238 | 1281 if (! end_token_ok ($1, token::function_end)) |
| 2970 | 1282 ABORT_PARSE; |
| 1283 } | |
| 1284 | END_OF_INPUT | |
| 1285 { | |
| 4240 | 1286 if (lexer_flags.parsing_nested_function) |
| 1287 lexer_flags.parsing_nested_function = -1; | |
| 4238 | 1288 |
| 3939 | 1289 if (! (reading_fcn_file || reading_script_file |
| 1290 || get_input_from_eval_string)) | |
| 2970 | 1291 YYABORT; |
| 1292 } | |
| 1293 ; | |
| 1294 | |
| 1295 // ============= | |
| 1296 // Miscellaneous | |
| 1297 // ============= | |
| 1298 | |
| 3665 | 1299 stash_comment : // empty |
| 1300 { $$ = octave_comment_buffer::get_comment (); } | |
| 1301 ; | |
| 1302 | |
| 2970 | 1303 parse_error : LEXICAL_ERROR |
| 1304 { yyerror ("parse error"); } | |
| 1305 | error | |
| 1 | 1306 ; |
| 1307 | |
| 2525 | 1308 sep_no_nl : ',' |
| 1309 { $$ = ','; } | |
| 1310 | ';' | |
| 1311 { $$ = ';'; } | |
| 1312 | sep_no_nl ',' | |
| 1313 { $$ = $1; } | |
| 1314 | sep_no_nl ';' | |
| 1315 { $$ = $1; } | |
| 1316 ; | |
| 1317 | |
| 1318 opt_sep_no_nl : // empty | |
| 1319 { $$ = 0; } | |
| 1320 | sep_no_nl | |
| 1321 { $$ = $1; } | |
| 1322 ; | |
| 1323 | |
| 1324 sep : ',' | |
| 1325 { $$ = ','; } | |
| 1326 | ';' | |
| 1327 { $$ = ';'; } | |
| 1328 | '\n' | |
| 1329 { $$ = '\n'; } | |
| 1330 | sep ',' | |
| 1331 { $$ = $1; } | |
| 1332 | sep ';' | |
| 1333 { $$ = $1; } | |
| 1334 | sep '\n' | |
| 1335 { $$ = $1; } | |
| 1336 ; | |
| 1337 | |
| 1338 opt_sep : // empty | |
| 1339 { $$ = 0; } | |
| 1340 | sep | |
| 1341 { $$ = $1; } | |
| 1342 ; | |
| 1343 | |
| 1 | 1344 %% |
| 1345 | |
| 666 | 1346 // Generic error messages. |
| 1347 | |
| 1 | 1348 static void |
| 2805 | 1349 yyerror (const char *s) |
| 1 | 1350 { |
| 143 | 1351 int err_col = current_input_column - 1; |
| 1 | 1352 |
| 5765 | 1353 std::ostringstream output_buf; |
| 1 | 1354 |
| 1005 | 1355 if (reading_fcn_file || reading_script_file) |
| 1356 output_buf << "parse error near line " << input_line_number | |
| 1607 | 1357 << " of file " << curr_fcn_file_full_name; |
| 1005 | 1358 else |
| 1359 output_buf << "parse error:"; | |
| 581 | 1360 |
| 1005 | 1361 if (s && strcmp (s, "parse error") != 0) |
| 1362 output_buf << "\n\n " << s; | |
| 1363 | |
| 1364 output_buf << "\n\n"; | |
| 1 | 1365 |
| 1755 | 1366 if (! current_input_line.empty ()) |
| 1 | 1367 { |
| 1755 | 1368 size_t len = current_input_line.length (); |
| 1060 | 1369 |
| 1755 | 1370 if (current_input_line[len-1] == '\n') |
| 1371 current_input_line.resize (len-1); | |
| 1005 | 1372 |
| 4051 | 1373 // Print the line, maybe with a pointer near the error token. |
| 1005 | 1374 |
| 1755 | 1375 output_buf << ">>> " << current_input_line << "\n"; |
| 1060 | 1376 |
| 1377 if (err_col == 0) | |
| 1378 err_col = len; | |
| 1379 | |
| 1380 for (int i = 0; i < err_col + 3; i++) | |
| 1381 output_buf << " "; | |
| 1382 | |
| 1383 output_buf << "^"; | |
| 1 | 1384 } |
| 1005 | 1385 |
| 5765 | 1386 output_buf << "\n"; |
| 1387 | |
| 1388 std::string msg = output_buf.str (); | |
| 1389 | |
| 1390 parse_error ("%s", msg.c_str ()); | |
| 1 | 1391 } |
| 1392 | |
| 666 | 1393 // Error mesages for mismatched end tokens. |
| 1394 | |
| 496 | 1395 static void |
| 2805 | 1396 end_error (const char *type, token::end_tok_type ettype, int l, int c) |
| 496 | 1397 { |
| 2805 | 1398 static const char *fmt |
| 1399 = "`%s' command matched by `%s' near line %d column %d"; | |
| 496 | 1400 |
| 1401 switch (ettype) | |
| 1402 { | |
| 1403 case token::simple_end: | |
| 1404 error (fmt, type, "end", l, c); | |
| 1405 break; | |
| 777 | 1406 |
| 496 | 1407 case token::for_end: |
| 1408 error (fmt, type, "endfor", l, c); | |
| 1409 break; | |
| 777 | 1410 |
| 496 | 1411 case token::function_end: |
| 1412 error (fmt, type, "endfunction", l, c); | |
| 1413 break; | |
| 777 | 1414 |
| 496 | 1415 case token::if_end: |
| 1416 error (fmt, type, "endif", l, c); | |
| 1417 break; | |
| 777 | 1418 |
| 3233 | 1419 case token::switch_end: |
| 1420 error (fmt, type, "endswitch", l, c); | |
| 1421 break; | |
| 1422 | |
| 496 | 1423 case token::while_end: |
| 1424 error (fmt, type, "endwhile", l, c); | |
| 1425 break; | |
| 777 | 1426 |
| 5400 | 1427 case token::try_catch_end: |
| 1428 error (fmt, type, "end_try_catch", l, c); | |
| 1429 break; | |
| 1430 | |
| 1371 | 1431 case token::unwind_protect_end: |
| 1432 error (fmt, type, "end_unwind_protect", l, c); | |
| 1433 break; | |
| 1434 | |
| 496 | 1435 default: |
| 1436 panic_impossible (); | |
| 1437 break; | |
| 1438 } | |
| 1439 } | |
| 1440 | |
| 666 | 1441 // Check to see that end tokens are properly matched. |
| 1442 | |
| 2857 | 1443 static bool |
| 1444 end_token_ok (token *tok, token::end_tok_type expected) | |
| 143 | 1445 { |
| 2857 | 1446 bool retval = true; |
| 1447 | |
| 143 | 1448 token::end_tok_type ettype = tok->ettype (); |
| 2857 | 1449 |
| 143 | 1450 if (ettype != expected && ettype != token::simple_end) |
| 1451 { | |
| 2857 | 1452 retval = false; |
| 1453 | |
| 143 | 1454 yyerror ("parse error"); |
| 1455 | |
| 1456 int l = tok->line (); | |
| 1457 int c = tok->column (); | |
| 1458 | |
| 1459 switch (expected) | |
| 1460 { | |
| 1461 case token::for_end: | |
| 1462 end_error ("for", ettype, l, c); | |
| 1463 break; | |
| 777 | 1464 |
| 143 | 1465 case token::function_end: |
| 1466 end_error ("function", ettype, l, c); | |
| 1467 break; | |
| 777 | 1468 |
| 143 | 1469 case token::if_end: |
| 1470 end_error ("if", ettype, l, c); | |
| 1471 break; | |
| 777 | 1472 |
| 1489 | 1473 case token::try_catch_end: |
| 1474 end_error ("try", ettype, l, c); | |
| 1475 break; | |
| 1476 | |
| 2764 | 1477 case token::switch_end: |
| 1478 end_error ("switch", ettype, l, c); | |
| 1479 break; | |
| 1480 | |
| 1489 | 1481 case token::unwind_protect_end: |
| 1482 end_error ("unwind_protect", ettype, l, c); | |
| 1483 break; | |
| 1484 | |
| 143 | 1485 case token::while_end: |
| 1486 end_error ("while", ettype, l, c); | |
| 1487 break; | |
| 777 | 1488 |
| 143 | 1489 default: |
| 1490 panic_impossible (); | |
| 1491 break; | |
| 1492 } | |
| 1493 } | |
| 2857 | 1494 |
| 1495 return retval; | |
| 143 | 1496 } |
| 1497 | |
| 666 | 1498 // Maybe print a warning if an assignment expression is used as the |
| 1499 // test in a logical expression. | |
| 1500 | |
| 496 | 1501 static void |
| 1502 maybe_warn_assign_as_truth_value (tree_expression *expr) | |
| 1 | 1503 { |
| 5781 | 1504 if (expr->is_assignment_expression () |
| 2961 | 1505 && expr->paren_count () < 2) |
| 1 | 1506 { |
| 5781 | 1507 warning_with_id |
| 1508 ("Octave:assign-as-truth-value", | |
| 1509 "suggest parenthesis around assignment used as truth value"); | |
| 1 | 1510 } |
| 1511 } | |
| 578 | 1512 |
| 2764 | 1513 // Maybe print a warning about switch labels that aren't constants. |
| 1514 | |
| 1515 static void | |
| 1516 maybe_warn_variable_switch_label (tree_expression *expr) | |
| 1517 { | |
| 5781 | 1518 if (! expr->is_constant ()) |
| 5878 | 1519 warning_with_id ("Octave:variable-switch-label", |
| 5781 | 1520 "variable switch label"); |
| 2764 | 1521 } |
| 1522 | |
| 2533 | 1523 static tree_expression * |
| 1524 fold (tree_binary_expression *e) | |
| 1525 { | |
| 3110 | 1526 tree_expression *retval = e; |
| 1527 | |
| 3292 | 1528 unwind_protect::begin_frame ("fold_binary_expression"); |
| 3110 | 1529 |
| 1530 unwind_protect_int (error_state); | |
| 4452 | 1531 unwind_protect_int (warning_state); |
| 3110 | 1532 |
| 3815 | 1533 unwind_protect_bool (discard_error_messages); |
| 4452 | 1534 unwind_protect_bool (discard_warning_messages); |
| 1535 | |
| 3815 | 1536 discard_error_messages = true; |
| 4452 | 1537 discard_warning_messages = true; |
| 2533 | 1538 |
| 1539 tree_expression *op1 = e->lhs (); | |
| 1540 tree_expression *op2 = e->rhs (); | |
| 1541 | |
| 5161 | 1542 octave_value::binary_op op_type = e->op_type (); |
| 1543 | |
| 1544 if (op1->is_constant () && op2->is_constant () | |
| 5781 | 1545 && (! ((warning_enabled ("Octave:associativity-change") |
| 5161 | 1546 && (op_type == POW || op_type == EPOW)) |
| 5781 | 1547 || (warning_enabled ("Octave:precedence-change") |
| 5161 | 1548 && (op_type == EXPR_OR || op_type == EXPR_OR_OR))))) |
| 2533 | 1549 { |
| 2970 | 1550 octave_value tmp = e->rvalue (); |
| 2533 | 1551 |
| 3489 | 1552 if (! (error_state || warning_state)) |
| 2533 | 1553 { |
| 1554 tree_constant *tc_retval = new tree_constant (tmp); | |
| 1555 | |
| 5765 | 1556 std::ostringstream buf; |
| 2533 | 1557 |
| 1558 tree_print_code tpc (buf); | |
| 1559 | |
| 1560 e->accept (tpc); | |
| 1561 | |
| 5765 | 1562 tc_retval->stash_original_text (buf.str ()); |
| 2533 | 1563 |
| 1564 delete e; | |
| 1565 | |
| 1566 retval = tc_retval; | |
| 1567 } | |
| 1568 } | |
| 3110 | 1569 |
| 3292 | 1570 unwind_protect::run_frame ("fold_binary_expression"); |
| 1571 | |
| 1572 return retval; | |
| 1573 } | |
| 1574 | |
| 1575 static tree_expression * | |
| 1576 fold (tree_unary_expression *e) | |
| 1577 { | |
| 1578 tree_expression *retval = e; | |
| 1579 | |
| 1580 unwind_protect::begin_frame ("fold_unary_expression"); | |
| 1581 | |
| 1582 unwind_protect_int (error_state); | |
| 4452 | 1583 unwind_protect_int (warning_state); |
| 3292 | 1584 |
| 3815 | 1585 unwind_protect_bool (discard_error_messages); |
| 4452 | 1586 unwind_protect_bool (discard_warning_messages); |
| 1587 | |
| 3815 | 1588 discard_error_messages = true; |
| 4452 | 1589 discard_warning_messages = true; |
| 3292 | 1590 |
| 1591 tree_expression *op = e->operand (); | |
| 1592 | |
| 1593 if (op->is_constant ()) | |
| 1594 { | |
| 1595 octave_value tmp = e->rvalue (); | |
| 1596 | |
| 3489 | 1597 if (! (error_state || warning_state)) |
| 3292 | 1598 { |
| 1599 tree_constant *tc_retval = new tree_constant (tmp); | |
| 1600 | |
| 5765 | 1601 std::ostringstream buf; |
| 3292 | 1602 |
| 1603 tree_print_code tpc (buf); | |
| 1604 | |
| 1605 e->accept (tpc); | |
| 1606 | |
| 5765 | 1607 tc_retval->stash_original_text (buf.str ()); |
| 3292 | 1608 |
| 1609 delete e; | |
| 1610 | |
| 1611 retval = tc_retval; | |
| 1612 } | |
| 1613 } | |
| 1614 | |
| 1615 unwind_protect::run_frame ("fold_unary_expression"); | |
| 2533 | 1616 |
| 1617 return retval; | |
| 1618 } | |
| 1619 | |
| 1623 | 1620 // Finish building a range. |
| 1621 | |
| 1622 static tree_expression * | |
| 1623 finish_colon_expression (tree_colon_expression *e) | |
| 1624 { | |
| 3110 | 1625 tree_expression *retval = e; |
| 1626 | |
| 1627 unwind_protect::begin_frame ("finish_colon_expression"); | |
| 1628 | |
| 1629 unwind_protect_int (error_state); | |
| 4452 | 1630 unwind_protect_int (warning_state); |
| 3110 | 1631 |
| 3815 | 1632 unwind_protect_bool (discard_error_messages); |
| 4452 | 1633 unwind_protect_bool (discard_warning_messages); |
| 1634 | |
| 3815 | 1635 discard_error_messages = true; |
| 4452 | 1636 discard_warning_messages = true; |
| 1623 | 1637 |
| 2533 | 1638 tree_expression *base = e->base (); |
| 1639 tree_expression *limit = e->limit (); | |
| 1640 tree_expression *incr = e->increment (); | |
| 1641 | |
| 2970 | 1642 if (base) |
| 1623 | 1643 { |
| 2970 | 1644 if (limit) |
| 2533 | 1645 { |
| 2970 | 1646 if (base->is_constant () && limit->is_constant () |
| 1647 && (! incr || (incr && incr->is_constant ()))) | |
| 1648 { | |
| 1649 octave_value tmp = e->rvalue (); | |
| 1650 | |
| 3489 | 1651 if (! (error_state || warning_state)) |
| 2970 | 1652 { |
| 1653 tree_constant *tc_retval = new tree_constant (tmp); | |
| 1654 | |
| 5765 | 1655 std::ostringstream buf; |
| 2970 | 1656 |
| 1657 tree_print_code tpc (buf); | |
| 1658 | |
| 1659 e->accept (tpc); | |
| 1660 | |
| 5765 | 1661 tc_retval->stash_original_text (buf.str ()); |
| 2970 | 1662 |
| 1663 delete e; | |
| 1664 | |
| 1665 retval = tc_retval; | |
| 1666 } | |
| 1667 } | |
| 2533 | 1668 } |
| 1669 else | |
| 2970 | 1670 { |
| 2990 | 1671 e->preserve_base (); |
| 1672 delete e; | |
| 2970 | 1673 |
| 5775 | 1674 // FIXME -- need to attempt constant folding here |
| 2970 | 1675 // too (we need a generic way to do that). |
| 1676 retval = base; | |
| 1677 } | |
| 1623 | 1678 } |
| 1679 | |
| 3110 | 1680 unwind_protect::run_frame ("finish_colon_expression"); |
| 1681 | |
| 1623 | 1682 return retval; |
| 1683 } | |
| 1684 | |
| 1607 | 1685 // Make a constant. |
| 1686 | |
| 2375 | 1687 static tree_constant * |
| 1607 | 1688 make_constant (int op, token *tok_val) |
| 1689 { | |
| 1690 int l = tok_val->line (); | |
| 1691 int c = tok_val->column (); | |
| 1692 | |
| 3216 | 1693 tree_constant *retval = 0; |
| 1607 | 1694 |
| 1695 switch (op) | |
| 1696 { | |
| 1697 case NUM: | |
| 2533 | 1698 { |
| 2883 | 1699 octave_value tmp (tok_val->number ()); |
| 1700 retval = new tree_constant (tmp, l, c); | |
| 2533 | 1701 retval->stash_original_text (tok_val->text_rep ()); |
| 1702 } | |
| 1607 | 1703 break; |
| 1704 | |
| 1705 case IMAG_NUM: | |
| 1706 { | |
| 2883 | 1707 octave_value tmp (Complex (0.0, tok_val->number ())); |
| 1708 retval = new tree_constant (tmp, l, c); | |
| 1607 | 1709 retval->stash_original_text (tok_val->text_rep ()); |
| 1710 } | |
| 1711 break; | |
| 1712 | |
| 5279 | 1713 case DQ_STRING: |
| 1714 case SQ_STRING: | |
| 2883 | 1715 { |
| 5279 | 1716 octave_value tmp (tok_val->text (), op == DQ_STRING ? '"' : '\''); |
| 2883 | 1717 retval = new tree_constant (tmp, l, c); |
| 1718 } | |
| 1607 | 1719 break; |
| 1720 | |
| 1721 default: | |
| 1722 panic_impossible (); | |
| 1723 break; | |
| 1724 } | |
| 1725 | |
| 1726 return retval; | |
| 1727 } | |
| 1728 | |
| 4342 | 1729 // Make a function handle. |
| 1730 | |
| 1731 static tree_fcn_handle * | |
| 1732 make_fcn_handle (token *tok_val) | |
| 1733 { | |
| 1734 int l = tok_val->line (); | |
| 1735 int c = tok_val->column (); | |
| 1736 | |
| 1737 tree_fcn_handle *retval = new tree_fcn_handle (tok_val->text (), l, c); | |
| 1738 | |
| 1739 return retval; | |
| 1740 } | |
| 1741 | |
| 4935 | 1742 // Make an anonymous function handle. |
| 1743 | |
| 5861 | 1744 static tree_anon_fcn_handle * |
| 4935 | 1745 make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) |
| 1746 { | |
| 5775 | 1747 // FIXME -- need to get these from the location of the @ symbol. |
| 4935 | 1748 |
| 1749 int l = -1; | |
| 1750 int c = -1; | |
| 1751 | |
| 1752 tree_parameter_list *ret_list = 0; | |
| 1753 | |
| 7336 | 1754 symbol_table::scope_id fcn_scope = symbol_table::current_scope (); |
| 5861 | 1755 |
| 1756 if (symtab_context.empty ()) | |
| 1757 panic_impossible (); | |
| 1758 | |
| 7336 | 1759 symbol_table::set_scope (symtab_context.top ()); |
| 5861 | 1760 |
| 1761 symtab_context.pop (); | |
| 1762 | |
| 7351 | 1763 stmt->set_print_flag (false); |
| 4935 | 1764 |
| 1765 tree_statement_list *body = new tree_statement_list (stmt); | |
| 1766 | |
| 1767 body->mark_as_function_body (); | |
| 1768 | |
| 5861 | 1769 tree_anon_fcn_handle *retval |
| 7336 | 1770 = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); |
| 4935 | 1771 |
| 1772 return retval; | |
| 1773 } | |
| 1774 | |
| 5161 | 1775 static void |
| 1776 maybe_warn_associativity_change (tree_expression *op) | |
| 1777 { | |
| 5781 | 1778 if (op->paren_count () == 0 && op->is_binary_expression ()) |
| 5161 | 1779 { |
| 1780 tree_binary_expression *e | |
| 1781 = dynamic_cast<tree_binary_expression *> (op); | |
| 1782 | |
| 1783 octave_value::binary_op op_type = e->op_type (); | |
| 1784 | |
| 1785 if (op_type == octave_value::op_pow | |
| 1786 || op_type == octave_value::op_el_pow) | |
| 1787 { | |
| 1788 std::string op_str = octave_value::binary_op_as_string (op_type); | |
| 1789 | |
| 5781 | 1790 warning_with_id |
| 1791 ("Octave:associativity-change", | |
| 1792 "meaning may have changed due to change in associativity for %s operator", op_str.c_str ()); | |
| 5161 | 1793 } |
| 1794 } | |
| 1795 } | |
| 1796 | |
| 666 | 1797 // Build a binary expression. |
| 1798 | |
| 578 | 1799 static tree_expression * |
| 1800 make_binary_op (int op, tree_expression *op1, token *tok_val, | |
| 1801 tree_expression *op2) | |
| 1802 { | |
| 2883 | 1803 octave_value::binary_op t = octave_value::unknown_binary_op; |
| 1623 | 1804 |
| 578 | 1805 switch (op) |
| 1806 { | |
| 1807 case POW: | |
| 3525 | 1808 t = octave_value::op_pow; |
| 5161 | 1809 maybe_warn_associativity_change (op1); |
| 578 | 1810 break; |
| 777 | 1811 |
| 578 | 1812 case EPOW: |
| 3525 | 1813 t = octave_value::op_el_pow; |
| 5161 | 1814 maybe_warn_associativity_change (op1); |
| 578 | 1815 break; |
| 777 | 1816 |
| 578 | 1817 case '+': |
| 3525 | 1818 t = octave_value::op_add; |
| 578 | 1819 break; |
| 777 | 1820 |
| 578 | 1821 case '-': |
| 3525 | 1822 t = octave_value::op_sub; |
| 578 | 1823 break; |
| 777 | 1824 |
| 578 | 1825 case '*': |
| 3525 | 1826 t = octave_value::op_mul; |
| 578 | 1827 break; |
| 777 | 1828 |
| 578 | 1829 case '/': |
| 3525 | 1830 t = octave_value::op_div; |
| 578 | 1831 break; |
| 777 | 1832 |
| 578 | 1833 case EMUL: |
| 3525 | 1834 t = octave_value::op_el_mul; |
| 578 | 1835 break; |
| 777 | 1836 |
| 578 | 1837 case EDIV: |
| 3525 | 1838 t = octave_value::op_el_div; |
| 578 | 1839 break; |
| 777 | 1840 |
| 578 | 1841 case LEFTDIV: |
| 3525 | 1842 t = octave_value::op_ldiv; |
| 578 | 1843 break; |
| 777 | 1844 |
| 578 | 1845 case ELEFTDIV: |
| 3525 | 1846 t = octave_value::op_el_ldiv; |
| 578 | 1847 break; |
| 777 | 1848 |
| 2899 | 1849 case LSHIFT: |
| 3525 | 1850 t = octave_value::op_lshift; |
| 2899 | 1851 break; |
| 1852 | |
| 1853 case RSHIFT: | |
| 3525 | 1854 t = octave_value::op_rshift; |
| 2899 | 1855 break; |
| 1856 | |
| 578 | 1857 case EXPR_LT: |
| 3525 | 1858 t = octave_value::op_lt; |
| 578 | 1859 break; |
| 777 | 1860 |
| 578 | 1861 case EXPR_LE: |
| 3525 | 1862 t = octave_value::op_le; |
| 578 | 1863 break; |
| 777 | 1864 |
| 578 | 1865 case EXPR_EQ: |
| 3525 | 1866 t = octave_value::op_eq; |
| 578 | 1867 break; |
| 777 | 1868 |
| 578 | 1869 case EXPR_GE: |
| 3525 | 1870 t = octave_value::op_ge; |
| 578 | 1871 break; |
| 777 | 1872 |
| 578 | 1873 case EXPR_GT: |
| 3525 | 1874 t = octave_value::op_gt; |
| 578 | 1875 break; |
| 777 | 1876 |
| 578 | 1877 case EXPR_NE: |
| 3525 | 1878 t = octave_value::op_ne; |
| 578 | 1879 break; |
| 777 | 1880 |
| 578 | 1881 case EXPR_AND: |
| 3525 | 1882 t = octave_value::op_el_and; |
| 578 | 1883 break; |
| 777 | 1884 |
| 578 | 1885 case EXPR_OR: |
| 3525 | 1886 t = octave_value::op_el_or; |
| 5781 | 1887 if (op2->paren_count () == 0 && op2->is_binary_expression ()) |
| 4023 | 1888 { |
| 1889 tree_binary_expression *e | |
| 1890 = dynamic_cast<tree_binary_expression *> (op2); | |
| 1891 | |
| 1892 if (e->op_type () == octave_value::op_el_and) | |
| 5781 | 1893 warning_with_id |
| 1894 ("Octave:precedence-change", | |
| 1895 "meaning may have changed due to change in precedence for & and | operators"); | |
| 4023 | 1896 } |
| 578 | 1897 break; |
| 777 | 1898 |
| 578 | 1899 default: |
| 1900 panic_impossible (); | |
| 1901 break; | |
| 1902 } | |
| 1903 | |
| 1904 int l = tok_val->line (); | |
| 1905 int c = tok_val->column (); | |
| 1906 | |
| 2533 | 1907 tree_binary_expression *e |
| 1908 = new tree_binary_expression (op1, op2, l, c, t); | |
| 1623 | 1909 |
| 2533 | 1910 return fold (e); |
| 578 | 1911 } |
| 1912 | |
| 2375 | 1913 // Build a boolean expression. |
| 666 | 1914 |
| 578 | 1915 static tree_expression * |
| 2375 | 1916 make_boolean_op (int op, tree_expression *op1, token *tok_val, |
| 1917 tree_expression *op2) | |
| 578 | 1918 { |
| 2375 | 1919 tree_boolean_expression::type t; |
| 1920 | |
| 578 | 1921 switch (op) |
| 1922 { | |
| 2375 | 1923 case EXPR_AND_AND: |
| 2805 | 1924 t = tree_boolean_expression::bool_and; |
| 578 | 1925 break; |
| 777 | 1926 |
| 2375 | 1927 case EXPR_OR_OR: |
| 2805 | 1928 t = tree_boolean_expression::bool_or; |
| 5781 | 1929 if (op2->paren_count () == 0 && op2->is_boolean_expression ()) |
| 4023 | 1930 { |
| 1931 tree_boolean_expression *e | |
| 1932 = dynamic_cast<tree_boolean_expression *> (op2); | |
| 1933 | |
| 1934 if (e->op_type () == tree_boolean_expression::bool_and) | |
| 5781 | 1935 warning_with_id |
| 1936 ("Octave:precedence-change", | |
| 1937 "meaning may have changed due to change in precedence for && and || operators"); | |
| 4023 | 1938 } |
| 578 | 1939 break; |
| 777 | 1940 |
| 578 | 1941 default: |
| 1942 panic_impossible (); | |
| 1943 break; | |
| 1944 } | |
| 1945 | |
| 1946 int l = tok_val->line (); | |
| 1947 int c = tok_val->column (); | |
| 1948 | |
| 2533 | 1949 tree_boolean_expression *e |
| 1950 = new tree_boolean_expression (op1, op2, l, c, t); | |
| 2375 | 1951 |
| 2533 | 1952 return fold (e); |
| 578 | 1953 } |
| 1954 | |
| 2375 | 1955 // Build a prefix expression. |
| 666 | 1956 |
| 578 | 1957 static tree_expression * |
| 2960 | 1958 make_prefix_op (int op, tree_expression *op1, token *tok_val) |
| 578 | 1959 { |
| 3203 | 1960 octave_value::unary_op t = octave_value::unknown_unary_op; |
| 2375 | 1961 |
| 578 | 1962 switch (op) |
| 1963 { | |
| 2960 | 1964 case EXPR_NOT: |
| 3525 | 1965 t = octave_value::op_not; |
| 2960 | 1966 break; |
| 1967 | |
| 4965 | 1968 case '+': |
| 1969 t = octave_value::op_uplus; | |
| 1970 break; | |
| 1971 | |
| 2960 | 1972 case '-': |
| 3525 | 1973 t = octave_value::op_uminus; |
| 2960 | 1974 break; |
| 1975 | |
| 578 | 1976 case PLUS_PLUS: |
| 3525 | 1977 t = octave_value::op_incr; |
| 578 | 1978 break; |
| 777 | 1979 |
| 578 | 1980 case MINUS_MINUS: |
| 3525 | 1981 t = octave_value::op_decr; |
| 578 | 1982 break; |
| 777 | 1983 |
| 578 | 1984 default: |
| 1985 panic_impossible (); | |
| 1986 break; | |
| 1987 } | |
| 1988 | |
| 1989 int l = tok_val->line (); | |
| 1990 int c = tok_val->column (); | |
| 1991 | |
| 3292 | 1992 tree_prefix_expression *e |
| 1993 = new tree_prefix_expression (op1, l, c, t); | |
| 1994 | |
| 1995 return fold (e); | |
| 578 | 1996 } |
| 1997 | |
| 2375 | 1998 // Build a postfix expression. |
| 666 | 1999 |
| 578 | 2000 static tree_expression * |
| 2960 | 2001 make_postfix_op (int op, tree_expression *op1, token *tok_val) |
| 578 | 2002 { |
| 3203 | 2003 octave_value::unary_op t = octave_value::unknown_unary_op; |
| 1623 | 2004 |
| 578 | 2005 switch (op) |
| 2006 { | |
| 2960 | 2007 case QUOTE: |
| 3525 | 2008 t = octave_value::op_hermitian; |
| 2960 | 2009 break; |
| 2010 | |
| 2011 case TRANSPOSE: | |
| 3525 | 2012 t = octave_value::op_transpose; |
| 2960 | 2013 break; |
| 2014 | |
| 2375 | 2015 case PLUS_PLUS: |
| 3525 | 2016 t = octave_value::op_incr; |
| 578 | 2017 break; |
| 777 | 2018 |
| 2375 | 2019 case MINUS_MINUS: |
| 3525 | 2020 t = octave_value::op_decr; |
| 578 | 2021 break; |
| 777 | 2022 |
| 578 | 2023 default: |
| 2024 panic_impossible (); | |
| 2025 break; | |
| 2026 } | |
| 2027 | |
| 2028 int l = tok_val->line (); | |
| 2029 int c = tok_val->column (); | |
| 2030 | |
| 3292 | 2031 tree_postfix_expression *e |
| 2032 = new tree_postfix_expression (op1, l, c, t); | |
| 2033 | |
| 2034 return fold (e); | |
| 1623 | 2035 } |
| 2036 | |
| 2037 // Build an unwind-protect command. | |
| 2038 | |
| 2039 static tree_command * | |
| 2040 make_unwind_command (token *unwind_tok, tree_statement_list *body, | |
| 3665 | 2041 tree_statement_list *cleanup, token *end_tok, |
| 2042 octave_comment_list *lc, octave_comment_list *mc) | |
| 1623 | 2043 { |
| 2044 tree_command *retval = 0; | |
| 2045 | |
| 2857 | 2046 if (end_token_ok (end_tok, token::unwind_protect_end)) |
| 1623 | 2047 { |
| 3665 | 2048 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2049 | |
| 1623 | 2050 int l = unwind_tok->line (); |
| 2051 int c = unwind_tok->column (); | |
| 2052 | |
| 3665 | 2053 retval = new tree_unwind_protect_command (body, cleanup, |
| 2054 lc, mc, tc, l, c); | |
| 1623 | 2055 } |
| 2056 | |
| 2057 return retval; | |
| 2058 } | |
| 2059 | |
| 2060 // Build a try-catch command. | |
| 2061 | |
| 2062 static tree_command * | |
| 2063 make_try_command (token *try_tok, tree_statement_list *body, | |
| 3665 | 2064 tree_statement_list *cleanup, token *end_tok, |
| 2065 octave_comment_list *lc, octave_comment_list *mc) | |
| 1623 | 2066 { |
| 2067 tree_command *retval = 0; | |
| 2068 | |
| 2857 | 2069 if (end_token_ok (end_tok, token::try_catch_end)) |
| 1623 | 2070 { |
| 3665 | 2071 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2072 | |
| 1623 | 2073 int l = try_tok->line (); |
| 2074 int c = try_tok->column (); | |
| 2075 | |
| 3665 | 2076 retval = new tree_try_catch_command (body, cleanup, |
| 2077 lc, mc, tc, l, c); | |
| 1623 | 2078 } |
| 2079 | |
| 2080 return retval; | |
| 2081 } | |
| 2082 | |
| 2083 // Build a while command. | |
| 2084 | |
| 2085 static tree_command * | |
| 2086 make_while_command (token *while_tok, tree_expression *expr, | |
| 3665 | 2087 tree_statement_list *body, token *end_tok, |
| 2088 octave_comment_list *lc) | |
| 1623 | 2089 { |
| 2090 tree_command *retval = 0; | |
| 2091 | |
| 2092 maybe_warn_assign_as_truth_value (expr); | |
| 2093 | |
| 2857 | 2094 if (end_token_ok (end_tok, token::while_end)) |
| 1623 | 2095 { |
| 3665 | 2096 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2097 | |
| 1826 | 2098 lexer_flags.looping--; |
| 1623 | 2099 |
| 2100 int l = while_tok->line (); | |
| 2101 int c = while_tok->column (); | |
| 2102 | |
| 3665 | 2103 retval = new tree_while_command (expr, body, lc, tc, l, c); |
| 1623 | 2104 } |
| 2105 | |
| 2106 return retval; | |
| 2107 } | |
| 2108 | |
| 3484 | 2109 // Build a do-until command. |
| 2110 | |
| 2111 static tree_command * | |
| 2112 make_do_until_command (token *do_tok, tree_statement_list *body, | |
| 3665 | 2113 tree_expression *expr, octave_comment_list *lc) |
| 3484 | 2114 { |
| 2115 tree_command *retval = 0; | |
| 2116 | |
| 2117 maybe_warn_assign_as_truth_value (expr); | |
| 2118 | |
| 3665 | 2119 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2120 | |
| 3484 | 2121 lexer_flags.looping--; |
| 2122 | |
| 2123 int l = do_tok->line (); | |
| 2124 int c = do_tok->column (); | |
| 2125 | |
| 3665 | 2126 retval = new tree_do_until_command (expr, body, lc, tc, l, c); |
| 3484 | 2127 |
| 2128 return retval; | |
| 2129 } | |
| 2130 | |
| 1623 | 2131 // Build a for command. |
| 2132 | |
| 2133 static tree_command * | |
| 2970 | 2134 make_for_command (token *for_tok, tree_argument_list *lhs, |
| 1623 | 2135 tree_expression *expr, tree_statement_list *body, |
| 3665 | 2136 token *end_tok, octave_comment_list *lc) |
| 1623 | 2137 { |
| 2138 tree_command *retval = 0; | |
| 2139 | |
| 2857 | 2140 if (end_token_ok (end_tok, token::for_end)) |
| 1623 | 2141 { |
| 3665 | 2142 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2143 | |
| 1826 | 2144 lexer_flags.looping--; |
| 1623 | 2145 |
| 2146 int l = for_tok->line (); | |
| 2147 int c = for_tok->column (); | |
| 2148 | |
| 2970 | 2149 if (lhs->length () == 1) |
| 2150 { | |
| 2151 tree_expression *tmp = lhs->remove_front (); | |
| 2152 | |
| 3665 | 2153 retval = new tree_simple_for_command (tmp, expr, body, |
| 2154 lc, tc, l, c); | |
| 2970 | 2155 |
| 2156 delete lhs; | |
| 2157 } | |
| 2158 else | |
| 3665 | 2159 retval = new tree_complex_for_command (lhs, expr, body, |
| 2160 lc, tc, l, c); | |
| 1623 | 2161 } |
| 2162 | |
| 2163 return retval; | |
| 2164 } | |
| 2165 | |
| 4207 | 2166 // Build a break command. |
| 2167 | |
| 2168 static tree_command * | |
| 2169 make_break_command (token *break_tok) | |
| 1623 | 2170 { |
| 4207 | 2171 tree_command *retval = 0; |
| 1623 | 2172 |
| 2620 | 2173 int l = break_tok->line (); |
| 2174 int c = break_tok->column (); | |
| 2175 | |
| 3489 | 2176 if (lexer_flags.looping || lexer_flags.defining_func |
| 3877 | 2177 || reading_script_file || evaluating_function_body |
| 2178 || evaluating_looping_command) | |
| 4207 | 2179 retval = new tree_break_command (l, c); |
| 1623 | 2180 else |
| 4207 | 2181 retval = new tree_no_op_command ("break", l, c); |
| 1623 | 2182 |
| 2183 return retval; | |
| 2184 } | |
| 2185 | |
| 4207 | 2186 // Build a continue command. |
| 2187 | |
| 2188 static tree_command * | |
| 2189 make_continue_command (token *continue_tok) | |
| 1623 | 2190 { |
| 4207 | 2191 tree_command *retval = 0; |
| 1623 | 2192 |
| 2620 | 2193 int l = continue_tok->line (); |
| 2194 int c = continue_tok->column (); | |
| 2195 | |
| 3877 | 2196 if (lexer_flags.looping || evaluating_looping_command) |
| 4207 | 2197 retval = new tree_continue_command (l, c); |
| 1623 | 2198 else |
| 4207 | 2199 retval = new tree_no_op_command ("continue", l, c); |
| 1623 | 2200 |
| 2201 return retval; | |
| 2202 } | |
| 2203 | |
| 4207 | 2204 // Build a return command. |
| 2205 | |
| 2206 static tree_command * | |
| 2207 make_return_command (token *return_tok) | |
| 1623 | 2208 { |
| 4207 | 2209 tree_command *retval = 0; |
| 1623 | 2210 |
| 2620 | 2211 int l = return_tok->line (); |
| 2212 int c = return_tok->column (); | |
| 2213 | |
| 3489 | 2214 if (lexer_flags.defining_func || reading_script_file |
| 2215 || evaluating_function_body) | |
| 4207 | 2216 retval = new tree_return_command (l, c); |
| 1623 | 2217 else |
| 4207 | 2218 retval = new tree_no_op_command ("return", l, c); |
| 1623 | 2219 |
| 2220 return retval; | |
| 2221 } | |
| 2222 | |
| 2223 // Start an if command. | |
| 2224 | |
| 2225 static tree_if_command_list * | |
| 2226 start_if_command (tree_expression *expr, tree_statement_list *list) | |
| 2227 { | |
| 2228 maybe_warn_assign_as_truth_value (expr); | |
| 2229 | |
| 2230 tree_if_clause *t = new tree_if_clause (expr, list); | |
| 2231 | |
| 2232 return new tree_if_command_list (t); | |
| 2233 } | |
| 2234 | |
| 2235 // Finish an if command. | |
| 2236 | |
| 2237 static tree_if_command * | |
| 2238 finish_if_command (token *if_tok, tree_if_command_list *list, | |
| 3665 | 2239 token *end_tok, octave_comment_list *lc) |
| 1623 | 2240 { |
| 2241 tree_if_command *retval = 0; | |
| 2242 | |
| 2857 | 2243 if (end_token_ok (end_tok, token::if_end)) |
| 1623 | 2244 { |
| 3665 | 2245 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2246 | |
| 1623 | 2247 int l = if_tok->line (); |
| 2248 int c = if_tok->column (); | |
| 2249 | |
| 3665 | 2250 retval = new tree_if_command (list, lc, tc, l, c); |
| 1623 | 2251 } |
| 2252 | |
| 2253 return retval; | |
| 2254 } | |
| 2255 | |
| 2256 // Build an elseif clause. | |
| 2257 | |
| 2258 static tree_if_clause * | |
| 3665 | 2259 make_elseif_clause (tree_expression *expr, tree_statement_list *list, |
| 2260 octave_comment_list *lc) | |
| 1623 | 2261 { |
| 2262 maybe_warn_assign_as_truth_value (expr); | |
| 2263 | |
| 3665 | 2264 return new tree_if_clause (expr, list, lc); |
| 1623 | 2265 } |
| 2266 | |
| 2764 | 2267 // Finish a switch command. |
| 2268 | |
| 2269 static tree_switch_command * | |
| 2270 finish_switch_command (token *switch_tok, tree_expression *expr, | |
| 3665 | 2271 tree_switch_case_list *list, token *end_tok, |
| 2272 octave_comment_list *lc) | |
| 2764 | 2273 { |
| 2274 tree_switch_command *retval = 0; | |
| 2275 | |
| 2857 | 2276 if (end_token_ok (end_tok, token::switch_end)) |
| 2764 | 2277 { |
| 3665 | 2278 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2279 | |
| 2764 | 2280 int l = switch_tok->line (); |
| 2281 int c = switch_tok->column (); | |
| 2282 | |
| 3665 | 2283 retval = new tree_switch_command (expr, list, lc, tc, l, c); |
| 2764 | 2284 } |
| 2285 | |
| 2286 return retval; | |
| 2287 } | |
| 2288 | |
| 2289 // Build a switch case. | |
| 2290 | |
| 2291 static tree_switch_case * | |
| 3665 | 2292 make_switch_case (tree_expression *expr, tree_statement_list *list, |
| 2293 octave_comment_list *lc) | |
| 2764 | 2294 { |
| 2295 maybe_warn_variable_switch_label (expr); | |
| 2296 | |
| 3665 | 2297 return new tree_switch_case (expr, list, lc); |
| 2764 | 2298 } |
| 2299 | |
| 1623 | 2300 // Build an assignment to a variable. |
| 2301 | |
| 2302 static tree_expression * | |
| 2970 | 2303 make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, |
| 2304 tree_expression *rhs) | |
| 1623 | 2305 { |
| 2970 | 2306 tree_expression *retval = 0; |
| 2307 | |
| 2883 | 2308 octave_value::assign_op t = octave_value::unknown_assign_op; |
| 2309 | |
| 2310 switch (op) | |
| 2311 { | |
| 2312 case '=': | |
| 3525 | 2313 t = octave_value::op_asn_eq; |
| 2883 | 2314 break; |
| 2315 | |
| 2316 case ADD_EQ: | |
| 3525 | 2317 t = octave_value::op_add_eq; |
| 2883 | 2318 break; |
| 2319 | |
| 2320 case SUB_EQ: | |
| 3525 | 2321 t = octave_value::op_sub_eq; |
| 2883 | 2322 break; |
| 2323 | |
| 2324 case MUL_EQ: | |
| 3525 | 2325 t = octave_value::op_mul_eq; |
| 2883 | 2326 break; |
| 2327 | |
| 2328 case DIV_EQ: | |
| 3525 | 2329 t = octave_value::op_div_eq; |
| 2883 | 2330 break; |
| 2331 | |
| 3204 | 2332 case LEFTDIV_EQ: |
| 3525 | 2333 t = octave_value::op_ldiv_eq; |
| 3204 | 2334 break; |
| 2335 | |
| 4018 | 2336 case POW_EQ: |
| 2337 t = octave_value::op_pow_eq; | |
| 2338 break; | |
| 2339 | |
| 2899 | 2340 case LSHIFT_EQ: |
| 3525 | 2341 t = octave_value::op_lshift_eq; |
| 2899 | 2342 break; |
| 2343 | |
| 2344 case RSHIFT_EQ: | |
| 3525 | 2345 t = octave_value::op_rshift_eq; |
| 2899 | 2346 break; |
| 2347 | |
| 2883 | 2348 case EMUL_EQ: |
| 3525 | 2349 t = octave_value::op_el_mul_eq; |
| 2883 | 2350 break; |
| 2351 | |
| 2352 case EDIV_EQ: | |
| 3525 | 2353 t = octave_value::op_el_div_eq; |
| 2883 | 2354 break; |
| 2355 | |
| 3204 | 2356 case ELEFTDIV_EQ: |
| 3525 | 2357 t = octave_value::op_el_ldiv_eq; |
| 3204 | 2358 break; |
| 2359 | |
| 4018 | 2360 case EPOW_EQ: |
| 2361 t = octave_value::op_el_pow_eq; | |
| 2362 break; | |
| 2363 | |
| 2883 | 2364 case AND_EQ: |
| 3525 | 2365 t = octave_value::op_el_and_eq; |
| 2883 | 2366 break; |
| 2367 | |
| 2368 case OR_EQ: | |
| 3525 | 2369 t = octave_value::op_el_or_eq; |
| 2883 | 2370 break; |
| 2371 | |
| 2372 default: | |
| 2373 panic_impossible (); | |
| 2374 break; | |
| 2375 } | |
| 2376 | |
| 1623 | 2377 int l = eq_tok->line (); |
| 2378 int c = eq_tok->column (); | |
| 2379 | |
| 5841 | 2380 if (lhs->is_simple_assign_lhs ()) |
| 666 | 2381 { |
| 2970 | 2382 tree_expression *tmp = lhs->remove_front (); |
| 2383 | |
| 2384 retval = new tree_simple_assignment (tmp, rhs, false, l, c, t); | |
| 2385 | |
| 2386 delete lhs; | |
| 666 | 2387 } |
| 2388 else | |
| 3208 | 2389 return new tree_multi_assignment (lhs, rhs, false, l, c, t); |
| 666 | 2390 |
| 2391 return retval; | |
| 2392 } | |
| 751 | 2393 |
| 1623 | 2394 // Begin defining a function. |
| 2395 | |
| 2891 | 2396 static octave_user_function * |
| 2397 start_function (tree_parameter_list *param_list, tree_statement_list *body) | |
| 1623 | 2398 { |
| 2399 body->mark_as_function_body (); | |
| 2400 | |
| 2891 | 2401 // We'll fill in the return list later. |
| 2402 | |
| 2403 octave_user_function *fcn | |
| 7336 | 2404 = new octave_user_function (symbol_table::current_scope (), |
| 2405 param_list, 0, body); | |
| 2406 | |
| 1623 | 2407 |
| 3665 | 2408 if (fcn) |
| 2409 { | |
| 2410 octave_comment_list *tc = octave_comment_buffer::get_comment (); | |
| 2411 | |
| 2412 fcn->stash_trailing_comment (tc); | |
| 2413 } | |
| 2414 | |
| 1623 | 2415 return fcn; |
| 2416 } | |
| 2417 | |
| 2418 // Do most of the work for defining a function. | |
| 2419 | |
| 2891 | 2420 static octave_user_function * |
| 4872 | 2421 frob_function (const std::string& fname, octave_user_function *fcn) |
| 1623 | 2422 { |
| 4872 | 2423 std::string id_name = fname; |
| 1623 | 2424 |
| 2425 // If input is coming from a file, issue a warning if the name of | |
| 2426 // the file does not match the name of the function stated in the | |
| 2427 // file. Matlab doesn't provide a diagnostic (it ignores the stated | |
| 2428 // name). | |
| 2429 | |
| 5484 | 2430 if (reading_fcn_file || autoloading) |
| 1623 | 2431 { |
| 7336 | 2432 if (! (autoloading |
| 2433 || lexer_flags.parsing_nested_function | |
| 2434 || lexer_flags.parsing_class_method)) | |
| 1623 | 2435 { |
| 7336 | 2436 // FIXME -- should curr_fcn_file_name already be |
| 2437 // preprocessed when we get here? It seems to only be a | |
| 2438 // problem with relative file names. | |
| 2439 | |
| 2440 std::string nm = curr_fcn_file_name; | |
| 2441 | |
| 2442 size_t pos = nm.find_last_of (file_ops::dir_sep_chars); | |
| 2443 | |
| 2444 if (pos != NPOS) | |
| 2445 nm = curr_fcn_file_name.substr (pos+1); | |
| 2446 | |
| 2447 if (nm != id_name) | |
| 2448 { | |
| 2449 warning_with_id | |
| 2450 ("Octave:function-name-clash", | |
| 2451 "function name `%s' does not agree with function file name `%s'", | |
| 2452 id_name.c_str (), curr_fcn_file_full_name.c_str ()); | |
| 2453 | |
| 2454 id_name = nm; | |
| 2455 } | |
| 1623 | 2456 } |
| 2457 | |
| 3712 | 2458 octave_time now; |
| 3162 | 2459 |
| 4343 | 2460 fcn->stash_fcn_file_name (curr_fcn_file_full_name); |
| 3162 | 2461 fcn->stash_fcn_file_time (now); |
| 1623 | 2462 fcn->mark_as_system_fcn_file (); |
| 3162 | 2463 |
| 6323 | 2464 if (fcn_file_from_relative_lookup) |
| 2465 fcn->mark_relative (); | |
| 2466 | |
| 2467 if (lexer_flags.parsing_nested_function) | |
| 2468 fcn->stash_parent_fcn_name (parent_function_name); | |
| 2469 | |
| 7336 | 2470 if (lexer_flags.parsing_class_method) |
| 2471 { | |
| 2472 if (current_class_name == id_name) | |
| 2473 fcn->mark_as_class_constructor (); | |
| 2474 else | |
| 2475 fcn->mark_as_class_method (); | |
| 2476 | |
| 2477 fcn->stash_dispatch_class (current_class_name); | |
| 2478 } | |
| 2479 | |
| 5781 | 2480 std::string nm = fcn->fcn_file_name (); |
| 2481 | |
| 2482 file_stat fs (nm); | |
| 2483 | |
| 2484 if (fs && fs.is_newer (now)) | |
| 2485 warning_with_id ("Octave:future-time-stamp", | |
| 2486 "time stamp for `%s' is in the future", nm.c_str ()); | |
| 1623 | 2487 } |
| 2488 else if (! (input_from_tmp_history_file || input_from_startup_file) | |
| 2489 && reading_script_file | |
| 1755 | 2490 && curr_fcn_file_name == id_name) |
| 1623 | 2491 { |
| 2492 warning ("function `%s' defined within script file `%s'", | |
| 1755 | 2493 id_name.c_str (), curr_fcn_file_full_name.c_str ()); |
| 1623 | 2494 } |
| 2495 | |
| 4872 | 2496 fcn->stash_function_name (id_name); |
| 2497 | |
| 7336 | 2498 if (! help_buf.empty ()) |
| 2499 { | |
| 2500 fcn->document (help_buf.top ()); | |
| 2501 | |
| 2502 help_buf.pop (); | |
| 2503 } | |
| 2504 | |
| 2505 if (lexer_flags.parsing_nested_function) | |
| 5609 | 2506 { |
| 7336 | 2507 std::string nm = fcn->name (); |
| 2508 | |
| 2509 fcn->mark_as_nested_function (); | |
| 2510 | |
| 2511 symbol_table::install_subfunction (nm, octave_value (fcn)); | |
| 2512 | |
| 2513 if (lexer_flags.parsing_nested_function < 0) | |
| 2514 { | |
| 2515 lexer_flags.parsing_nested_function = 0; | |
| 2516 symbol_table::reset_parent_scope (); | |
| 5397 | 2517 } |
| 4238 | 2518 } |
| 7336 | 2519 else if (! reading_fcn_file) |
| 4426 | 2520 { |
| 7336 | 2521 std::string nm = fcn->name (); |
| 2522 | |
| 2523 symbol_table::install_cmdline_function (nm, octave_value (fcn)); | |
| 2524 | |
| 2525 // Make sure that any variable with the same name as the new | |
| 2526 // function is cleared. | |
| 2527 | |
| 2528 symbol_table::varref (nm) = octave_value (); | |
| 4426 | 2529 } |
| 7336 | 2530 else |
| 2531 curr_fcn_ptr = fcn; | |
| 4426 | 2532 |
| 1623 | 2533 return fcn; |
| 2534 } | |
| 2535 | |
| 2536 // Finish defining a function. | |
| 2537 | |
| 7336 | 2538 static void |
| 3665 | 2539 finish_function (tree_parameter_list *ret_list, |
| 2540 octave_user_function *fcn, octave_comment_list *lc) | |
| 1623 | 2541 { |
| 2542 ret_list->mark_as_formal_parameters (); | |
| 2543 | |
| 3665 | 2544 fcn->stash_leading_comment (lc); |
| 2545 | |
| 7336 | 2546 fcn->define_ret_list (ret_list); |
| 1623 | 2547 } |
| 2548 | |
| 2883 | 2549 static void |
| 2550 recover_from_parsing_function (void) | |
| 2551 { | |
| 4238 | 2552 if (symtab_context.empty ()) |
| 3903 | 2553 panic_impossible (); |
| 2554 | |
| 7336 | 2555 symbol_table::set_scope (symtab_context.top ()); |
| 4238 | 2556 symtab_context.pop (); |
| 2883 | 2557 |
| 2558 lexer_flags.defining_func = false; | |
| 2559 lexer_flags.beginning_of_function = false; | |
| 2560 lexer_flags.parsed_function_name = false; | |
| 2561 lexer_flags.looking_at_return_list = false; | |
| 2562 lexer_flags.looking_at_parameter_list = false; | |
| 2563 } | |
| 2564 | |
| 2846 | 2565 // Make an index expression. |
| 2566 | |
| 751 | 2567 static tree_index_expression * |
| 3929 | 2568 make_index_expression (tree_expression *expr, tree_argument_list *args, |
| 3933 | 2569 char type) |
| 751 | 2570 { |
| 2571 tree_index_expression *retval = 0; | |
| 2572 | |
| 2970 | 2573 int l = expr->line (); |
| 2574 int c = expr->column (); | |
| 2575 | |
| 2576 expr->mark_postfix_indexed (); | |
| 2577 | |
| 3933 | 2578 if (expr->is_index_expression ()) |
| 2579 { | |
| 2580 tree_index_expression *tmp = static_cast<tree_index_expression *> (expr); | |
| 2581 | |
| 2582 tmp->append (args, type); | |
| 2583 | |
| 2584 retval = tmp; | |
| 2585 } | |
| 2586 else | |
| 2587 retval = new tree_index_expression (expr, args, l, c, type); | |
| 2970 | 2588 |
| 2589 return retval; | |
| 2590 } | |
| 2591 | |
| 2592 // Make an indirect reference expression. | |
| 2593 | |
| 3930 | 2594 static tree_index_expression * |
| 3523 | 2595 make_indirect_ref (tree_expression *expr, const std::string& elt) |
| 2970 | 2596 { |
| 3930 | 2597 tree_index_expression *retval = 0; |
| 2970 | 2598 |
| 2599 int l = expr->line (); | |
| 2600 int c = expr->column (); | |
| 2601 | |
| 3933 | 2602 if (expr->is_index_expression ()) |
| 2603 { | |
| 2604 tree_index_expression *tmp = static_cast<tree_index_expression *> (expr); | |
| 2605 | |
| 2606 tmp->append (elt); | |
| 2607 | |
| 2608 retval = tmp; | |
| 2609 } | |
| 2610 else | |
| 2611 retval = new tree_index_expression (expr, elt, l, c); | |
| 2970 | 2612 |
| 2613 lexer_flags.looking_at_indirect_ref = false; | |
| 751 | 2614 |
| 2615 return retval; | |
| 2616 } | |
| 1511 | 2617 |
| 4131 | 2618 // Make an indirect reference expression with dynamic field name. |
| 2619 | |
| 2620 static tree_index_expression * | |
| 2621 make_indirect_ref (tree_expression *expr, tree_expression *elt) | |
| 2622 { | |
| 2623 tree_index_expression *retval = 0; | |
| 2624 | |
| 2625 int l = expr->line (); | |
| 2626 int c = expr->column (); | |
| 2627 | |
| 2628 if (expr->is_index_expression ()) | |
| 2629 { | |
| 2630 tree_index_expression *tmp = static_cast<tree_index_expression *> (expr); | |
| 2631 | |
| 2632 tmp->append (elt); | |
| 2633 | |
| 2634 retval = tmp; | |
| 2635 } | |
| 2636 else | |
| 2637 retval = new tree_index_expression (expr, elt, l, c); | |
| 2638 | |
| 2639 lexer_flags.looking_at_indirect_ref = false; | |
| 2640 | |
| 2641 return retval; | |
| 2642 } | |
| 2643 | |
| 2846 | 2644 // Make a declaration command. |
| 2645 | |
| 2646 static tree_decl_command * | |
| 2647 make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst) | |
| 2648 { | |
| 2649 tree_decl_command *retval = 0; | |
| 2650 | |
| 2651 int l = tok_val->line (); | |
| 2652 int c = tok_val->column (); | |
| 2653 | |
| 2654 switch (tok) | |
| 2655 { | |
| 2656 case GLOBAL: | |
| 2657 retval = new tree_global_command (lst, l, c); | |
| 2658 break; | |
| 2659 | |
| 2660 case STATIC: | |
| 2661 if (lexer_flags.defining_func) | |
| 2662 retval = new tree_static_command (lst, l, c); | |
| 2663 else | |
| 2664 { | |
| 2665 if (reading_script_file) | |
| 4844 | 2666 warning ("ignoring persistent declaration near line %d of file `%s'", |
| 2846 | 2667 l, curr_fcn_file_full_name.c_str ()); |
| 2668 else | |
| 4844 | 2669 warning ("ignoring persistent declaration near line %d", l); |
| 2846 | 2670 } |
| 2671 break; | |
| 2672 | |
| 2673 default: | |
| 2674 panic_impossible (); | |
| 2675 break; | |
| 2676 } | |
| 2677 | |
| 2678 return retval; | |
| 2679 } | |
| 2680 | |
| 1623 | 2681 // Finish building a matrix list. |
| 2682 | |
| 2683 static tree_expression * | |
| 1829 | 2684 finish_matrix (tree_matrix *m) |
| 1623 | 2685 { |
| 3110 | 2686 tree_expression *retval = m; |
| 2687 | |
| 2688 unwind_protect::begin_frame ("finish_matrix"); | |
| 2689 | |
| 2690 unwind_protect_int (error_state); | |
| 4452 | 2691 unwind_protect_int (warning_state); |
| 3110 | 2692 |
| 3815 | 2693 unwind_protect_bool (discard_error_messages); |
| 4452 | 2694 unwind_protect_bool (discard_warning_messages); |
| 2695 | |
| 3815 | 2696 discard_error_messages = true; |
| 4452 | 2697 discard_warning_messages = true; |
| 1623 | 2698 |
| 2533 | 2699 if (m->all_elements_are_constant ()) |
| 1829 | 2700 { |
| 2970 | 2701 octave_value tmp = m->rvalue (); |
| 1623 | 2702 |
| 3489 | 2703 if (! (error_state || warning_state)) |
| 2533 | 2704 { |
| 2705 tree_constant *tc_retval = new tree_constant (tmp); | |
| 2706 | |
| 5765 | 2707 std::ostringstream buf; |
| 2533 | 2708 |
| 2709 tree_print_code tpc (buf); | |
| 2710 | |
| 2711 m->accept (tpc); | |
| 2712 | |
| 5765 | 2713 tc_retval->stash_original_text (buf.str ()); |
| 2533 | 2714 |
| 2715 delete m; | |
| 2716 | |
| 2717 retval = tc_retval; | |
| 2718 } | |
| 1623 | 2719 } |
| 3110 | 2720 |
| 2721 unwind_protect::run_frame ("finish_matrix"); | |
| 1623 | 2722 |
| 2723 return retval; | |
| 2724 } | |
| 2725 | |
| 3351 | 2726 // Finish building a cell list. |
| 2727 | |
| 2728 static tree_expression * | |
| 2729 finish_cell (tree_cell *c) | |
| 2730 { | |
| 5875 | 2731 return finish_matrix (c); |
| 3351 | 2732 } |
| 2733 | |
| 1511 | 2734 static void |
| 2735 maybe_warn_missing_semi (tree_statement_list *t) | |
| 2736 { | |
| 5781 | 2737 if (lexer_flags.defining_func) |
| 1511 | 2738 { |
| 4219 | 2739 tree_statement *tmp = t->back(); |
| 1607 | 2740 |
| 1511 | 2741 if (tmp->is_expression ()) |
| 5781 | 2742 warning_with_id |
| 2743 ("Octave:missing-semicolon", | |
| 2744 "missing semicolon near line %d, column %d in file `%s'", | |
| 2745 tmp->line (), tmp->column (), curr_fcn_file_full_name.c_str ()); | |
| 1511 | 2746 } |
| 2747 } | |
| 1994 | 2748 |
| 2525 | 2749 static void |
| 2750 set_stmt_print_flag (tree_statement_list *list, char sep, | |
| 2751 bool warn_missing_semi) | |
| 2752 { | |
| 2753 switch (sep) | |
| 2754 { | |
| 2755 case ';': | |
| 2756 { | |
| 4219 | 2757 tree_statement *tmp = list->back (); |
| 2525 | 2758 tmp->set_print_flag (0); |
| 2759 } | |
| 2760 break; | |
| 2761 | |
| 2762 case 0: | |
| 2763 case ',': | |
| 2764 case '\n': | |
| 2765 if (warn_missing_semi) | |
| 2766 maybe_warn_missing_semi (list); | |
| 2767 break; | |
| 2768 | |
| 2769 default: | |
| 2770 warning ("unrecognized separator type!"); | |
| 2771 break; | |
| 2772 } | |
| 2773 } | |
| 2774 | |
| 3021 | 2775 void |
| 2776 parse_and_execute (FILE *f) | |
| 2777 { | |
| 2778 unwind_protect::begin_frame ("parse_and_execute"); | |
| 3880 | 2779 |
| 5309 | 2780 unwind_protect_ptr (global_command); |
| 2781 | |
| 3021 | 2782 YY_BUFFER_STATE old_buf = current_buffer (); |
| 2783 YY_BUFFER_STATE new_buf = create_buffer (f); | |
| 2784 | |
| 2785 unwind_protect::add (restore_input_buffer, old_buf); | |
| 2786 unwind_protect::add (delete_input_buffer, new_buf); | |
| 2787 | |
| 2788 switch_to_buffer (new_buf); | |
| 2789 | |
| 2790 unwind_protect_bool (line_editing); | |
| 3880 | 2791 unwind_protect_bool (get_input_from_eval_string); |
| 3883 | 2792 unwind_protect_bool (parser_end_of_input); |
| 3021 | 2793 |
| 2794 line_editing = false; | |
| 3880 | 2795 get_input_from_eval_string = false; |
| 3883 | 2796 parser_end_of_input = false; |
| 3021 | 2797 |
| 2798 int retval; | |
| 2799 do | |
| 2800 { | |
| 2801 reset_parser (); | |
| 2802 | |
| 2803 retval = yyparse (); | |
| 2804 | |
| 3883 | 2805 if (retval == 0) |
| 2806 { | |
| 2807 if (global_command) | |
| 3021 | 2808 { |
| 3883 | 2809 global_command->eval (); |
| 2810 | |
| 2811 delete global_command; | |
| 2812 | |
| 2813 global_command = 0; | |
| 2814 | |
| 4171 | 2815 OCTAVE_QUIT; |
| 2816 | |
| 4207 | 2817 bool quit = (tree_return_command::returning |
| 2818 || tree_break_command::breaking); | |
| 2819 | |
| 2820 if (tree_return_command::returning) | |
| 2821 tree_return_command::returning = 0; | |
| 2822 | |
| 2823 if (tree_break_command::breaking) | |
| 2824 tree_break_command::breaking--; | |
| 3883 | 2825 |
| 2826 if (error_state) | |
| 2827 { | |
| 2828 error ("near line %d of file `%s'", input_line_number, | |
| 2829 curr_fcn_file_full_name.c_str ()); | |
| 2830 | |
| 2831 break; | |
| 2832 } | |
| 2833 | |
| 2834 if (quit) | |
| 2835 break; | |
| 3021 | 2836 } |
| 3883 | 2837 else if (parser_end_of_input) |
| 3021 | 2838 break; |
| 3883 | 2839 } |
| 3021 | 2840 } |
| 2841 while (retval == 0); | |
| 2842 | |
| 2843 unwind_protect::run_frame ("parse_and_execute"); | |
| 2844 } | |
| 2845 | |
| 2846 static void | |
| 2847 safe_fclose (void *f) | |
| 2848 { | |
| 5775 | 2849 // FIXME -- comments at the end of an input file are |
| 3765 | 2850 // discarded (otherwise, they would be appended to the next |
| 2851 // statement, possibly from the command line or another file, which | |
| 2852 // can be quite confusing). | |
| 2853 | |
| 5308 | 2854 octave_comment_list *tc = octave_comment_buffer::get_comment (); |
| 2855 | |
| 2856 delete tc; | |
| 3765 | 2857 |
| 3021 | 2858 if (f) |
| 2859 fclose (static_cast<FILE *> (f)); | |
| 2860 } | |
| 2861 | |
| 2862 void | |
| 3523 | 2863 parse_and_execute (const std::string& s, bool verbose, const char *warn_for) |
| 3021 | 2864 { |
| 2865 unwind_protect::begin_frame ("parse_and_execute_2"); | |
| 2866 | |
| 2867 unwind_protect_bool (reading_script_file); | |
| 2868 unwind_protect_str (curr_fcn_file_full_name); | |
| 2869 | |
| 2870 reading_script_file = true; | |
| 2871 curr_fcn_file_full_name = s; | |
| 2872 | |
| 2873 FILE *f = get_input_from_file (s, 0); | |
| 2874 | |
| 2875 if (f) | |
| 2876 { | |
| 2877 unwind_protect::add (safe_fclose, f); | |
| 2878 | |
| 5744 | 2879 octave_user_script *script = new octave_user_script (s, s, ""); |
| 2880 octave_call_stack::push (script); | |
| 2881 unwind_protect::add (octave_call_stack::unwind_pop_script, 0); | |
| 2882 | |
| 3021 | 2883 unwind_protect_int (input_line_number); |
| 2884 unwind_protect_int (current_input_column); | |
| 2885 | |
| 2886 input_line_number = 0; | |
| 2887 current_input_column = 1; | |
| 2888 | |
| 2889 if (verbose) | |
| 2890 { | |
| 3531 | 2891 std::cout << "reading commands from " << s << " ... "; |
| 3021 | 2892 reading_startup_message_printed = true; |
| 3531 | 2893 std::cout.flush (); |
| 3021 | 2894 } |
| 2895 | |
| 2896 parse_and_execute (f); | |
| 2897 | |
| 2898 if (verbose) | |
| 3538 | 2899 std::cout << "done." << std::endl; |
| 3021 | 2900 } |
| 2901 else if (warn_for) | |
| 2902 error ("%s: unable to open file `%s'", warn_for, s.c_str ()); | |
| 2903 | |
| 2904 unwind_protect::run_frame ("parse_and_execute_2"); | |
| 2905 } | |
| 2906 | |
| 2907 static bool | |
| 5175 | 2908 looks_like_copyright (const std::string& s) |
| 3021 | 2909 { |
| 5175 | 2910 // Perhaps someday we will want to do more here, so leave this as a |
| 2911 // separate function. | |
| 2912 | |
| 5180 | 2913 return (s.substr (0, 9) == "Copyright"); |
| 3021 | 2914 } |
| 2915 | |
| 4540 | 2916 static int |
| 2917 text_getc (FILE *f) | |
| 2918 { | |
| 2919 int c = getc (f); | |
| 2920 | |
| 2921 // Convert CRLF into just LF. | |
| 2922 | |
| 2923 if (c == '\r') | |
| 2924 { | |
| 2925 c = getc (f); | |
| 2926 | |
| 2927 if (c != '\n') | |
| 2928 { | |
| 2929 ungetc (c, f); | |
| 2930 c = '\r'; | |
| 2931 } | |
| 2932 } | |
| 2933 | |
| 2934 return c; | |
| 2935 } | |
| 2936 | |
| 3021 | 2937 // Eat whitespace and comments from FFILE, returning the text of the |
| 2938 // comments read if it doesn't look like a copyright notice. If | |
| 2939 // IN_PARTS, consider each block of comments separately; otherwise, | |
| 2940 // grab them all at once. If UPDATE_POS is TRUE, line and column | |
| 3665 | 2941 // number information is updated. If SAVE_COPYRIGHT is TRUE, then |
| 2942 // comments that are recognized as a copyright notice are saved in the | |
| 5932 | 2943 // comment buffer. If SKIP_CODE is TRUE, then ignore code, otherwise |
| 2944 // stop at the first non-whitespace character that is not part of a | |
| 2945 // comment. | |
| 2946 | |
| 2947 // FIXME -- skipping code will fail for something like this: | |
| 2948 // | |
| 2949 // function foo (x) | |
| 2950 // fprintf ('%d\n', x); | |
| 2951 // | |
| 2952 // % This is the help for foo. | |
| 2953 // | |
| 2954 // because we recognize the '%' in the fprintf format as a comment | |
| 2955 // character. Fixing this will probably require actually parsing the | |
| 2956 // file properly. | |
| 3021 | 2957 |
| 5775 | 2958 // FIXME -- grab_help_text() in lex.l duplicates some of this |
| 3021 | 2959 // code! |
| 2960 | |
| 3536 | 2961 static std::string |
| 3665 | 2962 gobble_leading_white_space (FILE *ffile, bool in_parts, |
| 5932 | 2963 bool update_pos, bool save_copyright, |
| 2964 bool skip_code) | |
| 3021 | 2965 { |
| 3523 | 2966 std::string help_txt; |
| 3021 | 2967 |
| 3802 | 2968 // TRUE means we have already seen the first block of comments. |
| 3021 | 2969 bool first_comments_seen = false; |
| 3802 | 2970 |
| 2971 // TRUE means we are at the beginning of a comment block. | |
| 3021 | 2972 bool begin_comment = false; |
| 3802 | 2973 |
| 2974 // TRUE means we have already cached the help text. | |
| 3021 | 2975 bool have_help_text = false; |
| 3802 | 2976 |
| 2977 // TRUE means we are currently reading a comment block. | |
| 3021 | 2978 bool in_comment = false; |
| 3802 | 2979 |
| 2980 // TRUE means we should discard the first space from the input | |
| 2981 // (used to strip leading spaces from the help text). | |
| 3427 | 2982 bool discard_space = true; |
| 3802 | 2983 |
| 3021 | 2984 int c; |
| 2985 | |
| 4540 | 2986 while ((c = text_getc (ffile)) != EOF) |
| 3021 | 2987 { |
| 2988 if (update_pos) | |
| 2989 current_input_column++; | |
| 2990 | |
| 2991 if (begin_comment) | |
| 2992 { | |
| 2993 if (c == '%' || c == '#') | |
| 2994 continue; | |
| 3427 | 2995 else if (discard_space && c == ' ') |
| 2996 { | |
| 2997 discard_space = false; | |
| 2998 continue; | |
| 2999 } | |
| 3021 | 3000 else |
| 3001 begin_comment = false; | |
| 3002 } | |
| 3003 | |
| 3004 if (in_comment) | |
| 3005 { | |
| 3006 if (! have_help_text) | |
| 3007 { | |
| 3008 first_comments_seen = true; | |
| 5760 | 3009 help_txt += static_cast<char> (c); |
| 3021 | 3010 } |
| 3011 | |
| 3012 if (c == '\n') | |
| 3013 { | |
| 3014 if (update_pos) | |
| 3015 { | |
| 3016 input_line_number++; | |
| 3017 current_input_column = 0; | |
| 3018 } | |
| 3427 | 3019 |
| 3021 | 3020 in_comment = false; |
| 3427 | 3021 discard_space = true; |
| 3021 | 3022 |
| 3023 if (in_parts) | |
| 3024 { | |
| 4540 | 3025 if ((c = text_getc (ffile)) != EOF) |
| 3021 | 3026 { |
| 3027 if (update_pos) | |
| 3028 current_input_column--; | |
| 3029 ungetc (c, ffile); | |
| 3030 if (c == '\n') | |
| 3031 break; | |
| 3032 } | |
| 3033 else | |
| 3034 break; | |
| 3035 } | |
| 3036 } | |
| 3037 } | |
| 3038 else | |
| 3039 { | |
| 3040 switch (c) | |
| 3041 { | |
| 3042 case ' ': | |
| 3043 case '\t': | |
| 3044 if (first_comments_seen) | |
| 3045 have_help_text = true; | |
| 3046 break; | |
| 3047 | |
| 3802 | 3048 case '%': |
| 3049 case '#': | |
| 3050 begin_comment = true; | |
| 3051 in_comment = true; | |
| 3052 break; | |
| 3053 | |
| 3021 | 3054 case '\n': |
| 3055 if (first_comments_seen) | |
| 3056 have_help_text = true; | |
| 3057 if (update_pos) | |
| 3058 { | |
| 3059 input_line_number++; | |
| 3060 current_input_column = 0; | |
| 3061 } | |
| 3062 continue; | |
| 3063 | |
| 3064 default: | |
| 5932 | 3065 if (skip_code) |
| 3066 continue; | |
| 3067 else | |
| 3068 { | |
| 3069 if (update_pos) | |
| 3070 current_input_column--; | |
| 3071 ungetc (c, ffile); | |
| 3072 goto done; | |
| 3073 } | |
| 3021 | 3074 } |
| 3075 } | |
| 3076 } | |
| 3077 | |
| 3078 done: | |
| 3079 | |
| 3080 if (! help_txt.empty ()) | |
| 3081 { | |
| 5175 | 3082 if (looks_like_copyright (help_txt)) |
| 3665 | 3083 { |
| 3084 if (save_copyright) | |
| 3085 octave_comment_buffer::append (help_txt); | |
| 3086 | |
| 3087 help_txt.resize (0); | |
| 3088 } | |
| 3021 | 3089 |
| 3090 if (in_parts && help_txt.empty ()) | |
| 5932 | 3091 help_txt = gobble_leading_white_space (ffile, in_parts, update_pos, |
| 3092 false, skip_code); | |
| 3021 | 3093 } |
| 3094 | |
| 3095 return help_txt; | |
| 3096 } | |
| 3097 | |
| 3536 | 3098 std::string |
| 5484 | 3099 get_help_from_file (const std::string& nm, bool& symbol_found, |
| 5931 | 3100 std::string& file) |
| 3021 | 3101 { |
| 3523 | 3102 std::string retval; |
| 3021 | 3103 |
| 5931 | 3104 file = fcn_file_in_path (nm); |
| 5484 | 3105 |
| 3106 if (! file.empty ()) | |
| 3021 | 3107 { |
| 5484 | 3108 symbol_found = true; |
| 3109 | |
| 3110 FILE *fptr = fopen (file.c_str (), "r"); | |
| 3021 | 3111 |
| 3112 if (fptr) | |
| 3113 { | |
| 5760 | 3114 unwind_protect::add (safe_fclose, fptr); |
| 3021 | 3115 |
| 5932 | 3116 retval = gobble_leading_white_space (fptr, true, true, false, true); |
| 3021 | 3117 |
| 3118 unwind_protect::run (); | |
| 3119 } | |
| 3120 } | |
| 3121 | |
| 3122 return retval; | |
| 3123 } | |
| 3124 | |
| 5931 | 3125 std::string |
| 3126 get_help_from_file (const std::string& nm, bool& symbol_found) | |
| 3127 { | |
| 3128 std::string file; | |
| 3129 return get_help_from_file (nm, symbol_found, file); | |
| 3130 } | |
| 3131 | |
| 3021 | 3132 static int |
| 3133 is_function_file (FILE *ffile) | |
| 3134 { | |
| 3135 int status = 0; | |
| 3136 | |
| 3137 long pos = ftell (ffile); | |
| 3138 | |
| 5932 | 3139 gobble_leading_white_space (ffile, false, false, false, false); |
| 3021 | 3140 |
| 3141 char buf [10]; | |
| 3142 fgets (buf, 10, ffile); | |
| 3143 int len = strlen (buf); | |
| 3144 if (len > 8 && strncmp (buf, "function", 8) == 0 | |
| 3145 && ! (isalnum (buf[8]) || buf[8] == '_')) | |
| 3146 status = 1; | |
| 3147 | |
| 3148 fseek (ffile, pos, SEEK_SET); | |
| 3149 | |
| 3150 return status; | |
| 3151 } | |
| 3152 | |
| 7336 | 3153 static int |
| 3154 is_function_file (const std::string& fname) | |
| 3155 { | |
| 3156 int retval = 0; | |
| 3157 | |
| 3158 FILE *fid = fopen (fname.c_str (), "r"); | |
| 3159 | |
| 3160 if (fid) | |
| 3161 { | |
| 3162 retval = is_function_file (fid); | |
| 3163 | |
| 3164 fclose (fid); | |
| 3165 } | |
| 3166 | |
| 3167 return retval; | |
| 3168 } | |
| 3169 | |
| 3021 | 3170 static void |
| 3171 restore_command_history (void *) | |
| 3172 { | |
| 3173 command_history::ignore_entries (! Vsaving_history); | |
| 3174 } | |
| 3175 | |
| 3176 static void | |
| 3177 restore_input_stream (void *f) | |
| 3178 { | |
| 3179 command_editor::set_input_stream (static_cast<FILE *> (f)); | |
| 3180 } | |
| 3181 | |
| 7336 | 3182 typedef octave_function * octave_function_ptr; |
| 3183 | |
| 3184 static octave_function * | |
| 3185 parse_fcn_file (const std::string& ff, const std::string& dispatch_type, | |
| 3186 bool exec_script, bool force_script = false) | |
| 3021 | 3187 { |
| 3188 unwind_protect::begin_frame ("parse_fcn_file"); | |
| 3189 | |
| 7336 | 3190 octave_function *fcn_ptr = 0; |
| 3021 | 3191 |
| 3192 // Open function file and parse. | |
| 3193 | |
| 3194 bool old_reading_fcn_file_state = reading_fcn_file; | |
| 3195 | |
| 3196 FILE *in_stream = command_editor::get_input_stream (); | |
| 3197 | |
| 3198 unwind_protect::add (restore_input_stream, in_stream); | |
| 3199 | |
| 3200 unwind_protect_ptr (ff_instream); | |
| 3201 | |
| 3202 unwind_protect_int (input_line_number); | |
| 3203 unwind_protect_int (current_input_column); | |
| 4238 | 3204 unwind_protect_int (end_tokens_expected); |
| 3021 | 3205 unwind_protect_bool (reading_fcn_file); |
| 3206 unwind_protect_bool (line_editing); | |
| 4238 | 3207 unwind_protect_str (parent_function_name); |
| 7336 | 3208 unwind_protect_str (current_class_name); |
| 3021 | 3209 |
| 3210 input_line_number = 0; | |
| 3211 current_input_column = 1; | |
| 4238 | 3212 end_tokens_expected = 0; |
| 3021 | 3213 reading_fcn_file = true; |
| 3214 line_editing = false; | |
| 4238 | 3215 parent_function_name = ""; |
| 7336 | 3216 current_class_name = dispatch_type; |
| 3021 | 3217 |
| 3218 FILE *ffile = get_input_from_file (ff, 0); | |
| 3219 | |
| 3220 unwind_protect::add (safe_fclose, ffile); | |
| 3221 | |
| 3222 if (ffile) | |
| 3223 { | |
| 3224 // Check to see if this file defines a function or is just a | |
| 3225 // list of commands. | |
| 3226 | |
| 3165 | 3227 if (! force_script && is_function_file (ffile)) |
| 3021 | 3228 { |
| 5775 | 3229 // FIXME -- we shouldn't need both the |
| 3021 | 3230 // command_history object and the |
| 3231 // Vsaving_history variable... | |
| 3232 command_history::ignore_entries (); | |
| 3233 | |
| 3234 unwind_protect::add (restore_command_history, 0); | |
| 3235 | |
| 3236 unwind_protect_int (Vecho_executing_commands); | |
| 3237 unwind_protect_bool (Vsaving_history); | |
| 3238 unwind_protect_bool (reading_fcn_file); | |
| 3877 | 3239 unwind_protect_bool (get_input_from_eval_string); |
| 3883 | 3240 unwind_protect_bool (parser_end_of_input); |
| 3021 | 3241 |
| 3242 Vecho_executing_commands = ECHO_OFF; | |
| 3243 Vsaving_history = false; | |
| 3244 reading_fcn_file = true; | |
| 3877 | 3245 get_input_from_eval_string = false; |
| 3883 | 3246 parser_end_of_input = false; |
| 3021 | 3247 |
| 3248 YY_BUFFER_STATE old_buf = current_buffer (); | |
| 3249 YY_BUFFER_STATE new_buf = create_buffer (ffile); | |
| 3250 | |
| 5760 | 3251 unwind_protect::add (restore_input_buffer, old_buf); |
| 3252 unwind_protect::add (delete_input_buffer, new_buf); | |
| 3021 | 3253 |
| 3254 switch_to_buffer (new_buf); | |
| 3255 | |
| 7336 | 3256 unwind_protect_ptr (curr_fcn_ptr); |
| 3257 curr_fcn_ptr = 0; | |
| 3021 | 3258 |
| 3259 reset_parser (); | |
| 3260 | |
| 4426 | 3261 std::string txt |
| 5932 | 3262 = gobble_leading_white_space (ffile, true, true, true, false); |
| 4426 | 3263 |
| 3264 help_buf.push (txt); | |
| 3265 | |
| 3266 octave_comment_buffer::append (txt); | |
| 3021 | 3267 |
| 5775 | 3268 // FIXME -- this should not be necessary. |
| 5932 | 3269 gobble_leading_white_space (ffile, false, true, false, false); |
| 3021 | 3270 |
| 7336 | 3271 lexer_flags.parsing_class_method = ! dispatch_type.empty (); |
| 3272 | |
| 3021 | 3273 int status = yyparse (); |
| 3274 | |
| 7336 | 3275 fcn_ptr = curr_fcn_ptr; |
| 3276 | |
| 3021 | 3277 if (status != 0) |
| 7336 | 3278 error ("parse error while reading function file %s", ff.c_str ()); |
| 3021 | 3279 } |
| 3280 else if (exec_script) | |
| 3281 { | |
| 3282 // The value of `reading_fcn_file' will be restored to the | |
| 3283 // proper value when we unwind from this frame. | |
| 3284 reading_fcn_file = old_reading_fcn_file_state; | |
| 3285 | |
| 5775 | 3286 // FIXME -- we shouldn't need both the |
| 3021 | 3287 // command_history object and the |
| 3288 // Vsaving_history variable... | |
| 3289 command_history::ignore_entries (); | |
| 3290 | |
| 3291 unwind_protect::add (restore_command_history, 0); | |
| 3292 | |
| 3293 unwind_protect_bool (Vsaving_history); | |
| 3294 unwind_protect_bool (reading_script_file); | |
| 3295 | |
| 3296 Vsaving_history = false; | |
| 3297 reading_script_file = true; | |
| 3298 | |
| 5744 | 3299 octave_user_script *script = new octave_user_script (ff, ff, ""); |
| 3300 octave_call_stack::push (script); | |
| 3301 unwind_protect::add (octave_call_stack::unwind_pop_script, 0); | |
| 3302 | |
| 3021 | 3303 parse_and_execute (ffile); |
| 3304 } | |
| 3305 } | |
| 3880 | 3306 else |
| 3307 error ("no such file, `%s'", ff.c_str ()); | |
| 3021 | 3308 |
| 3309 unwind_protect::run_frame ("parse_fcn_file"); | |
| 3310 | |
| 7336 | 3311 return fcn_ptr; |
| 3021 | 3312 } |
| 3313 | |
| 5484 | 3314 std::string |
| 3315 lookup_autoload (const std::string& nm) | |
| 3316 { | |
| 5626 | 3317 std::string retval; |
| 3318 | |
| 3319 typedef std::map<std::string, std::string>::const_iterator am_iter; | |
| 3320 | |
| 3321 am_iter p = autoload_map.find (nm); | |
| 3322 | |
| 3323 if (p != autoload_map.end ()) | |
| 6323 | 3324 retval = load_path::find_file (p->second); |
| 5626 | 3325 |
| 3326 return retval; | |
| 5484 | 3327 } |
| 3328 | |
| 5592 | 3329 string_vector |
| 3330 autoloaded_functions (void) | |
| 3331 { | |
| 3332 string_vector names (autoload_map.size()); | |
| 3333 | |
| 3334 octave_idx_type i = 0; | |
| 5626 | 3335 typedef std::map<std::string, std::string>::const_iterator am_iter; |
| 3336 for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) | |
| 5592 | 3337 names[i++] = p->first; |
| 3338 | |
| 3339 return names; | |
| 3340 } | |
| 3341 | |
| 3342 string_vector | |
| 3343 reverse_lookup_autoload (const std::string& nm) | |
| 3344 { | |
| 3345 string_vector names; | |
| 3346 | |
| 5626 | 3347 typedef std::map<std::string, std::string>::const_iterator am_iter; |
| 3348 for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) | |
| 5592 | 3349 if (nm == p->second) |
| 3350 names.append (p->first); | |
| 3351 | |
| 3352 return names; | |
| 3353 } | |
| 3354 | |
| 7336 | 3355 octave_function * |
| 3356 load_fcn_from_file (const std::string& file_name, const std::string& dir_name, | |
| 3357 const std::string& dispatch_type, | |
| 3358 const std::string& fcn_name, bool autoload) | |
| 3021 | 3359 { |
| 7336 | 3360 octave_function *retval = 0; |
| 3361 | |
| 5484 | 3362 unwind_protect::begin_frame ("load_fcn_from_file"); |
| 3363 | |
| 7336 | 3364 std::string nm = file_name; |
| 6238 | 3365 |
| 3366 size_t nm_len = nm.length (); | |
| 5472 | 3367 |
| 3368 std::string file; | |
| 3369 | |
| 6323 | 3370 unwind_protect_bool (fcn_file_from_relative_lookup); |
| 3371 | |
| 3372 fcn_file_from_relative_lookup = false; | |
| 3373 | |
| 7336 | 3374 file = nm; |
| 3375 | |
| 3376 if ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") | |
| 3377 || (nm_len > 4 && nm.substr (nm_len-4) == ".mex") | |
| 3378 || (nm_len > 2 && nm.substr (nm_len-2) == ".m")) | |
| 5472 | 3379 { |
| 6238 | 3380 nm = octave_env::base_pathname (file); |
| 3381 nm = nm.substr (0, nm.find_last_of ('.')); | |
| 5472 | 3382 } |
| 7336 | 3383 |
| 3384 if (autoload) | |
| 5472 | 3385 { |
| 7336 | 3386 unwind_protect_bool (autoloading); |
| 3387 autoloading = true; | |
| 3388 } | |
| 3389 | |
| 3390 if (! file.empty ()) | |
| 3391 { | |
| 6323 | 3392 fcn_file_from_relative_lookup = ! octave_env::absolute_pathname (file); |
| 3393 | |
| 3394 file = octave_env::make_absolute (file, octave_env::getcwd ()); | |
| 5472 | 3395 } |
| 4243 | 3396 |
| 3397 int len = file.length (); | |
| 3398 | |
| 4244 | 3399 if (len > 4 && file.substr (len-4, len-1) == ".oct") |
| 3021 | 3400 { |
| 7336 | 3401 if (autoload && ! fcn_name.empty ()) |
| 3402 nm = fcn_name; | |
| 3403 | |
| 3404 retval = octave_dynamic_loader::load_oct (nm, file, fcn_file_from_relative_lookup); | |
| 5864 | 3405 } |
| 3406 else if (len > 4 && file.substr (len-4, len-1) == ".mex") | |
| 7336 | 3407 retval = octave_dynamic_loader::load_mex (nm, file, fcn_file_from_relative_lookup); |
| 4244 | 3408 else if (len > 2) |
| 3021 | 3409 { |
| 7336 | 3410 if (is_function_file (file)) |
| 5484 | 3411 { |
| 7336 | 3412 // These are needed by yyparse. |
| 3413 | |
| 3414 unwind_protect_str (curr_fcn_file_name); | |
| 3415 unwind_protect_str (curr_fcn_file_full_name); | |
| 3416 | |
| 3417 curr_fcn_file_name = nm; | |
| 3418 curr_fcn_file_full_name = file; | |
| 3419 | |
| 3420 retval = parse_fcn_file (file, dispatch_type, false, autoloading); | |
| 5484 | 3421 } |
| 7336 | 3422 else |
| 3423 retval = new octave_user_script (file, fcn_name); | |
| 3021 | 3424 } |
| 3425 | |
| 7336 | 3426 if (retval) |
| 3427 retval->stash_dir_name (dir_name); | |
| 3428 | |
| 5484 | 3429 unwind_protect::run_frame ("load_fcn_from_file"); |
| 3430 | |
| 7336 | 3431 return retval; |
| 5312 | 3432 } |
| 3433 | |
| 5484 | 3434 DEFCMD (autoload, args, , |
| 3435 "-*- texinfo -*-\n\ | |
| 3436 @deftypefn {Built-in Function} {} autoload (@var{function}, @var{file})\n\ | |
| 3437 Define @var{function} to autoload from @var{file}.\n\ | |
| 5626 | 3438 \n\ |
| 6926 | 3439 The second argument, @var{file}, should be an absolute file name or\n\ |
| 3440 a file name in the same directory as the function or script from which\n\ | |
| 3441 the autoload command was run. @var{file} should not depend on the\n\ | |
| 3442 Octave load path.\n\ | |
| 6380 | 3443 \n\ |
| 3444 Normally, calls to @code{autoload} appear in PKG_ADD script files that\n\ | |
| 3445 are evaluated when a directory is added to the Octave's load path. To\n\ | |
| 6926 | 3446 avoid having to hardcode directory names in @var{file}, if @var{file}\n\ |
| 3447 is in the same directory as the PKG_ADD script then\n\ | |
| 6380 | 3448 \n\ |
| 3449 @example\n\ | |
| 6926 | 3450 autoload (\"foo\", \"bar.oct\");\n\ |
| 6380 | 3451 @end example\n\ |
| 3452 \n\ | |
| 6926 | 3453 will load the function @code{foo} from the file @code{bar.oct}. The above\n\ |
| 3454 when @code{bar.oct} is not in the same directory or uses like\n\ | |
| 6380 | 3455 \n\ |
| 3456 @example\n\ | |
| 6637 | 3457 autoload (\"foo\", file_in_loadpath (\"bar.oct\"))\n\ |
| 6380 | 3458 @end example\n\ |
| 3459 \n\ | |
| 3460 @noindent\n\ | |
| 6926 | 3461 are strongly discouraged, as their behavior might be unpredictable.\n\ |
| 6380 | 3462 \n\ |
| 6637 | 3463 With no arguments, return a structure containing the current autoload map.\n\ |
| 6380 | 3464 @seealso{PKG_ADD}\n\ |
| 5484 | 3465 @end deftypefn") |
| 3466 { | |
| 5626 | 3467 octave_value retval; |
| 5484 | 3468 |
| 3469 int nargin = args.length (); | |
| 3470 | |
| 5626 | 3471 if (nargin == 0) |
| 3472 { | |
| 3473 Cell func_names (dim_vector (autoload_map.size ()), 1); | |
| 3474 Cell file_names (dim_vector (autoload_map.size ()), 1); | |
| 3475 | |
| 3476 octave_idx_type i = 0; | |
| 3477 typedef std::map<std::string, std::string>::const_iterator am_iter; | |
| 3478 for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) | |
| 3479 { | |
| 3480 func_names(i) = p->first; | |
| 3481 file_names(i) = p->second; | |
| 3482 | |
| 3483 i++; | |
| 3484 } | |
| 3485 | |
| 3486 Octave_map m; | |
| 3487 | |
| 3488 m.assign ("function", func_names); | |
| 3489 m.assign ("file", file_names); | |
| 3490 | |
| 3491 retval = m; | |
| 3492 } | |
| 3493 else if (nargin == 2) | |
| 5484 | 3494 { |
| 3495 string_vector argv = args.make_argv ("autoload"); | |
| 3496 | |
| 3497 if (! error_state) | |
| 6380 | 3498 { |
| 3499 std::string nm = argv[2]; | |
| 3500 | |
| 3501 if (! octave_env::absolute_pathname (nm)) | |
| 6926 | 3502 { |
| 3503 octave_function *fcn = | |
| 3504 octave_call_stack::caller_user_script_or_function (); | |
| 3505 bool found = false; | |
| 3506 if (fcn) | |
| 3507 { | |
| 3508 std::string fname = fcn->fcn_file_name (); | |
| 3509 if (! fname.empty ()) | |
| 3510 { | |
| 3511 fname = octave_env::make_absolute (fname, | |
| 3512 octave_env::getcwd ()); | |
| 3513 fname = fname.substr (0, | |
| 3514 fname.find_last_of (file_ops::dir_sep_str) + 1); | |
| 3515 file_stat fs (fname + nm); | |
| 3516 if (fs.exists ()) | |
| 3517 { | |
| 3518 nm = fname + nm; | |
| 3519 found = true; | |
| 3520 } | |
| 3521 } | |
| 3522 } | |
| 3523 if (! found) | |
| 3524 warning_with_id ("Octave:autoload-relative-file-name", | |
| 3525 "autoload: `%s' is not an absolute file name", | |
| 3526 nm.c_str ()); | |
| 3527 } | |
| 6380 | 3528 autoload_map[argv[1]] = nm; |
| 3529 } | |
| 5484 | 3530 } |
| 3531 else | |
| 5823 | 3532 print_usage (); |
| 5484 | 3533 |
| 3534 return retval; | |
| 3535 } | |
| 3536 | |
| 4486 | 3537 void |
| 5975 | 3538 source_file (const std::string& file_name, const std::string& context) |
| 4486 | 3539 { |
| 3540 std::string file_full_name = file_ops::tilde_expand (file_name); | |
| 3541 | |
| 3542 unwind_protect::begin_frame ("source_file"); | |
| 3543 | |
| 3544 unwind_protect_str (curr_fcn_file_name); | |
| 3545 unwind_protect_str (curr_fcn_file_full_name); | |
| 3546 | |
| 3547 curr_fcn_file_name = file_name; | |
| 3548 curr_fcn_file_full_name = file_full_name; | |
| 3549 | |
| 5975 | 3550 if (! context.empty ()) |
| 3551 { | |
| 3552 if (context == "caller") | |
| 7336 | 3553 symbol_table::push_scope (symbol_table::current_caller_scope ()); |
| 5975 | 3554 else if (context == "base") |
| 7336 | 3555 symbol_table::push_scope (symbol_table::top_scope ()); |
| 5975 | 3556 else |
| 3557 error ("source: context must be \"caller\" or \"base\""); | |
| 7336 | 3558 |
| 3559 if (! error_state) | |
| 3560 unwind_protect::add (symbol_table::pop_scope); | |
| 5975 | 3561 } |
| 3562 | |
| 3563 if (! error_state) | |
| 3564 { | |
| 7336 | 3565 parse_fcn_file (file_full_name, "", true, true); |
| 5975 | 3566 |
| 3567 if (error_state) | |
| 3568 error ("source: error sourcing file `%s'", | |
| 3569 file_full_name.c_str ()); | |
| 3570 } | |
| 4486 | 3571 |
| 3572 unwind_protect::run_frame ("source_file"); | |
| 3573 } | |
| 3574 | |
| 5739 | 3575 DEFUN (mfilename, args, , |
| 3576 "-*- texinfo -*-\n\ | |
| 3577 @deftypefn {Built-in Function} {} mfilename ()\n\ | |
| 3578 @deftypefnx {Built-in Function} {} mfilename (@code{\"fullpath\"})\n\ | |
| 3579 @deftypefnx {Built-in Function} {} mfilename (@code{\"fullpathext\"})\n\ | |
| 3580 Return the name of the currently executing file. At the top-level,\n\ | |
| 3581 return the empty string. Given the argument @code{\"fullpath\"},\n\ | |
| 3582 include the directory part of the file name, but not the extension.\n\ | |
| 3583 Given the argument @code{\"fullpathext\"}, include the directory part\n\ | |
| 3584 of the file name and the extension.\n\ | |
| 5774 | 3585 @end deftypefn") |
| 5739 | 3586 { |
| 3587 octave_value retval; | |
| 3588 | |
| 3589 int nargin = args.length (); | |
| 3590 | |
| 3591 if (nargin > 1) | |
| 3592 { | |
| 5823 | 3593 print_usage (); |
| 5739 | 3594 return retval; |
| 3595 } | |
| 3596 | |
| 3597 std::string arg; | |
| 3598 | |
| 3599 if (nargin == 1) | |
| 3600 { | |
| 3601 arg = args(0).string_value (); | |
| 3602 | |
| 3603 if (error_state) | |
| 3604 { | |
| 3605 error ("mfilename: expecting argument to be a character string"); | |
| 3606 return retval; | |
| 3607 } | |
| 3608 } | |
| 3609 | |
| 3610 std::string fname; | |
| 3611 | |
| 5744 | 3612 octave_function *fcn = octave_call_stack::caller_user_script_or_function (); |
| 5743 | 3613 |
| 3614 if (fcn) | |
| 3615 { | |
| 3616 fname = fcn->fcn_file_name (); | |
| 3617 | |
| 3618 if (fname.empty ()) | |
| 3619 fname = fcn->name (); | |
| 3620 } | |
| 5739 | 3621 |
| 3622 if (arg == "fullpathext") | |
| 3623 retval = fname; | |
| 3624 else | |
| 3625 { | |
| 5747 | 3626 size_t dpos = fname.rfind (file_ops::dir_sep_char); |
| 3627 size_t epos = fname.rfind ('.'); | |
| 3628 | |
| 3629 if (epos <= dpos) | |
| 3630 epos = NPOS; | |
| 3631 | |
| 3632 fname = (epos != NPOS) ? fname.substr (0, epos) : fname; | |
| 5739 | 3633 |
| 3634 if (arg == "fullpath") | |
| 3635 retval = fname; | |
| 3636 else | |
| 5747 | 3637 retval = (dpos != NPOS) ? fname.substr (dpos+1) : fname; |
| 5739 | 3638 } |
| 3639 | |
| 3640 return retval; | |
| 3641 } | |
| 3642 | |
| 3643 | |
| 3021 | 3644 DEFUN (source, args, , |
| 3371 | 3645 "-*- texinfo -*-\n\ |
| 3646 @deftypefn {Built-in Function} {} source (@var{file})\n\ | |
| 3647 Parse and execute the contents of @var{file}. This is equivalent to\n\ | |
| 3648 executing commands from a script file, but without requiring the file to\n\ | |
| 3649 be named @file{@var{file}.m}.\n\ | |
| 3650 @end deftypefn") | |
| 3021 | 3651 { |
| 3652 octave_value_list retval; | |
| 3653 | |
| 3654 int nargin = args.length (); | |
| 3655 | |
| 5975 | 3656 if (nargin == 1 || nargin == 2) |
| 3021 | 3657 { |
| 3523 | 3658 std::string file_name = args(0).string_value (); |
| 3021 | 3659 |
| 3660 if (! error_state) | |
| 5975 | 3661 { |
| 3662 std::string context; | |
| 3663 | |
| 3664 if (nargin == 2) | |
| 3665 context = args(1).string_value (); | |
| 3666 | |
| 3667 if (! error_state) | |
| 3668 source_file (file_name, context); | |
| 3669 else | |
| 3670 error ("source: expecting context to be character string"); | |
| 3671 } | |
| 3021 | 3672 else |
| 3673 error ("source: expecting file name as argument"); | |
| 3674 } | |
| 3675 else | |
| 5823 | 3676 print_usage (); |
| 3021 | 3677 |
| 3678 return retval; | |
| 3679 } | |
| 3680 | |
| 3726 | 3681 // Evaluate an Octave function (built-in or interpreted) and return |
| 3844 | 3682 // the list of result values. NAME is the name of the function to |
| 3683 // call. ARGS are the arguments to the function. NARGOUT is the | |
| 3684 // number of output arguments expected. | |
| 3726 | 3685 |
| 3021 | 3686 octave_value_list |
| 3523 | 3687 feval (const std::string& name, const octave_value_list& args, int nargout) |
| 3156 | 3688 { |
| 3689 octave_value_list retval; | |
| 3690 | |
| 7336 | 3691 octave_value fcn = symbol_table::find_function (name, args); |
| 3692 | |
| 3693 if (fcn.is_defined ()) | |
| 3694 retval = fcn.do_multi_index_op (nargout, args); | |
| 3695 else | |
| 3696 error ("feval: function `%s' not found", name.c_str ()); | |
| 3156 | 3697 |
| 3698 return retval; | |
| 3699 } | |
| 3700 | |
| 4342 | 3701 octave_value_list |
| 3702 feval (octave_function *fcn, const octave_value_list& args, int nargout) | |
| 3703 { | |
| 3704 octave_value_list retval; | |
| 3705 | |
| 3706 if (fcn) | |
| 3707 retval = fcn->do_multi_index_op (nargout, args); | |
| 3708 | |
| 3709 return retval; | |
| 3710 } | |
| 3711 | |
| 3712 static octave_value_list | |
| 3713 get_feval_args (const octave_value_list& args) | |
| 3714 { | |
| 3715 int tmp_nargin = args.length () - 1; | |
| 3716 | |
| 3717 octave_value_list retval (tmp_nargin, octave_value ()); | |
| 3718 | |
| 3719 for (int i = 0; i < tmp_nargin; i++) | |
| 3720 retval(i) = args(i+1); | |
| 3721 | |
| 3722 string_vector arg_names = args.name_tags (); | |
| 3723 | |
| 3724 if (! arg_names.empty ()) | |
| 3725 { | |
| 3726 // tmp_nargin and arg_names.length () - 1 may differ if | |
| 3727 // we are passed all_va_args. | |
| 3728 | |
| 3729 int n = arg_names.length () - 1; | |
| 3730 | |
| 3731 int len = n > tmp_nargin ? tmp_nargin : n; | |
| 3732 | |
| 3733 string_vector tmp_arg_names (len); | |
| 3734 | |
| 3735 for (int i = 0; i < len; i++) | |
| 3736 tmp_arg_names(i) = arg_names(i+1); | |
| 3737 | |
| 3738 retval.stash_name_tags (tmp_arg_names); | |
| 3739 } | |
| 3740 | |
| 3741 return retval; | |
| 3742 } | |
| 3743 | |
| 3744 | |
| 3726 | 3745 // Evaluate an Octave function (built-in or interpreted) and return |
| 3746 // the list of result values. The first element of ARGS should be a | |
| 3747 // string containing the name of the function to call, then the rest | |
| 3748 // are the actual arguments to the function. NARGOUT is the number of | |
| 3749 // output arguments expected. | |
| 3750 | |
| 3156 | 3751 octave_value_list |
| 3021 | 3752 feval (const octave_value_list& args, int nargout) |
| 3753 { | |
| 3754 octave_value_list retval; | |
| 3755 | |
| 4342 | 3756 int nargin = args.length (); |
| 3757 | |
| 3758 if (nargin > 0) | |
| 3021 | 3759 { |
| 4342 | 3760 octave_value f_arg = args(0); |
| 3761 | |
| 3762 if (f_arg.is_string ()) | |
| 3763 { | |
| 3764 std::string name = f_arg.string_value (); | |
| 3765 | |
| 3766 if (! error_state) | |
| 3156 | 3767 { |
| 4342 | 3768 octave_value_list tmp_args = get_feval_args (args); |
| 3769 | |
| 3770 retval = feval (name, tmp_args, nargout); | |
| 3156 | 3771 } |
| 4342 | 3772 } |
| 3773 else | |
| 3774 { | |
| 3775 octave_function *fcn = f_arg.function_value (); | |
| 3776 | |
| 3777 if (fcn) | |
| 3778 { | |
| 3779 octave_value_list tmp_args = get_feval_args (args); | |
| 3780 | |
| 3781 retval = feval (fcn, tmp_args, nargout); | |
| 3782 } | |
| 3021 | 3783 } |
| 3784 } | |
| 3785 | |
| 3786 return retval; | |
| 3787 } | |
| 3788 | |
| 3789 DEFUN (feval, args, nargout, | |
| 3371 | 3790 "-*- texinfo -*-\n\ |
| 3791 @deftypefn {Built-in Function} {} feval (@var{name}, @dots{})\n\ | |
| 3792 Evaluate the function named @var{name}. Any arguments after the first\n\ | |
| 3793 are passed on to the named function. For example,\n\ | |
| 3794 \n\ | |
| 3795 @example\n\ | |
| 3796 feval (\"acos\", -1)\n\ | |
| 3797 @result{} 3.1416\n\ | |
| 3798 @end example\n\ | |
| 3021 | 3799 \n\ |
| 3371 | 3800 @noindent\n\ |
| 3801 calls the function @code{acos} with the argument @samp{-1}.\n\ | |
| 3802 \n\ | |
| 3803 The function @code{feval} is necessary in order to be able to write\n\ | |
| 3804 functions that call user-supplied functions, because Octave does not\n\ | |
| 3805 have a way to declare a pointer to a function (like C) or to declare a\n\ | |
| 3806 special kind of variable that can be used to hold the name of a function\n\ | |
| 3807 (like @code{EXTERNAL} in Fortran). Instead, you must refer to functions\n\ | |
| 3808 by name, and use @code{feval} to call them.\n\ | |
| 3809 @end deftypefn") | |
| 3021 | 3810 { |
| 3811 octave_value_list retval; | |
| 3812 | |
| 3813 int nargin = args.length (); | |
| 3814 | |
| 3815 if (nargin > 0) | |
| 3816 retval = feval (args, nargout); | |
| 3817 else | |
| 5823 | 3818 print_usage (); |
| 3021 | 3819 |
| 3820 return retval; | |
| 3821 } | |
| 3822 | |
| 3099 | 3823 octave_value_list |
| 3523 | 3824 eval_string (const std::string& s, bool silent, int& parse_status, int nargout) |
| 3021 | 3825 { |
| 3877 | 3826 octave_value_list retval; |
| 3827 | |
| 3021 | 3828 unwind_protect::begin_frame ("eval_string"); |
| 3829 | |
| 3830 unwind_protect_bool (get_input_from_eval_string); | |
| 3877 | 3831 unwind_protect_bool (input_from_eval_string_pending); |
| 3883 | 3832 unwind_protect_bool (parser_end_of_input); |
| 5189 | 3833 unwind_protect_bool (line_editing); |
| 3021 | 3834 unwind_protect_str (current_eval_string); |
| 3835 | |
| 3836 get_input_from_eval_string = true; | |
| 3877 | 3837 input_from_eval_string_pending = true; |
| 3883 | 3838 parser_end_of_input = false; |
| 5189 | 3839 line_editing = false; |
| 3840 | |
| 3021 | 3841 current_eval_string = s; |
| 3842 | |
| 3877 | 3843 unwind_protect_ptr (global_command); |
| 3844 | |
| 3021 | 3845 YY_BUFFER_STATE old_buf = current_buffer (); |
| 3846 YY_BUFFER_STATE new_buf = create_buffer (0); | |
| 3847 | |
| 3848 unwind_protect::add (restore_input_buffer, old_buf); | |
| 3849 unwind_protect::add (delete_input_buffer, new_buf); | |
| 3850 | |
| 3851 switch_to_buffer (new_buf); | |
| 3852 | |
| 3877 | 3853 do |
| 3854 { | |
| 4318 | 3855 reset_parser (); |
| 3856 | |
| 3877 | 3857 parse_status = yyparse (); |
| 3858 | |
| 3859 tree_statement_list *command = global_command; | |
| 3860 | |
| 3883 | 3861 if (parse_status == 0) |
| 3877 | 3862 { |
| 3883 | 3863 if (command) |
| 3864 { | |
| 3865 retval = command->eval (silent, nargout); | |
| 3866 | |
| 3867 delete command; | |
| 3868 | |
| 3869 command = 0; | |
| 3870 | |
| 3871 if (error_state | |
| 4207 | 3872 || tree_return_command::returning |
| 3873 || tree_break_command::breaking | |
| 3874 || tree_continue_command::continuing) | |
| 3883 | 3875 break; |
| 3876 } | |
| 3877 else if (parser_end_of_input) | |
| 3877 | 3878 break; |
| 3883 | 3879 } |
| 3877 | 3880 } |
| 3881 while (parse_status == 0); | |
| 3021 | 3882 |
| 3883 unwind_protect::run_frame ("eval_string"); | |
| 3884 | |
| 3885 return retval; | |
| 3886 } | |
| 3887 | |
| 3888 octave_value | |
| 3523 | 3889 eval_string (const std::string& s, bool silent, int& parse_status) |
| 3021 | 3890 { |
| 3891 octave_value retval; | |
| 3892 | |
| 3893 octave_value_list tmp = eval_string (s, silent, parse_status, 1); | |
| 3894 | |
| 3895 if (! tmp.empty ()) | |
| 3896 retval = tmp(0); | |
| 3897 | |
| 3898 return retval; | |
| 3899 } | |
| 3900 | |
| 3901 static octave_value_list | |
| 3902 eval_string (const octave_value& arg, bool silent, int& parse_status, | |
| 3903 int nargout) | |
| 3904 { | |
| 3523 | 3905 std::string s = arg.string_value (); |
| 3021 | 3906 |
| 3907 if (error_state) | |
| 3908 { | |
| 3523 | 3909 error ("eval: expecting std::string argument"); |
| 4233 | 3910 return octave_value (-1); |
| 3021 | 3911 } |
| 3912 | |
| 3913 return eval_string (s, silent, parse_status, nargout); | |
| 3914 } | |
| 3915 | |
| 3916 DEFUN (eval, args, nargout, | |
| 3371 | 3917 "-*- texinfo -*-\n\ |
| 3918 @deftypefn {Built-in Function} {} eval (@var{try}, @var{catch})\n\ | |
| 3919 Parse the string @var{try} and evaluate it as if it were an Octave\n\ | |
| 6643 | 3920 program. If that fails, evaluate the optional string @var{catch}.\n\ |
| 4463 | 3921 The string @var{try} is evaluated in the current context,\n\ |
| 3922 so any results remain available after @code{eval} returns.\n\ | |
| 6643 | 3923 \n\ |
| 3924 The following example makes the variable @var{a} with the approximate\n\ | |
| 3925 value 3.1416 available.\n\ | |
| 3926 \n\ | |
| 3927 @example\n\ | |
| 3928 eval(\"a = acos(-1);\");\n\ | |
| 3929 @end example\n\ | |
| 3930 \n\ | |
| 3931 If an error occurs during the evaluation of @var{try} the @var{catch}\n\ | |
| 3932 string is evaluated, as the following example shows.\n\ | |
| 3933 \n\ | |
| 3934 @example\n\ | |
| 3935 eval ('error (\"This is a bad example\");',\n\ | |
| 7001 | 3936 'printf (\"This error occurred:\\n%s\", lasterr ());');\n\ |
| 3937 @print{} This error occurred:\n\ | |
| 6643 | 3938 error: This is a bad example\n\ |
| 3939 @end example\n\ | |
| 3371 | 3940 @end deftypefn") |
| 3021 | 3941 { |
| 3942 octave_value_list retval; | |
| 3943 | |
| 3944 int nargin = args.length (); | |
| 3945 | |
| 3946 if (nargin > 0) | |
| 3947 { | |
| 3948 unwind_protect::begin_frame ("Feval"); | |
| 3949 | |
| 3950 if (nargin > 1) | |
| 3951 { | |
| 4699 | 3952 unwind_protect_int (buffer_error_messages); |
| 3953 buffer_error_messages++; | |
| 3021 | 3954 } |
| 3955 | |
| 3956 int parse_status = 0; | |
| 3957 | |
| 4463 | 3958 octave_value_list tmp = eval_string (args(0), nargout > 0, |
| 3959 parse_status, nargout); | |
| 3960 | |
| 3961 if (nargout > 0) | |
| 3962 retval = tmp; | |
| 3021 | 3963 |
| 3964 if (nargin > 1 && (parse_status != 0 || error_state)) | |
| 3965 { | |
| 3966 error_state = 0; | |
| 3967 | |
| 3968 // Set up for letting the user print any messages from | |
| 3969 // errors that occurred in the first part of this eval(). | |
| 3970 | |
| 4699 | 3971 buffer_error_messages--; |
| 3021 | 3972 |
| 3973 eval_string (args(1), 0, parse_status, nargout); | |
| 3974 | |
| 3975 retval = octave_value_list (); | |
| 3976 } | |
| 3977 | |
| 3978 unwind_protect::run_frame ("Feval"); | |
| 3979 } | |
| 3980 else | |
| 5823 | 3981 print_usage (); |
| 3021 | 3982 |
| 3983 return retval; | |
| 3984 } | |
| 3985 | |
|
7562
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3986 /* |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3987 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3988 %% test/octave.test/eval/eval-1.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3989 %!#test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3990 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3991 %! assert(eval ("x"),1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3992 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3993 %% test/octave.test/eval/eval-2.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3994 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3995 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3996 %! assert(eval ("x;")); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3997 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3998 %% test/octave.test/eval/eval-3.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
3999 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4000 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4001 %! assert(eval ("x;"),1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4002 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4003 %% FIXME |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4004 %% Disable this test as adding the ";" is redundant with eval-1 and |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4005 %% in any case is a syntax error with assert |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4006 %% test/octave.test/eval/eval-4.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4007 %!#test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4008 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4009 %! assert(eval ("x");,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4010 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4011 %% test/octave.test/eval/eval-5.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4012 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4013 %! eval ("flipud = 2;"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4014 %! assert(flipud,2); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4015 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4016 %% test/octave.test/eval/eval-6.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4017 %!function y = f () |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4018 %! eval ("flipud = 2;"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4019 %! y = flipud; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4020 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4021 %! assert(f,2); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4022 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4023 %% test/octave.test/eval/eval-7.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4024 %!#test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4025 %! eval ("x = 1"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4026 %! assert(x,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4027 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4028 %% test/octave.test/eval/eval-8.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4029 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4030 %! eval ("x = 1;") |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4031 %! assert(x,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4032 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4033 %% test/octave.test/eval/eval-9.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4034 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4035 %! eval ("x = 1;"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4036 %! assert(x,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4037 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4038 %% test/octave.test/eval/eval-10.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4039 %!#test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4040 %! eval ("x = 1") |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4041 %! assert(x,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4042 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4043 %% test/octave.test/eval/eval-11.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4044 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4045 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4046 %! y = eval ("x"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4047 %! assert(y,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4048 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4049 %% test/octave.test/eval/eval-12.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4050 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4051 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4052 %! y = eval ("x;"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4053 %! assert(y,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4054 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4055 %% test/octave.test/eval/eval-13.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4056 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4057 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4058 %! y = eval ("x;"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4059 %! assert(y,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4060 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4061 %% test/octave.test/eval/eval-14.m |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4062 %!test |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4063 %! x = 1; |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4064 %! y = eval ("x"); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4065 %! assert(y,1); |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4066 |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4067 */ |
|
c827f5673321
move tests to individual source files
John W. Eaton <jwe@octave.org>
parents:
7351
diff
changeset
|
4068 |
| 4661 | 4069 DEFUN (assignin, args, , |
| 4297 | 4070 "-*- texinfo -*-\n\ |
| 4071 @deftypefn {Built-in Function} {} assignin (@var{context}, @var{varname}, @var{value})\n\ | |
| 4072 Assign @var{value} to @var{varname} in context @var{context}, which\n\ | |
| 4073 may be either @code{\"base\"} or @code{\"caller\"}.\n\ | |
| 4074 @end deftypefn") | |
| 4075 { | |
| 4076 octave_value_list retval; | |
| 4077 | |
| 4078 int nargin = args.length (); | |
| 4079 | |
| 4080 if (nargin == 3) | |
| 4081 { | |
| 4082 std::string context = args(0).string_value (); | |
| 4083 | |
| 4084 if (! error_state) | |
| 4085 { | |
| 7336 | 4086 symbol_table::scope_id scope = -1; |
| 4297 | 4087 |
| 4088 if (context == "caller") | |
| 7336 | 4089 { |
| 4090 if (symbol_table::current_scope () == symbol_table::current_caller_scope ()) | |
| 4091 { | |
| 4092 error ("assignin: assignment in caller not implemented yet for direct recursion"); | |
| 4093 return retval; | |
| 4094 } | |
| 4095 else | |
| 4096 scope = symbol_table::current_caller_scope (); | |
| 4097 } | |
| 4297 | 4098 else if (context == "base") |
| 7336 | 4099 scope = symbol_table::top_scope (); |
| 4297 | 4100 else |
| 4101 error ("assignin: context must be \"caller\" or \"base\""); | |
| 4102 | |
| 4103 if (! error_state) | |
| 4104 { | |
| 4105 std::string nm = args(1).string_value (); | |
| 4106 | |
| 4107 if (! error_state) | |
| 4108 { | |
| 4109 if (valid_identifier (nm)) | |
| 7336 | 4110 symbol_table::varref (nm, scope) = args(2); |
| 4297 | 4111 else |
| 4112 error ("assignin: invalid variable name"); | |
| 4113 } | |
| 4114 else | |
| 4115 error ("assignin: expecting variable name as second argument"); | |
| 4116 } | |
| 4117 } | |
| 4118 else | |
| 4119 error ("assignin: expecting string as first argument"); | |
| 4120 } | |
| 4121 else | |
| 5823 | 4122 print_usage (); |
| 4297 | 4123 |
| 4124 return retval; | |
| 4125 } | |
| 4126 | |
| 4245 | 4127 DEFUN (evalin, args, nargout, |
| 4128 "-*- texinfo -*-\n\ | |
| 4129 @deftypefn {Built-in Function} {} evalin (@var{context}, @var{try}, @var{catch})\n\ | |
| 4130 Like @code{eval}, except that the expressions are evaluated in the\n\ | |
| 4131 context @var{context}, which may be either @code{\"caller\"} or\n\ | |
| 4246 | 4132 @code{\"base\"}.\n\ |
| 4245 | 4133 @end deftypefn") |
| 4134 { | |
| 4135 octave_value_list retval; | |
| 4136 | |
| 4137 int nargin = args.length (); | |
| 4138 | |
| 4139 if (nargin > 1) | |
| 4140 { | |
| 4141 std::string context = args(0).string_value (); | |
| 4142 | |
| 4143 if (! error_state) | |
| 4144 { | |
| 4145 unwind_protect::begin_frame ("Fevalin"); | |
| 4146 | |
| 4147 if (context == "caller") | |
| 7336 | 4148 { |
| 4149 if (symbol_table::current_scope () == symbol_table::current_caller_scope ()) | |
| 4150 { | |
| 4151 error ("evalin: evaluation in caller not implemented yet for direct recursion"); | |
| 4152 return retval; | |
| 4153 } | |
| 4154 else | |
| 4155 symbol_table::push_scope (symbol_table::current_caller_scope ()); | |
| 4156 } | |
| 4245 | 4157 else if (context == "base") |
| 7336 | 4158 symbol_table::push_scope (symbol_table::top_scope ()); |
| 4245 | 4159 else |
| 4160 error ("evalin: context must be \"caller\" or \"base\""); | |
| 4161 | |
| 4297 | 4162 if (! error_state) |
| 4245 | 4163 { |
| 7336 | 4164 unwind_protect::add (symbol_table::pop_scope); |
| 4165 | |
| 4297 | 4166 if (nargin > 2) |
| 4167 { | |
| 4699 | 4168 unwind_protect_int (buffer_error_messages); |
| 4169 buffer_error_messages++; | |
| 4297 | 4170 } |
| 4171 | |
| 4172 int parse_status = 0; | |
| 4173 | |
| 4463 | 4174 octave_value_list tmp = eval_string (args(1), nargout > 0, |
| 4175 parse_status, nargout); | |
| 4176 | |
| 4177 if (nargout > 0) | |
| 4178 retval = tmp; | |
| 4297 | 4179 |
| 4180 if (nargin > 2 && (parse_status != 0 || error_state)) | |
| 4181 { | |
| 4182 error_state = 0; | |
| 4183 | |
| 4184 // Set up for letting the user print any messages from | |
| 4185 // errors that occurred in the first part of this eval(). | |
| 4186 | |
| 4699 | 4187 buffer_error_messages--; |
| 4297 | 4188 |
| 4189 eval_string (args(2), 0, parse_status, nargout); | |
| 4190 | |
| 4191 retval = octave_value_list (); | |
| 4192 } | |
| 4245 | 4193 } |
| 4194 | |
| 4195 unwind_protect::run_frame ("Fevalin"); | |
| 4196 } | |
| 4197 else | |
| 4198 error ("evalin: expecting string as first argument"); | |
| 4199 } | |
| 4200 else | |
| 5823 | 4201 print_usage (); |
| 4245 | 4202 |
| 4203 return retval; | |
| 4204 } | |
| 4205 | |
| 1994 | 4206 /* |
| 4207 ;;; Local Variables: *** | |
| 4208 ;;; mode: text *** | |
| 4209 ;;; End: *** | |
| 4210 */ |