Anarres-Mud-Driver

 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.



( run in 1.023 second using v1.01-cache-2.11-cpan-49f99fa48dc )