# HG changeset patch # User jwe # Date 1091762233 0 # Node ID 4fc993a4e0726a90e634549537195c74bc62d43f # Parent ca6c86504105969532d1e21b5ebdf037cd2415e8 [project @ 2004-08-06 03:17:12 by jwe] diff -r ca6c86504105 -r 4fc993a4e072 src/ChangeLog --- a/src/ChangeLog Thu Aug 05 16:38:36 2004 +0000 +++ b/src/ChangeLog Fri Aug 06 03:17:13 2004 +0000 @@ -1,3 +1,14 @@ +2004-08-05 John W. Eaton + + * pt-stmt.h (tree_statement::set_command, + (tree_statement::set_expression): New functions. + + * parse.y (param_list_beg): Handle pushing new symbol table + context for anonymous function handle parameter lists here. + (anon_fcn_handle): New non-terminal. + (expression): Include anon_fcn_handle here. + (make_anon_fcn_handle): New static function. + 2004-08-05 David Bateman * ov.cc (octave_value::fcn_inline_value): New virtual function. diff -r ca6c86504105 -r 4fc993a4e072 src/Makefile.in --- a/src/Makefile.in Thu Aug 05 16:38:36 2004 +0000 +++ b/src/Makefile.in Fri Aug 06 03:17:13 2004 +0000 @@ -502,7 +502,7 @@ @$(top_srcdir)/move-if-change $@-t $@ parse.cc : parse.y - @echo "expect 11 shift/reduce conflicts" + @echo "expect 87 shift/reduce conflicts" $(YACC) $(YFLAGS) $< @$(top_srcdir)/move-if-change y.tab.c $(@F) diff -r ca6c86504105 -r 4fc993a4e072 src/ov-fcn-handle.cc --- a/src/ov-fcn-handle.cc Thu Aug 05 16:38:36 2004 +0000 +++ b/src/ov-fcn-handle.cc Fri Aug 06 03:17:13 2004 +0000 @@ -146,7 +146,12 @@ std::string nm = fcn->fcn_file_name (); if (nm.empty ()) - m.assign ("file", "built-in function"); + { + if (fh_nm == "@") + m.assign ("file", "none"); + else + m.assign ("file", "built-in function"); + } else m.assign ("file", nm); diff -r ca6c86504105 -r 4fc993a4e072 src/parse.y --- a/src/parse.y Thu Aug 05 16:38:36 2004 +0000 +++ b/src/parse.y Fri Aug 06 03:17:13 2004 +0000 @@ -58,6 +58,7 @@ #include "input.h" #include "lex.h" #include "oct-hist.h" +#include "ov-fcn-handle.h" #include "ov-usr-fcn.h" #include "toplev.h" #include "pager.h" @@ -183,6 +184,10 @@ static tree_fcn_handle * make_fcn_handle (token *tok_val); +// Build an anonymous function handle. +static tree_constant * +make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); + // Build a binary expression. static tree_expression * make_binary_op (int op, tree_expression *op1, token *tok_val, @@ -432,7 +437,7 @@ %type stash_comment function_beg %type sep_no_nl opt_sep_no_nl sep opt_sep %type input -%type constant magic_colon +%type constant magic_colon anon_fcn_handle %type fcn_handle %type matrix_rows matrix_rows1 %type cell_rows cell_rows1 @@ -445,7 +450,7 @@ %type colon_expr1 %type arg_list word_list assign_lhs %type cell_or_matrix_row -%type param_list param_list1 +%type param_list param_list1 param_list2 %type return_list return_list1 %type command select_command loop_command %type jump_command except_command function @@ -679,8 +684,8 @@ } ; -fcn_handle : FCN_HANDLE - { $$ = make_fcn_handle ($1); } +anon_fcn_handle : '@' param_list statement + { $$ = make_anon_fcn_handle ($2, $3); } ; primary_expr : identifier @@ -938,6 +943,8 @@ { $$ = $1; } | assign_expr { $$ = $1; } + | anon_fcn_handle + { $$ = $1; } ; // ================================================ @@ -1160,46 +1167,29 @@ // =========================== param_list_beg : '(' - { lexer_flags.looking_at_parameter_list = true; } + { + lexer_flags.looking_at_parameter_list = true; + + if (lexer_flags.looking_at_function_handle) + { + symtab_context.push (curr_sym_tab); + + tmp_local_sym_tab = new symbol_table (); + curr_sym_tab = tmp_local_sym_tab; + + lexer_flags.looking_at_function_handle--; + } + } ; param_list_end : ')' { lexer_flags.looking_at_parameter_list = false; } ; -param_list : param_list_beg param_list_end - { - lexer_flags.quote_is_transpose = false; - $$ = 0; - } - | param_list_beg VARARGIN param_list_end - { - lexer_flags.quote_is_transpose = false; - tree_parameter_list *tmp = new tree_parameter_list (); - tmp->mark_varargs_only (); - $$ = tmp; - } - | param_list1 param_list_end +param_list : param_list_beg param_list1 param_list_end { lexer_flags.quote_is_transpose = false; - $1->mark_as_formal_parameters (); - $$ = $1; - } - | param_list1 ',' VARARGIN param_list_end - { - lexer_flags.quote_is_transpose = false; - $1->mark_as_formal_parameters (); - $1->mark_varargs (); - $$ = $1; - } - ; - -param_list1 : param_list_beg identifier - { $$ = new tree_parameter_list ($2); } - | param_list1 ',' identifier - { - $1->append ($3); - $$ = $1; + $$ = $2; } | param_list_beg error { @@ -1207,11 +1197,35 @@ $$ = 0; ABORT_PARSE; } - | param_list1 ',' error + ; + +param_list1 : // empty + { $$ = 0; } + | param_list2 + { + $1->mark_as_formal_parameters (); + $$ = $1; + } + | VARARGIN { - yyerror ("invalid parameter list"); - $$ = 0; - ABORT_PARSE; + tree_parameter_list *tmp = new tree_parameter_list (); + tmp->mark_varargs_only (); + $$ = tmp; + } + | param_list2 ',' VARARGIN + { + $1->mark_as_formal_parameters (); + $1->mark_varargs (); + $$ = $1; + } + ; + +param_list2 : identifier + { $$ = new tree_parameter_list ($1); } + | param_list2 ',' identifier + { + $1->append ($3); + $$ = $1; } ; @@ -1981,6 +1995,61 @@ return retval; } +// Make an anonymous function handle. + +static tree_constant * +make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) +{ + // XXX FIXME XXX -- need to get these from the location of the @ symbol. + + int l = -1; + int c = -1; + + tree_parameter_list *ret_list = 0; + + if (stmt && stmt->is_expression ()) + { + symbol_record *sr = curr_sym_tab->lookup ("__retval__", true); + + tree_expression *e = stmt->expression (); + + tree_identifier *id = new tree_identifier (sr); + + tree_simple_assignment *asn = new tree_simple_assignment (id, e); + + stmt->set_expression (asn); + + stmt->set_print_flag (false); + + // XXX FIXME XXX -- would like to delete old_stmt here or + // replace expression inside it with the new expression we just + // created so we don't have to create a new statement at all. + + id = new tree_identifier (sr); + + ret_list = new tree_parameter_list (id); + } + + tree_statement_list *body = new tree_statement_list (stmt); + + body->mark_as_function_body (); + + octave_user_function *fcn + = new octave_user_function (param_list, ret_list, body, curr_sym_tab); + + if (symtab_context.empty ()) + panic_impossible (); + + curr_sym_tab = symtab_context.top (); + symtab_context.pop (); + + octave_value fh (new octave_fcn_handle (fcn, "@")); + + tree_constant *retval = new tree_constant (fh, l, c); + + return retval; +} + // Build a binary expression. static tree_expression * diff -r ca6c86504105 -r 4fc993a4e072 src/pt-stmt.h --- a/src/pt-stmt.h Thu Aug 05 16:38:36 2004 +0000 +++ b/src/pt-stmt.h Fri Aug 06 03:17:13 2004 +0000 @@ -77,6 +77,14 @@ octave_comment_list *comment_text (void) { return comm; } + // Allow modification of this statement. Note that there is no + // checking. If you use these, are you sure you knwo what you are + // doing? + + void set_command (tree_command *c) { cmd = c; } + + void set_expression (tree_expression *e) { expr = e; } + void accept (tree_walker& tw); private: