package Anarres::Mud::Driver::Compiler::Node;
# A lot of things throw code into this package's namespace.
use strict;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS @NODETYPES);
use Exporter;
use Carp qw(confess);
BEGIN { # Does this still have to be a BEGIN?
@ISA = qw(Exporter);
@EXPORT_OK = qw(@NODETYPES);
%EXPORT_TAGS = (
all => \@EXPORT_OK,
);
# Vivify the relevant packages
# It might be useful to have a "Coerce" node which does a runtime
# type coercion/promotion, rather than an Assert node which just
# does a runtime type check.
# We can't read these out of <DATA> at BEGIN-time.
@NODETYPES = qw(
StmtNull
ExpComma
IntAssert StrAssert ArrAssert MapAssert ClsAssert ObjAssert
ToString
Nil String Integer Array Mapping Closure
Variable Parameter Funcall CallOther
VarStatic VarGlobal VarLocal
Index Range Member New
Postinc Postdec Preinc Predec Unot Tilde Plus Minus
Eq Ne Lt Gt Le Ge
Lsh Rsh Add Sub Mul Div Mod
Or And Xor
LogOr LogAnd
AddEq SubEq DivEq MulEq ModEq
AndEq OrEq XorEq
LshEq RshEq
LogOrEq LogAndEq
IntEq IntNe IntLt IntGt IntLe IntGe
IntAdd IntSub IntMul IntDiv IntMod IntLsh IntRsh
IntOr IntAnd IntXor
IntAndEq IntOrEq IntXorEq
IntAddEq IntSubEq IntMulEq IntDivEq IntModEq
IntLshEq IntRshEq
StrAdd StrMul
StrIndex StrRange
StrEq StrNe StrLt StrGt StrLe StrGe
StrAddEq StrMulEq
ArrEq ArrNe
ArrAdd ArrSub
ArrOr ArrAnd
ArrIndex ArrRange
MapEq MapNe
MapAdd
MapIndex
ObjEq ObjNe
Catch Sscanf
ExpCond Assign Block StmtExp
StmtDo StmtWhile StmtFor
StmtForeach StmtForeachArr StmtForeachMap
StmtRlimits StmtTry StmtCatch
StmtIf StmtSwitch StmtCase StmtDefault
StmtBreak StmtContinue StmtReturn
);
my $PACKAGE = __PACKAGE__;
foreach (@NODETYPES) {
my $visit = "v_" . lc $_;
eval qq{
package $PACKAGE\::$_;
use strict;
use vars qw(\@ISA);
use Carp qw(:DEFAULT cluck);
use Data::Dumper;
use Anarres::Mud::Driver::Compiler::Node qw(:all);
use Anarres::Mud::Driver::Compiler::Type qw(:all);
\@ISA = qw(Anarres::Mud::Driver::Compiler::Node);
sub accept { return \$_[1]->$visit(\$_[0]); } # Visitors
}; die $@ if $@;
}
}
# Now that we have set up the Node packages, we can do this:
# use Anarres::Mud::Driver::Compiler::Dump;
# use Anarres::Mud::Driver::Compiler::Check;
# use Anarres::Mud::Driver::Compiler::Generate;
# Meanwhile, back in the Node package...
sub new {
my ($class, @vals) = @_;
# die "Construct invalid node type $class" unless $class =~ /::/;
# print "Construct node $class with " . scalar(@vals) . " values\n";
my $self = [ undef, 0, @vals ]; # type, flags, vals
return bless $self, $class;
}
# The format of a node is [ type, flags, value0, value1, ... ]
sub type { $_[0]->[0] }
sub settype { $_[0]->[0] = $_[1] }
sub value { $_[0]->[2 + $_[1]] }
sub setvalue{ $_[0]->[2 + $_[1]] = $_[2] }
sub values { @{$_[0]}[2..$#{$_[0]}] }
# sub flag { $_[0]->[1] & $_[1] }
sub setflag { $_[0]->[1] |= $_[1] }
sub flags { $_[0]->[1] }
sub opcode {
(my $name = (ref($_[0]) || $_[0])) =~ s/.*:://;
return $name;
}
sub setopcode {
my ($self, $newopcode) = @_;
my $class = ref($self);
$class =~ s/[^:]+$/$newopcode/;
bless $self, $class;
return 1;
}
1;