%top{

/* ex: set ro ft=c:
 * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 *
 * This file is generated automatically by the Parrot build process
 * from the file compilers/pirc/macro/macro.l.
 *
 * Any changes made here will be lost!
 *
*/

/* HEADERIZER HFILE: none */
/* HEADERIZER STOP */

#ifndef __STDC_VERSION__
#  define __STDC_VERSION__ 0
#endif

}

%{

/*
 * $Id: /mirror/trunk/compilers/pirc/macro/macro.l 33586 2008-12-06T13:00:56.132030Z moritz  $
 * Copyright (C) 2007-2008, The Perl Foundation.
 */

/*
 * This pre-processor handles the macro layer of the
 * PIR language. The following constructs are filtered
 * out and handled:
 *
 * .include
 * .macro
 * .macro_local
 * .macro_label
 * .macro_const
 *
 */


#include <stdio.h>
#include <string.h>
#include <assert.h>
#include <stdlib.h>
#include "macro.h"
#include "lexer.h"

#include "parrot/parrot.h"

#define  YY_NO_UNISTD_H

#include "macroparser.h"

#define YY_EXTRA_TYPE  struct lexer_state *


extern macro_def *find_macro(constant_table *table, char *name);
extern char *concat(char *str1, char *str2);

int  macroget_column(yyscan_t yyscanner);
void macroset_column(int col, yyscan_t yyscanner);

char *dupstrn(char const * const source, size_t num_chars);
char *dupstr(char const * const source);

/*

=head1 FUNCTIONS

=over 4

=item C<char *
dupstrn(char const * const source, size_t num_chars)>

See dupstr, except that this version takes the number of characters to be
copied. Easy for copying a string except the quotes.

=cut

*/
PARROT_MALLOC
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
char *
dupstrn(char const * const source, size_t num_chars) {
    char *newstring = (char *)mem_sys_allocate_zeroed((num_chars + 1) * sizeof (char));
    assert(newstring);
    /* only copy num_chars characters */
    strncpy(newstring, source, num_chars);
    return newstring;
}


/*

=item C<char *
dupstr(char const * const source)>

The C89 standard does not define a strdup() in the C library,
so define our own strdup. Function names beginning with "str"
are reserved (I think), so make it dupstr, as that is what it
does: duplicate a string.

=cut

*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
char *
dupstr(char const * const source) {
    return dupstrn(source, strlen(source));
}


/*

=back

=cut

*/

/*
Use these on a big file with macros, and check out whether there are unused rules.
*/
int ctr[YY_NUM_RULES];
int num_rules = YY_NUM_RULES;


#define YY_USER_ACTION   { ++ctr[yy_act]; }



static int is_pir_directive(char const * const name);

%}

%option reentrant
%option noyywrap
%option bison-bridge
%option never-interactive
%option nounput
%option stack
%option debug
%option prefix="macro"
%option warn
%option noyy_top_state
%option outfile="macrolexer.c"
%option header-file="macrolexer.h"
%option yylineno


%x MACRODEF
%x CONSTDEF
%x INCLUDE
%x MACROPAR
%x MACROBODY
%x EXPAND
%x MACROLOCAL
%x BRACEDARGS
%s EXPARGS




ALPHA          [a-zA-Z@_]
DIGIT          [0-9]
DIGITS         {DIGIT}+
ALNUM          {ALPHA}|{DIGIT}

IDENT          {ALPHA}{ALNUM}*

DOT            [.]
HEX            0[xX][0-9A-Fa-f]+
OCT            0[oO][0-7]+
BIN            0[bB][01]+
WS             [\t\f\r\x1a ]
EOL            \r?\n

SIGN           [-+]
BIGINT         {SIGN}?{DIGITS}"L"
FLOATNUM       {SIGN}?(({DIGITS}{DOT}{DIGIT}*|{DOT}{DIGITS})([eE]{SIGN}?{DIGITS})?|{DIGITS}[eE]{SIGN}?{DIGITS})


