use strict;
use warnings;
use Parse::RecDescent;

our(%Accum);
@Accum{qw(I N S P)}=qw(I0 N0 S0 P0);

our($asm, $pool, %symbols, @args);
our(%unop_to_name, %binop_to_name, %funcs);

{
	my(%regcounts);
	#0 is accum, 1-4 are temporaries
	@regcounts{qw(I N S P)}=qw(5 5 5 5);
	warn values %regcounts;

	sub alloc($$) {
		my($type, $var)=@_;

		($type)=$type=~/^(\w)/;
		$type=uc $type;
		
		$symbols{$var}=$type.$regcounts{$type}++;
		die "Out of $type registers!\n" if $regcounts{$type} > 31;
		add_asm("#	$var($type) => $symbols{$var}");
	}
}


my $tree=parse(slurp(shift()));

die "Cannot continue after parsing errors\n" unless $tree;
add_asm('');

print STDERR "Symbol dump:\n";
for(keys %symbols) {
	print STDERR "	$_ => $symbols{$_}\n";
}
print STDERR "\n";

$tree->traverse;

print $asm;


sub picktype {
	no warnings 'uninitialized';
	my($r, $cur);
	until($r =~ /^[INSP]/) {
		$cur=shift;
		($r)=($cur =~ /^(.)/);

		unless(@_ or defined $r) {
			if($cur =~ /^[+-]\d+(?:\.\d+)?$/) {
				return 'N';
			}
			else {
				return 'S';
			}
		}
	}


	for(@_) {
		($r)=/^(.)/ if(/^([INSP])/ gt $r);
	}

	return $r;
}

sub argpush($) {
	push @args, shift;
}

sub argpop() {
	pop @args;
}

sub argpush2($$) {
	argpush(shift);
	argpush(shift);
}

sub argpop2() {
	(argpop, argpop);
}

sub argpushn(@) {
	push @args, @_;
}

sub argpopn($) {
	my @r;
	for(1..shift) {
		unshift @r, argpop();
	}
	return @r;
}

sub argpoptomark {
	my @r;
	no warnings 'uninitialized';
	while($r[0] ne '::MARK::') {
		unshift @r, argpop();
	}
	shift @r;
	return @r;
}

sub slurp {
	local $/;
	my($filename)=shift()||'-';
	open(IN, $filename) or die "Can't open $filename: $!";
	add_asm("#File: $filename\n\n#Variables:");
	my($r)=<IN>;
	close(IN);
	return $r;
}

sub parse {
	my($file)=shift;

	my $p=new Parse::RecDescent(our $grammar);

	$p->start($file);
}



sub add_asm {
	$asm .= shift() . "\n";
}

sub UNIVERSAL::traverse {
	my($me)=shift;
	$me->preaction;

	if($me->{__DIRECTIVE1__}) {
		for( @{$me->{__DIRECTIVE1__}} ) {
			$_->traverse;
		}
	}
	else {
		for(keys %$me) {
			next if /^__.*__$/;

			$me->{$_}->traverse if ref $me->{$_};
		}
	}

	$me->action;
	no warnings 'uninitialized';
	warn ref $me, ": [@::args]\n";
}

sub start::preaction {}
sub start::action {
	::add_asm("end");
}

sub statements::preaction {}
sub statements::action    {}

sub statement::preaction {
	$::pool=1;
}
sub statement::action     {}

sub expression::preaction {
	push @::args, '::MARK::'
}

sub expression::action {
	my($me)=shift;

	my(@myargs)=::argpoptomark();
	my($type, $name)=(shift @myargs, shift @myargs);
	@myargs=reverse @myargs;

	for($type) {
		if(/:\w/) {
			for(my $i=0; $i < @myargs; $i++) {
				unless(defined $myargs[$i]) {
					splice @myargs, $i, 1;
					$i--;
					next;
				}
			}

			if(/:f/)    {
				#function call
				$::funcs{$name}||=[$name, 0];
				if($::funcs{$name}[1]) {
					::add_asm("$::funcs{$name}[0] ".join(', ', @myargs));
					::argpush(undef);
				}
				else {
					::add_asm("$::funcs{$name}[0] ".join(', ', $::Accum{::picktype(@myargs)}, @myargs));
					::argpush($::Accum{::picktype(@myargs)});
				}
			}
			elsif(/:u/) {
				if($::unop_to_name{$name}[1]) {
					::add_asm("$::unop_to_name{$name}[0] $myargs[0]");
					::argpush(undef);
				}
				else {
					::add_asm("$::unop_to_name{$name}[0] $::Accum{::picktype(@myargs)}, $myargs[0]");
					::argpush($::Accum{::picktype(@myargs)});
				}
			}
			elsif(/:b/) {
				if($::binop_to_name{$name}[1]) {
					::add_asm("$::binop_to_name{$name}[0] $myargs[0], $myargs[1]");
					::argpush(undef);
				}
				else {
					::add_asm("$::binop_to_name{$name}[0] $::Accum{::picktype(@myargs)}, $myargs[0], $myargs[1]");
					::argpush($::Accum{::picktype(@myargs)});
				}
			}
		}
		else {
			unshift @myargs, $type, $name;
			::argpushn(@myargs);
		}
	}
}

