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
22 #include <libpspp/message.h>
29 #include <libpspp/alloc.h>
30 #include <libpspp/assertion.h>
31 #include <language/command.h>
32 #include <libpspp/message.h>
33 #include <libpspp/magic.h>
34 #include <data/settings.h>
35 #include <libpspp/getl.h>
36 #include <libpspp/str.h>
41 #define _(msgid) gettext (msgid)
42 #define N_(msgid) msgid
50 struct string line_buffer;
52 bool (*read_line) (struct string *, bool *);
54 int token; /* Current token. */
55 double tokval; /* T_POS_NUM, T_NEG_NUM: the token's value. */
57 char tokid [LONG_NAME_LEN + 1]; /* T_ID: the identifier. */
59 struct string tokstr; /* T_ID, T_STRING: token string value.
60 For T_ID, this is not truncated as is
63 char *prog; /* Pointer to next token in line_buffer. */
64 bool dot; /* True only if this line ends with a terminal dot. */
65 bool eof; /* True only if the last token returned was T_STOP. */
67 int put_token ; /* If nonzero, next token returned by lex_get().
68 Used only in exceptional circumstances. */
70 struct string put_tokstr;
75 static int parse_id (struct lexer *);
77 /* How a string represents its contents. */
80 CHARACTER_STRING, /* Characters. */
81 BINARY_STRING, /* Binary digits. */
82 OCTAL_STRING, /* Octal digits. */
83 HEX_STRING /* Hexadecimal digits. */
86 static int parse_string (struct lexer *, enum string_type);
89 static void dump_token (void);
94 /* Initializes the lexer. */
96 lex_create (bool (*read_line_func) (struct string *, bool *))
98 struct lexer *lexer = xzalloc (sizeof (*lexer));
100 ds_init_empty (&lexer->tokstr);
101 ds_init_empty (&lexer->put_tokstr);
102 ds_init_empty (&lexer->line_buffer);
103 lexer->read_line = read_line_func;
105 if (!lex_get_line (lexer))
112 lex_destroy (struct lexer *lexer)
116 ds_destroy (&lexer->put_tokstr);
117 ds_destroy (&lexer->tokstr);
118 ds_destroy (&lexer->line_buffer);
125 /* Common functions. */
127 /* Copies put_token, lexer->put_tokstr, put_tokval into token, tokstr,
128 tokval, respectively, and sets tokid appropriately. */
130 restore_token (struct lexer *lexer)
132 assert (lexer->put_token != 0);
133 lexer->token = lexer->put_token;
134 ds_assign_string (&lexer->tokstr, &lexer->put_tokstr);
135 str_copy_trunc (lexer->tokid, sizeof lexer->tokid, ds_cstr (&lexer->tokstr));
136 lexer->tokval = lexer->put_tokval;
137 lexer->put_token = 0;
140 /* Copies token, tokstr, lexer->tokval into lexer->put_token, put_tokstr,
141 put_lexer->tokval respectively. */
143 save_token (struct lexer *lexer)
145 lexer->put_token = lexer->token;
146 ds_assign_string (&lexer->put_tokstr, &lexer->tokstr);
147 lexer->put_tokval = lexer->tokval;
150 /* Parses a single token, setting appropriate global variables to
151 indicate the token's attributes. */
153 lex_get (struct lexer *lexer)
155 /* If a token was pushed ahead, return it. */
156 if (lexer->put_token)
158 restore_token (lexer);
168 /* Skip whitespace. */
171 lexer->token = T_STOP;
177 while (isspace ((unsigned char) *lexer->prog))
191 else if (!lex_get_line (lexer))
194 lexer->token = T_STOP;
201 if (lexer->put_token)
203 restore_token (lexer);
212 /* Actually parse the token. */
213 ds_clear (&lexer->tokstr);
215 switch (*lexer->prog)
218 case '0': case '1': case '2': case '3': case '4':
219 case '5': case '6': case '7': case '8': case '9':
223 /* `-' can introduce a negative number, or it can be a
224 token by itself. If it is not followed by a digit or a
225 decimal point, it is definitely not a number.
226 Otherwise, it might be either, but most of the time we
227 want it as a number. When the syntax calls for a `-'
228 token, lex_negative_to_dash() must be used to break
229 negative numbers into two tokens. */
230 if (*lexer->prog == '-')
232 ds_put_char (&lexer->tokstr, *lexer->prog++);
233 while (isspace ((unsigned char) *lexer->prog))
236 if (!isdigit ((unsigned char) *lexer->prog) && *lexer->prog != '.')
241 lexer->token = T_NEG_NUM;
244 lexer->token = T_POS_NUM;
246 /* Parse the number, copying it into tokstr. */
247 while (isdigit ((unsigned char) *lexer->prog))
248 ds_put_char (&lexer->tokstr, *lexer->prog++);
249 if (*lexer->prog == '.')
251 ds_put_char (&lexer->tokstr, *lexer->prog++);
252 while (isdigit ((unsigned char) *lexer->prog))
253 ds_put_char (&lexer->tokstr, *lexer->prog++);
255 if (*lexer->prog == 'e' || *lexer->prog == 'E')
257 ds_put_char (&lexer->tokstr, *lexer->prog++);
258 if (*lexer->prog == '+' || *lexer->prog == '-')
259 ds_put_char (&lexer->tokstr, *lexer->prog++);
260 while (isdigit ((unsigned char) *lexer->prog))
261 ds_put_char (&lexer->tokstr, *lexer->prog++);
264 /* Parse as floating point. */
265 lexer->tokval = strtod (ds_cstr (&lexer->tokstr), &tail);
268 msg (SE, _("%s does not form a valid number."),
269 ds_cstr (&lexer->tokstr));
272 ds_clear (&lexer->tokstr);
273 ds_put_char (&lexer->tokstr, '0');
280 lexer->token = parse_string (lexer, CHARACTER_STRING);
283 case '(': case ')': case ',': case '=': case '+': case '/':
284 lexer->token = *lexer->prog++;
288 if (*++lexer->prog == '*')
291 lexer->token = T_EXP;
298 if (*++lexer->prog == '=')
303 else if (*lexer->prog == '>')
313 if (*++lexer->prog == '=')
323 if (*++lexer->prog == '=')
329 lexer->token = T_NOT;
334 lexer->token = T_AND;
343 if (lexer->prog[1] == '\'' || lexer->prog[1] == '"')
344 lexer->token = parse_string (lexer, BINARY_STRING);
346 lexer->token = parse_id (lexer);
350 if (lexer->prog[1] == '\'' || lexer->prog[1] == '"')
351 lexer->token = parse_string (lexer, OCTAL_STRING);
353 lexer->token = parse_id (lexer);
357 if (lexer->prog[1] == '\'' || lexer->prog[1] == '"')
358 lexer->token = parse_string (lexer, HEX_STRING);
360 lexer->token = parse_id (lexer);
364 if (lex_is_id1 (*lexer->prog))
366 lexer->token = parse_id (lexer);
371 if (isgraph ((unsigned char) *lexer->prog))
372 msg (SE, _("Bad character in input: `%c'."), *lexer->prog++);
374 msg (SE, _("Bad character in input: `\\%o'."), *lexer->prog++);
386 /* Parses an identifier at the current position into tokid and
388 Returns the correct token type. */
390 parse_id (struct lexer *lexer)
392 const char *start = lexer->prog;
393 lexer->prog = lex_skip_identifier (start);
395 ds_put_substring (&lexer->tokstr, ss_buffer (start, lexer->prog - start));
396 str_copy_trunc (lexer->tokid, sizeof lexer->tokid, ds_cstr (&lexer->tokstr));
397 return lex_id_to_token (ds_cstr (&lexer->tokstr), ds_length (&lexer->tokstr));
400 /* Reports an error to the effect that subcommand SBC may only be
403 lex_sbc_only_once (const char *sbc)
405 msg (SE, _("Subcommand %s may only be specified once."), sbc);
408 /* Reports an error to the effect that subcommand SBC is
411 lex_sbc_missing (struct lexer *lexer, const char *sbc)
413 lex_error (lexer, _("missing required subcommand %s"), sbc);
416 /* Prints a syntax error message containing the current token and
417 given message MESSAGE (if non-null). */
419 lex_error (struct lexer *lexer, const char *message, ...)
424 token_rep = lex_token_representation (lexer);
425 if (lexer->token == T_STOP)
426 strcpy (where, "end of file");
427 else if (lexer->token == '.')
428 strcpy (where, "end of command");
430 snprintf (where, sizeof where, "`%s'", token_rep);
438 va_start (args, message);
439 vsnprintf (buf, 1024, message, args);
442 msg (SE, _("Syntax error %s at %s."), buf, where);
445 msg (SE, _("Syntax error at %s."), where);
448 /* Checks that we're at end of command.
449 If so, returns a successful command completion code.
450 If not, flags a syntax error and returns an error command
453 lex_end_of_command (struct lexer *lexer)
455 if (lexer->token != '.')
457 lex_error (lexer, _("expecting end of command"));
464 /* Token testing functions. */
466 /* Returns true if the current token is a number. */
468 lex_is_number (struct lexer *lexer)
470 return lexer->token == T_POS_NUM || lexer->token == T_NEG_NUM;
473 /* Returns the value of the current token, which must be a
474 floating point number. */
476 lex_number (struct lexer *lexer)
478 assert (lex_is_number (lexer));
479 return lexer->tokval;
482 /* Returns true iff the current token is an integer. */
484 lex_is_integer (struct lexer *lexer)
486 return (lex_is_number (lexer)
487 && lexer->tokval != NOT_LONG
488 && lexer->tokval >= LONG_MIN
489 && lexer->tokval <= LONG_MAX
490 && floor (lexer->tokval) == lexer->tokval);
493 /* Returns the value of the current token, which must be an
496 lex_integer (struct lexer *lexer)
498 assert (lex_is_integer (lexer));
499 return lexer->tokval;
502 /* Token matching functions. */
504 /* If TOK is the current token, skips it and returns true
505 Otherwise, returns false. */
507 lex_match (struct lexer *lexer, int t)
509 if (lexer->token == t)
518 /* If the current token is the identifier S, skips it and returns
519 true. The identifier may be abbreviated to its first three
521 Otherwise, returns false. */
523 lex_match_id (struct lexer *lexer, const char *s)
525 if (lexer->token == T_ID && lex_id_match (s, lexer->tokid))
534 /* If the current token is integer N, skips it and returns true.
535 Otherwise, returns false. */
537 lex_match_int (struct lexer *lexer, int x)
539 if (lex_is_integer (lexer) && lex_integer (lexer) == x)
548 /* Forced matches. */
550 /* If this token is identifier S, fetches the next token and returns
552 Otherwise, reports an error and returns zero. */
554 lex_force_match_id (struct lexer *lexer, const char *s)
556 if (lexer->token == T_ID && lex_id_match (s, lexer->tokid))
563 lex_error (lexer, _("expecting `%s'"), s);
568 /* If the current token is T, skips the token. Otherwise, reports an
569 error and returns from the current function with return value false. */
571 lex_force_match (struct lexer *lexer, int t)
573 if (lexer->token == t)
580 lex_error (lexer, _("expecting `%s'"), lex_token_name (t));
585 /* If this token is a string, does nothing and returns true.
586 Otherwise, reports an error and returns false. */
588 lex_force_string (struct lexer *lexer)
590 if (lexer->token == T_STRING)
594 lex_error (lexer, _("expecting string"));
599 /* If this token is an integer, does nothing and returns true.
600 Otherwise, reports an error and returns false. */
602 lex_force_int (struct lexer *lexer)
604 if (lex_is_integer (lexer))
608 lex_error (lexer, _("expecting integer"));
613 /* If this token is a number, does nothing and returns true.
614 Otherwise, reports an error and returns false. */
616 lex_force_num (struct lexer *lexer)
618 if (lex_is_number (lexer))
621 lex_error (lexer, _("expecting number"));
625 /* If this token is an identifier, does nothing and returns true.
626 Otherwise, reports an error and returns false. */
628 lex_force_id (struct lexer *lexer)
630 if (lexer->token == T_ID)
633 lex_error (lexer, _("expecting identifier"));
637 /* Weird token functions. */
639 /* Returns the first character of the next token, except that if the
640 next token is not an identifier, the character returned will not be
641 a character that can begin an identifier. Specifically, the
642 hexstring lead-in X' causes lookahead() to return '. Note that an
643 alphanumeric return value doesn't guarantee an ID token, it could
644 also be a reserved-word token. */
646 lex_look_ahead (struct lexer *lexer)
648 if (lexer->put_token)
649 return lexer->put_token;
658 while (isspace ((unsigned char) *lexer->prog))
665 else if (!lex_get_line (lexer))
668 if (lexer->put_token)
669 return lexer->put_token;
672 if ((toupper ((unsigned char) *lexer->prog) == 'X'
673 || toupper ((unsigned char) *lexer->prog) == 'B'
674 || toupper ((unsigned char) *lexer->prog) == 'O')
675 && (lexer->prog[1] == '\'' || lexer->prog[1] == '"'))
682 /* Makes the current token become the next token to be read; the
683 current token is set to T. */
685 lex_put_back (struct lexer *lexer, int t)
691 /* Makes the current token become the next token to be read; the
692 current token is set to the identifier ID. */
694 lex_put_back_id (struct lexer *lexer, const char *id)
696 assert (lex_id_to_token (id, strlen (id)) == T_ID);
699 ds_assign_cstr (&lexer->tokstr, id);
700 str_copy_trunc (lexer->tokid, sizeof lexer->tokid, ds_cstr (&lexer->tokstr));
703 /* Weird line processing functions. */
705 /* Returns the entire contents of the current line. */
707 lex_entire_line (struct lexer *lexer)
709 return ds_cstr (&lexer->line_buffer);
712 const struct string *
713 lex_entire_line_ds (struct lexer *lexer)
715 return &lexer->line_buffer;
718 /* As lex_entire_line(), but only returns the part of the current line
719 that hasn't already been tokenized.
720 If END_DOT is non-null, stores nonzero into *END_DOT if the line
721 ends with a terminal dot, or zero if it doesn't. */
723 lex_rest_of_line (struct lexer *lexer, int *end_dot)
726 *end_dot = lexer->dot;
730 /* Causes the rest of the current input line to be ignored for
731 tokenization purposes. */
733 lex_discard_line (struct lexer *lexer)
735 ds_cstr (&lexer->line_buffer); /* Ensures ds_end points to something valid */
736 lexer->prog = ds_end (&lexer->line_buffer);
738 lexer->put_token = 0;
742 /* Discards the rest of the current command.
743 When we're reading commands from a file, we skip tokens until
744 a terminal dot or EOF.
745 When we're reading commands interactively from the user,
746 that's just discarding the current line, because presumably
747 the user doesn't want to finish typing a command that will be
750 lex_discard_rest_of_command (struct lexer *lexer)
752 if (!getl_is_interactive ())
754 while (lexer->token != T_STOP && lexer->token != '.')
758 lex_discard_line (lexer);
761 /* Weird line reading functions. */
763 /* Remove C-style comments in STRING, begun by slash-star and
764 terminated by star-slash or newline. */
766 strip_comments (struct string *string)
774 for (cp = ds_cstr (string); *cp; )
776 /* If we're not in a comment, check for quote marks. */
781 else if (*cp == '\'' || *cp == '"')
785 /* If we're not inside a quotation, check for comment. */
788 if (cp[0] == '/' && cp[1] == '*')
795 else if (in_comment && cp[0] == '*' && cp[1] == '/')
804 /* Check commenting. */
811 /* Reads a line, without performing any preprocessing */
813 lex_get_line_raw (struct lexer *lexer)
816 return lexer->read_line (&lexer->line_buffer, &dummy);
819 /* Reads a line for use by the tokenizer, and preprocesses it by
820 removing comments, stripping trailing whitespace and the
821 terminal dot, and removing leading indentors. */
823 lex_get_line (struct lexer *lexer)
825 struct string *line = &lexer->line_buffer;
828 if (!lexer->read_line (line, &interactive))
831 strip_comments (line);
832 ds_rtrim (line, ss_cstr (CC_SPACES));
834 /* Check for and remove terminal dot. */
835 lexer->dot = (ds_chomp (line, get_endcmd ())
836 || (ds_is_empty (line) && get_nulline ()));
838 /* Strip leading indentors or insert a terminal dot (unless the
839 line was obtained interactively). */
842 int first = ds_first (line);
844 if (first == '+' || first == '-')
845 *ds_data (line) = ' ';
846 else if (first != EOF && !isspace (first))
847 lexer->put_token = '.';
850 lexer->prog = ds_cstr (line);
857 /* Returns the name of a token in a static buffer. */
859 lex_token_name (int token)
861 if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
862 return keywords[token - T_FIRST_KEYWORD];
874 /* Returns an ASCII representation of the current token as a
875 malloc()'d string. */
877 lex_token_representation (struct lexer *lexer)
881 switch (lexer->token)
886 return ds_xstrdup (&lexer->tokstr);
894 for (sp = ds_cstr (&lexer->tokstr); sp < ds_end (&lexer->tokstr); sp++)
895 if (!isprint ((unsigned char) *sp))
901 token_rep = xmalloc (2 + ds_length (&lexer->tokstr) * 2 + 1 + 1);
909 for (sp = ds_cstr (&lexer->tokstr); *sp; )
913 *dp++ = (unsigned char) *sp++;
916 for (sp = ds_cstr (&lexer->tokstr); sp < ds_end (&lexer->tokstr); sp++)
918 *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
919 *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
929 token_rep = xmalloc (1);
934 return xstrdup ("**");
937 if (lexer->token >= T_FIRST_KEYWORD && lexer->token <= T_LAST_KEYWORD)
938 return xstrdup (keywords [lexer->token - T_FIRST_KEYWORD]);
941 token_rep = xmalloc (2);
942 token_rep[0] = lexer->token;
951 /* Really weird functions. */
953 /* Most of the time, a `-' is a lead-in to a negative number. But
954 sometimes it's actually part of the syntax. If a dash can be part
955 of syntax then this function is called to rip it off of a
958 lex_negative_to_dash (struct lexer *lexer)
960 if (lexer->token == T_NEG_NUM)
962 lexer->token = T_POS_NUM;
963 lexer->tokval = -lexer->tokval;
964 ds_assign_substring (&lexer->tokstr, ds_substr (&lexer->tokstr, 1, SIZE_MAX));
970 /* We're not at eof any more. */
972 lex_reset_eof (struct lexer *lexer)
977 /* Skip a COMMENT command. */
979 lex_skip_comment (struct lexer *lexer)
983 if (!lex_get_line (lexer))
985 lexer->put_token = T_STOP;
990 if (lexer->put_token == '.')
993 ds_cstr (&lexer->line_buffer); /* Ensures ds_end will point to a valid char */
994 lexer->prog = ds_end (&lexer->line_buffer);
1000 /* Private functions. */
1002 /* When invoked, tokstr contains a string of binary, octal, or
1003 hex digits, according to TYPE. The string is converted to
1004 characters having the specified values. */
1006 convert_numeric_string_to_char_string (struct lexer *lexer,
1007 enum string_type type)
1009 const char *base_name;
1019 base_name = _("binary");
1024 base_name = _("octal");
1029 base_name = _("hex");
1037 byte_cnt = ds_length (&lexer->tokstr) / chars_per_byte;
1038 if (ds_length (&lexer->tokstr) % chars_per_byte)
1039 msg (SE, _("String of %s digits has %d characters, which is not a "
1041 base_name, ds_length (&lexer->tokstr), chars_per_byte);
1043 p = ds_cstr (&lexer->tokstr);
1044 for (i = 0; i < byte_cnt; i++)
1050 for (j = 0; j < chars_per_byte; j++, p++)
1054 if (*p >= '0' && *p <= '9')
1058 static const char alpha[] = "abcdef";
1059 const char *q = strchr (alpha, tolower ((unsigned char) *p));
1068 msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
1070 value = value * base + v;
1073 ds_cstr (&lexer->tokstr)[i] = (unsigned char) value;
1076 ds_truncate (&lexer->tokstr, byte_cnt);
1079 /* Parses a string from the input buffer into tokstr. The input
1080 buffer pointer lexer->prog must point to the initial single or double
1081 quote. TYPE indicates the type of string to be parsed.
1082 Returns token type. */
1084 parse_string (struct lexer *lexer, enum string_type type)
1086 if (type != CHARACTER_STRING)
1089 /* Accumulate the entire string, joining sections indicated by +
1093 /* Single or double quote. */
1094 int c = *lexer->prog++;
1096 /* Accumulate section. */
1099 /* Check end of line. */
1100 if (*lexer->prog == '\0')
1102 msg (SE, _("Unterminated string constant."));
1106 /* Double quote characters to embed them in strings. */
1107 if (*lexer->prog == c)
1109 if (lexer->prog[1] == c)
1115 ds_put_char (&lexer->tokstr, *lexer->prog++);
1119 /* Skip whitespace after final quote mark. */
1124 while (isspace ((unsigned char) *lexer->prog))
1132 if (!lex_get_line (lexer))
1136 /* Skip plus sign. */
1137 if (*lexer->prog != '+')
1141 /* Skip whitespace after plus sign. */
1146 while (isspace ((unsigned char) *lexer->prog))
1154 if (!lex_get_line (lexer))
1156 msg (SE, _("Unexpected end of file in string concatenation."));
1161 /* Ensure that a valid string follows. */
1162 if (*lexer->prog != '\'' && *lexer->prog != '"')
1164 msg (SE, _("String expected following `+'."));
1169 /* We come here when we've finished concatenating all the string sections
1170 into one large string. */
1172 if (type != CHARACTER_STRING)
1173 convert_numeric_string_to_char_string (lexer, type);
1175 if (ds_length (&lexer->tokstr) > 255)
1177 msg (SE, _("String exceeds 255 characters in length (%d characters)."),
1178 ds_length (&lexer->tokstr));
1179 ds_truncate (&lexer->tokstr, 255);
1186 /* Reads one token from the lexer and writes a textual representation
1187 on stdout for debugging purposes. */
1189 dump_token (struct lexer *lexer)
1195 getl_location (&curfn, &curln);
1197 fprintf (stderr, "%s:%d\t", curfn, curln);
1200 switch (lexer->token)
1203 fprintf (stderr, "ID\t%s\n", lexer->tokid);
1208 fprintf (stderr, "NUM\t%f\n", lexer->tokval);
1212 fprintf (stderr, "STRING\t\"%s\"\n", ds_cstr (&lexer->tokstr));
1216 fprintf (stderr, "STOP\n");
1220 fprintf (stderr, "MISC\tEXP\"");
1224 fprintf (stderr, "MISC\tEOF\n");
1228 if (lexer->token >= T_FIRST_KEYWORD && lexer->token <= T_LAST_KEYWORD)
1229 fprintf (stderr, "KEYWORD\t%s\n", lex_token_name (token));
1231 fprintf (stderr, "PUNCT\t%c\n", lexer->token);
1235 #endif /* DUMP_TOKENS */
1238 /* Token Accessor Functions */
1241 lex_token (const struct lexer *lexer)
1243 return lexer->token;
1247 lex_tokval (const struct lexer *lexer)
1249 return lexer->tokval;
1253 lex_tokid (const struct lexer *lexer)
1255 return lexer->tokid;
1258 const struct string *
1259 lex_tokstr (const struct lexer *lexer)
1261 return &lexer->tokstr;