DQ_STRING       \"(\\.|[^"\\\n])*\"
SQ_STRING       \'[^'\n]*\'
Q_STRING       {SQ_STRING}|{DQ_STRING}

NEWLINE        {EOL}({WS}|{EOL})*

REG            "$"?[SNIP]{DIGITS}

%%



<EXPAND>{NEWLINE}   { /**/
                      yy_pop_state(yyscanner);
                      yylval->sval = dupstr("\n");
                      return TK_NL;
                    }

<MACROPAR>{NEWLINE} { /* after macro header start the macro body */
                      yy_push_state(MACROBODY, yyscanner);
                      yylval->sval = dupstr("\n");
                      return TK_NL;
                    }

<MACROBODY>{NEWLINE} { /* return newlines in macro body as any tokens */
                       yylval->sval = dupstr("\n");
                       return TK_ANY;
                     }

<CONSTDEF>{NEWLINE} { yy_pop_state(yyscanner);
                      yylval->sval = "\n";
                      return TK_NL;
                    }

<BRACEDARGS>{NEWLINE} { yylval->sval = "\n"; return TK_ANY; }


".include"          { /* */
                      yy_push_state(INCLUDE, yyscanner);
                      return TK_INCLUDE;
                    }

".macro_const"      { /* */
                      yy_push_state(CONSTDEF, yyscanner);
                      return TK_MACRO_CONST;
                    }

".macro"            { /* */
                      yy_push_state(MACROPAR, yyscanner);
                      return TK_MACRO;
                    }

<MACROBODY>".macro_label" { /* */
                            return TK_MACRO_LABEL;
                          }

<MACROBODY>"$"{IDENT}":"  { /* unique label declaration using macro parameter */
                            yylval->sval = dupstr(yytext);
                            return TK_LABEL_ID;
                          }

<MACROBODY>{IDENT}":"   { /* unique label declaration, add special marker. */
                          char * temp = (char *)mem_sys_allocate((yyleng + 1 + 1) * sizeof (char));
                          /* stick a special marker "@" so we can recognize this as a label that
                           * must be munged.
                           */
                          strncpy(temp, yytext, yyleng - 1);
                          strcpy(temp + yyleng - 1, "@:");
                          yylval->sval = temp;
                          return TK_LABEL_ID;
                        }

<MACROBODY>".$"{IDENT}    { /* referring to a declared label or local id. */
                            yylval->sval = dupstr(yytext );
                            return TK_ANY;
                          }

<MACROBODY>".macro_local" { /* unique local declaration */
                            yy_push_state(MACROLOCAL, yyscanner);
                            return TK_MACRO_LOCAL;
                          }

<MACROLOCAL>"int"         { yylval->sval = dupstr("int");
                            return TK_INT;
                          }

<MACROLOCAL>"num"         { yylval->sval = dupstr("num");
                            return TK_NUM;
                          }

<MACROLOCAL>"pmc"         { yylval->sval = dupstr("pmc");
                            return TK_PMC;
                          }
<MACROLOCAL>"string"      { yylval->sval = dupstr("string");
                            return TK_STRING;
                          }

<MACROLOCAL>"$"{IDENT}     { /* unique local id declaration */
                            yylval->sval = dupstr(yytext);
                            yy_pop_state(yyscanner);
                            return TK_LOCAL_ID;
                          }

<MACROLOCAL>{IDENT}    { /* unique local id declaration -- non-parameter */
                         char * temp = (char *)mem_sys_allocate((yyleng + 1 + 1) * sizeof (char));
                         strcpy(temp, yytext);
                         /* add special marker that this token needs munging later */
                         temp[yyleng] = '@';
                         yylval->sval = temp;
                         yy_pop_state(yyscanner);
                         return TK_LOCAL_ID;
                       }

<MACROBODY>".endm" { /* when reading ".endm" while scanning macro body, go back to previous state */

                     yy_pop_state(yyscanner);
                     yy_pop_state(yyscanner);

                     return TK_ENDM;
                   }

<MACROPAR>"("      { /* recognize "(" when scanning macro parameter list */
                     return '(';
                   }

