Mercurial > hg > octave-terminal
changeset 206:1761d7a3770c
[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; };