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