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