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., 59 Temple Place - Suite 330, Boston, MA
42 /* Global variables. */
47 /* T_NUM: the token's value. */
50 /* T_ID: the identifier. */
53 /* T_ID, T_STRING: token string value.
54 For T_ID, this is not truncated to 8 characters as is tokid. */
57 /* Static variables. */
59 /* Table of keywords. */
60 static const char *keywords[T_N_KEYWORDS + 1] =
63 "EQ", "GE", "GT", "LE", "LT", "NE",
64 "ALL", "BY", "TO", "WITH",
68 /* Pointer to next token in getl_buf. */
71 /* Nonzero only if this line ends with a terminal dot. */
74 /* Nonzero only if the last token returned was T_EOF. */
77 /* If nonzero, next token returned by lex_get().
78 Used only in exceptional circumstances. */
81 static void unexpected_eof (void);
82 static inline int check_id (const char *id, size_t len);
83 static void convert_numeric_string_to_char_string (int type);
84 static int parse_string (int type);
87 static void dump_token (void);
92 /* Initializes the lexer. */
100 /* Common functions. */
102 /* Parses a single token, setting appropriate global variables to
103 indicate the token's attributes. */
107 /* If a token was pushed ahead, return it. */
123 /* Skip whitespace. */
129 while (isspace ((unsigned char) *prog))
143 else if (!lex_get_line ())
165 /* Actually parse the token. */
172 case '0': case '1': case '2': case '3': case '4':
173 case '5': case '6': case '7': case '8': case '9':
177 /* `-' can introduce a negative number, or it can be a
178 token by itself. If it is not followed by a digit or a
179 decimal point, it is definitely not a number.
180 Otherwise, it might be either, but most of the time we
181 want it as a number. When the syntax calls for a `-'
182 token, lex_negative_to_dash() must be used to break
183 negative numbers into two tokens. */
186 ds_putchar (&tokstr, *prog++);
187 while (isspace ((unsigned char) *prog))
190 if (!isdigit ((unsigned char) *prog) && *prog != '.')
197 /* Parse the number, copying it into tokstr. */
198 while (isdigit ((unsigned char) *prog))
199 ds_putchar (&tokstr, *prog++);
202 ds_putchar (&tokstr, *prog++);
203 while (isdigit ((unsigned char) *prog))
204 ds_putchar (&tokstr, *prog++);
206 if (*prog == 'e' || *prog == 'E')
208 ds_putchar (&tokstr, *prog++);
209 if (*prog == '+' || *prog == '-')
210 ds_putchar (&tokstr, *prog++);
211 while (isdigit ((unsigned char) *prog))
212 ds_putchar (&tokstr, *prog++);
215 /* Parse as floating point. */
216 tokval = strtod (ds_value (&tokstr), &tail);
219 msg (SE, _("%s does not form a valid number."),
224 ds_putchar (&tokstr, '0');
232 token = parse_string (0);
235 case '(': case ')': case ',': case '=': case '+': case '/':
255 else if (*prog == '>')
294 case 'a': case 'b': case 'c': case 'd': case 'e':
295 case 'f': case 'g': case 'h': case 'i': case 'j':
296 case 'k': case 'l': case 'm': case 'n': case 'o':
297 case 'p': case 'q': case 'r': case 's': case 't':
298 case 'u': case 'v': case 'w': case 'x': case 'y':
300 case 'A': case 'B': case 'C': case 'D': case 'E':
301 case 'F': case 'G': case 'H': case 'I': case 'J':
302 case 'K': case 'L': case 'M': case 'N': case 'O':
303 case 'P': case 'Q': case 'R': case 'S': case 'T':
304 case 'U': case 'V': case 'W': case 'X': case 'Y':
306 case '#': case '$': case '@':
307 /* Strings can be specified in binary, octal, or hex using
308 this special syntax. */
309 if (prog[1] == '\'' || prog[1] == '"')
311 static const char special[3] = "box";
314 p = strchr (special, tolower ((unsigned char) *prog));
318 token = parse_string (p - special + 1);
323 /* Copy id to tokstr. */
324 ds_putchar (&tokstr, toupper ((unsigned char) *prog++));
325 while (CHAR_IS_IDN (*prog))
326 ds_putchar (&tokstr, toupper ((unsigned char) *prog++));
328 /* Copy tokstr to tokid, truncating it to 8 characters. */
329 strncpy (tokid, ds_value (&tokstr), 8);
332 token = check_id (ds_value (&tokstr), ds_length (&tokstr));
336 if (isgraph ((unsigned char) *prog))
337 msg (SE, _("Bad character in input: `%c'."), *prog++);
339 msg (SE, _("Bad character in input: `\\%o'."), *prog++);
351 /* Prints a syntax error message containing the current token and
352 given message MESSAGE (if non-null). */
354 lex_error (const char *message, ...)
358 token_rep = lex_token_representation ();
359 if (token_rep[0] == 0)
360 msg (SE, _("Syntax error at end of file."));
366 va_start (args, message);
367 vsnprintf (buf, 1024, message, args);
370 msg (SE, _("Syntax error %s at `%s'."), buf, token_rep);
373 msg (SE, _("Syntax error at `%s'."), token_rep);
378 /* Checks that we're at end of command.
379 If so, returns a successful command completion code.
380 If not, flags a syntax error and returns an error command
383 lex_end_of_command (void)
387 lex_error (_("expecting end of command"));
388 return CMD_TRAILING_GARBAGE;
394 /* Token testing functions. */
396 /* Returns nonzero if the current token is an integer. */
400 return (token == T_NUM
401 && tokval != NOT_LONG
402 && tokval >= LONG_MIN
403 && tokval <= LONG_MAX
404 && floor (tokval) == tokval);
407 /* Returns the value of the current token, which must be an
412 assert (lex_integer_p ());
415 /* Returns nonzero if the current token is an floating point. */
419 return ( token == T_NUM
420 && tokval != NOT_DOUBLE );
423 /* Returns the value of the current token, which must be a
424 floating point number. */
428 assert (lex_double_p ());
433 /* Token matching functions. */
435 /* If TOK is the current token, skips it and returns nonzero.
436 Otherwise, returns zero. */
449 /* If the current token is the identifier S, skips it and returns
451 Otherwise, returns zero. */
453 lex_match_id (const char *s)
455 if (token == T_ID && lex_id_match (s, tokid))
464 /* If the current token is integer N, skips it and returns nonzero.
465 Otherwise, returns zero. */
467 lex_match_int (int x)
469 if (lex_integer_p () && lex_integer () == x)
478 /* Forced matches. */
480 /* If this token is identifier S, fetches the next token and returns
482 Otherwise, reports an error and returns zero. */
484 lex_force_match_id (const char *s)
486 if (token == T_ID && lex_id_match (s, tokid))
493 lex_error (_("expecting `%s'"), s);
498 /* If the current token is T, skips the token. Otherwise, reports an
499 error and returns from the current function with return value 0. */
501 lex_force_match (int t)
510 lex_error (_("expecting %s"), lex_token_name (t));
515 /* If this token is a string, does nothing and returns nonzero.
516 Otherwise, reports an error and returns zero. */
518 lex_force_string (void)
520 if (token == T_STRING)
524 lex_error (_("expecting string"));
529 /* If this token is an integer, does nothing and returns nonzero.
530 Otherwise, reports an error and returns zero. */
534 if (lex_integer_p ())
538 lex_error (_("expecting integer"));
543 /* If this token is a number, does nothing and returns nonzero.
544 Otherwise, reports an error and returns zero. */
552 lex_error (_("expecting number"));
557 /* If this token is an identifier, does nothing and returns nonzero.
558 Otherwise, reports an error and returns zero. */
566 lex_error (_("expecting identifier"));
571 /* Comparing identifiers. */
573 /* Keywords match if one of the following is true: KW and TOK are
574 identical (barring differences in case), or TOK is at least 3
575 characters long and those characters are identical to KW. KW_LEN
576 is the length of KW, TOK_LEN is the length of TOK. */
578 lex_id_match_len (const char *kw, size_t kw_len,
579 const char *tok, size_t tok_len)
586 if (i == kw_len && i == tok_len)
588 else if (i == tok_len)
590 else if (i == kw_len)
592 else if (toupper ((unsigned char) kw[i])
593 != toupper ((unsigned char) tok[i]))
600 /* Same as lex_id_match_len() minus the need to pass in the lengths. */
602 lex_id_match (const char *kw, const char *tok)
604 return lex_id_match_len (kw, strlen (kw), tok, strlen (tok));
607 /* Weird token functions. */
609 /* Returns the first character of the next token, except that if the
610 next token is not an identifier, the character returned will not be
611 a character that can begin an identifier. Specifically, the
612 hexstring lead-in X' causes lookahead() to return '. Note that an
613 alphanumeric return value doesn't guarantee an ID token, it could
614 also be a reserved-word token. */
616 lex_look_ahead (void)
628 while (isspace ((unsigned char) *prog))
635 else if (!lex_get_line ())
642 if ((toupper ((unsigned char) *prog) == 'X'
643 || toupper ((unsigned char) *prog) == 'B')
644 && (prog[1] == '\'' || prog[1] == '"'))
651 /* Makes the current token become the next token to be read; the
652 current token is set to T. */
660 /* Makes T the next token read. */
662 lex_put_forward (int t)
667 /* Weird line processing functions. */
669 /* Discards the rest of the current input line for tokenization
670 purposes, but returns the entire contents of the line for use by
673 lex_entire_line (void)
675 prog = ds_end (&getl_buf);
677 return ds_value (&getl_buf);
680 /* As lex_entire_line(), but only returns the part of the current line
681 that hasn't already been tokenized.
682 If HAD_DOT is non-null, stores nonzero into *HAD_DOT if the line
683 ends with a terminal dot, or zero if it doesn't. */
685 lex_rest_of_line (int *had_dot)
688 prog = ds_end (&getl_buf);
697 /* Causes the rest of the current input line to be ignored for
698 tokenization purposes. */
700 lex_discard_line (void)
702 msg (SW, _("The rest of this command has been discarded."));
704 ds_clear (&getl_buf);
705 prog = ds_value (&getl_buf);
709 /* Sets the current position in the current line to P, which must be
712 lex_set_prog (char *p)
717 /* Weird line reading functions. */
719 /* Read a line for use by the tokenizer. */
723 if (!getl_read_line ())
726 lex_preprocess_line ();
730 /* Preprocesses getl_buf by removing comments, stripping trailing
731 whitespace and the terminal dot, and removing leading indentors. */
733 lex_preprocess_line (void)
735 /* Strips comments. */
737 /* getl_buf iterator. */
740 /* Nonzero inside a comment. */
743 /* Nonzero inside a quoted string. */
746 /* Remove C-style comments begun by slash-star and terminated by
747 star-slash or newline. */
749 for (cp = ds_value (&getl_buf); *cp; )
751 /* If we're not commented out, toggle quoting. */
756 else if (*cp == '\'' || *cp == '"')
760 /* If we're not quoting, toggle commenting. */
763 if (cp[0] == '/' && cp[1] == '*')
770 else if (cp[0] == '*' && cp[1] == '/' && comment)
779 /* Check commenting. */
787 /* Strip trailing whitespace and terminal dot. */
789 size_t len = ds_length (&getl_buf);
790 char *s = ds_value (&getl_buf);
792 /* Strip trailing whitespace. */
793 while (len > 0 && isspace ((unsigned char) s[len - 1]))
796 /* Check for and remove terminal dot. */
797 if (len > 0 && s[len - 1] == set_endcmd)
802 else if (len == 0 && set_nullline)
808 ds_truncate (&getl_buf, len);
811 /* In batch mode, strip leading indentors and insert a terminal dot
813 if (getl_interactive != 2 && getl_mode == GETL_MODE_BATCH)
815 char *s = ds_value (&getl_buf);
817 if (s[0] == '+' || s[0] == '-' || s[0] == '.')
819 else if (s[0] && !isspace ((unsigned char) s[0]))
820 lex_put_forward ('.');
823 prog = ds_value (&getl_buf);
828 /* Returns the name of a token in a static buffer. */
830 lex_token_name (int token)
832 if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
833 return keywords[token - T_FIRST_KEYWORD];
845 /* Returns an ASCII representation of the current token as a
846 malloc()'d string. */
848 lex_token_representation (void)
856 return xstrdup (ds_value (&tokstr));
864 for (sp = ds_value (&tokstr); sp < ds_end (&tokstr); sp++)
865 if (!isprint ((unsigned char) *sp))
871 token_rep = xmalloc (2 + ds_length (&tokstr) * 2 + 1 + 1);
879 for (sp = ds_value (&tokstr); *sp; )
883 *dp++ = (unsigned char) *sp++;
886 for (sp = ds_value (&tokstr); sp < ds_end (&tokstr); sp++)
888 *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
889 *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
899 token_rep = xmalloc (1);
904 return xstrdup ("**");
907 if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
908 return xstrdup (keywords [token - T_FIRST_KEYWORD]);
911 token_rep = xmalloc (2);
912 token_rep[0] = token;
921 /* Really weird functions. */
923 /* Most of the time, a `-' is a lead-in to a negative number. But
924 sometimes it's actually part of the syntax. If a dash can be part
925 of syntax then this function is called to rip it off of a
928 lex_negative_to_dash (void)
930 if (token == T_NUM && tokval < 0.0)
934 ds_replace (&tokstr, ds_value (&tokstr) + 1);
935 lex_put_forward (T_NUM);
939 /* We're not at eof any more. */
946 /* Skip a COMMENT command. */
948 lex_skip_comment (void)
956 prog = ds_end (&getl_buf);
962 /* Private functions. */
964 /* Unexpected end of file. */
966 unexpected_eof (void)
968 msg (FE, _("Unexpected end of file."));
971 /* Returns the proper token type, either T_ID or a reserved keyword
972 enum, for ID[], which must contain LEN characters. */
974 check_id (const char *id, size_t len)
978 if (len < 2 || len > 4)
981 for (kwp = keywords; *kwp; kwp++)
982 if (!strcmp (*kwp, id))
983 return T_FIRST_KEYWORD + (kwp - keywords);
988 /* When invoked, tokstr contains a string of binary, octal, or hex
989 digits, for values of TYPE of 0, 1, or 2, respectively. The string
990 is converted to characters having the specified values. */
992 convert_numeric_string_to_char_string (int type)
994 static const char *base_names[] = {N_("binary"), N_("octal"), N_("hex")};
995 static const int bases[] = {2, 8, 16};
996 static const int chars_per_byte[] = {8, 3, 2};
998 const char *const base_name = base_names[type];
999 const int base = bases[type];
1000 const int cpb = chars_per_byte[type];
1001 const int nb = ds_length (&tokstr) / cpb;
1005 assert (type >= 0 && type <= 2);
1007 if (ds_length (&tokstr) % cpb)
1008 msg (SE, _("String of %s digits has %d characters, which is not a "
1010 gettext (base_name), ds_length (&tokstr), cpb);
1012 p = ds_value (&tokstr);
1013 for (i = 0; i < nb; i++)
1019 for (j = 0; j < cpb; j++, p++)
1023 if (*p >= '0' && *p <= '9')
1027 static const char alpha[] = "abcdef";
1028 const char *q = strchr (alpha, tolower ((unsigned char) *p));
1037 msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
1039 value = value * base + v;
1042 ds_value (&tokstr)[i] = (unsigned char) value;
1045 ds_truncate (&tokstr, nb);
1048 /* Parses a string from the input buffer into tokstr. The input
1049 buffer pointer prog must point to the initial single or double
1050 quote. TYPE is 0 if it is an ordinary string, or 1, 2, or 3 for a
1051 binary, octal, or hexstring, respectively. Returns token type. */
1053 parse_string (int type)
1055 /* Accumulate the entire string, joining sections indicated by +
1059 /* Single or double quote. */
1062 /* Accumulate section. */
1065 /* Check end of line. */
1068 msg (SE, _("Unterminated string constant."));
1072 /* Double quote characters to embed them in strings. */
1081 ds_putchar (&tokstr, *prog++);
1085 /* Skip whitespace after final quote mark. */
1090 while (isspace ((unsigned char) *prog))
1098 if (!lex_get_line ())
1102 /* Skip plus sign. */
1107 /* Skip whitespace after plus sign. */
1112 while (isspace ((unsigned char) *prog))
1120 if (!lex_get_line ())
1124 /* Ensure that a valid string follows. */
1125 if (*prog != '\'' && *prog != '"')
1127 msg (SE, "String expected following `+'.");
1132 /* We come here when we've finished concatenating all the string sections
1133 into one large string. */
1136 convert_numeric_string_to_char_string (type - 1);
1138 if (ds_length (&tokstr) > 255)
1140 msg (SE, _("String exceeds 255 characters in length (%d characters)."),
1141 ds_length (&tokstr));
1142 ds_truncate (&tokstr, 255);
1150 for (i = 0; i < ds_length (&tokstr); i++)
1151 if (ds_value (&tokstr)[i] == 0)
1155 msg (SE, _("Sorry, literal strings may not contain null "
1156 "characters. Replacing with spaces."));
1159 ds_value (&tokstr)[i] = ' ';
1167 /* Reads one token from the lexer and writes a textual representation
1168 on stdout for debugging purposes. */
1176 getl_location (&curfn, &curln);
1178 printf ("%s:%d\t", curfn, curln);
1184 printf ("ID\t%s\n", tokid);
1188 printf ("NUM\t%f\n", tokval);
1192 printf ("STRING\t\"%s\"\n", ds_value (&tokstr));
1208 if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
1209 printf ("KEYWORD\t%s\n", lex_token_name (token));
1211 printf ("PUNCT\t%c\n", token);
1215 #endif /* DEBUGGING */