Mercurial > hg > octave-nkf
diff src/variables.cc @ 1:78fd87e624cb
[project @ 1993-08-08 01:13:40 by jwe]
Initial revision
author | jwe |
---|---|
date | Sun, 08 Aug 1993 01:13:40 +0000 |
parents | |
children | 174de3807b61 |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/src/variables.cc @@ -0,0 +1,514 @@ +// variables.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include <sys/types.h> +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif +#include <ctype.h> +#include <iostream.h> + +#include "statdefs.h" +#include "tree-const.h" +#include "variables.h" +#include "symtab.h" +#include "error.h" +#include "utils.h" +#include "tree.h" + +// Symbol table for symbols at the top level. +symbol_table *top_level_sym_tab; + +// Symbol table for the current scope. +symbol_table *curr_sym_tab; + +// Symbol table for global symbols. +symbol_table *global_sym_tab; + +/* + * Is there a corresponding M-file that is newer than the symbol + * definition? + */ +int +symbol_out_of_date (symbol_record *sr) +{ + int status = 0; + if (sr != (symbol_record *) NULL) + { + tree *ans = sr->def (); + if (ans != NULL_TREE) + { + char *mf = ans->m_file_name (); + if (mf != (char *) NULL) + { + time_t tp = ans->time_parsed (); + status = is_newer (mf, tp); + } + } + } + return status; +} + +/* + * Force a symbol into the global symbol table. + */ +symbol_record * +force_global (char *name) +{ + symbol_record *retval = (symbol_record *) NULL; + + if (valid_identifier (name)) + { + symbol_record *sr; + sr = curr_sym_tab->lookup (name, 0, 0); + if (sr == (symbol_record *) NULL) + { + retval = global_sym_tab->lookup (name, 1, 0); + } + else if (sr->is_formal_parameter ()) + { + error ("formal parameter `%s' can't be made global", name); + } + else + { + retval = global_sym_tab->lookup (name, 1, 0); + retval->alias (sr); + curr_sym_tab->clear (name); + } + } + else + warning ("`%s' is invalid as an identifier", name); + + return retval; +} + +int +bind_variable (char *varname, tree_constant *val) +{ +// Look for the symbol in the current symbol table. If it's there, +// great. If not, don't insert it, but look for it in the global +// symbol table. If it's there, great. If not, insert it in the +// original current symbol table. + + symbol_record *sr; + sr = curr_sym_tab->lookup (varname, 0, 0); + if (sr == (symbol_record *) NULL) + { + sr = global_sym_tab->lookup (varname, 0, 0); + if (sr == (symbol_record *) NULL) + { + sr = curr_sym_tab->lookup (varname, 1); + } + } + + if (sr != (symbol_record *) NULL) + { + sr->define (val); + return 0; + } + else + return 1; +} + +int +bind_protected_variable (char *varname, tree_constant *val) +{ +// Look for the symbol in the current symbol table. If it's there, +// great. If not, don't insert it, but look for it in the global +// symbol table. If it's there, great. If not, insert it in the +// original current symbol table. + + symbol_record *sr; + sr = curr_sym_tab->lookup (varname, 0, 0); + if (sr == (symbol_record *) NULL) + { + sr = global_sym_tab->lookup (varname, 0, 0); + if (sr == (symbol_record *) NULL) + { + sr = curr_sym_tab->lookup (varname, 1); + } + } + + if (sr != (symbol_record *) NULL) + { + sr->unprotect (); + sr->define (val); + sr->protect (); + return 0; + } + else + return 1; +} + +/* + * Look for name first in current then in global symbol tables. If + * name is found and it refers to a string, return a new string + * containing its value. Otherwise, return NULL. + */ +char * +octave_string_variable (char *name) +{ + char *retval = (char *) NULL; + symbol_record *sr; + sr = curr_sym_tab->lookup (name, 0, 0); + if (sr == (symbol_record *) NULL) + { + sr = global_sym_tab->lookup (name, 0, 0); + if (sr == (symbol_record *) NULL) + return retval; + } + + tree *defn = sr->def (); + if (defn != NULL_TREE) + { + tree_constant val = defn->eval (0); + if (val.is_string_type ()) + { + char *s = val.string_value (); + if (s != (char *) NULL) + retval = strsave (s); + } + } + + return retval; +} + +/* + * Look for name first in current then in global symbol tables. If + * name is found and it refers to a real scalar, place the value in d + * and return 0. Otherwise, return -1. + */ +int +octave_real_scalar_variable (char *name, double& d) +{ + int status = -1; + symbol_record *sr; + sr = curr_sym_tab->lookup (name, 0, 0); + if (sr == (symbol_record *) NULL) + { + sr = global_sym_tab->lookup (name, 0, 0); + if (sr == (symbol_record *) NULL) + return status; + } + + tree *defn = sr->def (); + if (defn != NULL_TREE) + { + tree_constant val = defn->eval (0); + if (val.const_type () == tree_constant_rep::scalar_constant) + { + d = val.double_value (); + status = 0; + } + } + + return status; +} + +/* + * Extract a keyword and its value from a file. Input should look + * something like: + * + * #[ \t]*keyword[ \t]*:[ \t]*string-value\n + */ +int +extract_keyword (istream& is, char *keyword, char *value) +{ + char *ptr = value; + + int status = 0; + + char c; + while (is.get (c)) + { + if (c == '#') + { + while (is.get (c) && (c == ' ' || c == '\t' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + *ptr++ = c; + + while (is.get (c) && isalpha (c)) + *ptr++ = c; + + if (strncmp (value, keyword, strlen (keyword)) == 0) + { + ptr = value; + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + if (c != '\n') + { + *ptr++ = c; + while (is.get (c) && c != '\n') + *ptr++ = c; + } + *ptr = '\0'; + status = 1; + break; + } + } + } + return status; +} + +int +extract_keyword (istream& is, char *keyword, int& value) +{ + char buf [128]; + char *ptr = buf; + + int status = 0; + value = 0; + + char c; + while (is.get (c)) + { + if (c == '#') + { + while (is.get (c) && (c == ' ' || c == '\t' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + *ptr++ = c; + + while (is.get (c) && isalpha (c)) + *ptr++ = c; + + if (strncmp (buf, keyword, strlen (keyword)) == 0) + { + ptr = buf; + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + if (c != '\n') + is >> value; + if (is) + status = 1; + while (is.get (c) && c != '\n') + ; // Skip to beginning of next line; + break; + } + } + } + return status; +} + +/* + * Skip trailing white space and + */ +void +skip_comments (istream& is) +{ + char c = '\0'; + while (is.get (c)) + { + if (c == ' ' || c == '\t' || c == '\n') + ; // Skip whitespace on way to beginning of next line. + else + break; + } + + for (;;) + { + if (is && c == '#') + while (is.get (c) && c != '\n') + ; // Skip to beginning of next line, ignoring everything. + else + break; + } +} + +/* + * Is `s' a valid identifier? + */ +int +valid_identifier (char *s) +{ + if (s == (char *) NULL || ! (isalnum (*s) || *s == '_')) + return 0; + + while (*++s != '\0') + if (! (isalnum (*s) || *s == '_')) + return 0; + + return 1; +} + +/* + * See if the identifier is in scope. + */ +int +identifier_exists (char *name) +{ + int status = 0; + + if (curr_sym_tab->lookup (name, 0, 0) != (symbol_record *) NULL + || global_sym_tab->lookup (name, 0, 0) != (symbol_record *) NULL) + status = 1; + else + { + char *path = m_file_in_path (name); + if (path != (char *) NULL) + { + delete [] path; + status = 2; + } + else + { + struct stat buf; + if (stat (name, &buf) == 0 && S_ISREG (buf.st_mode)) + status = 2; + } + + } + return status; +} + +/* + * Is this tree_constant a valid function? + */ +tree * +is_valid_function (tree_constant& arg, char *warn_for, int warn = 0) +{ + tree *ans = NULL_TREE; + + if (! arg.is_string_type ()) + { + if (warn) + message (warn_for, "expecting function name as argument"); + return ans; + } + + char *fcn_name = arg.string_value (); + symbol_record *sr = global_sym_tab->lookup (fcn_name, 0, 0); + + if (sr == (symbol_record *) NULL) + { + sr = global_sym_tab->lookup (fcn_name, 1, 0); + tree_identifier tmp (sr); + tmp.parse_m_file (0); + } + else if (symbol_out_of_date (sr)) + { + tree_identifier tmp (sr); + tmp.parse_m_file (0); + } + + ans = sr->def (); + if (ans == NULL_TREE || ! sr->is_function ()) + { + if (warn) + message (warn_for, "the symbol `%s' is not valid as a function", + fcn_name); + ans = NULL_TREE; + } + + return ans; +} + +/* + * Does this function take the right number of arguments? + */ +int +takes_correct_nargs (tree *fcn, int expected_nargin, char *warn_for, + int warn = 0) +{ + int nargs = fcn->max_expected_args () - 1; + int e_nargs = expected_nargin - 1; + if (nargs != e_nargs) + { + if (warn) + message (warn_for, "expecting function to take %d argument%c", + e_nargs, s_plural (e_nargs)); + return 0; + } + return 1; +} + +char ** +make_name_list (void) +{ + int key_len = 0; + int glb_len = 0; + int top_len = 0; + int lcl_len = 0; + int mfl_len = 0; + + char **key = (char **) NULL; + char **glb = (char **) NULL; + char **top = (char **) NULL; + char **lcl = (char **) NULL; + char **mfl = (char **) NULL; + + key = names (keyword_help (), key_len); + glb = global_sym_tab->list (glb_len); + top = top_level_sym_tab->list (top_len); + if (top_level_sym_tab != curr_sym_tab) + lcl = curr_sym_tab->list (lcl_len); + mfl = get_m_file_names (mfl_len, 1); + + int total_len = key_len + glb_len + top_len + lcl_len + mfl_len; + + char **list = new char * [total_len+1]; + + int j = 0; + int i = 0; + for (i = 0; i < key_len; i++) + list[j++] = key[i]; + + for (i = 0; i < glb_len; i++) + list[j++] = glb[i]; + + for (i = 0; i < top_len; i++) + list[j++] = top[i]; + + for (i = 0; i < lcl_len; i++) + list[j++] = lcl[i]; + + for (i = 0; i < mfl_len; i++) + list[j++] = mfl[i]; + + list[j] = (char *) NULL; + + delete [] key; + delete [] glb; + delete [] top; + delete [] lcl; + delete [] mfl; + + return list; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/