<MACROPAR>","      { /* recognize "," when scanning macro parameter list */
                     return ',';
                   }

<MACROPAR>")"      { /* recognize ")" when scanning a macro parameter list */
                     return ')';
                   }


<EXPAND>"("        { /* recognize "(" when expanding a macro */
                     yy_push_state(EXPARGS, yyscanner);
                     return '(';
                   }


<EXPAND>[^)]       { /* anything except a ")" in this state means a constant expansion, which
                      * has no arguments. This works, because if we did see a '(', the
                      * state EXPARGS is activated.
                      */
                     yylval->sval = dupstr(yytext);
                     yy_pop_state(yyscanner);
                     return TK_ANY;
                   }


<INITIAL>"("      { /* */
                    yylval->sval = dupstr(yytext);
                    return TK_ANY;
                  }

<EXPARGS>","       { /* */
                     return ',';
                   }

<EXPARGS>")"       { /* */
                     yy_pop_state(yyscanner);
                     return ')';
                   }

<EXPARGS>"{"       { /* braced argument */
                     yy_push_state(BRACEDARGS, yyscanner);
                     return '{';
                   }

<BRACEDARGS>[\ ]   { yylval->sval = dupstr(" "); return TK_ANY; }

<BRACEDARGS>[^}]   {
                     yylval->sval = dupstr(yytext);
                     return TK_ANY;
                   }

<BRACEDARGS>"}"    {
                     yy_pop_state(yyscanner);
                     return '}';
                   }

<EXPARGS>{IDENT}   { /* variable argument of macro expansion */
                     yylval->sval = dupstr(yytext);
                     return TK_IDENT;
                   }

<EXPARGS>"."{IDENT} { /* .foo(.bar) */
                      lexer_state *lexer = yyget_extra(yyscanner);
                      macro_def *macro = find_macro(lexer->globaldefinitions, dupstr(yytext + 1));

                      if (macro != NULL) {
                         yylval->sval = macro->body;
                         return TK_IDENT;
                      }
                      else {
                         fprintf(stderr, "Error: cannot find expansion for %s\n", yytext + 1);
                         lexer->errors++;
                      }
                    }



<EXPARGS>{REG}     { /* register can be an argument for macro expansion. */
                     yylval->sval = dupstr(yytext);
                     return TK_IDENT;
                   }

<CONSTDEF,MACROPAR>{IDENT}   { /* constant or macro parameter ID */
                               yylval->sval = dupstr(yytext);
                               return TK_IDENT;
                             }

"."{IDENT}          { /* directive, constant, macro or method-call */
                      if (is_pir_directive(yytext)) {
                          yylval->sval = dupstr(yytext);
                          return TK_ANY;
                      }
                      else { /* not a directive */
                          lexer_state *lexer = yyget_extra(yyscanner);
                          macro_def *macro = find_macro(lexer->globaldefinitions, yytext + 1);
                          if (macro != NULL) { /* it's a macro! */
                              /* only go into EXPAND state if it's a macro/constant */
                              yy_push_state(EXPAND, yyscanner);
                              yylval->mval = macro; /* pass the pointer to the macro_def */
                              return TK_DOT_IDENT;
                          }
                          else { /* it's not a macro, just a method-call, but if it was supposed
                                    to be a macro expansion, we will only see the error in the pir
                                    compiler.
                                  */
                              yylval->sval = dupstr(yytext);
                              return TK_ANY;
                          }
                      }
                   }

"$"{IDENT}":"      { /* */
                     lexer_state *lexer = yyget_extra(yyscanner);
                     macro_def *macro = find_macro(lexer->globaldefinitions, /* skip "$" and ":" */
                                                   dupstrn(yytext + 1, yyleng - 2));

                     if (macro != NULL) { /* found the parameter */
                        yylval->sval = macro->body; /* expand the macro-parameter */
                        return TK_LABEL_EXPANSION;
                     }
                     else {
                        fprintf(stderr, "Error: cannot find expansion for '%s'\n", yytext);
                        lexer->errors++;
                     }
                   }

