Mercurial > octave-nkf

changeset 4935:4fc993a4e072

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2004-08-06 03:17:12 by jwe]
author jwe
date Fri, 06 Aug 2004 03:17:13 +0000
parents ca6c86504105
children e63617efbd3f
files src/ChangeLog src/Makefile.in src/ov-fcn-handle.cc src/parse.y src/pt-stmt.h
diffstat 5 files changed, 135 insertions(+), 42 deletions(-) [+]
line wrap: on
line diff
--- 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  <jwe@octave.org>
+
+	* 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  <dbateman@free.fr>
 
 	* ov.cc (octave_value::fcn_inline_value): New virtual function.
--- 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)
 
--- 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 == "@<anonymous>")
+		    m.assign ("file", "none");
+		  else
+		    m.assign ("file", "built-in function");
+		}
 	      else
 		m.assign ("file", nm);
 
--- 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 <comment_type> stash_comment function_beg
 %type <sep_type> sep_no_nl opt_sep_no_nl sep opt_sep
 %type <tree_type> input
-%type <tree_constant_type> constant magic_colon
+%type <tree_constant_type> constant magic_colon anon_fcn_handle
 %type <tree_fcn_handle_type> fcn_handle
 %type <tree_matrix_type> matrix_rows matrix_rows1
 %type <tree_cell_type> cell_rows cell_rows1
@@ -445,7 +450,7 @@
 %type <tree_colon_expression_type> colon_expr1
 %type <tree_argument_list_type> arg_list word_list assign_lhs
 %type <tree_argument_list_type> cell_or_matrix_row
-%type <tree_parameter_list_type> param_list param_list1
+%type <tree_parameter_list_type> param_list param_list1 param_list2
 %type <tree_parameter_list_type> return_list return_list1
 %type <tree_command_type> command select_command loop_command
 %type <tree_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, "@<anonymous>"));
+
+  tree_constant *retval = new tree_constant (fh, l, c);
+
+  return retval;
+}
+
 // Build a binary expression.
 
 static tree_expression *
--- 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: