#!/usr/bin/perl

# Unlambda "compiler"
# written by Emil Jerabek, public domain

# Usage:
#    unlc file.unl > file.c
#    cc file.c

#CHANGELOG:
#2004-??-??: initial release
#2006-02-24: fixed spurious refcounts

# name of the unl.c source file in a C #include syntax, adjust to your needs
$c_src = "<unl.c>";

%bltin = ("@" => "At", "|" => "Pipe", "/" => "Slash");
$bltin{$_} = $_ for "S", "K", "I", "V", "C", "D", "E";
$f{$_} = {rc => 0, t => $_} for values %bltin;
$f{$_}->{rc}++ for "I", "V";
$lf = ord "\n";
$bltin{"R"} = "Dot$lf"; $f{"Dot$lf"} = {rc => 0, t => "Dot", c => $lf};

$src_name = @ARGV ? $ARGV[0] : "<stdin>";

$line = <>;

sub getnext {
    for (;;) {
	die "$0: unexpected EOF\n" unless defined $line;
	$line =~ s/^\s*//;
	return $1 if $line =~ s/^([^\#\s])//;
	$line = <>;
    }
}

sub parse {
    my ($c) = getnext();
    die "$0: unrecognized character `$c'\n"
	unless $c =~ m{[skivcder@|/.?`]}i; #emacs hack `]};
    if ($c eq '`') {
	my ($a) = parse();
	my ($b) = parse();
	if (exists($ap{"$a $b"})) {
	    $c = $ap{"$a $b"};
	    $f{$_}->{rc}-- for $a, $b;
	} else {
	    $c = $ap{"$a $b"} = $nume++;
	    $f{$c} = {rc => 0, t => "Back", a => $a, b => $b};
	}
    } elsif ($c =~ /[.?]/) {
	die "$0: unexpected EOF\n" if $line eq "";
	$line =~ s/^(.)//s;
	my ($a) = ord $1;
	my ($t) = $c eq "." ? "Dot" : "Q";
	$c = "$t$a";
	$f{$c} = {rc => 0, t => $t, c => $a} unless exists($f{$c});
    } else {
	$c = $bltin{uc $c};
    }
    $f{$c}->{rc}++;
    return $c;
}

#NB: dump() is a builtin Perl function, which dumps core when called
#do not use that name!
sub dumpe {
    my ($x) = @_;
    return unless $f{$x}->{rc};
    if ($f{$x}->{t} eq "Back") {
	dumpe($f{$x}->{a});
	dumpe($f{$x}->{b});
    }
    printf "static func pre%s = {%d, %s", $x, $f{$x}->{rc}, $f{$x}->{t};
    if ($f{$x}->{t} eq "Back") {
	printf ", {{&pre%s, &pre%s}}", $f{$x}->{a}, $f{$x}->{b};
    } elsif (exists($f{$x}->{c})) {
	printf ", IC(%d)", $f{$x}->{c};
    }
    print "};\n";
    $f{$x}->{rc} = 0;
}


$prg = parse ();

print <<EOT;
/* "compiled" Unlambda program, generated by $0 from $src_name */
#define COMPILE
#include $c_src
EOT

dumpe "I";
dumpe "V";
dumpe $prg;

print "static func *main_expr = &pre$prg;\n";

0;