pintos-os.org Git - pspp/blob - src/language/lexer/lexer.c

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