{IDENT}"@:"        { /* this label was declared unique by ".macro_label foo:" but was munged so we
                        can recognize it now, and return a signal to the parser it needs to
                        munge it into a unique ID.
                      */
                     yylval->sval = dupstrn(yytext, yyleng - 2);
                     return TK_UNIQUE_LABEL;
                   }

{IDENT}"@"         { /* this local was declared unique by ".macro_local", but was munged so we can
                        recognize it now.
                     */
                     yylval->sval = dupstrn(yytext, yyleng - 1);
                     return TK_UNIQUE_LOCAL;
                   }

".$"{IDENT}      {   /* expanding a declared variable (local or label) */
                     lexer_state *lexer = yyget_extra(yyscanner);
                     macro_def *macro = find_macro(lexer->globaldefinitions, yytext + 2);

                     if (macro != NULL) { /**/
                        yylval->sval = macro->body;
                        return TK_VAR_EXPANSION;
                     }
                     else {
                        fprintf(stderr, "Error: cannot find expansion for symbol '%s'\n", yytext);
                        lexer->errors++;
                     }
                 }

"$"{IDENT}      {    /* */
                     lexer_state *lexer = yyget_extra(yyscanner);
                     macro_def *macro = find_macro(lexer->globaldefinitions, yytext + 1);
                     if (macro != NULL) { /*  */
                        yylval->sval = macro->body;
                        return TK_VAR_EXPANSION;
                     }
                     else {
                        fprintf(stderr, "Error: cannot find expansion for parameter '%s'\n",
                                yytext + 1);
                        lexer->errors++;
                     }


                   }

"."({Q_STRING}|{REG}) {/* treat ".'foo'" or ".$P0" as 1 token to prevent the tokens are separated
                        * by a space; they clearly belong to each other if they were written
                        * together (without a space). This is a method-call, life foo .'bar'().
                        */
                       yylval->sval = dupstr(yytext);
                       return TK_ANY;
                      }

<*>","                { /* in all other cases (than the above), treat a comma just as any token. */
                        yylval->sval = dupstr(yytext);
                        return TK_ANY;
                      }


<CONSTDEF>{REG}      { /**/
                       yylval->sval = dupstr(yytext);
                       return TK_IDENT;
                     }
<CONSTDEF>{Q_STRING} { yylval->sval = dupstr(yytext);
                       return TK_STRINGC;
                     }

<CONSTDEF>{SIGN}?{DIGITS} { yylval->sval = dupstr(yytext);
                            return TK_INTC;
                          }

<CONSTDEF>({HEX}|{BIN}|{OCT}) { yylval->sval = dupstr(yytext);
                                return TK_INTC;
                              }

<CONSTDEF>{FLOATNUM}      { yylval->sval = dupstr(yytext);
                            return TK_NUMC;
                          }

<INCLUDE>{Q_STRING}       { /* a quoted string is needed for an .include or the value of a
                             * macro constant. After this token, leave the current state.
                             */
                             yylval->sval = dupstr(yytext);
                             yy_pop_state(yyscanner);
                             return TK_STRINGC;
                          }

<EXPARGS>{Q_STRING}       { /* quoted strings argument for macro expansion */
                            yylval->sval = dupstr(yytext);
                            return TK_STRINGC;
                          }

<EXPARGS>{SIGN}?{DIGITS}  { yylval->sval = dupstr(yytext);
                            return TK_INTC;
                          }
<EXPARGS>{HEX}            { yylval->sval = dupstr(yytext);
                            return TK_INTC;
                          }
<EXPARGS>{BIN}            { yylval->sval = dupstr(yytext);
                            return TK_INTC;
                          }
<EXPARGS>{OCT}            { yylval->sval = dupstr(yytext);
                            return TK_INTC;
                          }
<EXPARGS>{FLOATNUM}       { yylval->sval = dupstr(yytext);
                            return TK_NUMC;
                          }

