view release on metacpan or search on metacpan
Compiler/lexer.c view on Meta::CPAN
#include "compiler.h"
#include "parser.h"
#define YY_DECL int amd_yylex(AMD_YYSTYPE *amd_yylval, amd_parse_param_t *param)
static int amd_yyinteger(AMD_YYSTYPE *lvalp);
static int amd_yyidentifier(AMD_YYSTYPE *lvalp, amd_parse_param_t *param);
#define YY_NO_INPUT 1
#define YY_NO_UNPUT 1
#define YY_NO_TOP_STATE 1
/* %option debug */
#define CODE 1
#define BLANK 2
#define STRING 3
#define PPLINE 4
#define CCOMMENT 5
Compiler/lexer.yy view on Meta::CPAN
static int yyinteger(YYSTYPE *lvalp);
static int yyidentifier(YYSTYPE *lvalp, amd_parse_param_t *param);
%}
%option noyywrap
%option noinput
%option nounput
%option noreject
%option noyy_top_state
/* %option debug */
%s CODE
%x BLANK
%x STRING
%x PPLINE
%x CCOMMENT
%x CPPCOMMENT
WHITE [ \f\t\v]+
NONWHITE [^ \f\t\v\r\n]
Compiler/parser.c view on Meta::CPAN
#ifdef YYLSP_NEEDED
YYLTYPE amd_yylloc; /* location data for the lookahead */
/* symbol */
#endif
int amd_yynerrs; /* number of parse errors so far */
#endif /* not YYPURE */
#if YYDEBUG != 0
int amd_yydebug; /* nonzero means print parse trace */
/* Since this is uninitialized, it does not stop multiple parsers
from coexisting. */
#endif
/* YYINITDEPTH indicates the initial size of the parser's stacks */
#ifndef YYINITDEPTH
#define YYINITDEPTH 200
#endif
Compiler/parser.c view on Meta::CPAN
#endif
#endif
AMD_YYSTYPE amd_yyval; /* the variable used to return */
/* semantic values from the action */
/* routines */
int amd_yylen;
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Starting parse\n");
#endif
amd_yystate = 0;
amd_yyerrstatus = 0;
amd_yynerrs = 0;
amd_yychar = YYEMPTY; /* Cause a token to be read. */
/* Initialize stack pointers.
Waste one element of value and location stack
Compiler/parser.c view on Meta::CPAN
#endif
#endif /* no amd_yyoverflow */
amd_yyssp = amd_yyss + size - 1;
amd_yyvsp = amd_yyvs + size - 1;
#ifdef YYLSP_NEEDED
amd_yylsp = amd_yyls + size - 1;
#endif
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Stack size increased to %d\n", amd_yystacksize);
#endif
if (amd_yyssp >= amd_yyss + amd_yystacksize - 1)
YYABORT;
}
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Entering state %d\n", amd_yystate);
#endif
goto amd_yybackup;
amd_yybackup:
/* Do appropriate processing given the current state. */
/* Read a lookahead token if we need one and don't already have one. */
/* amd_yyresume: */
Compiler/parser.c view on Meta::CPAN
goto amd_yydefault;
/* Not known => get a lookahead token if don't already have one. */
/* amd_yychar is either YYEMPTY or YYEOF
or a valid token in external form. */
if (amd_yychar == YYEMPTY)
{
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Reading a token: ");
#endif
amd_yychar = YYLEX;
}
/* Convert token to internal form (in amd_yychar1) for indexing tables with */
if (amd_yychar <= 0) /* This means end of input. */
{
amd_yychar1 = 0;
amd_yychar = YYEOF; /* Don't call YYLEX any more */
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Now at end of input.\n");
#endif
}
else
{
amd_yychar1 = YYTRANSLATE(amd_yychar);
#if YYDEBUG != 0
if (amd_yydebug)
{
fprintf (stderr, "Next token is %d (%s", amd_yychar, amd_yytname[amd_yychar1]);
/* Give the individual parser a way to print the precise meaning
of a token, for further debugging info. */
#ifdef YYPRINT
YYPRINT (stderr, amd_yychar, amd_yylval);
#endif
fprintf (stderr, ")\n");
}
#endif
}
amd_yyn += amd_yychar1;
if (amd_yyn < 0 || amd_yyn > YYLAST || amd_yycheck[amd_yyn] != amd_yychar1)
Compiler/parser.c view on Meta::CPAN
}
else if (amd_yyn == 0)
goto amd_yyerrlab;
if (amd_yyn == YYFINAL)
YYACCEPT;
/* Shift the lookahead token. */
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Shifting token %d (%s), ", amd_yychar, amd_yytname[amd_yychar1]);
#endif
/* Discard the token being shifted unless it is eof. */
if (amd_yychar != YYEOF)
amd_yychar = YYEMPTY;
*++amd_yyvsp = amd_yylval;
#ifdef YYLSP_NEEDED
*++amd_yylsp = amd_yylloc;
Compiler/parser.c view on Meta::CPAN
if (amd_yyn == 0)
goto amd_yyerrlab;
/* Do a reduction. amd_yyn is the number of a rule to reduce with. */
amd_yyreduce:
amd_yylen = amd_yyr2[amd_yyn];
if (amd_yylen > 0)
amd_yyval = amd_yyvsp[1-amd_yylen]; /* implement default value of the action */
#if YYDEBUG != 0
if (amd_yydebug)
{
int i;
fprintf (stderr, "Reducing via rule %d (line %d), ",
amd_yyn, amd_yyrline[amd_yyn]);
/* Print the symbols being reduced, and their result. */
for (i = amd_yyprhs[amd_yyn]; amd_yyrhs[i] > 0; i++)
fprintf (stderr, "%s ", amd_yytname[amd_yyrhs[i]]);
fprintf (stderr, " -> %s\n", amd_yytname[amd_yyr1[amd_yyn]]);
Compiler/parser.c view on Meta::CPAN
/* the action file gets copied in in place of this dollarsign */
#line 554 "/usr/share/bison.simple"
amd_yyvsp -= amd_yylen;
amd_yyssp -= amd_yylen;
#ifdef YYLSP_NEEDED
amd_yylsp -= amd_yylen;
#endif
#if YYDEBUG != 0
if (amd_yydebug)
{
short *ssp1 = amd_yyss - 1;
fprintf (stderr, "state stack now");
while (ssp1 != amd_yyssp)
fprintf (stderr, " %d", *++ssp1);
fprintf (stderr, "\n");
}
#endif
*++amd_yyvsp = amd_yyval;
Compiler/parser.c view on Meta::CPAN
if (amd_yyerrstatus == 3)
{
/* if just tried and failed to reuse lookahead token after an error, discard it. */
/* return failure if at end of input */
if (amd_yychar == YYEOF)
YYABORT;
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Discarding token %d (%s).\n", amd_yychar, amd_yytname[amd_yychar1]);
#endif
amd_yychar = YYEMPTY;
}
/* Else will try to reuse lookahead token
after shifting the error token. */
amd_yyerrstatus = 3; /* Each real token shifted decrements this */
Compiler/parser.c view on Meta::CPAN
amd_yyerrpop: /* pop the current state because it cannot handle the error token */
if (amd_yyssp == amd_yyss) YYABORT;
amd_yyvsp--;
amd_yystate = *--amd_yyssp;
#ifdef YYLSP_NEEDED
amd_yylsp--;
#endif
#if YYDEBUG != 0
if (amd_yydebug)
{
short *ssp1 = amd_yyss - 1;
fprintf (stderr, "Error: state stack now");
while (ssp1 != amd_yyssp)
fprintf (stderr, " %d", *++ssp1);
fprintf (stderr, "\n");
}
#endif
amd_yyerrhandle:
Compiler/parser.c view on Meta::CPAN
amd_yyn = -amd_yyn;
goto amd_yyreduce;
}
else if (amd_yyn == 0)
goto amd_yyerrpop;
if (amd_yyn == YYFINAL)
YYACCEPT;
#if YYDEBUG != 0
if (amd_yydebug)
fprintf(stderr, "Shifting error token, ");
#endif
*++amd_yyvsp = amd_yylval;
#ifdef YYLSP_NEEDED
*++amd_yylsp = amd_yylloc;
#endif
amd_yystate = amd_yyn;
goto amd_yynewstate;
Compiler/parser.c view on Meta::CPAN
// fprintf(stderr, "Start of amd_yyparser_parse\n");
// fflush(stderr);
memset(¶m, 0, sizeof(param));
param.program = program;
param.symtab = newHV();
amd_yylex_init(str);
#if YYDEBUG != 0
amd_yydebug = 1;
#endif
ret = amd_yyparse((void *)(¶m));
/* Delete the HV but not the contents. */
hv_undef(param.symtab);
return ret;
}
Compiler/parser.y view on Meta::CPAN
%left '&'
%left L_EQ L_NE
%left L_GE L_LE '<' '>'
%left L_LSH L_RSH
%left '.'
%left '+' '-'
%left '*' '%' '/'
%right '!' '~'
%nonassoc L_INC L_DEC
/* These aren't strictly necessary, but they help debugging. */
%token '{' '}' ',' ';' ':' '(' ')' '[' ']' '=' '$'
/* I should have a new type 'node' in here for blessed objects
* which are specifically parse nodes. */
/* It is very very tempting to expand this to say 12 bytes
* to save on the use of AVs for type declarators. */
%union {
int number;
const char *str;
Compiler/parser.y view on Meta::CPAN
// fprintf(stderr, "Start of yyparser_parse\n");
// fflush(stderr);
memset(¶m, 0, sizeof(param));
param.program = program;
param.symtab = newHV();
yylex_init(str);
#if YYDEBUG != 0
yydebug = 1;
#endif
ret = yyparse((void *)(¶m));
/* Delete the HV but not the contents. */
hv_undef(param.symtab);
return ret;
}
Efun/Core/Core.pm view on Meta::CPAN
# File stuff
file_size => [ 0, T_INTEGER, T_STRING, ],
read_file => [ 0, T_STRING, T_STRING, ],
write_file => [ 0, T_INTEGER, T_STRING, T_STRING, ],
# System stuff
time => [ 0, T_INTEGER, ],
debug_message => [ 0, T_STRING, T_STRING, ],
error => [ 0, T_INTEGER, T_STRING, ],
catch => [ 0, T_STRING, T_UNKNOWN, ],
shutdown => [ 0, T_INTEGER, ],
trace => [ 0, T_INTEGER, T_INTEGER, ],
);
# We call this as an exported function since ISA isn't yet set up.
foreach (keys %efuns) {
register(__PACKAGE__ . "::" . $_, @{ $efuns{$_} });
}
}
{
package Anarres::Mud::Driver::Efun::Core::time;
sub generate_call { "time()" }
}
{
package Anarres::Mud::Driver::Efun::Core::debug_message;
sub generate_call { "print STDERR $_[1], '\\n'" }
}
{
package Anarres::Mud::Driver::Efun::Core::previous_object;
sub invoke { undef }
}
{
package Anarres::Mud::Driver::Efun::Core::file_name;
lib/Driver/Compiler/Check.pm view on Meta::CPAN
sub DBG_TC_PROMOTE () { 2 }
sub DBG_TC_CONVERT () { 4 }
$DEBUG = 0;;
$DEBUG |= DBG_TC_NAME if 0;
$DEBUG |= DBG_TC_PROMOTE if 0;
$DEBUG |= DBG_TC_CONVERT if 0;
@STACK = ();
sub debug_tc {
my ($self, $class, @args) = @_;
return undef unless $DEBUG & $class;
my $msg = join(": ", @args);
print STDERR "DebugTC: $msg\n";
}
# Called at the beginning of any typecheck call
sub tc_start {
my ($self, @args) = @_;
push(@STACK, $self);
$self->debug_tc(DBG_TC_NAME, "Checking " . $self->opcode, @args);
}
# Called at the end of any typecheck call, possibly by tc_fail().
sub tc_end {
my ($self, $type, @args) = @_;
$self->settype($type) if $type;
$self->debug_tc(DBG_TC_NAME, "Finished " . $self->opcode, @args);
pop(@STACK);
return 1; # Make it return a success.
}
# This is a utility method. Calling it is mandatory
# in the case of failure.
sub tc_fail {
my ($self, $type, @args) = @_;
$type = T_FAILED unless $type;
$self->tc_end($type, @args);
lib/Driver/Compiler/Check.pm view on Meta::CPAN
}
# There is a special case of this in Integer.
sub promote {
my ($self, $newtype) = @_;
my $type = $self->type;
# XXX Checking for T_UNKNOWN is wrong here. I need to check
# whether the old type is 'weaker' than the new type.
confess "XXX No type in " . $self->dump unless $type;
return $self if $type->equals($newtype);
$self->debug_tc(DBG_TC_PROMOTE, "Promoting ([" . $type->dump . "] ".
$self->opcode . ") into " . $newtype->dump);
# Anything can become 'unknown' - this allows weakening
return $self if $type->compatible($newtype);
# This should really be done by 'compatible'?
return $self if $newtype->equals(T_BOOL);
# The Assert nodes are broken for some reason?
# return $self->assert($newtype) if $type->equals(T_UNKNOWN);
lib/Driver/Compiler/Check.pm view on Meta::CPAN
return undef;
}
# This might return an undef in the error list in the case that an
# error occurred which has already been reported.
sub convert {
my ($self, $program, @rest) = @_;
my $opcode = $self->opcode;
$self->debug_tc(DBG_TC_CONVERT, "Convert " . $self->opcode .
" to " . $opcode);
unless (ref $OPTYPES{$opcode}) {
confess "XXX OPTYPES for $opcode is $OPTYPES{$opcode}"
if $OPTYPES{$opcode};
confess "XXX No OPTYPES for $opcode!";
}
my @values = $self->values;
my @template = @{ $OPTYPES{$opcode} };
my $rettype = pop(@template);
unless (@values == @template) {
# XXX This is for self-debugging.
print STDERR "I have " . scalar(@values) . " values\n";
print STDERR "I have " . scalar(@template) . " template\n";
die "Child count mismatch in $opcode";
}
# We push undef into @errors to indicate that an error occurred
# but should have been reported already at a lower level.
my $i = 0;
my @tvals = ();
lib/Driver/Compiler/Generate.pm view on Meta::CPAN
# "Refactor", I hear you say?
# This needs a magic token for line number...
sub generate ($) {
my $self = shift;
my $name = $self->opcode;
# print "Finding code for $name\n";
my $code = $OPCODETABLE{$name};
return "GEN($name)" unless defined $code;
# This is mostly for debugging. It can be safely removed.
if ($code eq 'NOGEN') {
print "XXX Attempt to generate NOGEN opcode $name\n";
return "GEN($name)";
}
my $subref = $self->gensub($name, $code);
{
# Backpatch our original package.
no strict qw(refs);