source/texk/web2c/web2c/web2c-lexer.l

   1 %option never-interactive
   2
   3 %top{
   4 /* web2c-lexer.l -- lexical analysis for Tangle output.  Public domain. */
   5
   6 #include "web2c.h"
   7 #include "web2c-parser.h"
   8 }
   9
  10 %{
  11 /* Hack to make it possible to compile the generated code with C++
  12    Required if you use flex. */
  13 #ifdef __cplusplus
  14 #define webinput yyinput
  15 #else
  16 #define webinput input
  17 #endif
  18
  19 /* For some reason flex wants to do a system call, so we must lose our
  20    definition of the Pascal read.  */
  21 #undef read
  22
  23 char conditional[20], negbuf[2], temp[20];
  24 extern boolean doing_statements;
  25
  26
  27 /* We only read one input file.  This is the default definition, but
  28    giving it ourselves avoids the need to find -lfl or -ll at link time.
  29    This is a good thing, since libfl.a is often installed somewhere that
  30    the linker doesn't search by default.  */
  31 static int
  32 yywrap (void)
  33 {
  34   return 1;
  35 }
  36 #define YY_SKIP_YYWRAP /* not that it matters */
  37 %}
  38 DIGIT           [0-9]
  39 ALPHA           [a-zA-Z]
  40 ALPHANUM        ({DIGIT}|{ALPHA}|"_")
  41 IDENTIFIER      ({ALPHA}{ALPHANUM}*)
  42 NUMBER          ({DIGIT}+)
  43 SIGN            ("+"|"-")
  44 SIGNED          ({SIGN}?{NUMBER})
  45 WHITE           [ \n\t]+
  46 REAL            ({NUMBER}"."{NUMBER}("e"{SIGNED})?)|({NUMBER}"e"{SIGNED})
  47 COMMENT         (("{"[^}]*"}")|("(*"([^*]|"*"[^)])*"*)"))
  48 W               ({WHITE}|"packed ")+
  49 WW              ({WHITE}|{COMMENT}|"packed ")*
  50 HHB0            ("hh"{WW}"."{WW}"b0")
  51 HHB1            ("hh"{WW}"."{WW}"b1")
  52
  53 %%
  54 {W}                             ;
  55 "{"             { while (webinput() != '}'); }
  56
  57 "#"             {
  58                     register int c;
  59                     putc('#', out);
  60                     while ((c = webinput()) && c != ';')
  61                         putc(c, out);
  62                     putc('\n', out);
  63                 }
  64
  65 "ifdef("        {register int c;
  66                  register char *cp=conditional;
  67                  new_line();
  68                  while ((c = webinput()) != '\'')
  69                     ;
  70                  while ((c = webinput()) != '\'')
  71                     *cp++ = c;
  72                  *cp = '\0';
  73                  (void) webinput();
  74                  if (doing_statements) fputs("\t;\n", out);
  75                  fprintf(out, "#ifdef %s\n", conditional);
  76                 }
  77
  78 "endif("        {register int c;
  79                  new_line();
  80                  fputs("#endif /* ", out);
  81                  while ((c = webinput()) != '\'')
  82                     ;
  83                  while ((c = webinput()) != '\'')
  84                     (void) putc(c, out);
  85                  (void) webinput();
  86                  conditional[0] = '\0';
  87                  fputs(" */\n", out);
  88                 }
  89
  90 "ifndef("       {register int c;
  91                  register char *cp=conditional;
  92                  new_line();
  93                  while ((c = webinput()) != '\'')
  94                     ;
  95                  while ((c = webinput()) != '\'')
  96                     *cp++ = c;
  97                  *cp = '\0';
  98                  (void) webinput();
  99                  if (doing_statements) fputs("\t;\n", out);
 100                  fprintf(out, "#ifndef %s\n", conditional);
 101                 }
 102
 103 "endifn("       {register int c;
 104                  new_line();
 105                  fputs("#endif /* not ", out);
 106                  while ((c = webinput()) != '\'')
 107                     ;
 108                  while ((c = webinput()) != '\'')
 109                     putc(c, out);
 110                  (void) webinput();
 111                  conditional[0] = '\0';
 112                  fputs(" */\n", out);
 113                 }
 114
 115
 116 "procedure "[a-z_]+";"[ \n\t]*"forward;"        ;
 117
 118 "function "[(),:a-z_]+";"[ \n\t]*"forward;"     ;
 119
 120 "@define"       return last_tok=define_tok;
 121 "@field"        return last_tok=field_tok;
 122 "and"           return last_tok=and_tok;
 123 "array"         return last_tok=array_tok;
 124 "begin"         return last_tok=begin_tok;
 125 "case"          return last_tok=case_tok;
 126 "const"         return last_tok=const_tok;
 127 "div"           return last_tok=div_tok;
 128 "break"         return last_tok=break_tok;
 129 "do"            return last_tok=do_tok;
 130 "downto"        return last_tok=downto_tok;
 131 "else"          return last_tok=else_tok;
 132 "end"           return last_tok=end_tok;
 133 "file"          return last_tok=file_tok;
 134 "for"           return last_tok=for_tok;
 135 "function"      return last_tok=function_tok;
 136 "goto"          return last_tok=goto_tok;
 137 "if"            return last_tok=if_tok;
 138 "label"         return last_tok=label_tok;
 139 "mod"           return last_tok=mod_tok;
 140 "noreturn"      return last_tok=noreturn_tok;
 141 "not"           return last_tok=not_tok;
 142 "of"            return last_tok=of_tok;
 143 "or"            return last_tok=or_tok;
 144 "procedure"     return last_tok=procedure_tok;
 145 "program"       return last_tok=program_tok;
 146 "record"        return last_tok=record_tok;
 147 "repeat"        return last_tok=repeat_tok;
 148 {HHB0}          return last_tok=hhb0_tok;
 149 {HHB1}          return last_tok=hhb1_tok;
 150 "then"          return last_tok=then_tok;
 151 "to"            return last_tok=to_tok;
 152 "type"          return last_tok=type_tok;
 153 "until"         return last_tok=until_tok;
 154 "var"           return last_tok=var_tok;
 155 "while"         return last_tok=while_tok;
 156 "others"        return last_tok=others_tok;
 157
 158 {REAL}          {
 159                   sprintf (temp, "%s%s", negbuf, yytext);
 160                   negbuf[0] = '\0';
 161                   return last_tok=r_num_tok;
 162                 }
 163
 164 {NUMBER}        {
 165                   sprintf (temp, "%s%s", negbuf, yytext);
 166                   negbuf[0] = '\0';
 167                   return last_tok=i_num_tok;
 168                 }
 169
 170 ("'"([^']|"''")"'")             return last_tok=single_char_tok;
 171
 172 ("'"([^']|"''")*"'")            return last_tok=string_literal_tok;
 173
 174 "+"             { if ((last_tok>=undef_id_tok &&
 175                       last_tok<=field_id_tok) ||
 176                       last_tok==i_num_tok ||
 177                       last_tok==r_num_tok ||
 178                       last_tok==')' ||
 179                       last_tok==']')
 180                    return last_tok='+';
 181                 else return last_tok=unary_plus_tok; }
 182
 183 "-"             { if ((last_tok>=undef_id_tok &&
 184                       last_tok<=field_id_tok) ||
 185                       last_tok==i_num_tok ||
 186                       last_tok==r_num_tok ||
 187                       last_tok==')' ||
 188                       last_tok==']')
 189                    return last_tok='-';
 190                 else {
 191                   int c;
 192                   while ((c = webinput()) == ' ' || c == '\t')
 193                     ;
 194                   unput(c);
 195                   if (c < '0' || c > '9') {
 196                         return last_tok = unary_minus_tok;
 197                   }
 198                   negbuf[0] = '-';
 199                 }}
 200
 201 "*"             return last_tok='*';
 202 "/"             return last_tok='/';
 203 "="             return last_tok='=';
 204 "<>"            return last_tok=not_eq_tok;
 205 "<"             return last_tok='<';
 206 ">"             return last_tok='>';
 207 "<="            return last_tok=less_eq_tok;
 208 ">="            return last_tok=great_eq_tok;
 209 "("             return last_tok='(';
 210 ")"             return last_tok=')';
 211 "["             return last_tok='[';
 212 "]"             return last_tok=']';
 213 ":="            return last_tok=assign_tok;
 214 ".."            return last_tok=two_dots_tok;
 215 "."             return last_tok='.';
 216 ","             return last_tok=',';
 217 ";"             return last_tok=';';
 218 ":"             return last_tok=':';
 219 "^"             return last_tok='^';
 220
 221 {IDENTIFIER}    { strcpy (last_id, yytext);
 222                   l_s = search_table (last_id);
 223                   return
 224                     last_tok = (l_s == -1 ? undef_id_tok : sym_table[l_s].typ);
 225                 }
 226
 227
 228 .               { /* Any bizarre token will do.  */
 229                   return last_tok = two_dots_tok; }
 230 %%
 231 /* Some helper routines.  Defining these here means we don't have references
 232    to yytext outside of this file.  Which means we can omit one of the more
 233    troublesome autoconf tests. */
 234 void
 235 get_string_literal (char *s)
 236 {
 237     int i, j;
 238     j = 1;
 239     s[0] = '"';
 240     for (i=1; yytext[i-1] != 0; i++) {
 241         if (yytext[i] == '\\' || yytext[i] == '"')
 242             s[j++] = '\\';
 243         else if (yytext[i] == '\'')
 244             i++;
 245         s[j++] = yytext[i];
 246     }
 247     s[j-1] = '"';
 248     s[j] = 0;
 249 }
 250
 251 void
 252 get_single_char (char *s)
 253 {
 254     s[0]='\'';
 255     if (yytext[1] == '\\' || yytext[1] == '\'') {
 256         s[1] = '\\';
 257         s[2] = yytext[1];
 258         s[3] = '\'';
 259         s[4] = 0;
 260     } else {
 261         s[1] = yytext[1];
 262         s[2] = '\'';
 263         s[3] = 0;
 264     }
 265 }
 266
 267 void
 268 get_result_type (char *s)
 269 {
 270     strcpy(s, yytext);
 271 }
 272
 273
 274 /* Since a syntax error can never be recovered from, we exit here with
 275    bad status.  */
 276
 277 int
 278 yyerror (const_string s)
 279 {
 280   /* This is so the convert script can delete the output file on error.  */
 281   puts ("@error@");
 282   fflush (stdout);
 283   fputs (s, stderr);
 284   fprintf (stderr, ": Last token = %d (%c), ", last_tok, last_tok);
 285   fprintf (stderr, "error buffer = `%s',\n\t", yytext);
 286   fprintf (stderr, "last id = `%s' (", last_id);
 287   ii = search_table (last_id);
 288   if (ii == -1)
 289     fputs ("not in symbol table", stderr);
 290   else
 291     switch (sym_table[ii].typ)
 292       {
 293       case undef_id_tok:
 294         fputs ("undefined", stderr);
 295         break;
 296       case var_id_tok:
 297         fputs ("variable", stderr);
 298         break;
 299       case const_id_tok:
 300         fputs ("constant", stderr);
 301         break;
 302       case type_id_tok:
 303         fputs ("type", stderr);
 304         break;
 305       case proc_id_tok:
 306         fputs ("parameterless procedure", stderr);
 307         break;
 308       case proc_param_tok:
 309         fputs ("procedure with parameters", stderr);
 310         break;
 311       case fun_id_tok:
 312         fputs ("parameterless function", stderr);
 313         break;
 314       case fun_param_tok:
 315         fputs ("function with parameters", stderr);
 316         break;
 317       default:
 318         fputs ("unknown!", stderr);
 319         break;
 320       }
 321   fputs (").\n", stderr);
 322   exit (1);
 323
 324   /* Avoid silly warnings.  */
 325   return 0;
 326 }