sub value::preaction      {}
sub value::action         {}

sub subcall::preaction {
	my($me)=shift;
	::argpush2(':f', $me->{IDENT}->{__VALUE__});
}

sub subcall::action {}

sub command::preaction    {}
sub command::action       {}

sub if_command::preaction {
	die "if commands are not implemented\n";
}
sub if_command::action    {}

sub ifelse_command::preaction {
	die "if/else commands are not implemented\n";
}
sub ifelse_command::action
						  {}

sub while_command::preaction {
	die "while commands are not implemented\n";
}
sub while_command::action {}

sub dowhile_command::preaction {
	die "do/while commands are not implemented\n";
}
sub dowhile_command::action
						  {}

sub BLOCK::preaction      {}
sub BLOCK::action         {}

sub BINOP::preaction      {
	my($me)=shift;
	::argpush2(':b', $me->{__VALUE__});
}

sub BINOP::action		  {}

sub UNOP::preaction {
	my($me)=shift;
	::argpush2(':u', $me->{__VALUE__});
}
sub UNOP::action          {}

sub CONSTANT::preaction   {}
sub CONSTANT::action {
	my($me)=shift;
	::argpush($me->{__VALUE__});
}

sub VARIABLE::preaction   {}
sub VARIABLE::action {
	my($me)=shift;
	my($name)=pop @::args;
	::argpush($symbols{'$'.$name});
}

sub IDENT::preaction      {}
sub IDENT::action         {
	my($me)=shift;
	::argpush($me->{__VALUE__});
}





INIT {
	our $grammar=<<'PARSER';

<autotree>

start:
	statements /^;?\Z/  |
	<error>

statements:
	statement(s /;/) #/ for the highlighter

statement:
	declaration						|
	command							|
	expression						|
	''								|
	<error>

expression:
	value BINOP expression			|
	UNOP expression					|
	value							|
	<error>


value:
	CONSTANT						|
	VARIABLE						|
	'(' expression ')'				|
	subcall							|
	<error>

subcall:
	IDENT '(' expression(s /,/) ')' | #/ for the syntax highlighter
	IDENT							|
	<error>

declaration:
	'our' <commit> IDENT '(' VARIABLE ')'
	{
		::alloc(
			$item{IDENT}{__VALUE__},
			'$'.$item{VARIABLE}{IDENT}{__VALUE__}
		);
		$return=undef;
		1;
	}								|
	<error>

command:
	if_command						|
	ifelse_command					|
	while_command					|
	dowhile_command					|
	<error>

if_command:
	IF <commit> '(' expression ')' BLOCK		|
	<error>

ifelse_command:
	IF <commit> '(' expression ')' BLOCK 'else' BLOCK |
	<error>

while_command:
	WHILE <commit> '(' expression ')' BLOCK	|
	<error>

dowhile_command:
	'do' <commit> BLOCK <uncommit> WHILE <commit> '(' expression ')' |
	<error>

IF:
	'if' | 'unless'

WHILE:
	'while' | 'until'

BLOCK:
	'{' statements '}'				|
	<error>

CONSTANT:
	/[+-]?\d+(?:\.\d+)?/			|
	/^".*?"/						|
	/^'.*?'/						|
	<error>

VARIABLE:
	'$' IDENT						|
	'${' IDENT '}'					|
	<error>

BINOP:
	'+'  | '-'  | '*'  | '/'  | '%'  | '~'  | 'x'  | '='  |
	'+=' | '-=' | '*=' | '/=' | '%=' | '~=' | 'x=' |
	'>'  | '<'  | '==' | 'lt' | 'gt' | 'eq' |
    '<=' | '>=' | '!=' | 'ge' | 'le' | 'ne' |
	'&&' | '||' | 'and'| 'or'		|
	<error>

UNOP:
	'-'  | '+'  | '!'				|
	<error>

IDENT:
	/^\w+/							|
	<error>

PARSER

	%unop_to_name=(
		'+' => ['nop', 0],
		'-' => ['neg', 0]
	);

	%binop_to_name=(
		'+' => ['add', 0],
		'-' => ['sub', 0],
		'*' => ['mul', 0],
		'/' => ['div', 0],
		'%' => ['mod', 0],
		'~' => ['concat', 0],
		'=' => ['set', 1]
	);

	%funcs=(
		'print' => ['print', 1]
	);
}