ghc/compiler/parser/hslexer.flex

   1 %{
   2 /**********************************************************************
   3 *                                                                     *
   4 *                                                                     *
   5 *       FLEX for Haskell.                                             *
   6 *       -----------------                                             *
   7 *                                                                     *
   8 **********************************************************************/
   9
  10 /* The includes/config.h one */
  11 #include "config.h"
  12
  13 #include <stdio.h>
  14
  15 #if defined(STDC_HEADERS) || defined(HAVE_STRING_H)
  16 #include <string.h>
  17 /* An ANSI string.h and pre-ANSI memory.h might conflict.  */
  18 #if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H)
  19 #include <memory.h>
  20 #endif /* not STDC_HEADERS and HAVE_MEMORY_H */
  21 #define index strchr
  22 #define rindex strrchr
  23 #define bcopy(s, d, n) memcpy ((d), (s), (n))
  24 #define bcmp(s1, s2, n) memcmp ((s1), (s2), (n))
  25 #define bzero(s, n) memset ((s), 0, (n))
  26 #else /* not STDC_HEADERS and not HAVE_STRING_H */
  27 #include <strings.h>
  28 /* memory.h and strings.h conflict on some systems.  */
  29 #endif /* not STDC_HEADERS and not HAVE_STRING_H */
  30
  31 #include "hspincl.h"
  32 #include "hsparser.tab.h"
  33 #include "constants.h"
  34 #include "utils.h"
  35
  36 /* Our substitute for <ctype.h> */
  37
  38 #define NCHARS  256
  39 #define _S      0x1
  40 #define _D      0x2
  41 #define _H      0x4
  42 #define _O      0x8
  43 #define _C      0x10
  44
  45 static unsigned char CharTable[NCHARS] = {
  46 /* nul */       0,      0,      0,      0,      0,      0,      0,      0,
  47 /* bs  */       0,      _S,     _S,     _S,     _S,     0,      0,      0,
  48 /* dle */       0,      0,      0,      0,      0,      0,      0,      0,
  49 /* can */       0,      0,      0,      0,      0,      0,      0,      0,
  50 /* sp  */       _S,     0,      0,      0,      0,      0,      0,      0,
  51 /* '(' */       _C,     0,      0,      0,      0,      0,      0,      0,
  52 /* '0' */       _D|_H|_O,_D|_H|_O,_D|_H|_O,_D|_H|_O,_D|_H|_O,_D|_H|_O,_D|_H|_O,_D|_H|_O,
  53 /* '8' */       _D|_H,  _D|_H,  _C,     0,      0,      0,      0,      0,
  54 /* '@' */       0,      _H|_C,  _H|_C,  _H|_C,  _H|_C,  _H|_C,  _H|_C,  _C,
  55 /* 'H' */       _C,     _C,     _C,     _C,     _C,     _C,     _C,     _C,
  56 /* 'P' */       _C,     _C,     _C,     _C,     _C,     _C,     _C,     _C,
  57 /* 'X' */       _C,     _C,     _C,     _C,     0,      0,      0,      0,
  58 /* '`' */       0,      _H,     _H,     _H,     _H,     _H,     _H,     0,
  59 /* 'h' */       0,      0,      0,      0,      0,      0,      0,      0,
  60 /* 'p' */       0,      0,      0,      0,      0,      0,      0,      0,
  61 /* 'x' */       0,      0,      0,      0,      0,      0,      0,      0,
  62
  63 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  64 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  65 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  66 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  67 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  68 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  69 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  70 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  71 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  72 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  73 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  74 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  75 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  76 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  77 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  78 /*     */       0,      0,      0,      0,      0,      0,      0,      0,
  79 };
  80
  81 BOOLEAN
  82 isconstr (char *s)
  83 {
  84     return(CharTable[*s]&(_C));
  85 }
  86
  87 /**********************************************************************
  88 *                                                                     *
  89 *                                                                     *
  90 *      Declarations                                                   *
  91 *                                                                     *
  92 *                                                                     *
  93 **********************************************************************/
  94
  95 char *input_filename = NULL;    /* Always points to a dynamically allocated string */
  96
  97 /*
  98  * For my own sanity, things that are not part of the flex skeleton
  99  * have been renamed as hsXXXXX rather than yyXXXXX.  --JSM
 100  */
 101
 102 static int hslineno = 0;        /* Line number at end of token */
 103 int hsplineno = 0;              /* Line number at end of previous token */
 104
 105 static int hscolno = 0;         /* Column number at end of token */
 106 int hspcolno = 0;               /* Column number at end of previous token */
 107 static int hsmlcolno = 0;       /* Column number for multiple-rule lexemes */
 108
 109 int modulelineno = -1;          /* The line number where the module starts */
 110 int startlineno = 0;            /* The line number where something starts */
 111 int endlineno = 0;              /* The line number where something ends */
 112
 113 static BOOLEAN noGap = TRUE;    /* For checking string gaps */
 114 static BOOLEAN forgetindent = FALSE;    /* Don't bother applying indentation rules */
 115
 116 static int nested_comments;     /* For counting comment nesting depth */
 117
 118 /* OLD: Hacky definition of yywrap: see flex doc.
 119
 120    If we don't do this, then we'll have to get the default
 121    yywrap from the flex library, which is often something
 122    we are not good at locating.  This avoids that difficulty.
 123    (Besides which, this is the way old flexes (pre 2.4.x) did it.)
 124    WDP 94/09/05
 125 #define yywrap() 1
 126 */
 127
 128 /* Essential forward declarations */
 129
 130 static void hsnewid      PROTO((char *, int));
 131 static void layout_input PROTO((char *, int));
 132 static void cleartext    (NO_ARGS);
 133 static void addtext      PROTO((char *, unsigned));
 134 static void addchar      PROTO((char));
 135 static char *fetchtext   PROTO((unsigned *));
 136 static void new_filename PROTO((char *));
 137 static int  Return       PROTO((int));
 138 static void hsentercontext PROTO((int));
 139
 140 /* Special file handling for IMPORTS */
 141 /*  Note: imports only ever go *one deep* (hence no need for a stack) WDP 94/09 */
 142
 143 static YY_BUFFER_STATE hsbuf_save = NULL;       /* Saved input buffer    */
 144 static char *filename_save;             /* File Name                     */
 145 static int hslineno_save = 0,           /* Line Number                   */
 146  hsplineno_save = 0,                    /* Line Number of Prev. token    */
 147  hscolno_save = 0,                      /* Indentation                   */
 148  hspcolno_save = 0;                     /* Left Indentation              */
 149 static short icontexts_save = 0;        /* Indent Context Level          */
 150
 151 static BOOLEAN etags_save;              /* saved: whether doing etags stuff or not */
 152 extern BOOLEAN etags;                   /* that which is saved */
 153
 154 extern BOOLEAN nonstandardFlag;         /* Glasgow extensions allowed */
 155
 156 static int hssttok = -1;        /* Stacked Token: -1   -- no token; -ve  -- ";"
 157                                  * inserted before token +ve  -- "}" inserted before
 158                                  * token */
 159
 160 short icontexts = 0;            /* Which context we're in */
 161
 162 /*
 163         Table of indentations:  right bit indicates whether to use
 164           indentation rules (1 = use rules; 0 = ignore)
 165
 166     partain:
 167     push one of these "contexts" at every "case" or "where"; the right bit says
 168     whether user supplied braces, etc., or not.  pop appropriately (hsendindent).
 169
 170     ALSO, a push/pop when enter/exit a new file (e.g., on importing).  A -1 is
 171     pushed (the "column" for "module", "interface" and EOF).  The -1 from the initial
 172     push is shown just below.
 173
 174 */
 175
 176
 177 static short indenttab[MAX_CONTEXTS] = {-1};
 178
 179 #define INDENTPT (indenttab[icontexts]>>1)
 180 #define INDENTON (indenttab[icontexts]&1)
 181
 182 #define RETURN(tok) return(Return(tok))
 183
 184 #undef YY_DECL
 185 #define YY_DECL int yylex1()
 186
 187 /* We should not peek at yy_act, but flex calls us even for the internal action
 188    triggered on 'end-of-buffer' (This is not true of flex 2.4.4 and up, but
 189    to support older versions of flex, we'll continue to peek for now.
 190  */
 191 #define YY_USER_ACTION \
 192     if (yy_act != YY_END_OF_BUFFER) layout_input(yytext, yyleng);
 193
 194 #if 0/*debug*/
 195 #undef YY_BREAK
 196 #define YY_BREAK if (etags) fprintf(stderr,"%d %d / %d %d / %d\n",hsplineno,hspcolno,hslineno,hscolno,startlineno); break;
 197 #endif
 198
 199 /* Each time we enter a new start state, we push it onto the state stack.
 200 */
 201 #define PUSH_STATE(n)   yy_push_state(n)
 202 #define POP_STATE       yy_pop_state()
 203
 204 %}
 205 /* Options:
 206     8bit (8-bit input)
 207     noyywrap (do not call yywrap on end of file; avoid use of -lfl)
 208     never-interactive (to go a bit faster)
 209     stack (use a start-condition stack)
 210 */
 211 %option 8bit
 212 %option noyywrap
 213 %option never-interactive
 214 %option stack
 215
 216 /* The start states are:
 217    Code -- normal Haskell code (principal lexer)
 218    GlaExt -- Haskell code with Glasgow extensions
 219    Comment -- Nested comment processing
 220    String -- Inside a string literal with backslashes
 221    StringEsc -- Immediately following a backslash in a string literal
 222    Char -- Inside a character literal with backslashes
 223    CharEsc -- Immediately following a backslash in a character literal
 224
 225    Note that the INITIAL state is unused.  Also note that these states
 226    are _exclusive_.  All rules should be prefixed with an appropriate
 227    list of start states.
 228  */
 229
 230 %x Char CharEsc Code Comment GlaExt UserPragma String StringEsc
 231
 232 isoS                    [\xa1-\xbf\xd7\xf7]
 233 isoL                    [\xc0-\xd6\xd8-\xde]
 234 isol                    [\xdf-\xf6\xf8-\xff]
 235 isoA                    [\xa1-\xff]
 236
 237 D                       [0-9]
 238 O                       [0-7]
 239 H                       [0-9A-Fa-f]
 240 N                       {D}+
 241 F                       {N}"."{N}(("e"|"E")("+"|"-")?{N})?
 242 S                       [!#$%&*+./<=>?@\\^|\-~:\xa1-\xbf\xd7\xf7]
 243 SId                     {S}{S}*
 244 L                       [A-Z\xc0-\xd6\xd8-\xde]
 245 l                       [a-z\xdf-\xf6\xf8-\xff]
 246 I                       {L}|{l}
 247 i                       {L}|{l}|[0-9'_]
 248 Id                      {I}{i}*
 249 Mod                     {L}{i}*
 250 CHAR                    [ !#$%&()*+,\-./0-9:;<=>?@A-Z\[\]^_`a-z{|}~\xa1-\xff]
 251 CNTRL                   [@A-Z\[\\\]^_]
 252 WS                      [ \t\n\r\f\v]
 253 NL                      [\n\r]
 254
 255 %%
 256
 257 %{
 258     /*
 259      * Simple comments and whitespace.  Normally, we would just ignore these, but
 260      * in case we're processing a string escape, we need to note that we've seen
 261      * a gap.
 262      *
 263      * Note that we cater for a comment line that *doesn't* end in a newline.
 264      * This is incorrect, strictly speaking, but seems like the right thing
 265      * to do.  Reported by Rajiv Mirani.  (WDP 95/08)
 266      *
 267      * Hackily moved up here so that --<<EOF>> will match     -- SOF 5/97
 268      */
 269 %}
 270
 271 <Code,GlaExt,StringEsc>"--"[^\n\r]*{NL}?{WS}* |
 272 <Code,GlaExt,UserPragma,StringEsc>{WS}+ { noGap = FALSE; }
 273
 274 %{
 275     /*
 276      * Special GHC pragma rules.  Do we need a start state for interface files,
 277      * so these won't be matched in source files? --JSM
 278      */
 279
 280 %}
 281
 282 %{
 283 /* I believe the next rule is not ever matched.
 284
 285    The '#line ' rule is un-cool, recognising a cpp directive inside hs source.
 286    Driver has now been modified to output `standard' {-# LINE ..-} pragmas
 287    where possible, so the lexer should now never see cpp directives
 288    like '# ' and '#line'.
 289
 290    -- SOF
 291
 292 <Code,GlaExt>^"# ".*{NL}    {
 293                           char tempf[FILENAME_SIZE];
 294                           sscanf(yytext+1, "%d \"%[^\"]", &hslineno, tempf);
 295                           new_filename(tempf);
 296                           hsplineno = hslineno; hscolno = 0; hspcolno = 0;
 297                         }
 298
 299 <Code,GlaExt>^"#line ".*{NL}    {
 300                           char tempf[FILENAME_SIZE];
 301                           sscanf(yytext+5, "%d \"%[^\"]", &hslineno, tempf);
 302                           new_filename(tempf);
 303                           hsplineno = hslineno; hscolno = 0; hspcolno = 0;
 304                         }
 305 */
 306 %}
 307
 308 <Code,GlaExt>"{-# LINE ".*"-}"{NL} {
 309                           /* partain: pragma-style line directive */
 310                           char tempf[FILENAME_SIZE];
 311                           sscanf(yytext+9, "%d \"%[^\"]", &hslineno, tempf);
 312                           new_filename(tempf);
 313                           hsplineno = hslineno; hscolno = 0; hspcolno = 0;
 314                         }
 315
 316 <Code,GlaExt>"{-#"{WS}*"INTERFACE" {
 317                               PUSH_STATE(UserPragma);
 318                               RETURN(INTERFACE_UPRAGMA);
 319                             }
 320 <Code,GlaExt>"{-#"{WS}*"SPECIALI"[SZ]E {
 321                               PUSH_STATE(UserPragma);
 322                               RETURN(SPECIALISE_UPRAGMA);
 323                             }
 324 <Code,GlaExt>"{-#"{WS}*"INLINE" {
 325                               PUSH_STATE(UserPragma);
 326                               RETURN(INLINE_UPRAGMA);
 327                             }
 328 <Code,GlaExt>"{-#"{WS}*"NOINLINE" {
 329                               PUSH_STATE(UserPragma);
 330                               RETURN(NOINLINE_UPRAGMA);
 331                             }
 332 <Code,GlaExt>"{-#"{WS}*"MAGIC_UNFOLDING" {
 333                               PUSH_STATE(UserPragma);
 334                               RETURN(MAGIC_UNFOLDING_UPRAGMA);
 335                             }
 336 <Code,GlaExt>"{-#"{WS}*"GENERATE_SPECS" {
 337                               /* these are handled by hscpp */
 338                               nested_comments =1;
 339                               PUSH_STATE(Comment);
 340                             }
 341 <Code,GlaExt>"{-#"{WS}*"OPTIONS" {
 342                               /* these are for the driver! */
 343                               nested_comments =1;
 344                               PUSH_STATE(Comment);
 345                             }
 346 <Code,GlaExt>"{-#"{WS}*"SOURCE"{WS}*"#"?"-}" {
 347                               /* these are used by `make depend' and the
 348                                  compiler to indicate that a module should
 349                                  be imported from source */
 350                               nested_comments =1;
 351                               RETURN(SOURCE_UPRAGMA);
 352                             }
 353
 354 <Code,GlaExt>"{-#"{WS}*[A-Z_]+ {
 355                               fprintf(stderr, "%s:%d: Warning: Unrecognised pragma '",
 356                                 input_filename, hsplineno);
 357                               format_string(stderr, (unsigned char *) yytext, yyleng);
 358                               fputs("'\n", stderr);
 359                               nested_comments = 1;
 360                               PUSH_STATE(Comment);
 361                             }
 362 <UserPragma>"#-}"           { POP_STATE; RETURN(END_UPRAGMA); }
 363
 364 %{
 365     /*
 366      * Haskell keywords.  `scc' is actually a Glasgow extension, but it is
 367      * intentionally accepted as a keyword even for normal <Code>.
 368      */
 369 %}
 370
 371 <Code,GlaExt>"case"             { RETURN(CASE); }
 372 <Code,GlaExt>"class"            { RETURN(CLASS); }
 373 <Code,GlaExt,UserPragma>"data"  { RETURN(DATA); }
 374 <Code,GlaExt>"default"          { RETURN(DEFAULT); }
 375 <Code,GlaExt>"deriving"         { RETURN(DERIVING); }
 376 <Code,GlaExt>"do"               { RETURN(DO); }
 377 <Code,GlaExt>"else"             { RETURN(ELSE); }
 378 <Code,GlaExt>"if"               { RETURN(IF); }
 379 <Code,GlaExt>"import"           { RETURN(IMPORT); }
 380 <Code,GlaExt>"in"               { RETURN(IN); }
 381 <Code,GlaExt>"infix"            { RETURN(INFIX); }
 382 <Code,GlaExt>"infixl"           { RETURN(INFIXL); }
 383 <Code,GlaExt>"infixr"           { RETURN(INFIXR); }
 384 <Code,GlaExt,UserPragma>"instance" { RETURN(INSTANCE); }
 385 <Code,GlaExt>"let"              { RETURN(LET); }
 386 <Code,GlaExt>"module"           { RETURN(MODULE); }
 387 <Code,GlaExt>"newtype"          { RETURN(NEWTYPE); }
 388 <Code,GlaExt>"of"               { RETURN(OF); }
 389 <Code,GlaExt>"then"             { RETURN(THEN); }
 390 <Code,GlaExt>"type"             { RETURN(TYPE); }
 391 <Code,GlaExt>"where"            { RETURN(WHERE); }
 392
 393 <Code,GlaExt>"as"               { RETURN(AS); }
 394 <Code,GlaExt>"hiding"           { RETURN(HIDING); }
 395 <Code,GlaExt>"qualified"        { RETURN(QUALIFIED); }
 396
 397 <Code,GlaExt>"_scc_"            { RETURN(SCC); }
 398 <GlaExt>"_ccall_"               { RETURN(CCALL); }
 399 <GlaExt>"_ccall_GC_"            { RETURN(CCALL_GC); }
 400 <GlaExt>"_casm_"                { RETURN(CASM); }
 401 <GlaExt>"_casm_GC_"             { RETURN(CASM_GC); }
 402 <GlaExt>"foreign"               { RETURN(FOREIGN); }
 403 <GlaExt>"export"                { RETURN(EXPORT); }
 404 <GlaExt>"label"                 { RETURN(LABEL); }
 405 <GlaExt>"unsafe"                { RETURN(UNSAFE); }
 406 <GlaExt>"_stdcall"              { RETURN(STDCALL); }
 407 <GlaExt>"_ccall"                { RETURN(C_CALL); }
 408 <GlaExt>"_pascal"               { RETURN(PASCAL); }
 409 <GlaExt>"_fastcall"             { RETURN(FASTCALL); }
 410 <GlaExt>"dynamic"               { RETURN(DYNAMIC); }
 411
 412 %{
 413     /*
 414      * Haskell operators: special, reservedops and useful varsyms
 415      */
 416 %}
 417
 418 <Code,GlaExt,UserPragma>"("     { RETURN(OPAREN); }
 419 <Code,GlaExt,UserPragma>")"     { RETURN(CPAREN); }
 420 <Code,GlaExt,UserPragma>"["     { RETURN(OBRACK); }
 421 <Code,GlaExt,UserPragma>"]"     { RETURN(CBRACK); }
 422 <Code,GlaExt>"{"                { RETURN(OCURLY); }
 423 <Code,GlaExt>"}"                { RETURN(CCURLY); }
 424 <Code,GlaExt,UserPragma>","     { RETURN(COMMA); }
 425 <Code,GlaExt>";"                { RETURN(SEMI); }
 426 <Code,GlaExt>"`"                { RETURN(BQUOTE); }
 427 <Code,GlaExt>"_"                { RETURN(WILDCARD); }
 428
 429 <Code,GlaExt>".."               { RETURN(DOTDOT); }
 430 <Code,GlaExt,UserPragma>"::"    { RETURN(DCOLON); }
 431 <Code,GlaExt,UserPragma>"="     { RETURN(EQUAL); }
 432 <Code,GlaExt>"\\"               { RETURN(LAMBDA); }
 433 <Code,GlaExt>"|"                { RETURN(VBAR); }
 434 <Code,GlaExt>"<-"               { RETURN(LARROW); }
 435 <Code,GlaExt,UserPragma>"->"    { RETURN(RARROW); }
 436 <Code,GlaExt>"-"                { RETURN(MINUS); }
 437 <Code,GlaExt>"+"                { RETURN(PLUS); }
 438
 439 <Code,GlaExt,UserPragma>"=>"    { RETURN(DARROW); }
 440 <Code,GlaExt>"@"                { RETURN(AT); }
 441 <Code,GlaExt>"!"                { RETURN(BANG); }
 442 <Code,GlaExt>"~"                { RETURN(LAZY); }
 443
 444 %{
 445     /*
 446      * Integers and (for Glasgow extensions) primitive integers.  Note that
 447      * we pass all of the text on to the parser, because flex/C can't handle
 448      * arbitrary precision numbers.
 449      */
 450 %}
 451
 452 <GlaExt>("-")?"0"[Oo]{O}+"#"  { /* octal */
 453                          yylval.uid = xstrndup(yytext, yyleng - 1);
 454                          RETURN(INTPRIM);
 455                         }
 456 <Code,GlaExt>"0"[Oo]{O}+  { /* octal */
 457                          yylval.uid = xstrndup(yytext, yyleng);
 458                          RETURN(INTEGER);
 459                         }
 460 <GlaExt>("-")?"0"[Xx]{H}+"#"  { /* hexadecimal */
 461                          yylval.uid = xstrndup(yytext, yyleng - 1);
 462                          RETURN(INTPRIM);
 463                         }
 464 <Code,GlaExt>"0"[Xx]{H}+  { /* hexadecimal */
 465                          yylval.uid = xstrndup(yytext, yyleng);
 466                          RETURN(INTEGER);
 467                         }
 468 <GlaExt>("-")?{N}"#"    {
 469                          yylval.uid = xstrndup(yytext, yyleng - 1);
 470                          RETURN(INTPRIM);
 471                         }
 472 <Code,GlaExt,UserPragma>{N} {
 473                          yylval.uid = xstrndup(yytext, yyleng);
 474                          RETURN(INTEGER);
 475                         }
 476
 477 %{
 478     /*
 479      * Floats and (for Glasgow extensions) primitive floats/doubles.
 480      */
 481 %}
 482
 483 <GlaExt>("-")?{F}"##"   {
 484                          yylval.uid = xstrndup(yytext, yyleng - 2);
 485                          RETURN(DOUBLEPRIM);
 486                         }
 487 <GlaExt>("-")?{F}"#"    {
 488                          yylval.uid = xstrndup(yytext, yyleng - 1);
 489                          RETURN(FLOATPRIM);
 490                         }
 491 <Code,GlaExt>{F}        {
 492                          yylval.uid = xstrndup(yytext, yyleng);
 493                          RETURN(FLOAT);
 494                         }
 495
 496 %{
 497     /*
 498      * Funky ``foo'' style C literals for Glasgow extensions
 499      */
 500 %}
 501
 502 <GlaExt>"``"[^']+"''"   {
 503                          hsnewid(yytext + 2, yyleng - 4);
 504                          RETURN(CLITLIT);
 505                         }
 506
 507 %{
 508     /*
 509      * Identifiers, both variables and operators.  The trailing hash is allowed
 510      * for Glasgow extensions.
 511      */
 512 %}
 513
 514
 515 %{
 516 /* These SHOULDNAE work in "Code" (sigh) */
 517 %}
 518 <GlaExt,UserPragma>{Id}"#" {
 519                         if (! nonstandardFlag) {
 520                             char errbuf[ERR_BUF_SIZE];
 521                             sprintf(errbuf, "Non-standard identifier (trailing `#'): %s\n", yytext);
 522                             hsperror(errbuf);
 523                          }
 524                          hsnewid(yytext, yyleng);
 525                          RETURN(isconstr(yytext) ? CONID : VARID);
 526                         }
 527 <Code,GlaExt,UserPragma>{Id}    {
 528                          hsnewid(yytext, yyleng);
 529                          RETURN(isconstr(yytext) ? CONID : VARID);
 530                         }
 531 <Code,GlaExt,UserPragma>{SId}   {
 532                          hsnewid(yytext, yyleng);
 533                          RETURN(isconstr(yytext) ? CONSYM : VARSYM);
 534                         }
 535 <Code,GlaExt,UserPragma>{Mod}"."{Id}"#" {
 536                          BOOLEAN is_constr;
 537                          if (! nonstandardFlag) {
 538                             char errbuf[ERR_BUF_SIZE];
 539                             sprintf(errbuf, "Non-standard identifier (trailing `#'): %s\n", yytext);
 540                             hsperror(errbuf);
 541                          }
 542                          is_constr = hsnewqid(yytext, yyleng);
 543                          RETURN(is_constr ? QCONID : QVARID);
 544                         }
 545 <Code,GlaExt,UserPragma>{Mod}"."{Id}    {
 546                          BOOLEAN is_constr = hsnewqid(yytext, yyleng);
 547                          RETURN(is_constr ? QCONID : QVARID);
 548                         }
 549 <Code,GlaExt,UserPragma>{Mod}"."{SId}   {
 550                          BOOLEAN is_constr = hsnewqid(yytext, yyleng);
 551                          RETURN(is_constr ? QCONSYM : QVARSYM);
 552                         }
 553
 554 %{
 555     /* Why is `{Id}#` matched this way, and `{Id}` lexed as three tokens? --JSM */
 556
 557     /* Because we can make the former well-behaved (we defined them).
 558
 559        Sadly, the latter is defined by Haskell, which allows such
 560        la-la land constructs as `{-a 900-line comment-} foo`.  (WDP 94/12)
 561     */
 562 %}
 563
 564 <GlaExt,UserPragma>"`"{Id}"#`"  {
 565                          hsnewid(yytext + 1, yyleng - 2);
 566                          RETURN(isconstr(yytext+1) ? CONSYM : VARSYM);
 567                         }
 568
 569 %{
 570     /*
 571      * Character literals.  The first form is the quick form, for character
 572      * literals that don't contain backslashes.  Literals with backslashes are
 573      * lexed through multiple rules.  First, we match the open ' and as many
 574      * normal characters as possible.  This puts us into the <Char> state, where
 575      * a backslash is legal.  Then, we match the backslash and move into the
 576      * <CharEsc> state.  When we drop out of <CharEsc>, we collect more normal
 577      * characters and the close '.  We may end up with too many characters, but
 578      * this allows us to easily share the lex rules with strings.  Excess characters
 579      * are ignored with a warning.
 580      */
 581 %}
 582
 583 <GlaExt>'({CHAR}|"\"")"'#" {
 584                          yylval.uhstring = installHstring(1, yytext+1);
 585                          RETURN(CHARPRIM);
 586                         }
 587 <Code,GlaExt>'({CHAR}|"\"")'    {
 588                          yylval.uhstring = installHstring(1, yytext+1);
 589                          RETURN(CHAR);
 590                         }
 591 <Code,GlaExt>''         {char errbuf[ERR_BUF_SIZE];
 592                          sprintf(errbuf, "'' is not a valid character (or string) literal\n");
 593                          hsperror(errbuf);
 594                         }
 595 <Code,GlaExt>'({CHAR}|"\"")* {
 596                          hsmlcolno = hspcolno;
 597                          cleartext();
 598                          addtext(yytext+1, yyleng-1);
 599                          PUSH_STATE(Char);
 600                         }
 601 <Char>({CHAR}|"\"")*'#  {
 602                          unsigned length;
 603                          char *text;
 604
 605                          addtext(yytext, yyleng - 2);
 606                          text = fetchtext(&length);
 607
 608                          if (! nonstandardFlag) {
 609                             char errbuf[ERR_BUF_SIZE];
 610                             sprintf(errbuf, "`Char-hash' literals are non-standard: %s\n", text);
 611                             hsperror(errbuf);
 612                          }
 613
 614                          if (length > 1) {
 615                             fprintf(stderr, "%s:%d:%d: Unboxed character literal '",
 616                               input_filename, hsplineno, hspcolno + 1);
 617                             format_string(stderr, (unsigned char *) text, length);
 618                             fputs("' too long\n", stderr);
 619                             hsperror("");
 620                          }
 621                          yylval.uhstring = installHstring(1, text);
 622                          hspcolno = hsmlcolno;
 623                          POP_STATE;
 624                          RETURN(CHARPRIM);
 625                         }
 626 <Char>({CHAR}|"\"")*'   {
 627                          unsigned length;
 628                          char *text;
 629
 630                          addtext(yytext, yyleng - 1);
 631                          text = fetchtext(&length);
 632
 633                          if (length > 1) {
 634                             fprintf(stderr, "%s:%d:%d: Character literal '",
 635                               input_filename, hsplineno, hspcolno + 1);
 636                             format_string(stderr, (unsigned char *) text, length);
 637                             fputs("' too long\n", stderr);
 638                             hsperror("");
 639                          }
 640                          yylval.uhstring = installHstring(1, text);
 641                          hspcolno = hsmlcolno;
 642                          POP_STATE;
 643                          RETURN(CHAR);
 644                         }
 645 <Char>({CHAR}|"\"")+    { addtext(yytext, yyleng); }
 646
 647
 648 %{
 649     /*
 650      * String literals.  The first form is the quick form, for string literals
 651      * that don't contain backslashes.  Literals with backslashes are lexed
 652      * through multiple rules.  First, we match the open " and as many normal
 653      * characters as possible.  This puts us into the <String> state, where
 654      * a backslash is legal.  Then, we match the backslash and move into the
 655      * <StringEsc> state.  When we drop out of <StringEsc>, we collect more normal
 656      * characters, moving back and forth between <String> and <StringEsc> as more
 657      * backslashes are encountered.  (We may even digress into <Comment> mode if we
 658      * find a comment in a gap between backslashes.)  Finally, we read the last chunk
 659      * of normal characters and the close ".
 660      */
 661 %}
 662
 663 <GlaExt>"\""({CHAR}|"'")*"\""#  {
 664                          yylval.uhstring = installHstring(yyleng-3, yytext+1);
 665                             /* the -3 accounts for the " on front, "# on the end */
 666                          RETURN(STRINGPRIM);
 667                         }
 668 <Code,GlaExt>"\""({CHAR}|"'")*"\""  {
 669                          yylval.uhstring = installHstring(yyleng-2, yytext+1);
 670                          RETURN(STRING);
 671                         }
 672 <Code,GlaExt>"\""({CHAR}|"'")* {
 673                          hsmlcolno = hspcolno;
 674                          cleartext();
 675                          addtext(yytext+1, yyleng-1);
 676                          PUSH_STATE(String);
 677                         }
 678 <String>({CHAR}|"'")*"\"#"   {
 679                          unsigned length;
 680                          char *text;
 681
 682                          addtext(yytext, yyleng-2);
 683                          text = fetchtext(&length);
 684
 685                          if (! nonstandardFlag) {
 686                             char errbuf[ERR_BUF_SIZE];
 687                             sprintf(errbuf, "`String-hash' literals are non-standard: %s\n", text);
 688                             hsperror(errbuf);
 689                          }
 690
 691                          yylval.uhstring = installHstring(length, text);
 692                          hspcolno = hsmlcolno;
 693                          POP_STATE;
 694                          RETURN(STRINGPRIM);
 695                         }
 696 <String>({CHAR}|"'")*"\""   {
 697                          unsigned length;
 698                          char *text;
 699
 700                          addtext(yytext, yyleng-1);
 701                          text = fetchtext(&length);
 702
 703                          yylval.uhstring = installHstring(length, text);
 704                          hspcolno = hsmlcolno;
 705                          POP_STATE;
 706                          RETURN(STRING);
 707                         }
 708 <String>({CHAR}|"'")+   { addtext(yytext, yyleng); }
 709
 710 %{
 711     /*
 712      * Character and string escapes are roughly the same, but strings have the
 713      * extra `\&' sequence which is not allowed for characters.  Also, comments
 714      * are allowed in the <StringEsc> state.  (See the comment section much
 715      * further down.)
 716      *
 717      * NB: Backslashes and tabs are stored in strings as themselves.
 718      * But if we print them (in printtree.c), they must go out as
 719      * "\\\\" and "\\t" respectively.  (This is because of the bogus
 720      * intermediate format that the parser produces.  It uses '\t' fpr end of
 721      * string, so it needs to be able to escape tabs, which means that it
 722      * also needs to be able to escape the escape character ('\\').  Sigh.
 723      */
 724 %}
 725
 726 <Char>\\                { PUSH_STATE(CharEsc); }
 727 <String>\\&             /* Ignore */ ;
 728 <String>\\              { PUSH_STATE(StringEsc); noGap = TRUE; }
 729
 730 <CharEsc>\\             { addchar(*yytext); POP_STATE; }
 731 <StringEsc>\\           { if (noGap) { addchar(*yytext); } POP_STATE; }
 732
 733 <CharEsc,StringEsc>["'] { addchar(*yytext); POP_STATE; }
 734 <CharEsc,StringEsc>NUL  { addchar('\000'); POP_STATE; }
 735 <CharEsc,StringEsc>SOH  { addchar('\001'); POP_STATE; }
 736 <CharEsc,StringEsc>STX  { addchar('\002'); POP_STATE; }
 737 <CharEsc,StringEsc>ETX  { addchar('\003'); POP_STATE; }
 738 <CharEsc,StringEsc>EOT  { addchar('\004'); POP_STATE; }
 739 <CharEsc,StringEsc>ENQ  { addchar('\005'); POP_STATE; }
 740 <CharEsc,StringEsc>ACK  { addchar('\006'); POP_STATE; }
 741 <CharEsc,StringEsc>BEL  |
 742 <CharEsc,StringEsc>a    { addchar('\007'); POP_STATE; }
 743 <CharEsc,StringEsc>BS   |
 744 <CharEsc,StringEsc>b    { addchar('\010'); POP_STATE; }
 745 <CharEsc,StringEsc>HT   |
 746 <CharEsc,StringEsc>t    { addchar('\011'); POP_STATE; }
 747 <CharEsc,StringEsc>LF   |
 748 <CharEsc,StringEsc>n    { addchar('\012'); POP_STATE; }
 749 <CharEsc,StringEsc>VT   |
 750 <CharEsc,StringEsc>v    { addchar('\013'); POP_STATE; }
 751 <CharEsc,StringEsc>FF   |
 752 <CharEsc,StringEsc>f    { addchar('\014'); POP_STATE; }
 753 <CharEsc,StringEsc>CR   |
 754 <CharEsc,StringEsc>r    { addchar('\015'); POP_STATE; }
 755 <CharEsc,StringEsc>SO   { addchar('\016'); POP_STATE; }
 756 <CharEsc,StringEsc>SI   { addchar('\017'); POP_STATE; }
 757 <CharEsc,StringEsc>DLE  { addchar('\020'); POP_STATE; }
 758 <CharEsc,StringEsc>DC1  { addchar('\021'); POP_STATE; }
 759 <CharEsc,StringEsc>DC2  { addchar('\022'); POP_STATE; }
 760 <CharEsc,StringEsc>DC3  { addchar('\023'); POP_STATE; }
 761 <CharEsc,StringEsc>DC4  { addchar('\024'); POP_STATE; }
 762 <CharEsc,StringEsc>NAK  { addchar('\025'); POP_STATE; }
 763 <CharEsc,StringEsc>SYN  { addchar('\026'); POP_STATE; }
 764 <CharEsc,StringEsc>ETB  { addchar('\027'); POP_STATE; }
 765 <CharEsc,StringEsc>CAN  { addchar('\030'); POP_STATE; }
 766 <CharEsc,StringEsc>EM   { addchar('\031'); POP_STATE; }
 767 <CharEsc,StringEsc>SUB  { addchar('\032'); POP_STATE; }
 768 <CharEsc,StringEsc>ESC  { addchar('\033'); POP_STATE; }
 769 <CharEsc,StringEsc>FS   { addchar('\034'); POP_STATE; }
 770 <CharEsc,StringEsc>GS   { addchar('\035'); POP_STATE; }
 771 <CharEsc,StringEsc>RS   { addchar('\036'); POP_STATE; }
 772 <CharEsc,StringEsc>US   { addchar('\037'); POP_STATE; }
 773 <CharEsc,StringEsc>SP   { addchar('\040'); POP_STATE; }
 774 <CharEsc,StringEsc>DEL  { addchar('\177'); POP_STATE; }
 775 <CharEsc,StringEsc>"^"{CNTRL} { char c = yytext[1] - '@'; addchar(c); POP_STATE; }
 776 <CharEsc,StringEsc>{D}+  {
 777                           int i = strtol(yytext, NULL, 10);
 778                           if (i < NCHARS) {
 779                              addchar((char) i);
 780                           } else {
 781                              char errbuf[ERR_BUF_SIZE];
 782                              sprintf(errbuf, "Numeric escape \"\\%s\" out of range\n",
 783                                 yytext);
 784                              hsperror(errbuf);
 785                           }
 786                           POP_STATE;
 787                         }
 788 <CharEsc,StringEsc>o{O}+ {
 789                           int i = strtol(yytext + 1, NULL, 8);
 790                           if (i < NCHARS) {
 791                              addchar((char) i);
 792                           } else {
 793                              char errbuf[ERR_BUF_SIZE];
 794                              sprintf(errbuf, "Numeric escape \"\\%s\" out of range\n",
 795                                 yytext);
 796                              hsperror(errbuf);
 797                           }
 798                           POP_STATE;
 799                         }
 800 <CharEsc,StringEsc>x{H}+ {
 801                           int i = strtol(yytext + 1, NULL, 16);
 802                           if (i < NCHARS) {
 803                              addchar((char) i);
 804                           } else {
 805                              char errbuf[ERR_BUF_SIZE];
 806                              sprintf(errbuf, "Numeric escape \"\\%s\" out of range\n",
 807                                 yytext);
 808                              hsperror(errbuf);
 809                           }
 810                           POP_STATE;
 811                         }
 812
 813
 814 %{
 815     /*
 816      * Nested comments.  The major complication here is in trying to match the
 817      * longest lexemes possible, for better performance.  (See the flex document.)
 818      * That's why the rules look so bizarre.
 819      */
 820 %}
 821
 822 <Code,GlaExt,UserPragma,StringEsc>"{-"  {
 823                           noGap = FALSE; nested_comments = 1; PUSH_STATE(Comment);
 824                         }
 825
 826 <Comment>[^-{]*         |
 827 <Comment>"-"+[^-{}]+    |
 828 <Comment>"{"+[^-{}]+    ;
 829 <Comment>"{-"           { nested_comments++; }
 830 <Comment>"-}"           { if (--nested_comments == 0) POP_STATE; }
 831 <Comment>(.|\n)         ;
 832
 833 %{
 834     /*
 835      * Illegal characters.  This used to be a single rule, but we might as well
 836      * pass on as much information as we have, so now we indicate our state in
 837      * the error message.
 838      */
 839 %}
 840
 841 <INITIAL,Code,GlaExt,UserPragma>(.|\n)  {
 842                          fprintf(stderr, "%s:%d:%d: Illegal character: `",
 843                             input_filename, hsplineno, hspcolno + 1);
 844                          format_string(stderr, (unsigned char *) yytext, 1);
 845                          fputs("'\n", stderr);
 846                          hsperror("");
 847                         }
 848 <Char>(.|\n)            {
 849                          fprintf(stderr, "%s:%d:%d: Illegal character: `",
 850                             input_filename, hsplineno, hspcolno + 1);
 851                          format_string(stderr, (unsigned char *) yytext, 1);
 852                          fputs("' in a character literal\n", stderr);
 853                          hsperror("");
 854                         }
 855 <CharEsc>(.|\n)         {
 856                          fprintf(stderr, "%s:%d:%d: Illegal character escape: `\\",
 857                             input_filename, hsplineno, hspcolno + 1);
 858                          format_string(stderr, (unsigned char *) yytext, 1);
 859                          fputs("'\n", stderr);
 860                          hsperror("");
 861                         }
 862 <String>(.|\n)          { if (nonstandardFlag) {
 863                              addtext(yytext, yyleng);
 864                           } else {
 865                                 fprintf(stderr, "%s:%d:%d: Illegal character: `",
 866                                 input_filename, hsplineno, hspcolno + 1);
 867                                 format_string(stderr, (unsigned char *) yytext, 1);
 868                                 fputs("' in a string literal\n", stderr);
 869                                 hsperror("");
 870                           }
 871                         }
 872 <StringEsc>(.|\n)       {
 873                          if (noGap) {
 874                              fprintf(stderr, "%s:%d:%d: Illegal string escape: `\\",
 875                                 input_filename, hsplineno, hspcolno + 1);
 876                              format_string(stderr, (unsigned char *) yytext, 1);
 877                              fputs("'\n", stderr);
 878                              hsperror("");
 879                          } else {
 880                              fprintf(stderr, "%s:%d:%d: Illegal character: `",
 881                                 input_filename, hsplineno, hspcolno + 1);
 882                              format_string(stderr, (unsigned char *) yytext, 1);
 883                              fputs("' in a string gap\n", stderr);
 884                              hsperror("");
 885                          }
 886                         }
 887
 888 %{
 889     /*
 890      * End of file.  In any sub-state, this is an error.  However, for the primary
 891      * <Code> and <GlaExt> states, this is perfectly normal.  We just return an EOF
 892      * and let the yylex() wrapper deal with whatever has to be done next (e.g.
 893      * adding virtual close curlies, or closing an interface and returning to the
 894      * primary source file.
 895      *
 896      * Note that flex does not call YY_USER_ACTION for <<EOF>> rules.  Hence the
 897      * line/column advancement has to be done by hand.
 898      */
 899 %}
 900
 901 <Char,CharEsc><<EOF>>   {
 902                           hsplineno = hslineno; hspcolno = hscolno;
 903                           hsperror("unterminated character literal");
 904                         }
 905 <Comment><<EOF>>        {
 906                           hsplineno = hslineno; hspcolno = hscolno;
 907                           hsperror("unterminated comment");
 908                         }
 909 <String,StringEsc><<EOF>>   {
 910                           hsplineno = hslineno; hspcolno = hscolno;
 911                           hsperror("unterminated string literal");
 912                         }
 913 <UserPragma><<EOF>>     {
 914                           hsplineno = hslineno; hspcolno = hscolno;
 915                           hsperror("unterminated user-specified pragma");
 916                         }
 917 <Code,GlaExt><<EOF>>    { hsplineno = hslineno; hspcolno = hscolno; return(EOF); }
 918
 919 %%
 920
 921 /**********************************************************************
 922 *                                                                     *
 923 *                                                                     *
 924 *     YACC/LEX Initialisation etc.                                    *
 925 *                                                                     *
 926 *                                                                     *
 927 **********************************************************************/
 928
 929 /*
 930    We initialise input_filename to "<stdin>".
 931    This allows unnamed sources to be piped into the parser.
 932 */
 933
 934 void
 935 yyinit(void)
 936 {
 937     input_filename = xstrdup("<stdin>");
 938
 939     /* We must initialize the input buffer _now_, because we call
 940        setyyin _before_ calling yylex for the first time! */
 941     yy_switch_to_buffer(yy_create_buffer(stdin, YY_BUF_SIZE));
 942
 943     if (nonstandardFlag)
 944         PUSH_STATE(GlaExt);
 945     else
 946         PUSH_STATE(Code);
 947 }
 948
 949 static void
 950 new_filename(char *f) /* This looks pretty dodgy to me (WDP) */
 951 {
 952     if (input_filename != NULL)
 953         free(input_filename);
 954     input_filename = xstrdup(f);
 955 }
 956
 957 /**********************************************************************
 958 *                                                                     *
 959 *                                                                     *
 960 *     Layout Processing                                               *
 961 *                                                                     *
 962 *                                                                     *
 963 **********************************************************************/
 964
 965 /*
 966         The following section deals with Haskell Layout conventions
 967         forcing insertion of ; or } as appropriate
 968 */
 969
 970 static BOOLEAN
 971 hsshouldindent(void)
 972 {
 973     return (!forgetindent && INDENTON);
 974 }
 975
 976
 977 /* Enter new context and set new indentation level */
 978 void
 979 hssetindent(void)
 980 {
 981 #ifdef HSP_DEBUG
 982     fprintf(stderr, "hssetindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT);
 983 #endif
 984
 985     /*
 986      * partain: first chk that new indent won't be less than current one; this code
 987      * doesn't make sense to me; hscolno tells the position of the _end_ of the
 988      * current token; what that has to do with indenting, I don't know.
 989      */
 990
 991
 992     if (hscolno - 1 <= INDENTPT) {
 993         if (INDENTPT == -1)
 994             return;             /* Empty input OK for Haskell 1.1 */
 995         else {
 996             char errbuf[ERR_BUF_SIZE];
 997
 998             sprintf(errbuf, "Layout error -- indentation should be > %d cols", INDENTPT);
 999             hsperror(errbuf);
1000         }
1001     }
1002     hsentercontext((hspcolno << 1) | 1);
1003 }
1004
1005
1006 /* Enter a new context without changing the indentation level */
1007 void
1008 hsincindent(void)
1009 {
1010 #ifdef HSP_DEBUG
1011     fprintf(stderr, "hsincindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT);
1012 #endif
1013     hsentercontext(indenttab[icontexts] & ~1);
1014 }
1015
1016
1017 /* Turn off indentation processing, usually because an explicit "{" has been seen */
1018 void
1019 hsindentoff(void)
1020 {
1021     forgetindent = TRUE;
1022 }
1023
1024
1025 /* Enter a new layout context. */
1026 static void
1027 hsentercontext(int indent)
1028 {
1029     /* Enter new context and set indentation as specified */
1030     if (++icontexts >= MAX_CONTEXTS) {
1031         char errbuf[ERR_BUF_SIZE];
1032
1033         sprintf(errbuf, "`wheres' and `cases' nested too deeply (>%d)", MAX_CONTEXTS - 1);
1034         hsperror(errbuf);
1035     }
1036     forgetindent = FALSE;
1037     indenttab[icontexts] = indent;
1038 #ifdef HSP_DEBUG
1039     fprintf(stderr, "hsentercontext:indent=%d,hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", indent, hscolno, hspcolno, icontexts, INDENTPT);
1040 #endif
1041 }
1042
1043
1044 /* Exit a layout context */
1045 void
1046 hsendindent(void)
1047 {
1048     --icontexts;
1049 #ifdef HSP_DEBUG
1050     fprintf(stderr, "hsendindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT);
1051 #endif
1052 }
1053
1054 /*
1055  *      Return checks the indentation level and returns ;, } or the specified token.
1056  */
1057
1058 static int
1059 Return(int tok)
1060 {
1061 #ifdef HSP_DEBUG
1062     extern int yyleng;
1063 #endif
1064
1065     if (hsshouldindent()) {
1066         if (hspcolno < INDENTPT) {
1067 #ifdef HSP_DEBUG
1068             fprintf(stderr, "inserted '}' before %d (%d:%d:%d:%d)\n", tok, hspcolno, hscolno, yyleng, INDENTPT);
1069 #endif
1070             hssttok = tok;
1071             return (VCCURLY);
1072         } else if (hspcolno == INDENTPT) {
1073 #ifdef HSP_DEBUG
1074             fprintf(stderr, "inserted ';' before %d (%d:%d)\n", tok, hspcolno, INDENTPT);
1075 #endif
1076             hssttok = -tok;
1077             return (SEMI);
1078         }
1079     }
1080     hssttok = -1;
1081 #ifdef HSP_DEBUG
1082     fprintf(stderr, "returning %d (%d:%d)\n", tok, hspcolno, INDENTPT);
1083 #endif
1084     return (tok);
1085 }
1086
1087
1088 /*
1089  *      Redefine yylex to check for stacked tokens, yylex1() is the original yylex()
1090  */
1091 int
1092 yylex()
1093 {
1094     int tok;
1095     static BOOLEAN eof = FALSE;
1096
1097     if (!eof) {
1098         if (hssttok != -1) {
1099             if (hssttok < 0) {
1100                 tok = -hssttok;
1101                 hssttok = -1;
1102                 return tok;
1103             }
1104             RETURN(hssttok);
1105         } else {
1106             endlineno = hslineno;
1107             if ((tok = yylex1()) != EOF)
1108                 return tok;
1109             else
1110                 eof = TRUE;
1111         }
1112     }
1113     if (icontexts > icontexts_save) {
1114         if (INDENTON) {
1115             eof = TRUE;
1116             indenttab[icontexts] = 0;
1117             return (VCCURLY);
1118         } else
1119             hsperror("missing '}' at end of file");
1120     } else if (hsbuf_save != NULL) {
1121         fclose(yyin);
1122         yy_delete_buffer(YY_CURRENT_BUFFER);
1123         yy_switch_to_buffer(hsbuf_save);
1124         hsbuf_save = NULL;
1125         new_filename(filename_save);
1126         free(filename_save);
1127         hslineno = hslineno_save;
1128         hsplineno = hsplineno_save;
1129         hscolno = hscolno_save;
1130         hspcolno = hspcolno_save;
1131         etags = etags_save;
1132         icontexts = icontexts_save - 1;
1133         icontexts_save = 0;
1134 #ifdef HSP_DEBUG
1135         fprintf(stderr, "finished reading interface (%d:%d:%d)\n", hscolno, hspcolno, INDENTPT);
1136 #endif
1137         eof = FALSE;
1138
1139         /* RETURN(LEOF); */
1140         hsperror("No longer using yacc to parse interface files");
1141
1142     } else {
1143         yyterminate();
1144     }
1145     abort(); /* should never get here! */
1146     return(0);
1147 }
1148
1149 /**********************************************************************
1150 *                                                                     *
1151 *                                                                     *
1152 *     Input Processing for Interfaces -- Not currently used !!!       *
1153 *                                                                     *
1154 *                                                                     *
1155 **********************************************************************/
1156
1157 /* setyyin(file)        open file as new lex input buffer */
1158 extern FILE *yyin;
1159
1160 void
1161 setyyin(char *file)
1162 {
1163     hsbuf_save = YY_CURRENT_BUFFER;
1164     if ((yyin = fopen(file, "r")) == NULL) {
1165         char errbuf[ERR_BUF_SIZE];
1166
1167         sprintf(errbuf, "can't read \"%-.50s\"", file);
1168         hsperror(errbuf);
1169     }
1170     yy_switch_to_buffer(yy_create_buffer(yyin, YY_BUF_SIZE));
1171
1172     hslineno_save = hslineno;
1173     hsplineno_save = hsplineno;
1174     hslineno = hsplineno = 1;
1175
1176     filename_save = input_filename;
1177     input_filename = NULL;
1178     new_filename(file);
1179     hscolno_save = hscolno;
1180     hspcolno_save = hspcolno;
1181     hscolno = hspcolno = 0;
1182     etags_save = etags; /* do not do "etags" stuff in interfaces */
1183     etags = 0;          /* We remember whether we are doing it in
1184                            the module, so we can restore it later [WDP 94/09] */
1185     hsentercontext(-1);         /* partain: changed this from 0 */
1186     icontexts_save = icontexts;
1187 #ifdef HSP_DEBUG
1188     fprintf(stderr, "reading %s (%d:%d:%d)\n", input_filename, hscolno_save, hspcolno_save, INDENTPT);
1189 #endif
1190 }
1191
1192 static void
1193 layout_input(char *text, int len)
1194 {
1195 #ifdef HSP_DEBUG
1196     fprintf(stderr, "Scanning \"%s\"\n", text);
1197 #endif
1198
1199     hsplineno = hslineno;
1200     hspcolno = hscolno;
1201
1202     while (len-- > 0) {
1203         switch (*text++) {
1204         case '\n':
1205         case '\r':
1206         case '\f':
1207             hslineno++;
1208             hscolno = 0;
1209             break;
1210         case '\t':
1211             hscolno += 8 - (hscolno % 8);       /* Tabs stops are 8 columns apart */
1212             break;
1213         case '\v':
1214             break;
1215         default:
1216             ++hscolno;
1217             break;
1218         }
1219     }
1220 }
1221
1222 void
1223 setstartlineno(void)
1224 {
1225     startlineno = hsplineno;
1226
1227     if (modulelineno == 0) {
1228         modulelineno = startlineno;
1229     }
1230
1231 #if 1/*etags*/
1232 #else
1233     if (etags)
1234         fprintf(stderr,"%u\tsetstartlineno (col %u)\n",startlineno,hscolno);
1235 #endif
1236 }
1237
1238 /**********************************************************************
1239 *                                                                     *
1240 *                                                                     *
1241 *                      Text Caching                                   *
1242 *                                                                     *
1243 *                                                                     *
1244 **********************************************************************/
1245
1246 #define CACHE_SIZE YY_BUF_SIZE
1247
1248 static struct {
1249     unsigned allocated;
1250     unsigned next;
1251     char *text;
1252 } textcache = { 0, 0, NULL };
1253
1254 static void
1255 cleartext(void)
1256 {
1257 /*  fprintf(stderr, "cleartext\n"); */
1258     textcache.next = 0;
1259     if (textcache.allocated == 0) {
1260         textcache.allocated = CACHE_SIZE;
1261         textcache.text = xmalloc(CACHE_SIZE);
1262     }
1263 }
1264
1265 static void
1266 addtext(char *text, unsigned length)
1267 {
1268 /*  fprintf(stderr, "addtext: %d %s\n", length, text); */
1269
1270     if (length == 0)
1271         return;
1272
1273     if (textcache.next + length + 1 >= textcache.allocated) {
1274         textcache.allocated += length + CACHE_SIZE;
1275         textcache.text = xrealloc(textcache.text, textcache.allocated);
1276     }
1277     bcopy(text, textcache.text + textcache.next, length);
1278     textcache.next += length;
1279 }
1280
1281 static void
1282 addchar(char c)
1283 {
1284 /*  fprintf(stderr, "addchar: %c\n", c); */
1285
1286     if (textcache.next + 2 >= textcache.allocated) {
1287         textcache.allocated += CACHE_SIZE;
1288         textcache.text = xrealloc(textcache.text, textcache.allocated);
1289     }
1290     textcache.text[textcache.next++] = c;
1291 }
1292
1293 static char *
1294 fetchtext(unsigned *length)
1295 {
1296 /*  fprintf(stderr, "fetchtext: %d\n", textcache.next); */
1297
1298     *length = textcache.next;
1299     textcache.text[textcache.next] = '\0';
1300     return textcache.text;
1301 }
1302
1303 /**********************************************************************
1304 *                                                                     *
1305 *                                                                     *
1306 *    Identifier Processing                                             *
1307 *                                                                     *
1308 *                                                                     *
1309 **********************************************************************/
1310
1311 /*
1312         hsnewid         Enters an id of length n into the symbol table.
1313 */
1314
1315 static void
1316 hsnewid(char *name, int length)
1317 {
1318     char save = name[length];
1319
1320     name[length] = '\0';
1321     yylval.uid = installid(name);
1322     name[length] = save;
1323 }
1324
1325 BOOLEAN
1326 hsnewqid(char *name, int length)
1327 {
1328     char* dot;
1329     char save = name[length];
1330     name[length] = '\0';
1331
1332     dot = strchr(name, '.');
1333     *dot = '\0';
1334     yylval.uqid = mkaqual(installid(name),installid(dot+1));
1335     *dot = '.';
1336     name[length] = save;
1337
1338     return isconstr(dot+1);
1339 }