Mercurial > hg > octave-lyh

changeset 206:1761d7a3770c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1993-11-10 21:00:31 by jwe]
author jwe
date Wed, 10 Nov 1993 21:00:31 +0000
parents 76fa9345e0dc
children c8863fc976ee
files src/builtins.cc src/g-builtins.cc src/g-builtins.h src/lex.l src/octave.cc src/parse.y src/pt-const.cc src/tc-assign.cc src/toplev.h src/tree.h.old
diffstat 10 files changed, 97 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/src/builtins.cc
+++ b/src/builtins.cc
@@ -429,6 +429,10 @@
   { "min", 3, 2, builtin_min,
     "min (x): minimum value(s) of a vector (matrix)", },
 
+  { "get_next_arg", 1, 1, builtin_get_next_arg,
+    "get_next_arg (): return next argument in function taking varible\n\
+number of parameters", },
+
   { "npsol", 11, 3, builtin_npsol,
 #if defined (NPSOL_MISSING)
     "This function requires NPSOL, which is not freely\n\
--- a/src/g-builtins.cc
+++ b/src/g-builtins.cc
@@ -818,6 +818,35 @@
 }
 
 /*
+ * Variable argument lists.
+ */
+tree_constant *
+builtin_get_next_arg (const tree_constant *args, int nargin, int nargout)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+  if (nargin == 1)
+    {
+      if (curr_function != (tree_function *) NULL)
+	{
+	  if (curr_function->takes_varargs ())
+	    {
+	      retval = new tree_constant [2];
+	      retval[0] = curr_function->get_next_arg ();
+	    }
+	  else
+	    error ("next_arg only valid within function taking\
+ variable number of arguments");
+	}
+      else
+	error ("next_arg only valid within function body");
+    }
+  else
+    print_usage ("get_next_arg");
+
+  return retval;
+}
+
+/*
  * Get the value of an environment variable.
  */
 tree_constant *
--- a/src/g-builtins.h
+++ b/src/g-builtins.h
@@ -76,6 +76,7 @@
 extern tree_constant *builtin_fsolve (const tree_constant *, int, int);
 extern tree_constant *builtin_fsqp (const tree_constant *, int, int);
 extern tree_constant *builtin_ftell (const tree_constant *, int, int);
+extern tree_constant *builtin_get_next_arg (const tree_constant *, int, int);
 extern tree_constant *builtin_getenv (const tree_constant *, int, int);
 extern tree_constant *builtin_givens (const tree_constant *, int, int);
 extern tree_constant *builtin_hess (const tree_constant *, int, int);
--- a/src/lex.l
+++ b/src/lex.l
@@ -488,13 +488,8 @@
 
 {S}*		{ current_input_column += yyleng; }
 
-{EL}{S}*\n	{
-
-// Line continuation.
-
-		  promptflag--;
-		  current_input_column = 1;
-		}
+{EL}{S}*\n	{ promptflag--; current_input_column = 1; }
+{EL}		{ return ELLIPSIS; }
 
 <<EOF>>		TOK_RETURN (END_OF_INPUT);
 
--- a/src/octave.cc
+++ b/src/octave.cc
@@ -115,6 +115,9 @@
 // Current command to execute.
 tree *global_command = (tree *) NULL;
 
+// Pointer to function that is currently being evaluated.
+tree_function *curr_function = (tree_function *) NULL;
+
 // Top level context (?)
 jmp_buf toplevel;
 
--- a/src/parse.y
+++ b/src/parse.y
@@ -174,7 +174,9 @@
 
 // Other tokens.
 %token FCN SCREW_TWO
-%token END_OF_INPUT GLOBAL
+%token GLOBAL
+%token ELLIPSIS
+%token END_OF_INPUT
 %token USING TITLE WITH COLON OPEN_BRACE CLOSE_BRACE
 
 // Nonterminals we construct.
@@ -970,6 +972,13 @@
 		    tmp->mark_as_formal_parameters ();
 		    $$ = tmp;
 		  }
+		| param_list1 ',' ELLIPSIS ')'
+		  {
+		    tree_parameter_list *tmp = $1->reverse ();
+		    tmp->mark_as_formal_parameters ();
+		    tmp->mark_varargs ();
+		    $$ = tmp;
+		  }
 
 param_list1	: '(' identifier
 		  { $$ = new tree_parameter_list ($2); }
