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