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