<INITIAL,MACROBODY>{REG}         { /* register */
                                   yylval->sval = dupstr(yytext);
                                   return TK_ANY;
                                 }

<INITIAL,MACROBODY>{Q_STRING}    { /* quoted string */
                                   yylval->sval = dupstr(yytext);
                                   return TK_ANY;
                                 }

<INITIAL,MACROBODY>{IDENT}       { /* identifier */
                                   yylval->sval = dupstr(yytext);
                                   return TK_ANY;
                                 }



<INITIAL,MACROBODY>":"{IDENT}    { /* flag */
                                   yylval->sval = dupstr(yytext);
                                   return TK_ANY;
                                 }

<MACROBODY>"."{IDENT}            { /* expansions in a macro body; ignore for now. */
                                   yylval->sval = dupstr(yytext);
                                   return TK_ANY;
                                 }

<INITIAL,MACROBODY>{FLOATNUM}    { yylval->sval = dupstr(yytext);
                                   return TK_ANY;
                                 }

<INITIAL,MACROBODY>{SIGN}?{DIGITS} { yylval->sval = dupstr(yytext);
                                     return TK_ANY;
                                   }

<INITIAL,MACROBODY>({HEX}|{BIN}|{OCT}) { yylval->sval = dupstr(yytext);
                                         return TK_ANY;
                                       }




<INITIAL,MACROBODY>{IDENT}":"    { /* normal label */
                                   yylval->sval = dupstr(yytext);
                                   return TK_ANY;
                                 }

<*>"=="|"!="|"<="|"=>"|">="|">>"|"<<"|">>>"             { yylval->sval = dupstr(yytext);
                                                          return TK_ANY;
                                                        }

<*>"+="|"-="|"*="|"/="|".="|">>="|"<<="|">>>="|"//="    { yylval->sval = dupstr(yytext);
                                                          return TK_ANY;
                                                        }

<*>"%="|"|="|"&="|"**="|"~="|"||"|"&&"|"~~"|"//"        { yylval->sval = dupstr(yytext);
                                                          return TK_ANY;
                                                        }

<<EOF>>             { /* when end of file or end of string buffer, stop scanning. */
                      yyterminate();
                    }


<*>{WS}             { /* skip whitespace */ }

<*>{NEWLINE}        { /* in all other states, return newline as the newline token */
                      yylval->sval = dupstr("\n");
                      return TK_NL;
                    }

<*>.                   { /* just return any single character token we didn't match before. */
                         yylval->sval = dupstr(yytext);
                         return TK_ANY;
                       }

%%


/*

=head1 FUNCTIONS

=over 4

=item C<is_pir_directive>

Returns a non-zero value if the specified name is a PIR directive.

XXX It might be worthwhile to enter the PIR directives as rules; this saves a lot
of checking; these rules should just return TK_ANY.

=cut

*/
PARROT_PURE_FUNCTION
PARROT_WARN_UNUSED_RESULT
static int
is_pir_directive(char const * const name) {

    /* maybe make this a hash or at least a binary search.
     * Or, make these "special" macros, and have them expand
     * to their own spelling. This would remove the need
     * for special code, such as this.
     */
    static char const * const directives[] = {
        ".arg",
        ".begin_call",
        ".begin_return",
        ".begin_yield",
        ".call",
        ".const",
        ".end",
        ".end_call",
        ".end_return",
        ".end_yield",
        ".file",
        ".get_results",
        ".globalconst",
        ".HLL",
        ".HLL_map",
        ".invocant",
        ".lex",
        ".line",
        ".loadlib",
        ".local",
        ".meth_call",
        ".namespace",
        ".nci_call",
        ".param",
        ".return",
        ".sub",
        ".tailcall",
        ".yield",
        NULL /* needed to easily write loops on this array */
    };

    /* iter is a pointer to constant pointers to constant chars. */
    char const * const *iter = directives;

    while (*iter != NULL) {
        if (STREQ(*iter, name))
            return 1;

        iter++;
    }
    return 0;
}

/*

=back

=cut

*/



/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */


