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