1 /* PSPP - computes sample statistics.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3 Written by Ben Pfaff <blp@gnu.org>.
5 This program is free software; you can redistribute it and/or
6 modify it under the terms of the GNU General Public License as
7 published by the Free Software Foundation; either version 2 of the
8 License, or (at your option) any later version.
10 This program is distributed in the hope that it will be useful, but
11 WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
38 #define _(msgid) gettext (msgid)
39 #define N_(msgid) msgid
46 /* Global variables. */
48 extern const char *keywords[T_N_KEYWORDS + 1];
54 /* T_POS_NUM, T_NEG_NUM: the token's value. */
57 /* T_ID: the identifier. */
58 char tokid[LONG_NAME_LEN + 1];
60 /* T_ID, T_STRING: token string value.
61 For T_ID, this is not truncated as is tokid. */
64 /* Static variables. */
66 /* Pointer to next token in getl_buf. */
69 /* Nonzero only if this line ends with a terminal dot. */
72 /* Nonzero only if the last token returned was T_STOP. */
75 /* If nonzero, next token returned by lex_get().
76 Used only in exceptional circumstances. */
78 static struct string put_tokstr;
79 static double put_tokval;
81 static void unexpected_eof (void);
82 static void convert_numeric_string_to_char_string (int type);
83 static int parse_string (int type);
86 static void dump_token (void);
91 /* Initializes the lexer. */
95 ds_init (&put_tokstr, 64);
103 ds_destroy(&put_tokstr);
107 /* Common functions. */
109 /* Copies put_token, put_tokstr, put_tokval into token, tokstr,
110 tokval, respectively, and sets tokid appropriately. */
114 assert (put_token != 0);
116 ds_replace (&tokstr, ds_c_str (&put_tokstr));
117 str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
122 /* Copies token, tokstr, tokval into put_token, put_tokstr,
123 put_tokval respectively. */
128 ds_replace (&put_tokstr, ds_c_str (&tokstr));
132 /* Parses a single token, setting appropriate global variables to
133 indicate the token's attributes. */
137 /* If a token was pushed ahead, return it. */
152 /* Skip whitespace. */
158 while (isspace ((unsigned char) *prog))
172 else if (!lex_get_line ())
193 /* Actually parse the token. */
200 case '0': case '1': case '2': case '3': case '4':
201 case '5': case '6': case '7': case '8': case '9':
205 /* `-' can introduce a negative number, or it can be a
206 token by itself. If it is not followed by a digit or a
207 decimal point, it is definitely not a number.
208 Otherwise, it might be either, but most of the time we
209 want it as a number. When the syntax calls for a `-'
210 token, lex_negative_to_dash() must be used to break
211 negative numbers into two tokens. */
214 ds_putc (&tokstr, *prog++);
215 while (isspace ((unsigned char) *prog))
218 if (!isdigit ((unsigned char) *prog) && *prog != '.')
228 /* Parse the number, copying it into tokstr. */
229 while (isdigit ((unsigned char) *prog))
230 ds_putc (&tokstr, *prog++);
233 ds_putc (&tokstr, *prog++);
234 while (isdigit ((unsigned char) *prog))
235 ds_putc (&tokstr, *prog++);
237 if (*prog == 'e' || *prog == 'E')
239 ds_putc (&tokstr, *prog++);
240 if (*prog == '+' || *prog == '-')
241 ds_putc (&tokstr, *prog++);
242 while (isdigit ((unsigned char) *prog))
243 ds_putc (&tokstr, *prog++);
246 /* Parse as floating point. */
247 tokval = strtod (ds_c_str (&tokstr), &tail);
250 msg (SE, _("%s does not form a valid number."),
255 ds_putc (&tokstr, '0');
262 token = parse_string (0);
265 case '(': case ')': case ',': case '=': case '+': case '/':
285 else if (*prog == '>')
324 case 'a': case 'b': case 'c': case 'd': case 'e':
325 case 'f': case 'g': case 'h': case 'i': case 'j':
326 case 'k': case 'l': case 'm': case 'n': case 'o':
327 case 'p': case 'q': case 'r': case 's': case 't':
328 case 'u': case 'v': case 'w': case 'x': case 'y':
330 case 'A': case 'B': case 'C': case 'D': case 'E':
331 case 'F': case 'G': case 'H': case 'I': case 'J':
332 case 'K': case 'L': case 'M': case 'N': case 'O':
333 case 'P': case 'Q': case 'R': case 'S': case 'T':
334 case 'U': case 'V': case 'W': case 'X': case 'Y':
336 case '#': case '$': case '@':
337 /* Strings can be specified in binary, octal, or hex using
338 this special syntax. */
339 if (prog[1] == '\'' || prog[1] == '"')
341 static const char special[3] = "box";
344 p = strchr (special, tolower ((unsigned char) *prog));
348 token = parse_string (p - special + 1);
353 /* Copy id to tokstr. */
354 ds_putc (&tokstr, *prog++);
355 while (CHAR_IS_IDN (*prog))
356 ds_putc (&tokstr, *prog++);
358 /* Copy tokstr to tokid, possibly truncating it.*/
359 str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
361 /* Determine token type. */
362 token = lex_id_to_token (ds_c_str (&tokstr), ds_length (&tokstr));
366 if (isgraph ((unsigned char) *prog))
367 msg (SE, _("Bad character in input: `%c'."), *prog++);
369 msg (SE, _("Bad character in input: `\\%o'."), *prog++);
381 /* Reports an error to the effect that subcommand SBC may only be
384 lex_sbc_only_once (const char *sbc)
386 msg (SE, _("Subcommand %s may only be specified once."), sbc);
389 /* Reports an error to the effect that subcommand SBC is
392 lex_sbc_missing (const char *sbc)
394 lex_error (_("missing required subcommand %s"), sbc);
397 /* Prints a syntax error message containing the current token and
398 given message MESSAGE (if non-null). */
400 lex_error (const char *message, ...)
405 token_rep = lex_token_representation ();
407 strcpy (where, "end of file");
408 else if (token == '.')
409 strcpy (where, "end of command");
411 snprintf (where, sizeof where, "`%s'", token_rep);
419 va_start (args, message);
420 vsnprintf (buf, 1024, message, args);
423 msg (SE, _("Syntax error %s at %s."), buf, where);
426 msg (SE, _("Syntax error at %s."), where);
429 /* Checks that we're at end of command.
430 If so, returns a successful command completion code.
431 If not, flags a syntax error and returns an error command
434 lex_end_of_command (void)
438 lex_error (_("expecting end of command"));
439 return CMD_TRAILING_GARBAGE;
445 /* Token testing functions. */
447 /* Returns true if the current token is a number. */
451 return token == T_POS_NUM || token == T_NEG_NUM;
454 /* Returns the value of the current token, which must be a
455 floating point number. */
459 assert (lex_is_number ());
463 /* Returns true iff the current token is an integer. */
465 lex_is_integer (void)
467 return (lex_is_number ()
468 && tokval != NOT_LONG
469 && tokval >= LONG_MIN
470 && tokval <= LONG_MAX
471 && floor (tokval) == tokval);
474 /* Returns the value of the current token, which must be an
479 assert (lex_is_integer ());
483 /* Token matching functions. */
485 /* If TOK is the current token, skips it and returns nonzero.
486 Otherwise, returns zero. */
499 /* If the current token is the identifier S, skips it and returns
500 nonzero. The identifier may be abbreviated to its first three
502 Otherwise, returns zero. */
504 lex_match_id (const char *s)
506 if (token == T_ID && lex_id_match (s, tokid))
515 /* If the current token is integer N, skips it and returns nonzero.
516 Otherwise, returns zero. */
518 lex_match_int (int x)
520 if (lex_is_integer () && lex_integer () == x)
529 /* Forced matches. */
531 /* If this token is identifier S, fetches the next token and returns
533 Otherwise, reports an error and returns zero. */
535 lex_force_match_id (const char *s)
537 if (token == T_ID && lex_id_match (s, tokid))
544 lex_error (_("expecting `%s'"), s);
549 /* If the current token is T, skips the token. Otherwise, reports an
550 error and returns from the current function with return value 0. */
552 lex_force_match (int t)
561 lex_error (_("expecting `%s'"), lex_token_name (t));
566 /* If this token is a string, does nothing and returns nonzero.
567 Otherwise, reports an error and returns zero. */
569 lex_force_string (void)
571 if (token == T_STRING)
575 lex_error (_("expecting string"));
580 /* If this token is an integer, does nothing and returns nonzero.
581 Otherwise, reports an error and returns zero. */
585 if (lex_is_integer ())
589 lex_error (_("expecting integer"));
594 /* If this token is a number, does nothing and returns nonzero.
595 Otherwise, reports an error and returns zero. */
599 if (lex_is_number ())
603 lex_error (_("expecting number"));
608 /* If this token is an identifier, does nothing and returns nonzero.
609 Otherwise, reports an error and returns zero. */
617 lex_error (_("expecting identifier"));
621 /* Weird token functions. */
623 /* Returns the first character of the next token, except that if the
624 next token is not an identifier, the character returned will not be
625 a character that can begin an identifier. Specifically, the
626 hexstring lead-in X' causes lookahead() to return '. Note that an
627 alphanumeric return value doesn't guarantee an ID token, it could
628 also be a reserved-word token. */
630 lex_look_ahead (void)
642 while (isspace ((unsigned char) *prog))
649 else if (!lex_get_line ())
656 if ((toupper ((unsigned char) *prog) == 'X'
657 || toupper ((unsigned char) *prog) == 'B')
658 && (prog[1] == '\'' || prog[1] == '"'))
665 /* Makes the current token become the next token to be read; the
666 current token is set to T. */
674 /* Makes the current token become the next token to be read; the
675 current token is set to the identifier ID. */
677 lex_put_back_id (const char *id)
679 assert (lex_id_to_token (id, strlen (id)) == T_ID);
682 ds_replace (&tokstr, id);
683 str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
686 /* Weird line processing functions. */
688 /* Returns the entire contents of the current line. */
690 lex_entire_line (void)
692 return ds_c_str (&getl_buf);
695 /* As lex_entire_line(), but only returns the part of the current line
696 that hasn't already been tokenized.
697 If END_DOT is non-null, stores nonzero into *END_DOT if the line
698 ends with a terminal dot, or zero if it doesn't. */
700 lex_rest_of_line (int *end_dot)
707 /* Causes the rest of the current input line to be ignored for
708 tokenization purposes. */
710 lex_discard_line (void)
712 prog = ds_end (&getl_buf);
716 /* Sets the current position in the current line to P, which must be
719 lex_set_prog (char *p)
724 /* Weird line reading functions. */
726 /* Read a line for use by the tokenizer. */
730 if (!getl_read_line ())
733 lex_preprocess_line ();
737 /* Preprocesses getl_buf by removing comments, stripping trailing
738 whitespace and the terminal dot, and removing leading indentors. */
740 lex_preprocess_line (void)
742 /* Strips comments. */
744 /* getl_buf iterator. */
747 /* Nonzero inside a comment. */
750 /* Nonzero inside a quoted string. */
753 /* Remove C-style comments begun by slash-star and terminated by
754 star-slash or newline. */
756 for (cp = ds_c_str (&getl_buf); *cp; )
758 /* If we're not commented out, toggle quoting. */
763 else if (*cp == '\'' || *cp == '"')
767 /* If we're not quoting, toggle commenting. */
770 if (cp[0] == '/' && cp[1] == '*')
777 else if (cp[0] == '*' && cp[1] == '/' && comment)
786 /* Check commenting. */
794 /* Strip trailing whitespace and terminal dot. */
796 size_t len = ds_length (&getl_buf);
797 char *s = ds_c_str (&getl_buf);
799 /* Strip trailing whitespace. */
800 while (len > 0 && isspace ((unsigned char) s[len - 1]))
803 /* Check for and remove terminal dot. */
804 if (len > 0 && s[len - 1] == get_endcmd ())
809 else if (len == 0 && get_nullline() )
815 ds_truncate (&getl_buf, len);
818 /* In batch mode, strip leading indentors and insert a terminal dot
820 if (getl_interactive != 2 && getl_mode == GETL_MODE_BATCH)
822 char *s = ds_c_str (&getl_buf);
824 if (s[0] == '+' || s[0] == '-' || s[0] == '.')
826 else if (s[0] && !isspace ((unsigned char) s[0]))
830 prog = ds_c_str (&getl_buf);
835 /* Returns the name of a token in a static buffer. */
837 lex_token_name (int token)
839 if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
840 return keywords[token - T_FIRST_KEYWORD];
852 /* Returns an ASCII representation of the current token as a
853 malloc()'d string. */
855 lex_token_representation (void)
864 return xstrdup (ds_c_str (&tokstr));
872 for (sp = ds_c_str (&tokstr); sp < ds_end (&tokstr); sp++)
873 if (!isprint ((unsigned char) *sp))
879 token_rep = xmalloc (2 + ds_length (&tokstr) * 2 + 1 + 1);
887 for (sp = ds_c_str (&tokstr); *sp; )
891 *dp++ = (unsigned char) *sp++;
894 for (sp = ds_c_str (&tokstr); sp < ds_end (&tokstr); sp++)
896 *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
897 *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
907 token_rep = xmalloc (1);
912 return xstrdup ("**");
915 if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
916 return xstrdup (keywords [token - T_FIRST_KEYWORD]);
919 token_rep = xmalloc (2);
920 token_rep[0] = token;
929 /* Really weird functions. */
931 /* Most of the time, a `-' is a lead-in to a negative number. But
932 sometimes it's actually part of the syntax. If a dash can be part
933 of syntax then this function is called to rip it off of a
936 lex_negative_to_dash (void)
938 if (token == T_NEG_NUM)
942 ds_replace (&tokstr, ds_c_str (&tokstr) + 1);
948 /* We're not at eof any more. */
955 /* Skip a COMMENT command. */
957 lex_skip_comment (void)
961 if (!lex_get_line ())
968 if (put_token == '.')
971 prog = ds_end (&getl_buf);
977 /* Private functions. */
979 /* Unexpected end of file. */
981 unexpected_eof (void)
983 msg (FE, _("Unexpected end of file."));
986 /* When invoked, tokstr contains a string of binary, octal, or hex
987 digits, for values of TYPE of 0, 1, or 2, respectively. The string
988 is converted to characters having the specified values. */
990 convert_numeric_string_to_char_string (int type)
992 static const char *base_names[] = {N_("binary"), N_("octal"), N_("hex")};
993 static const int bases[] = {2, 8, 16};
994 static const int chars_per_byte[] = {8, 3, 2};
996 const char *const base_name = base_names[type];
997 const int base = bases[type];
998 const int cpb = chars_per_byte[type];
999 const int nb = ds_length (&tokstr) / cpb;
1003 assert (type >= 0 && type <= 2);
1005 if (ds_length (&tokstr) % cpb)
1006 msg (SE, _("String of %s digits has %d characters, which is not a "
1008 gettext (base_name), ds_length (&tokstr), cpb);
1010 p = ds_c_str (&tokstr);
1011 for (i = 0; i < nb; i++)
1017 for (j = 0; j < cpb; j++, p++)
1021 if (*p >= '0' && *p <= '9')
1025 static const char alpha[] = "abcdef";
1026 const char *q = strchr (alpha, tolower ((unsigned char) *p));
1035 msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
1037 value = value * base + v;
1040 ds_c_str (&tokstr)[i] = (unsigned char) value;
1043 ds_truncate (&tokstr, nb);
1046 /* Parses a string from the input buffer into tokstr. The input
1047 buffer pointer prog must point to the initial single or double
1048 quote. TYPE is 0 if it is an ordinary string, or 1, 2, or 3 for a
1049 binary, octal, or hexstring, respectively. Returns token type. */
1051 parse_string (int type)
1053 /* Accumulate the entire string, joining sections indicated by +
1057 /* Single or double quote. */
1060 /* Accumulate section. */
1063 /* Check end of line. */
1066 msg (SE, _("Unterminated string constant."));
1070 /* Double quote characters to embed them in strings. */
1079 ds_putc (&tokstr, *prog++);
1083 /* Skip whitespace after final quote mark. */
1088 while (isspace ((unsigned char) *prog))
1096 if (!lex_get_line ())
1100 /* Skip plus sign. */
1105 /* Skip whitespace after plus sign. */
1110 while (isspace ((unsigned char) *prog))
1118 if (!lex_get_line ())
1122 /* Ensure that a valid string follows. */
1123 if (*prog != '\'' && *prog != '"')
1125 msg (SE, "String expected following `+'.");
1130 /* We come here when we've finished concatenating all the string sections
1131 into one large string. */
1134 convert_numeric_string_to_char_string (type - 1);
1136 if (ds_length (&tokstr) > 255)
1138 msg (SE, _("String exceeds 255 characters in length (%d characters)."),
1139 ds_length (&tokstr));
1140 ds_truncate (&tokstr, 255);
1148 for (i = 0; i < ds_length (&tokstr); i++)
1149 if (ds_c_str (&tokstr)[i] == 0)
1153 msg (SE, _("Sorry, literal strings may not contain null "
1154 "characters. Replacing with spaces."));
1157 ds_c_str (&tokstr)[i] = ' ';
1165 /* Reads one token from the lexer and writes a textual representation
1166 on stdout for debugging purposes. */
1174 getl_location (&curfn, &curln);
1176 fprintf (stderr, "%s:%d\t", curfn, curln);
1182 fprintf (stderr, "ID\t%s\n", tokid);
1187 fprintf (stderr, "NUM\t%f\n", tokval);
1191 fprintf (stderr, "STRING\t\"%s\"\n", ds_c_str (&tokstr));
1195 fprintf (stderr, "STOP\n");
1199 fprintf (stderr, "MISC\tEXP\"");
1203 fprintf (stderr, "MISC\tEOF\n");
1207 if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
1208 fprintf (stderr, "KEYWORD\t%s\n", lex_token_name (token));
1210 fprintf (stderr, "PUNCT\t%c\n", token);
1214 #endif /* DUMP_TOKENS */