view release on metacpan or search on metacpan
Compiler/lexer.c view on Meta::CPAN
*amd_yy_cp = amd_yy_hold_char;
YY_RESTORE_YY_MORE_OFFSET
if ( amd_yy_current_buffer->amd_yy_buffer_status == YY_BUFFER_NEW )
{
/* We're scanning a new file or input source. It's
* possible that this happened because the user
* just pointed amd_yyin at a new source and called
* amd_yylex(). If so, then we have to assure
* consistency between amd_yy_current_buffer and our
* globals. Here is the right place to do so, because
* this is the first action (other than possibly a
* back-up) that will match for the new input source.
*/
amd_yy_n_chars = amd_yy_current_buffer->amd_yy_n_chars;
amd_yy_current_buffer->amd_yy_input_file = amd_yyin;
amd_yy_current_buffer->amd_yy_buffer_status = YY_BUFFER_NORMAL;
}
/* Note that here we test for amd_yy_c_buf_p "<=" to the position
* of the first EOB in the buffer, since amd_yy_c_buf_p will
Compiler/parser.c view on Meta::CPAN
"L_XOR_EQ","L_DOT_EQ","L_LOR_EQ","L_LAND_EQ","'?'","L_LOR","L_LAND","'|'","'^'",
"'&'","L_EQ","L_NE","L_GE","L_LE","'<'","'>'","L_LSH","L_RSH","'.'","'+'","'-'",
"'*'","'%'","'/'","'!'","'~'","L_INC","L_DEC","'{'","'}'","','","';'","':'",
"'('","')'","'['","']'","'='","'$'","'#'","program","definition","inheritance",
"identifier","function_declarator","variable_declarator","variable_declarator_list",
"variable_declarator_init","variable_declarator_list_init","function_prologue",
"prototype","function","block","statement_list","statement","opt_else","list_exp",
"opt_list_exp","nv_list_exp","opt_nv_list_exp","arg_list","opt_arg_list","opt_arg_list_comma",
"assoc_exp","assoc_arg_list","opt_assoc_arg_list_comma","function_name","lvalue",
"exp","cond_exp","logical_exp","compare_exp","arith_exp","prefix_exp","postfix_exp",
"array_exp","close_square","opt_endrange","basic_exp","lvalue_list","global_decl",
"local_decls","local_decl","type_decl","class_member_list","class_member","arguments",
"argument_list","argument","type_modifier_list","type_specifier","star_list",
"string_const","string","integer","array","mapping","closure", NULL
};
static const short amd_yytoknum[] = { 0,
256, 2, 257, 258, 259, 260, 261, 262, 263, 264,
265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
275, 276, 277, 278, 279, 280, 281, 282, 283, 284,
285, 286, 287, 288, 289, 290, 291, 292, 293, 294,
295, 296, 297, 298, 299, 300, 301, 302, 303, 304,
Compiler/parser.c view on Meta::CPAN
if (!svp) continue;
/* The AV returned from variable_declarator */
vd = (AV *)SvRV(*svp);
/* These two should be guaranteed dereferencable */
stars = *( av_fetch(vd, 0, FALSE) );
name = *( av_fetch(vd, 1, FALSE) );
var = amd_yyparse_variable(name, type, stars, newSViv(amd_yyvsp[-3].number));
/* XXX Check global modifiers, and possibly make these
* variables static. */
if (amd_yyvsp[-3].number & M_STATIC) {
SvREFCNT_dec(
amd_yyparse_program_apply(amd_yyparse_param,
"static", name, var));
}
else {
SvREFCNT_dec(
amd_yyparse_program_apply(amd_yyparse_param,
"global", name, var));
}
}
/* See local_decl for memory management notes. */
;
break;}
case 144:
#line 1251 "parser.y"
{
amd_yyval.av = newAV();
Compiler/parser.y view on Meta::CPAN
%%
program
: program definition
| /* empty */
;
definition
: inheritance
| global_decl
| type_decl
| function
| prototype
;
inheritance
: L_INHERIT string_const ';'
{
/* printf("Inheriting %s\n", SvPVX($2)); */
SvREFCNT_dec(
Compiler/parser.y view on Meta::CPAN
}
| lvalue_list ',' lvalue
{
av_push($1, $3);
$$ = $1;
}
;
global_decl
: type_modifier_list type_specifier variable_declarator_list ';'
{
int len;
int i;
SV **svp;
AV *vdl;
AV *vd;
SV *name;
const char *type;
SV *stars;
Compiler/parser.y view on Meta::CPAN
if (!svp) continue;
/* The AV returned from variable_declarator */
vd = (AV *)SvRV(*svp);
/* These two should be guaranteed dereferencable */
stars = *( av_fetch(vd, 0, FALSE) );
name = *( av_fetch(vd, 1, FALSE) );
var = yyparse_variable(name, type, stars, newSViv($1));
/* XXX Check global modifiers, and possibly make these
* variables static. */
if ($1 & M_STATIC) {
SvREFCNT_dec(
yyparse_program_apply(yyparse_param,
"static", name, var));
}
else {
SvREFCNT_dec(
yyparse_program_apply(yyparse_param,
"global", name, var));
}
}
/* See local_decl for memory management notes. */
}
;
local_decls
: /* empty */
{
lib/Driver/Compiler/Check.pm view on Meta::CPAN
# Look up type
sub check {
my ($self, $program, @rest) = @_;
my $name = $self->value(0);
$self->tc_start($name);
my ($var, $class);
confess "XXX No program" unless $program;
if ($var = $program->local($name)) {
$class = 'Anarres::Mud::Driver::Compiler::Node::VarLocal';
}
elsif ($var = $program->global($name)) {
$class = 'Anarres::Mud::Driver::Compiler::Node::VarGlobal';
}
# elsif ($var = $program->static($name)) {
# $class ='Anarres::Mud::Driver::Compiler::Node::VarStatic';
# }
else {
$program->error("Variable $name not found");
# XXX Should we fake something up? We end up
# dying later if we leave a Variable in the tree.
return $self->tc_fail;
lib/Driver/Compiler/Dump.pm view on Meta::CPAN
{
package Anarres::Mud::Driver::Compiler::Node::VarLocal;
sub dump {
"(" . $_[0]->dumptype . "varlocal " . $_[0]->value(0) . ")";
}
}
{
package Anarres::Mud::Driver::Compiler::Node::VarGlobal;
sub dump {
"(" . $_[0]->dumptype . "varglobal " . $_[0]->value(0) . ")";
}
}
{
package Anarres::Mud::Driver::Compiler::Node::VarStatic;
sub dump {
"(" . $_[0]->dumptype . "varstatic " . $_[0]->value(0) . ")";
}
}
lib/Driver/Program.pm view on Meta::CPAN
# Instance query methods
sub path { return $_[0]->{Path}; }
sub source { return $_[0]->{Source}; }
sub ppsource { return $_[0]->{PPSource}; }
sub package { return path_to_package $_[0]->{Path}; }
sub methods { return values %{ $_[0]->{Methods} }; }
# sub locals { return values %{ $_[0]->{Globals} }; }
sub globals { return values %{ $_[0]->{Globals} }; }
sub variable {
my ($self, $name) = @_;
return $self->{Locals}->{$name}
|| $self->{Globals}->{$name}
|| undef;
}
# Instance modification methods
lib/Driver/Program.pm view on Meta::CPAN
return $self->{Locals}->{$name} unless $var;
$self->warning("Local $name masks previous definition")
if $self->{Locals}->{$name}
|| $self->{Globals}->{$name}
|| $self->{Statics}->{$name};
# print "Storing local variable " . $var->dump . "\n";
$self->{Locals}->{$name} = $var;
return ();
}
sub global {
my ($self, $name, $var) = @_;
# print STDERR "global($name, $var)\n";
return $self->{Globals}->{$name} unless $var;
$self->error("Global $name masks previous definition in file XXX")
if $self->{Globals}->{$name}
|| $self->{Statics}->{$name};
# print "Storing variable $name\n";
$self->{Globals}->{$name} = $var;
return ();
}
sub static {
lib/Driver/Program.pm view on Meta::CPAN
return "Could not find inherited program '$path'" unless $inh;
$name = basename($path, ".c") unless $name; # Also support DGD
return "Already inheriting file named $name"
if $self->{Inherits}->{$path};
$self->{Inherits}->{$name} = $inh;
my @errors;
foreach ($inh->globals) {
my $err = $self->global($_);
push(@errors, $err), next if $err;
# Variable flags? Accessibility.
}
foreach ($inh->methods) {
next if $_->flags & (M_EFUN | M_UNKNOWN | M_PRIVATE);
my $err = $self->method($_->name, $_); # XXX Mark inherited
push(@errors, $err) if $err;
$err = $self->method($name . "::" . $_->name, $_);
push(@errors, $err) if $err;
lib/Driver/Program.pm view on Meta::CPAN
# Debugging
sub dump {
my ($self) = @_;
my @inh = map { "(inherit " .
quote(printable $_) . " " .
quote(printable $self->{Inherits}->{$_}->path)
. ")" }
keys %{$self->{Inherits}};
my @glob = sort map { $_->dump(1) } values %{$self->{Globals}};
my @meth = sort keys %{$self->{Methods}};
@meth = grep { ! ($self->{MethodFlags}->{$_} & M_EFUN) } @meth;
@meth = map { $self->{Methods}->{$_}->dump(1) } @meth;
my $out = "(program\n\t" . join("\n\t", @inh, @glob, @meth) . "\n)";
return $out;
}
# Semantics
sub check {
my $self = shift;
my @meth = grep { ! ($self->{MethodFlags}->{$_} & M_EFUN) }
lib/Driver/Program.pm view on Meta::CPAN
my ($self, $section, @code) = @_;
if (@code) {
push(@{ $self->{Perl}->[$section] }, @code);
return ();
}
else {
return join("\n", @{ $self->{Perl}->[$section] });
}
}
sub perl_global {
my ($self, @globals) = @_;
push( @{ $self->{PerlGlobals} }, @globals);
}
sub generate {
my ($self) = @_;
my $path = $self->{Path};
my $package = $self->package;
$self->perl(PERL_HEAD, "# program $path;");
$self->perl(PERL_HEAD, "package $package;");
$self->perl(PERL_USE, "use strict;");
$self->perl(PERL_USE, "use warnings;");
$self->perl_global(q[$PROGRAM]);
if (scalar %{ $self->{Inherits} }) {
my $inh = join " ",
map { $_->package }
values %{ $self->{Inherits} };
$self->perl_global(q[@ISA]);
$self->perl(PERL_VARS, qq[\@ISA = qw($inh);]);
}
else {
$self->perl(PERL_SUBS, qq[sub new { bless { }, shift; }\n]);
}
$self->perl(PERL_USE, 'use vars qw(' .
join(" ", @{ $self->{PerlGlobals} }) .
");");
# XXX $path forms part of a Perl program. Beware.