#!/usr/bin/perl

# Unlambda interpreter

sub parse {
    my $c;
    for (;;) {
	$line =~ s/^\s+//;
	$c = lc $1, last if $line =~ s/^([^\#])//;
	defined ($line = <>) or die "unexpected EOF\n";
    }
    if ($c eq "`") {
	return [$c, parse(), parse()];
    }
    if ($c =~ /^[.?]/) {
	$line =~ s/^(.)//s or die "unexpected EOF\n";
	return [$c, $1];
    }
    $c eq "r" and return [".", "\n"];
    $c =~ m{^[skivcde@|/]} or die "unknown character `$c'\n";
    return [$c];
}

@stk = (parse(), "E");

while (@stk) {
    for (pop @stk) {
	/^E/ and do {
	    $res = pop @stk;
	    push @stk, $res->[2], "F", $res->[1], "E" if $res->[0] eq "`";
	    last;
	};
	/^F/ and $res->[0] eq "d" ? $res = ["D", pop @stk]
	                          : ($a = pop(@stk),
				     push @stk, $res, "A", $a, "E"), last;
	for (($a = pop @stk)->[0]) {
	    /^k/ and $res = ["K", $res], last;
	    /^K/ and $res = $a->[1], last;
	    /^s/ and $res = ["S", $res], last;
	    /^S/ and $res = ["T", $a->[1], $res], last;
	    /^T/ and push(@stk,
		["`", ["`", $a->[1], $res], ["`", $a->[2], $res]], "E"), last;
	    /^i/ and last;
	    /^v/ and $res = $a, last;
	    /^e/ and @stk = (), last;
	    /^D/ and push(@stk, ["`", $a->[1], $res], "E"), last;
	    /^c/ and push(@stk, ["`", $res, ["C", [@stk]]], "E"), last;
	    /^C/ and @stk = @{$a->[1]}, last;
	    /^\./ and print($a->[1]), last;
	    /^\?/ and push(@stk, ["`", $res, [$a->[1] eq $cur_ch ? "i" : "v"]],
			   "E"), last;
	    /^@/ and push(@stk,
			  ["`", $res, [defined($cur_ch = getc) ? "i" : "v"]],
			  "E"), last;
	    /^\|/ and push(@stk,
			   ["`", $res, defined $cur_ch ? [".", $cur_ch] : ["v"]],
			   "E"), last;
	    /^\// and push(@stk,
			   ["`", $res, defined $cur_ch ? ["?", $cur_ch] : ["v"]],
			   "E"), last;
	    die "`$_' -- WTF?\n";
	}
    }
}