@@ -977,13 +986,15 @@
 		  { $$ = $1->chain ($3); }
 		| '(' error
 		  {
-		    error ("parameter lists may only contain identifiers");
-		    $$ = (tree_parameter_list *) NULL;
+		    yyerror ("parse error");
+		    error ("invalid parameter list");
+		    ABORT_PARSE;
 		  }
 		| param_list1 ',' error
 		  {
-		    error ("parameter lists may only contain identifiers");
-		    $$ = (tree_parameter_list *) NULL;
+		    yyerror ("parse error");
+		    error ("invalid parameter list");
+		    ABORT_PARSE;
 		  }
 		;
 
--- a/src/pt-const.cc
+++ b/src/pt-const.cc
@@ -1543,8 +1543,11 @@
 {
   switch (type_tag)
     {
+    case scalar_constant:
+      return Matrix (scalar);
     case matrix_constant:
       return *matrix;
+    case complex_scalar_constant:
     case complex_matrix_constant:
       {
 	int flag = user_pref.ok_to_lose_imaginary_part;
@@ -1552,7 +1555,14 @@
 	  warning ("implicit conversion of complex matrix to real matrix"); 
 
 	if (flag != 0)
-	  return real (*complex_matrix);
+	  {
+	    if (type_tag == complex_scalar_constant)
+	      return Matrix (real (*complex_scalar));
+	    else if (type_tag == complex_matrix_constant)
+	      return real (*complex_matrix);
+	    else
+	      panic_impossible ();
+	  }
 	else
 	  error ("implicit conversion of complex matrix to real matrix not allowed");
 	jump_to_top_level ();
--- a/src/tc-assign.cc
+++ b/src/tc-assign.cc
@@ -392,23 +392,29 @@
   int nr = rows ();
   int nc = columns ();
 
-  if (nr == 1 && nc == 1)  // No orientation to preserve
+  if ((nr == 1 && nc == 1) || nr == 0 || nc == 0)  // No orientation.
     {
-      if (! ( ilen == rhs_nr || ilen == rhs_nc))
-	error ("A(%s) = X: X and %s must have the same number of\
- elements", rm, rm); 
+      if (! (ilen == rhs_nr || ilen == rhs_nc))
+	{
+	  error ("A(%s) = X: X and %s must have the same number of elements",
+		 rm, rm);
+	}
     }
-  else if (nr == 1)  // Preserve current row orientation
+  else if (nr == 1)  // Preserve current row orientation.
     {
       if (! (rhs_nr == 1 && rhs_nc == ilen))
-	error ("A(%s) = X: where A is a row vector, X must also be a\
- row vector with the same number of elements as %s", rm, rm); 
+	{
+	  error ("A(%s) = X: where A is a row vector, X must also be a", rm);
+	  error ("row vector with the same number of elements as %s", rm);
+	}
     }
-  else if (nc == 1)  // Preserve current column orientation
+  else if (nc == 1)  // Preserve current column orientation.
     {
       if (! (rhs_nc == 1 && rhs_nr == ilen))
-	error ("A(%s) = X: where A is a column vector, X must also\
- be a column vector with the same number of elements as %s", rm, rm); 
+	{
+	  error ("A(%s) = X: where A is a column vector, X must also be", rm);
+	  error ("a column vector with the same number of elements as %s", rm);
+	}
     }
   else
     panic_impossible ();
--- a/src/toplev.h
+++ b/src/toplev.h
@@ -27,6 +27,7 @@
 #include <stdio.h>
 
 class tree;
+class tree_function;
 
 // Tell g++ that clean_up_and_exit doesn't return;
 
@@ -78,6 +79,9 @@
 // Current command to execute.
 extern tree *global_command;
 
+// Pointer to function that is currently being evaluated.
+extern tree_function *curr_function;
+
 #endif
 
 /*
--- a/src/tree.h.old
+++ b/src/tree.h.old
@@ -251,6 +251,9 @@
   void mark_as_system_m_file (void);
   int is_system_m_file (void) const;
 
+  int takes_varargs (void) const;
+  tree_constant get_next_arg (void);
+
   void stash_function_name (char *s);
   char *function_name (void);
 
@@ -277,6 +280,10 @@
   char *fcn_name;
   time_t t_parsed;
   int system_m_file;
+  int varargs_ok;
+  const tree_constant *args_passed;
+  int num_args_passed;
+  int curr_arg_number;
 };
 
 /*
@@ -556,6 +563,9 @@
 
   void mark_as_formal_parameters (void);
 
+  void mark_varargs (void);
+  int takes_varargs (void) const;
+
   tree_identifier *define (tree_constant *t);
 
   tree_parameter_list *next_elem (void);
@@ -563,6 +573,7 @@
   tree_constant eval (int print);
 
  private:
+  int marked_for_varargs;
   tree_identifier *param;
   tree_parameter_list *next;
 };