Fix missing @clicksequence problem with older Texinfo versions.
[pspp-builds.git] / lexer / lexer.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18 #include "lexer.h"
19 #include <libpspp/message.h>
20 #include <ctype.h>
21 #include <errno.h>
22 #include <limits.h>
23 #include <math.h>
24 #include <stdarg.h>
25 #include <stdint.h>
26 #include <stdlib.h>
27 #include <libpspp/assertion.h>
28 #include <language/command.h>
29 #include <libpspp/message.h>
30 #include <data/settings.h>
31 #include <libpspp/getl.h>
32 #include <libpspp/str.h>
33 #include <output/journal.h>
34
35 #include "xalloc.h"
36
37 #include "gettext.h"
38 #define _(msgid) gettext (msgid)
39 #define N_(msgid) msgid
40
41
42 #define DUMP_TOKENS 0
43
44
45
46 struct lexer
47 {
48   struct string line_buffer;
49
50   struct source_stream *ss;
51
52   int token;      /* Current token. */
53   double tokval;  /* T_POS_NUM, T_NEG_NUM: the token's value. */
54
55   char tokid [VAR_NAME_LEN + 1];   /* T_ID: the identifier. */
56
57   struct string tokstr;   /* T_ID, T_STRING: token string value.
58                             For T_ID, this is not truncated as is
59                             tokid. */
60
61   char *prog; /* Pointer to next token in line_buffer. */
62   bool dot;   /* True only if this line ends with a terminal dot. */
63
64   int put_token ; /* If nonzero, next token returned by lex_get().
65                     Used only in exceptional circumstances. */
66
67   struct string put_tokstr;
68   double put_tokval;
69 };
70
71
72 static int parse_id (struct lexer *);
73
74 /* How a string represents its contents. */
75 enum string_type
76   {
77     CHARACTER_STRING,   /* Characters. */
78     BINARY_STRING,      /* Binary digits. */
79     OCTAL_STRING,       /* Octal digits. */
80     HEX_STRING          /* Hexadecimal digits. */
81   };
82
83 static int parse_string (struct lexer *, enum string_type);
84
85 #if DUMP_TOKENS
86 static void dump_token (struct lexer *);
87 #endif
88 \f
89 /* Initialization. */
90
91 /* Initializes the lexer. */
92 struct lexer *
93 lex_create (struct source_stream *ss)
94 {
95   struct lexer *lexer = xzalloc (sizeof (*lexer));
96
97   ds_init_empty (&lexer->tokstr);
98   ds_init_empty (&lexer->put_tokstr);
99   ds_init_empty (&lexer->line_buffer);
100   lexer->ss = ss;
101
102   return lexer;
103 }
104
105 struct source_stream *
106 lex_get_source_stream (const struct lexer *lex)
107 {
108   return lex->ss;
109 }
110
111 enum syntax_mode
112 lex_current_syntax_mode (const struct lexer *lex)
113 {
114   return source_stream_current_syntax_mode (lex->ss);
115 }
116
117 enum error_mode
118 lex_current_error_mode (const struct lexer *lex)
119 {
120   return source_stream_current_error_mode (lex->ss);
121 }
122
123
124 void
125 lex_destroy (struct lexer *lexer)
126 {
127   if ( NULL != lexer )
128     {
129       ds_destroy (&lexer->put_tokstr);
130       ds_destroy (&lexer->tokstr);
131       ds_destroy (&lexer->line_buffer);
132
133       free (lexer);
134     }
135 }
136
137 \f
138 /* Common functions. */
139
140 /* Copies put_token, lexer->put_tokstr, put_tokval into token, tokstr,
141    tokval, respectively, and sets tokid appropriately. */
142 static void
143 restore_token (struct lexer *lexer)
144 {
145   assert (lexer->put_token != 0);
146   lexer->token = lexer->put_token;
147   ds_assign_string (&lexer->tokstr, &lexer->put_tokstr);
148   str_copy_trunc (lexer->tokid, sizeof lexer->tokid, ds_cstr (&lexer->tokstr));
149   lexer->tokval = lexer->put_tokval;
150   lexer->put_token = 0;
151 }
152
153 /* Copies token, tokstr, lexer->tokval into lexer->put_token, put_tokstr,
154    put_lexer->tokval respectively. */
155 static void
156 save_token (struct lexer *lexer)
157 {
158   lexer->put_token = lexer->token;
159   ds_assign_string (&lexer->put_tokstr, &lexer->tokstr);
160   lexer->put_tokval = lexer->tokval;
161 }
162
163 /* Parses a single token, setting appropriate global variables to
164    indicate the token's attributes. */
165 void
166 lex_get (struct lexer *lexer)
167 {
168   /* Find a token. */
169   for (;;)
170     {
171       if (NULL == lexer->prog && ! lex_get_line (lexer) )
172         {
173           lexer->token = T_STOP;
174           return;
175         }
176
177   /* If a token was pushed ahead, return it. */
178   if (lexer->put_token)
179     {
180       restore_token (lexer);
181 #if DUMP_TOKENS
182           dump_token (lexer);
183 #endif
184       return;
185     }
186
187   for (;;)
188     {
189       /* Skip whitespace. */
190           while (isspace ((unsigned char) *lexer->prog))
191             lexer->prog++;
192
193           if (*lexer->prog)
194             break;
195
196           if (lexer->dot)
197             {
198               lexer->dot = 0;
199               lexer->token = '.';
200 #if DUMP_TOKENS
201               dump_token (lexer);
202 #endif
203               return;
204             }
205           else if (!lex_get_line (lexer))
206             {
207               lexer->prog = NULL;
208               lexer->token = T_STOP;
209 #if DUMP_TOKENS
210               dump_token (lexer);
211 #endif
212               return;
213             }
214
215           if (lexer->put_token)
216             {
217               restore_token (lexer);
218 #if DUMP_TOKENS
219               dump_token (lexer);
220 #endif
221               return;
222             }
223         }
224
225
226       /* Actually parse the token. */
227       ds_clear (&lexer->tokstr);
228
229       switch (*lexer->prog)
230         {
231         case '-': case '.':
232         case '0': case '1': case '2': case '3': case '4':
233         case '5': case '6': case '7': case '8': case '9':
234           {
235             char *tail;
236
237             /* `-' can introduce a negative number, or it can be a
238                token by itself.  If it is not followed by a digit or a
239                decimal point, it is definitely not a number.
240                Otherwise, it might be either, but most of the time we
241                want it as a number.  When the syntax calls for a `-'
242                token, lex_negative_to_dash() must be used to break
243                negative numbers into two tokens. */
244             if (*lexer->prog == '-')
245               {
246                 ds_put_char (&lexer->tokstr, *lexer->prog++);
247                 while (isspace ((unsigned char) *lexer->prog))
248                   lexer->prog++;
249
250                 if (!isdigit ((unsigned char) *lexer->prog) && *lexer->prog != '.')
251                   {
252                     lexer->token = '-';
253                     break;
254                   }
255                 lexer->token = T_NEG_NUM;
256               }
257             else
258               lexer->token = T_POS_NUM;
259
260             /* Parse the number, copying it into tokstr. */
261             while (isdigit ((unsigned char) *lexer->prog))
262               ds_put_char (&lexer->tokstr, *lexer->prog++);
263             if (*lexer->prog == '.')
264               {
265                 ds_put_char (&lexer->tokstr, *lexer->prog++);
266                 while (isdigit ((unsigned char) *lexer->prog))
267                   ds_put_char (&lexer->tokstr, *lexer->prog++);
268               }
269             if (*lexer->prog == 'e' || *lexer->prog == 'E')
270               {
271                 ds_put_char (&lexer->tokstr, *lexer->prog++);
272                 if (*lexer->prog == '+' || *lexer->prog == '-')
273                   ds_put_char (&lexer->tokstr, *lexer->prog++);
274                 while (isdigit ((unsigned char) *lexer->prog))
275                   ds_put_char (&lexer->tokstr, *lexer->prog++);
276               }
277
278             /* Parse as floating point. */
279             lexer->tokval = strtod (ds_cstr (&lexer->tokstr), &tail);
280             if (*tail)
281               {
282                 msg (SE, _("%s does not form a valid number."),
283                      ds_cstr (&lexer->tokstr));
284                 lexer->tokval = 0.0;
285
286                 ds_clear (&lexer->tokstr);
287                 ds_put_char (&lexer->tokstr, '0');
288               }
289
290             break;
291           }
292
293         case '\'': case '"':
294           lexer->token = parse_string (lexer, CHARACTER_STRING);
295           break;
296
297         case '(': case ')': case ',': case '=': case '+': case '/':
298           lexer->token = *lexer->prog++;
299           break;
300
301         case '*':
302           if (*++lexer->prog == '*')
303             {
304               lexer->prog++;
305               lexer->token = T_EXP;
306             }
307           else
308             lexer->token = '*';
309           break;
310
311         case '<':
312           if (*++lexer->prog == '=')
313             {
314               lexer->prog++;
315               lexer->token = T_LE;
316             }
317           else if (*lexer->prog == '>')
318             {
319               lexer->prog++;
320               lexer->token = T_NE;
321             }
322           else
323             lexer->token = T_LT;
324           break;
325
326         case '>':
327           if (*++lexer->prog == '=')
328             {
329               lexer->prog++;
330               lexer->token = T_GE;
331             }
332           else
333             lexer->token = T_GT;
334           break;
335
336         case '~':
337           if (*++lexer->prog == '=')
338             {
339               lexer->prog++;
340               lexer->token = T_NE;
341             }
342           else
343             lexer->token = T_NOT;
344           break;
345
346         case '&':
347           lexer->prog++;
348           lexer->token = T_AND;
349           break;
350
351         case '|':
352           lexer->prog++;
353           lexer->token = T_OR;
354           break;
355
356         case 'b': case 'B':
357           if (lexer->prog[1] == '\'' || lexer->prog[1] == '"')
358             lexer->token = parse_string (lexer, BINARY_STRING);
359           else
360             lexer->token = parse_id (lexer);
361           break;
362
363         case 'o': case 'O':
364           if (lexer->prog[1] == '\'' || lexer->prog[1] == '"')
365             lexer->token = parse_string (lexer, OCTAL_STRING);
366           else
367             lexer->token = parse_id (lexer);
368           break;
369
370         case 'x': case 'X':
371           if (lexer->prog[1] == '\'' || lexer->prog[1] == '"')
372             lexer->token = parse_string (lexer, HEX_STRING);
373           else
374             lexer->token = parse_id (lexer);
375           break;
376
377         default:
378           if (lex_is_id1 (*lexer->prog))
379             {
380               lexer->token = parse_id (lexer);
381               break;
382             }
383           else
384             {
385               if (isgraph ((unsigned char) *lexer->prog))
386                 msg (SE, _("Bad character in input: `%c'."), *lexer->prog++);
387               else
388                 msg (SE, _("Bad character in input: `\\%o'."), *lexer->prog++);
389               continue;
390             }
391         }
392       break;
393     }
394
395 #if DUMP_TOKENS
396   dump_token (lexer);
397 #endif
398 }
399
400 /* Parses an identifier at the current position into tokid and
401    tokstr.
402    Returns the correct token type. */
403 static int
404 parse_id (struct lexer *lexer)
405 {
406   struct substring rest_of_line
407     = ss_substr (ds_ss (&lexer->line_buffer),
408                  ds_pointer_to_position (&lexer->line_buffer, lexer->prog),
409                  SIZE_MAX);
410   struct substring id = ss_head (rest_of_line,
411                                  lex_id_get_length (rest_of_line));
412   lexer->prog += ss_length (id);
413
414   ds_assign_substring (&lexer->tokstr, id);
415   str_copy_trunc (lexer->tokid, sizeof lexer->tokid, ds_cstr (&lexer->tokstr));
416   return lex_id_to_token (id);
417 }
418
419 /* Reports an error to the effect that subcommand SBC may only be
420    specified once. */
421 void
422 lex_sbc_only_once (const char *sbc)
423 {
424   msg (SE, _("Subcommand %s may only be specified once."), sbc);
425 }
426
427 /* Reports an error to the effect that subcommand SBC is
428    missing. */
429 void
430 lex_sbc_missing (struct lexer *lexer, const char *sbc)
431 {
432   lex_error (lexer, _("missing required subcommand %s"), sbc);
433 }
434
435 /* Prints a syntax error message containing the current token and
436    given message MESSAGE (if non-null). */
437 void
438 lex_error (struct lexer *lexer, const char *message, ...)
439 {
440   char *token_rep;
441   char where[128];
442
443   token_rep = lex_token_representation (lexer);
444   if (lexer->token == T_STOP)
445     strcpy (where, "end of file");
446   else if (lexer->token == '.')
447     strcpy (where, "end of command");
448   else
449     snprintf (where, sizeof where, "`%s'", token_rep);
450   free (token_rep);
451
452   if (message)
453     {
454       char buf[1024];
455       va_list args;
456
457       va_start (args, message);
458       vsnprintf (buf, 1024, message, args);
459       va_end (args);
460
461       msg (SE, _("Syntax error %s at %s."), buf, where);
462     }
463   else
464     msg (SE, _("Syntax error at %s."), where);
465 }
466
467 /* Checks that we're at end of command.
468    If so, returns a successful command completion code.
469    If not, flags a syntax error and returns an error command
470    completion code. */
471 int
472 lex_end_of_command (struct lexer *lexer)
473 {
474   if (lexer->token != '.')
475     {
476       lex_error (lexer, _("expecting end of command"));
477       return CMD_FAILURE;
478     }
479   else
480     return CMD_SUCCESS;
481 }
482 \f
483 /* Token testing functions. */
484
485 /* Returns true if the current token is a number. */
486 bool
487 lex_is_number (struct lexer *lexer)
488 {
489   return lexer->token == T_POS_NUM || lexer->token == T_NEG_NUM;
490 }
491
492
493 /* Returns true if the current token is a string. */
494 bool
495 lex_is_string (struct lexer *lexer)
496 {
497   return lexer->token == T_STRING;
498 }
499
500
501 /* Returns the value of the current token, which must be a
502    floating point number. */
503 double
504 lex_number (struct lexer *lexer)
505 {
506   assert (lex_is_number (lexer));
507   return lexer->tokval;
508 }
509
510 /* Returns true iff the current token is an integer. */
511 bool
512 lex_is_integer (struct lexer *lexer)
513 {
514   return (lex_is_number (lexer)
515           && lexer->tokval > LONG_MIN
516           && lexer->tokval <= LONG_MAX
517           && floor (lexer->tokval) == lexer->tokval);
518 }
519
520 /* Returns the value of the current token, which must be an
521    integer. */
522 long
523 lex_integer (struct lexer *lexer)
524 {
525   assert (lex_is_integer (lexer));
526   return lexer->tokval;
527 }
528 \f
529 /* Token matching functions. */
530
531 /* If TOK is the current token, skips it and returns true
532    Otherwise, returns false. */
533 bool
534 lex_match (struct lexer *lexer, int t)
535 {
536   if (lexer->token == t)
537     {
538       lex_get (lexer);
539       return true;
540     }
541   else
542     return false;
543 }
544
545 /* If the current token is the identifier S, skips it and returns
546    true.  The identifier may be abbreviated to its first three
547    letters.
548    Otherwise, returns false. */
549 bool
550 lex_match_id (struct lexer *lexer, const char *s)
551 {
552   return lex_match_id_n (lexer, s, 3);
553 }
554
555 /* If the current token is the identifier S, skips it and returns
556    true.  The identifier may be abbreviated to its first N
557    letters.
558    Otherwise, returns false. */
559 bool
560 lex_match_id_n (struct lexer *lexer, const char *s, size_t n)
561 {
562   if (lexer->token == T_ID
563       && lex_id_match_n (ss_cstr (s), ss_cstr (lexer->tokid), n))
564     {
565       lex_get (lexer);
566       return true;
567     }
568   else
569     return false;
570 }
571
572 /* If the current token is integer N, skips it and returns true.
573    Otherwise, returns false. */
574 bool
575 lex_match_int (struct lexer *lexer, int x)
576 {
577   if (lex_is_integer (lexer) && lex_integer (lexer) == x)
578     {
579       lex_get (lexer);
580       return true;
581     }
582   else
583     return false;
584 }
585 \f
586 /* Forced matches. */
587
588 /* If this token is identifier S, fetches the next token and returns
589    nonzero.
590    Otherwise, reports an error and returns zero. */
591 bool
592 lex_force_match_id (struct lexer *lexer, const char *s)
593 {
594   if (lex_match_id (lexer, s))
595     return true;
596   else
597     {
598       lex_error (lexer, _("expecting `%s'"), s);
599       return false;
600     }
601 }
602
603 /* If the current token is T, skips the token.  Otherwise, reports an
604    error and returns from the current function with return value false. */
605 bool
606 lex_force_match (struct lexer *lexer, int t)
607 {
608   if (lexer->token == t)
609     {
610       lex_get (lexer);
611       return true;
612     }
613   else
614     {
615       lex_error (lexer, _("expecting `%s'"), lex_token_name (t));
616       return false;
617     }
618 }
619
620 /* If this token is a string, does nothing and returns true.
621    Otherwise, reports an error and returns false. */
622 bool
623 lex_force_string (struct lexer *lexer)
624 {
625   if (lexer->token == T_STRING)
626     return true;
627   else
628     {
629       lex_error (lexer, _("expecting string"));
630       return false;
631     }
632 }
633
634 /* If this token is an integer, does nothing and returns true.
635    Otherwise, reports an error and returns false. */
636 bool
637 lex_force_int (struct lexer *lexer)
638 {
639   if (lex_is_integer (lexer))
640     return true;
641   else
642     {
643       lex_error (lexer, _("expecting integer"));
644       return false;
645     }
646 }
647
648 /* If this token is a number, does nothing and returns true.
649    Otherwise, reports an error and returns false. */
650 bool
651 lex_force_num (struct lexer *lexer)
652 {
653   if (lex_is_number (lexer))
654     return true;
655
656   lex_error (lexer, _("expecting number"));
657   return false;
658 }
659
660 /* If this token is an identifier, does nothing and returns true.
661    Otherwise, reports an error and returns false. */
662 bool
663 lex_force_id (struct lexer *lexer)
664 {
665   if (lexer->token == T_ID)
666     return true;
667
668   lex_error (lexer, _("expecting identifier"));
669   return false;
670 }
671
672 /* Weird token functions. */
673
674 /* Returns the first character of the next token, except that if the
675    next token is not an identifier, the character returned will not be
676    a character that can begin an identifier.  Specifically, the
677    hexstring lead-in X' causes lookahead() to return '.  Note that an
678    alphanumeric return value doesn't guarantee an ID token, it could
679    also be a reserved-word token. */
680 int
681 lex_look_ahead (struct lexer *lexer)
682 {
683   if (lexer->put_token)
684     return lexer->put_token;
685
686   for (;;)
687     {
688       if (NULL == lexer->prog && ! lex_get_line (lexer) )
689         return 0;
690
691       for (;;)
692         {
693           while (isspace ((unsigned char) *lexer->prog))
694             lexer->prog++;
695           if (*lexer->prog)
696             break;
697
698           if (lexer->dot)
699             return '.';
700           else if (!lex_get_line (lexer))
701             return 0;
702
703           if (lexer->put_token)
704             return lexer->put_token;
705         }
706
707       if ((toupper ((unsigned char) *lexer->prog) == 'X'
708            || toupper ((unsigned char) *lexer->prog) == 'B'
709            || toupper ((unsigned char) *lexer->prog) == 'O')
710           && (lexer->prog[1] == '\'' || lexer->prog[1] == '"'))
711         return '\'';
712
713       return *lexer->prog;
714     }
715 }
716
717 /* Makes the current token become the next token to be read; the
718    current token is set to T. */
719 void
720 lex_put_back (struct lexer *lexer, int t)
721 {
722   save_token (lexer);
723   lexer->token = t;
724 }
725
726 /* Makes the current token become the next token to be read; the
727    current token is set to the identifier ID. */
728 void
729 lex_put_back_id (struct lexer *lexer, const char *id)
730 {
731   assert (lex_id_to_token (ss_cstr (id)) == T_ID);
732   save_token (lexer);
733   lexer->token = T_ID;
734   ds_assign_cstr (&lexer->tokstr, id);
735   str_copy_trunc (lexer->tokid, sizeof lexer->tokid, ds_cstr (&lexer->tokstr));
736 }
737 \f
738 /* Weird line processing functions. */
739
740 /* Returns the entire contents of the current line. */
741 const char *
742 lex_entire_line (const struct lexer *lexer)
743 {
744   return ds_cstr (&lexer->line_buffer);
745 }
746
747 const struct string *
748 lex_entire_line_ds (const struct lexer *lexer)
749 {
750   return &lexer->line_buffer;
751 }
752
753 /* As lex_entire_line(), but only returns the part of the current line
754    that hasn't already been tokenized. */
755 const char *
756 lex_rest_of_line (const struct lexer *lexer)
757 {
758   return lexer->prog;
759 }
760
761 /* Returns true if the current line ends in a terminal dot,
762    false otherwise. */
763 bool
764 lex_end_dot (const struct lexer *lexer)
765 {
766   return lexer->dot;
767 }
768
769 /* Causes the rest of the current input line to be ignored for
770    tokenization purposes. */
771 void
772 lex_discard_line (struct lexer *lexer)
773 {
774   ds_cstr (&lexer->line_buffer);  /* Ensures ds_end points to something valid */
775   lexer->prog = ds_end (&lexer->line_buffer);
776   lexer->dot = false;
777   lexer->put_token = 0;
778 }
779
780
781 /* Discards the rest of the current command.
782    When we're reading commands from a file, we skip tokens until
783    a terminal dot or EOF.
784    When we're reading commands interactively from the user,
785    that's just discarding the current line, because presumably
786    the user doesn't want to finish typing a command that will be
787    ignored anyway. */
788 void
789 lex_discard_rest_of_command (struct lexer *lexer)
790 {
791   if (!getl_is_interactive (lexer->ss))
792     {
793       while (lexer->token != T_STOP && lexer->token != '.')
794         lex_get (lexer);
795     }
796   else
797     lex_discard_line (lexer);
798 }
799 \f
800 /* Weird line reading functions. */
801
802 /* Remove C-style comments in STRING, begun by slash-star and
803    terminated by star-slash or newline. */
804 static void
805 strip_comments (struct string *string)
806 {
807   char *cp;
808   int quote;
809   bool in_comment;
810
811   in_comment = false;
812   quote = EOF;
813   for (cp = ds_cstr (string); *cp; )
814     {
815       /* If we're not in a comment, check for quote marks. */
816       if (!in_comment)
817         {
818           if (*cp == quote)
819             quote = EOF;
820           else if (*cp == '\'' || *cp == '"')
821             quote = *cp;
822         }
823
824       /* If we're not inside a quotation, check for comment. */
825       if (quote == EOF)
826         {
827           if (cp[0] == '/' && cp[1] == '*')
828             {
829               in_comment = true;
830               *cp++ = ' ';
831               *cp++ = ' ';
832               continue;
833             }
834           else if (in_comment && cp[0] == '*' && cp[1] == '/')
835             {
836               in_comment = false;
837               *cp++ = ' ';
838               *cp++ = ' ';
839               continue;
840             }
841         }
842
843       /* Check commenting. */
844       if (in_comment)
845         *cp = ' ';
846       cp++;
847     }
848 }
849
850 /* Prepares LINE, which is subject to the given SYNTAX rules, for
851    tokenization by stripping comments and determining whether it
852    is the beginning or end of a command and storing into
853    *LINE_STARTS_COMMAND and *LINE_ENDS_COMMAND appropriately. */
854 void
855 lex_preprocess_line (struct string *line,
856                      enum syntax_mode syntax,
857                      bool *line_starts_command,
858                      bool *line_ends_command)
859 {
860   strip_comments (line);
861   ds_rtrim (line, ss_cstr (CC_SPACES));
862   *line_ends_command = (ds_chomp (line, get_endcmd ())
863                         || (ds_is_empty (line) && get_nulline ()));
864   *line_starts_command = false;
865   if (syntax == GETL_BATCH)
866     {
867       int first = ds_first (line);
868       *line_starts_command = !isspace (first);
869       if (first == '+' || first == '-')
870         *ds_data (line) = ' ';
871     }
872 }
873
874 /* Reads a line, without performing any preprocessing.
875    Sets *SYNTAX, if SYNTAX is non-null, to the line's syntax
876    mode. */
877 bool
878 lex_get_line_raw (struct lexer *lexer)
879 {
880   bool ok = getl_read_line (lexer->ss, &lexer->line_buffer);
881   enum syntax_mode mode = lex_current_syntax_mode (lexer);
882   journal_write (mode == GETL_BATCH, ds_cstr (&lexer->line_buffer));
883
884   return ok;
885 }
886
887 /* Reads a line for use by the tokenizer, and preprocesses it by
888    removing comments, stripping trailing whitespace and the
889    terminal dot, and removing leading indentors. */
890 bool
891 lex_get_line (struct lexer *lexer)
892 {
893   bool line_starts_command;
894
895   if (!lex_get_line_raw (lexer))
896     {
897       lexer->prog = NULL;
898       return false;
899     }
900
901   lex_preprocess_line (&lexer->line_buffer,
902                        lex_current_syntax_mode (lexer),
903                        &line_starts_command, &lexer->dot);
904
905   if (line_starts_command)
906     lexer->put_token = '.';
907
908   lexer->prog = ds_cstr (&lexer->line_buffer);
909   return true;
910 }
911 \f
912 /* Token names. */
913
914 /* Returns the name of a token. */
915 const char *
916 lex_token_name (int token)
917 {
918   if (lex_is_keyword (token))
919     return lex_id_name (token);
920   else if (token < 256)
921     {
922       static char t[256][2];
923       char *s = t[token];
924       s[0] = token;
925       s[1] = '\0';
926       return s;
927     }
928   else
929     NOT_REACHED ();
930 }
931
932 /* Returns an ASCII representation of the current token as a
933    malloc()'d string. */
934 char *
935 lex_token_representation (struct lexer *lexer)
936 {
937   char *token_rep;
938
939   switch (lexer->token)
940     {
941     case T_ID:
942     case T_POS_NUM:
943     case T_NEG_NUM:
944       return ds_xstrdup (&lexer->tokstr);
945       break;
946
947     case T_STRING:
948       {
949         int hexstring = 0;
950         char *sp, *dp;
951
952         for (sp = ds_cstr (&lexer->tokstr); sp < ds_end (&lexer->tokstr); sp++)
953           if (!isprint ((unsigned char) *sp))
954             {
955               hexstring = 1;
956               break;
957             }
958
959         token_rep = xmalloc (2 + ds_length (&lexer->tokstr) * 2 + 1 + 1);
960
961         dp = token_rep;
962         if (hexstring)
963           *dp++ = 'X';
964         *dp++ = '\'';
965
966         if (!hexstring)
967           for (sp = ds_cstr (&lexer->tokstr); *sp; )
968             {
969               if (*sp == '\'')
970                 *dp++ = '\'';
971               *dp++ = (unsigned char) *sp++;
972             }
973         else
974           for (sp = ds_cstr (&lexer->tokstr); sp < ds_end (&lexer->tokstr); sp++)
975             {
976               *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
977               *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
978             }
979         *dp++ = '\'';
980         *dp = '\0';
981
982         return token_rep;
983       }
984     break;
985
986     case T_STOP:
987       token_rep = xmalloc (1);
988       *token_rep = '\0';
989       return token_rep;
990
991     case T_EXP:
992       return xstrdup ("**");
993
994     default:
995       return xstrdup (lex_token_name (lexer->token));
996     }
997
998   NOT_REACHED ();
999 }
1000 \f
1001 /* Really weird functions. */
1002
1003 /* Most of the time, a `-' is a lead-in to a negative number.  But
1004    sometimes it's actually part of the syntax.  If a dash can be part
1005    of syntax then this function is called to rip it off of a
1006    number. */
1007 void
1008 lex_negative_to_dash (struct lexer *lexer)
1009 {
1010   if (lexer->token == T_NEG_NUM)
1011     {
1012       lexer->token = T_POS_NUM;
1013       lexer->tokval = -lexer->tokval;
1014       ds_assign_substring (&lexer->tokstr, ds_substr (&lexer->tokstr, 1, SIZE_MAX));
1015       save_token (lexer);
1016       lexer->token = '-';
1017     }
1018 }
1019
1020 /* Skip a COMMENT command. */
1021 void
1022 lex_skip_comment (struct lexer *lexer)
1023 {
1024   for (;;)
1025     {
1026       if (!lex_get_line (lexer))
1027         {
1028           lexer->put_token = T_STOP;
1029           lexer->prog = NULL;
1030           return;
1031         }
1032
1033       if (lexer->put_token == '.')
1034         break;
1035
1036       ds_cstr (&lexer->line_buffer); /* Ensures ds_end will point to a valid char */
1037       lexer->prog = ds_end (&lexer->line_buffer);
1038       if (lexer->dot)
1039         break;
1040     }
1041 }
1042 \f
1043 /* Private functions. */
1044
1045 /* When invoked, tokstr contains a string of binary, octal, or
1046    hex digits, according to TYPE.  The string is converted to
1047    characters having the specified values. */
1048 static void
1049 convert_numeric_string_to_char_string (struct lexer *lexer,
1050                                        enum string_type type)
1051 {
1052   const char *base_name;
1053   int base;
1054   int chars_per_byte;
1055   size_t byte_cnt;
1056   size_t i;
1057   char *p;
1058
1059   switch (type)
1060     {
1061     case BINARY_STRING:
1062       base_name = _("binary");
1063       base = 2;
1064       chars_per_byte = 8;
1065       break;
1066     case OCTAL_STRING:
1067       base_name = _("octal");
1068       base = 8;
1069       chars_per_byte = 3;
1070       break;
1071     case HEX_STRING:
1072       base_name = _("hex");
1073       base = 16;
1074       chars_per_byte = 2;
1075       break;
1076     default:
1077       NOT_REACHED ();
1078     }
1079
1080   byte_cnt = ds_length (&lexer->tokstr) / chars_per_byte;
1081   if (ds_length (&lexer->tokstr) % chars_per_byte)
1082     msg (SE, _("String of %s digits has %zu characters, which is not a "
1083                "multiple of %d."),
1084          base_name, ds_length (&lexer->tokstr), chars_per_byte);
1085
1086   p = ds_cstr (&lexer->tokstr);
1087   for (i = 0; i < byte_cnt; i++)
1088     {
1089       int value;
1090       int j;
1091
1092       value = 0;
1093       for (j = 0; j < chars_per_byte; j++, p++)
1094         {
1095           int v;
1096
1097           if (*p >= '0' && *p <= '9')
1098             v = *p - '0';
1099           else
1100             {
1101               static const char alpha[] = "abcdef";
1102               const char *q = strchr (alpha, tolower ((unsigned char) *p));
1103
1104               if (q)
1105                 v = q - alpha + 10;
1106               else
1107                 v = base;
1108             }
1109
1110           if (v >= base)
1111             msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
1112
1113           value = value * base + v;
1114         }
1115
1116       ds_cstr (&lexer->tokstr)[i] = (unsigned char) value;
1117     }
1118
1119   ds_truncate (&lexer->tokstr, byte_cnt);
1120 }
1121
1122 /* Parses a string from the input buffer into tokstr.  The input
1123    buffer pointer lexer->prog must point to the initial single or double
1124    quote.  TYPE indicates the type of string to be parsed.
1125    Returns token type. */
1126 static int
1127 parse_string (struct lexer *lexer, enum string_type type)
1128 {
1129   if (type != CHARACTER_STRING)
1130     lexer->prog++;
1131
1132   /* Accumulate the entire string, joining sections indicated by +
1133      signs. */
1134   for (;;)
1135     {
1136       /* Single or double quote. */
1137       int c = *lexer->prog++;
1138
1139       /* Accumulate section. */
1140       for (;;)
1141         {
1142           /* Check end of line. */
1143           if (*lexer->prog == '\0')
1144             {
1145               msg (SE, _("Unterminated string constant."));
1146               goto finish;
1147             }
1148
1149           /* Double quote characters to embed them in strings. */
1150           if (*lexer->prog == c)
1151             {
1152               if (lexer->prog[1] == c)
1153                 lexer->prog++;
1154               else
1155                 break;
1156             }
1157
1158           ds_put_char (&lexer->tokstr, *lexer->prog++);
1159         }
1160       lexer->prog++;
1161
1162       /* Skip whitespace after final quote mark. */
1163       if (lexer->prog == NULL)
1164         break;
1165       for (;;)
1166         {
1167           while (isspace ((unsigned char) *lexer->prog))
1168             lexer->prog++;
1169           if (*lexer->prog)
1170             break;
1171
1172           if (lexer->dot)
1173             goto finish;
1174
1175           if (!lex_get_line (lexer))
1176             goto finish;
1177         }
1178
1179       /* Skip plus sign. */
1180       if (*lexer->prog != '+')
1181         break;
1182       lexer->prog++;
1183
1184       /* Skip whitespace after plus sign. */
1185       if (lexer->prog == NULL)
1186         break;
1187       for (;;)
1188         {
1189           while (isspace ((unsigned char) *lexer->prog))
1190             lexer->prog++;
1191           if (*lexer->prog)
1192             break;
1193
1194           if (lexer->dot)
1195             goto finish;
1196
1197           if (!lex_get_line (lexer))
1198             {
1199               msg (SE, _("Unexpected end of file in string concatenation."));
1200               goto finish;
1201             }
1202         }
1203
1204       /* Ensure that a valid string follows. */
1205       if (*lexer->prog != '\'' && *lexer->prog != '"')
1206         {
1207           msg (SE, _("String expected following `+'."));
1208           goto finish;
1209         }
1210     }
1211
1212   /* We come here when we've finished concatenating all the string sections
1213      into one large string. */
1214 finish:
1215   if (type != CHARACTER_STRING)
1216     convert_numeric_string_to_char_string (lexer, type);
1217
1218   if (ds_length (&lexer->tokstr) > 255)
1219     {
1220       msg (SE, _("String exceeds 255 characters in length (%zu characters)."),
1221            ds_length (&lexer->tokstr));
1222       ds_truncate (&lexer->tokstr, 255);
1223     }
1224
1225   return T_STRING;
1226 }
1227 \f
1228 #if DUMP_TOKENS
1229 /* Reads one token from the lexer and writes a textual representation
1230    on stdout for debugging purposes. */
1231 static void
1232 dump_token (struct lexer *lexer)
1233 {
1234   {
1235     const char *curfn;
1236     int curln;
1237
1238     curln = getl_source_location (lexer->ss);
1239     curfn = getl_source_name (lexer->ss);
1240     if (curfn)
1241       fprintf (stderr, "%s:%d\t", curfn, curln);
1242   }
1243
1244   switch (lexer->token)
1245     {
1246     case T_ID:
1247       fprintf (stderr, "ID\t%s\n", lexer->tokid);
1248       break;
1249
1250     case T_POS_NUM:
1251     case T_NEG_NUM:
1252       fprintf (stderr, "NUM\t%f\n", lexer->tokval);
1253       break;
1254
1255     case T_STRING:
1256       fprintf (stderr, "STRING\t\"%s\"\n", ds_cstr (&lexer->tokstr));
1257       break;
1258
1259     case T_STOP:
1260       fprintf (stderr, "STOP\n");
1261       break;
1262
1263     case T_EXP:
1264       fprintf (stderr, "MISC\tEXP\"");
1265       break;
1266
1267     case 0:
1268       fprintf (stderr, "MISC\tEOF\n");
1269       break;
1270
1271     default:
1272       if (lex_is_keyword (lexer->token))
1273         fprintf (stderr, "KEYWORD\t%s\n", lex_token_name (lexer->token));
1274       else
1275         fprintf (stderr, "PUNCT\t%c\n", lexer->token);
1276       break;
1277     }
1278 }
1279 #endif /* DUMP_TOKENS */
1280
1281
1282 /* Token Accessor Functions */
1283
1284 int
1285 lex_token (const struct lexer *lexer)
1286 {
1287   return lexer->token;
1288 }
1289
1290 double
1291 lex_tokval (const struct lexer *lexer)
1292 {
1293   return lexer->tokval;
1294 }
1295
1296 const char *
1297 lex_tokid (const struct lexer *lexer)
1298 {
1299   return lexer->tokid;
1300 }
1301
1302 const struct string *
1303 lex_tokstr (const struct lexer *lexer)
1304 {
1305   return &lexer->tokstr;
1306 }