view release on metacpan or  search on metacpan

lib/Driver/Compiler/Generate.pm  view on Meta::CPAN

package Anarres::Mud::Driver::Compiler::Generate;

use strict;
use Carp qw(:DEFAULT cluck);
use Exporter;
use Data::Dumper;
use String::Escape qw(quote printable);
use Anarres::Mud::Driver::Compiler::Type;
use Anarres::Mud::Driver::Compiler::Node qw(@NODETYPES);
use Anarres::Mud::Driver::Compiler::Check qw(:flags);

push(@Anarres::Mud::Driver::Compiler::Node::ISA, __PACKAGE__);

my %ASSERTTABLE = (
	IntAssert	=> '+do { my ($__a) = ((A)); ' .
					'die "Not integer at XXX" if ref($__a); ' .
					'$__a; }',
	StrAssert	=> '+do { my ($__a) = ((A)); ' .
					'die "Not string at XXX" if ref($__a); ' .
					'$__a; }',
	ArrAssert	=> '+do { my ($__a) = ((A)); ' .
					'die "Not array at XXX" if ref($__a) ne "ARRAY"; '.
					'$__a; }',
	MapAssert	=> '+do { my ($__a) = ((A)); ' .
					'die "Not mapping at XXX" if ref($__a) ne "HASH"; '.
					'$__a; }',
	ClsAssert	=> '+do { my ($__a) = ((A)); ' .
					'die "Not closure at XXX" if ref($__a) ne "CODE"; '.
					'$__a; }',
	ObjAssert	=> '+do { my ($__a) = ((A)); ' .	# XXX Fixme
					'die "Not object at XXX" if ref($__a) !~ /::/; ' .
					'$__a; }',
		);

	# If we trap the relevant error messages from Perl and accept that
	# we are not going to get an error message on (array + 1) - we
	# just get a pointer increment, then we can just do this.
my %ASSERTTABLE_NOOP = (
	IntAssert	=> 'A',
	StrAssert	=> 'A',
	ArrAssert	=> 'A',
	MapAssert	=> 'A',
	ClsAssert	=> 'A',
	ObjAssert	=> 'A',
		);

my %OPCODETABLE = (
	# Can we tell the difference between strings and ints here?
	# DConway says this tells us if it's an int:
	# ($s_ref eq "" && defined $s_val && (~$s_val&$s_val) eq 0)

	StmtNull		=> '',

	Nil				=> 'undef',

	%ASSERTTABLE_NOOP,

	Postinc			=> '(A)++',
	Postdec			=> '(A)--',
	Preinc			=> '++(A)',
	Predec			=> '--(A)',
	Unot			=> '!(A)',
	Tilde			=> '~(A)',
	Plus			=> '+(A)',
	Minus			=> '-(A)',