2af520ac646cd94998708869ec6eecb3e3fa50e4
[pspp-builds.git] / src / language / 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 [LONG_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   if (lexer->token == T_ID
553       && lex_id_match (ss_cstr (s), ss_cstr (lexer->tokid)))
554     {
555       lex_get (lexer);
556       return true;
557     }
558   else
559     return false;
560 }
561
562 /* If the current token is integer N, skips it and returns true.
563    Otherwise, returns false. */
564 bool
565 lex_match_int (struct lexer *lexer, int x)
566 {
567   if (lex_is_integer (lexer) && lex_integer (lexer) == x)
568     {
569       lex_get (lexer);
570       return true;
571     }
572   else
573     return false;
574 }
575 \f
576 /* Forced matches. */
577
578 /* If this token is identifier S, fetches the next token and returns
579    nonzero.
580    Otherwise, reports an error and returns zero. */
581 bool
582 lex_force_match_id (struct lexer *lexer, const char *s)
583 {
584   if (lex_match_id (lexer, s))
585     return true;
586   else
587     {
588       lex_error (lexer, _("expecting `%s'"), s);
589       return false;
590     }
591 }
592
593 /* If the current token is T, skips the token.  Otherwise, reports an
594    error and returns from the current function with return value false. */
595 bool
596 lex_force_match (struct lexer *lexer, int t)
597 {
598   if (lexer->token == t)
599     {
600       lex_get (lexer);
601       return true;
602     }
603   else
604     {
605       lex_error (lexer, _("expecting `%s'"), lex_token_name (t));
606       return false;
607     }
608 }
609
610 /* If this token is a string, does nothing and returns true.
611    Otherwise, reports an error and returns false. */
612 bool
613 lex_force_string (struct lexer *lexer)
614 {
615   if (lexer->token == T_STRING)
616     return true;
617   else
618     {
619       lex_error (lexer, _("expecting string"));
620       return false;
621     }
622 }
623
624 /* If this token is an integer, does nothing and returns true.
625    Otherwise, reports an error and returns false. */
626 bool
627 lex_force_int (struct lexer *lexer)
628 {
629   if (lex_is_integer (lexer))
630     return true;
631   else
632     {
633       lex_error (lexer, _("expecting integer"));
634       return false;
635     }
636 }
637
638 /* If this token is a number, does nothing and returns true.
639    Otherwise, reports an error and returns false. */
640 bool
641 lex_force_num (struct lexer *lexer)
642 {
643   if (lex_is_number (lexer))
644     return true;
645
646   lex_error (lexer, _("expecting number"));
647   return false;
648 }
649
650 /* If this token is an identifier, does nothing and returns true.
651    Otherwise, reports an error and returns false. */
652 bool
653 lex_force_id (struct lexer *lexer)
654 {
655   if (lexer->token == T_ID)
656     return true;
657
658   lex_error (lexer, _("expecting identifier"));
659   return false;
660 }
661
662 /* Weird token functions. */
663
664 /* Returns the first character of the next token, except that if the
665    next token is not an identifier, the character returned will not be
666    a character that can begin an identifier.  Specifically, the
667    hexstring lead-in X' causes lookahead() to return '.  Note that an
668    alphanumeric return value doesn't guarantee an ID token, it could
669    also be a reserved-word token. */
670 int
671 lex_look_ahead (struct lexer *lexer)
672 {
673   if (lexer->put_token)
674     return lexer->put_token;
675
676   for (;;)
677     {
678       if (NULL == lexer->prog && ! lex_get_line (lexer) )
679         return 0;
680
681       for (;;)
682         {
683           while (isspace ((unsigned char) *lexer->prog))
684             lexer->prog++;
685           if (*lexer->prog)
686             break;
687
688           if (lexer->dot)
689             return '.';
690           else if (!lex_get_line (lexer))
691             return 0;
692
693           if (lexer->put_token)
694             return lexer->put_token;
695         }
696
697       if ((toupper ((unsigned char) *lexer->prog) == 'X'
698            || toupper ((unsigned char) *lexer->prog) == 'B'
699            || toupper ((unsigned char) *lexer->prog) == 'O')
700           && (lexer->prog[1] == '\'' || lexer->prog[1] == '"'))
701         return '\'';
702
703       return *lexer->prog;
704     }
705 }
706
707 /* Makes the current token become the next token to be read; the
708    current token is set to T. */
709 void
710 lex_put_back (struct lexer *lexer, int t)
711 {
712   save_token (lexer);
713   lexer->token = t;
714 }
715
716 /* Makes the current token become the next token to be read; the
717    current token is set to the identifier ID. */
718 void
719 lex_put_back_id (struct lexer *lexer, const char *id)
720 {
721   assert (lex_id_to_token (ss_cstr (id)) == T_ID);
722   save_token (lexer);
723   lexer->token = T_ID;
724   ds_assign_cstr (&lexer->tokstr, id);
725   str_copy_trunc (lexer->tokid, sizeof lexer->tokid, ds_cstr (&lexer->tokstr));
726 }
727 \f
728 /* Weird line processing functions. */
729
730 /* Returns the entire contents of the current line. */
731 const char *
732 lex_entire_line (const struct lexer *lexer)
733 {
734   return ds_cstr (&lexer->line_buffer);
735 }
736
737 const struct string *
738 lex_entire_line_ds (const struct lexer *lexer)
739 {
740   return &lexer->line_buffer;
741 }
742
743 /* As lex_entire_line(), but only returns the part of the current line
744    that hasn't already been tokenized. */
745 const char *
746 lex_rest_of_line (const struct lexer *lexer)
747 {
748   return lexer->prog;
749 }
750
751 /* Returns true if the current line ends in a terminal dot,
752    false otherwise. */
753 bool
754 lex_end_dot (const struct lexer *lexer)
755 {
756   return lexer->dot;
757 }
758
759 /* Causes the rest of the current input line to be ignored for
760    tokenization purposes. */
761 void
762 lex_discard_line (struct lexer *lexer)
763 {
764   ds_cstr (&lexer->line_buffer);  /* Ensures ds_end points to something valid */
765   lexer->prog = ds_end (&lexer->line_buffer);
766   lexer->dot = false;
767   lexer->put_token = 0;
768 }
769
770
771 /* Discards the rest of the current command.
772    When we're reading commands from a file, we skip tokens until
773    a terminal dot or EOF.
774    When we're reading commands interactively from the user,
775    that's just discarding the current line, because presumably
776    the user doesn't want to finish typing a command that will be
777    ignored anyway. */
778 void
779 lex_discard_rest_of_command (struct lexer *lexer)
780 {
781   if (!getl_is_interactive (lexer->ss))
782     {
783       while (lexer->token != T_STOP && lexer->token != '.')
784         lex_get (lexer);
785     }
786   else
787     lex_discard_line (lexer);
788 }
789 \f
790 /* Weird line reading functions. */
791
792 /* Remove C-style comments in STRING, begun by slash-star and
793    terminated by star-slash or newline. */
794 static void
795 strip_comments (struct string *string)
796 {
797   char *cp;
798   int quote;
799   bool in_comment;
800
801   in_comment = false;
802   quote = EOF;
803   for (cp = ds_cstr (string); *cp; )
804     {
805       /* If we're not in a comment, check for quote marks. */
806       if (!in_comment)
807         {
808           if (*cp == quote)
809             quote = EOF;
810           else if (*cp == '\'' || *cp == '"')
811             quote = *cp;
812         }
813
814       /* If we're not inside a quotation, check for comment. */
815       if (quote == EOF)
816         {
817           if (cp[0] == '/' && cp[1] == '*')
818             {
819               in_comment = true;
820               *cp++ = ' ';
821               *cp++ = ' ';
822               continue;
823             }
824           else if (in_comment && cp[0] == '*' && cp[1] == '/')
825             {
826               in_comment = false;
827               *cp++ = ' ';
828               *cp++ = ' ';
829               continue;
830             }
831         }
832
833       /* Check commenting. */
834       if (in_comment)
835         *cp = ' ';
836       cp++;
837     }
838 }
839
840 /* Prepares LINE, which is subject to the given SYNTAX rules, for
841    tokenization by stripping comments and determining whether it
842    is the beginning or end of a command and storing into
843    *LINE_STARTS_COMMAND and *LINE_ENDS_COMMAND appropriately. */
844 void
845 lex_preprocess_line (struct string *line,
846                      enum syntax_mode syntax,
847                      bool *line_starts_command,
848                      bool *line_ends_command)
849 {
850   strip_comments (line);
851   ds_rtrim (line, ss_cstr (CC_SPACES));
852   *line_ends_command = (ds_chomp (line, get_endcmd ())
853                         || (ds_is_empty (line) && get_nulline ()));
854   *line_starts_command = false;
855   if (syntax == GETL_BATCH)
856     {
857       int first = ds_first (line);
858       *line_starts_command = !isspace (first);
859       if (first == '+' || first == '-')
860         *ds_data (line) = ' ';
861     }
862 }
863
864 /* Reads a line, without performing any preprocessing.
865    Sets *SYNTAX, if SYNTAX is non-null, to the line's syntax
866    mode. */
867 bool
868 lex_get_line_raw (struct lexer *lexer)
869 {
870   bool ok = getl_read_line (lexer->ss, &lexer->line_buffer);
871   enum syntax_mode mode = lex_current_syntax_mode (lexer);
872   journal_write (mode == GETL_BATCH, ds_cstr (&lexer->line_buffer));
873
874   return ok;
875 }
876
877 /* Reads a line for use by the tokenizer, and preprocesses it by
878    removing comments, stripping trailing whitespace and the
879    terminal dot, and removing leading indentors. */
880 bool
881 lex_get_line (struct lexer *lexer)
882 {
883   bool line_starts_command;
884
885   if (!lex_get_line_raw (lexer))
886     {
887       lexer->prog = NULL;
888       return false;
889     }
890
891   lex_preprocess_line (&lexer->line_buffer,
892                        lex_current_syntax_mode (lexer),
893                        &line_starts_command, &lexer->dot);
894
895   if (line_starts_command)
896     lexer->put_token = '.';
897
898   lexer->prog = ds_cstr (&lexer->line_buffer);
899   return true;
900 }
901 \f
902 /* Token names. */
903
904 /* Returns the name of a token. */
905 const char *
906 lex_token_name (int token)
907 {
908   if (lex_is_keyword (token))
909     return lex_id_name (token);
910   else if (token < 256)
911     {
912       static char t[256][2];
913       char *s = t[token];
914       s[0] = token;
915       s[1] = '\0';
916       return s;
917     }
918   else
919     NOT_REACHED ();
920 }
921
922 /* Returns an ASCII representation of the current token as a
923    malloc()'d string. */
924 char *
925 lex_token_representation (struct lexer *lexer)
926 {
927   char *token_rep;
928
929   switch (lexer->token)
930     {
931     case T_ID:
932     case T_POS_NUM:
933     case T_NEG_NUM:
934       return ds_xstrdup (&lexer->tokstr);
935       break;
936
937     case T_STRING:
938       {
939         int hexstring = 0;
940         char *sp, *dp;
941
942         for (sp = ds_cstr (&lexer->tokstr); sp < ds_end (&lexer->tokstr); sp++)
943           if (!isprint ((unsigned char) *sp))
944             {
945               hexstring = 1;
946               break;
947             }
948
949         token_rep = xmalloc (2 + ds_length (&lexer->tokstr) * 2 + 1 + 1);
950
951         dp = token_rep;
952         if (hexstring)
953           *dp++ = 'X';
954         *dp++ = '\'';
955
956         if (!hexstring)
957           for (sp = ds_cstr (&lexer->tokstr); *sp; )
958             {
959               if (*sp == '\'')
960                 *dp++ = '\'';
961               *dp++ = (unsigned char) *sp++;
962             }
963         else
964           for (sp = ds_cstr (&lexer->tokstr); sp < ds_end (&lexer->tokstr); sp++)
965             {
966               *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
967               *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
968             }
969         *dp++ = '\'';
970         *dp = '\0';
971
972         return token_rep;
973       }
974     break;
975
976     case T_STOP:
977       token_rep = xmalloc (1);
978       *token_rep = '\0';
979       return token_rep;
980
981     case T_EXP:
982       return xstrdup ("**");
983
984     default:
985       return xstrdup (lex_token_name (lexer->token));
986     }
987
988   NOT_REACHED ();
989 }
990 \f
991 /* Really weird functions. */
992
993 /* Most of the time, a `-' is a lead-in to a negative number.  But
994    sometimes it's actually part of the syntax.  If a dash can be part
995    of syntax then this function is called to rip it off of a
996    number. */
997 void
998 lex_negative_to_dash (struct lexer *lexer)
999 {
1000   if (lexer->token == T_NEG_NUM)
1001     {
1002       lexer->token = T_POS_NUM;
1003       lexer->tokval = -lexer->tokval;
1004       ds_assign_substring (&lexer->tokstr, ds_substr (&lexer->tokstr, 1, SIZE_MAX));
1005       save_token (lexer);
1006       lexer->token = '-';
1007     }
1008 }
1009
1010 /* Skip a COMMENT command. */
1011 void
1012 lex_skip_comment (struct lexer *lexer)
1013 {
1014   for (;;)
1015     {
1016       if (!lex_get_line (lexer))
1017         {
1018           lexer->put_token = T_STOP;
1019           lexer->prog = NULL;
1020           return;
1021         }
1022
1023       if (lexer->put_token == '.')
1024         break;
1025
1026       ds_cstr (&lexer->line_buffer); /* Ensures ds_end will point to a valid char */
1027       lexer->prog = ds_end (&lexer->line_buffer);
1028       if (lexer->dot)
1029         break;
1030     }
1031 }
1032 \f
1033 /* Private functions. */
1034
1035 /* When invoked, tokstr contains a string of binary, octal, or
1036    hex digits, according to TYPE.  The string is converted to
1037    characters having the specified values. */
1038 static void
1039 convert_numeric_string_to_char_string (struct lexer *lexer,
1040                                        enum string_type type)
1041 {
1042   const char *base_name;
1043   int base;
1044   int chars_per_byte;
1045   size_t byte_cnt;
1046   size_t i;
1047   char *p;
1048
1049   switch (type)
1050     {
1051     case BINARY_STRING:
1052       base_name = _("binary");
1053       base = 2;
1054       chars_per_byte = 8;
1055       break;
1056     case OCTAL_STRING:
1057       base_name = _("octal");
1058       base = 8;
1059       chars_per_byte = 3;
1060       break;
1061     case HEX_STRING:
1062       base_name = _("hex");
1063       base = 16;
1064       chars_per_byte = 2;
1065       break;
1066     default:
1067       NOT_REACHED ();
1068     }
1069
1070   byte_cnt = ds_length (&lexer->tokstr) / chars_per_byte;
1071   if (ds_length (&lexer->tokstr) % chars_per_byte)
1072     msg (SE, _("String of %s digits has %d characters, which is not a "
1073                "multiple of %d."),
1074          base_name, (int) ds_length (&lexer->tokstr), chars_per_byte);
1075
1076   p = ds_cstr (&lexer->tokstr);
1077   for (i = 0; i < byte_cnt; i++)
1078     {
1079       int value;
1080       int j;
1081
1082       value = 0;
1083       for (j = 0; j < chars_per_byte; j++, p++)
1084         {
1085           int v;
1086
1087           if (*p >= '0' && *p <= '9')
1088             v = *p - '0';
1089           else
1090             {
1091               static const char alpha[] = "abcdef";
1092               const char *q = strchr (alpha, tolower ((unsigned char) *p));
1093
1094               if (q)
1095                 v = q - alpha + 10;
1096               else
1097                 v = base;
1098             }
1099
1100           if (v >= base)
1101             msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
1102
1103           value = value * base + v;
1104         }
1105
1106       ds_cstr (&lexer->tokstr)[i] = (unsigned char) value;
1107     }
1108
1109   ds_truncate (&lexer->tokstr, byte_cnt);
1110 }
1111
1112 /* Parses a string from the input buffer into tokstr.  The input
1113    buffer pointer lexer->prog must point to the initial single or double
1114    quote.  TYPE indicates the type of string to be parsed.
1115    Returns token type. */
1116 static int
1117 parse_string (struct lexer *lexer, enum string_type type)
1118 {
1119   if (type != CHARACTER_STRING)
1120     lexer->prog++;
1121
1122   /* Accumulate the entire string, joining sections indicated by +
1123      signs. */
1124   for (;;)
1125     {
1126       /* Single or double quote. */
1127       int c = *lexer->prog++;
1128
1129       /* Accumulate section. */
1130       for (;;)
1131         {
1132           /* Check end of line. */
1133           if (*lexer->prog == '\0')
1134             {
1135               msg (SE, _("Unterminated string constant."));
1136               goto finish;
1137             }
1138
1139           /* Double quote characters to embed them in strings. */
1140           if (*lexer->prog == c)
1141             {
1142               if (lexer->prog[1] == c)
1143                 lexer->prog++;
1144               else
1145                 break;
1146             }
1147
1148           ds_put_char (&lexer->tokstr, *lexer->prog++);
1149         }
1150       lexer->prog++;
1151
1152       /* Skip whitespace after final quote mark. */
1153       if (lexer->prog == NULL)
1154         break;
1155       for (;;)
1156         {
1157           while (isspace ((unsigned char) *lexer->prog))
1158             lexer->prog++;
1159           if (*lexer->prog)
1160             break;
1161
1162           if (lexer->dot)
1163             goto finish;
1164
1165           if (!lex_get_line (lexer))
1166             goto finish;
1167         }
1168
1169       /* Skip plus sign. */
1170       if (*lexer->prog != '+')
1171         break;
1172       lexer->prog++;
1173
1174       /* Skip whitespace after plus sign. */
1175       if (lexer->prog == NULL)
1176         break;
1177       for (;;)
1178         {
1179           while (isspace ((unsigned char) *lexer->prog))
1180             lexer->prog++;
1181           if (*lexer->prog)
1182             break;
1183
1184           if (lexer->dot)
1185             goto finish;
1186
1187           if (!lex_get_line (lexer))
1188             {
1189               msg (SE, _("Unexpected end of file in string concatenation."));
1190               goto finish;
1191             }
1192         }
1193
1194       /* Ensure that a valid string follows. */
1195       if (*lexer->prog != '\'' && *lexer->prog != '"')
1196         {
1197           msg (SE, _("String expected following `+'."));
1198           goto finish;
1199         }
1200     }
1201
1202   /* We come here when we've finished concatenating all the string sections
1203      into one large string. */
1204 finish:
1205   if (type != CHARACTER_STRING)
1206     convert_numeric_string_to_char_string (lexer, type);
1207
1208   if (ds_length (&lexer->tokstr) > 255)
1209     {
1210       msg (SE, _("String exceeds 255 characters in length (%d characters)."),
1211            (int) ds_length (&lexer->tokstr));
1212       ds_truncate (&lexer->tokstr, 255);
1213     }
1214
1215   return T_STRING;
1216 }
1217 \f
1218 #if DUMP_TOKENS
1219 /* Reads one token from the lexer and writes a textual representation
1220    on stdout for debugging purposes. */
1221 static void
1222 dump_token (struct lexer *lexer)
1223 {
1224   {
1225     const char *curfn;
1226     int curln;
1227
1228     curln = getl_source_location (lexer->ss);
1229     curfn = getl_source_name (lexer->ss);
1230     if (curfn)
1231       fprintf (stderr, "%s:%d\t", curfn, curln);
1232   }
1233
1234   switch (lexer->token)
1235     {
1236     case T_ID:
1237       fprintf (stderr, "ID\t%s\n", lexer->tokid);
1238       break;
1239
1240     case T_POS_NUM:
1241     case T_NEG_NUM:
1242       fprintf (stderr, "NUM\t%f\n", lexer->tokval);
1243       break;
1244
1245     case T_STRING:
1246       fprintf (stderr, "STRING\t\"%s\"\n", ds_cstr (&lexer->tokstr));
1247       break;
1248
1249     case T_STOP:
1250       fprintf (stderr, "STOP\n");
1251       break;
1252
1253     case T_EXP:
1254       fprintf (stderr, "MISC\tEXP\"");
1255       break;
1256
1257     case 0:
1258       fprintf (stderr, "MISC\tEOF\n");
1259       break;
1260
1261     default:
1262       if (lex_is_keyword (lexer->token))
1263         fprintf (stderr, "KEYWORD\t%s\n", lex_token_name (lexer->token));
1264       else
1265         fprintf (stderr, "PUNCT\t%c\n", lexer->token);
1266       break;
1267     }
1268 }
1269 #endif /* DUMP_TOKENS */
1270
1271
1272 /* Token Accessor Functions */
1273
1274 int
1275 lex_token (const struct lexer *lexer)
1276 {
1277   return lexer->token;
1278 }
1279
1280 double
1281 lex_tokval (const struct lexer *lexer)
1282 {
1283   return lexer->tokval;
1284 }
1285
1286 const char *
1287 lex_tokid (const struct lexer *lexer)
1288 {
1289   return lexer->tokid;
1290 }
1291
1292 const struct string *
1293 lex_tokstr (const struct lexer *lexer)
1294 {
1295   return &lexer->tokstr;
1296 }