src/language/lexer/lexer.c

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