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