#! /usr/bin/perl -CSD
use strict;

my ($Prog, $Version) = ("w0code", "2.0.3");
my $Macro_start = "<<";
my $Output = \*STDOUT;
my $Start = "";
my %Def = ();
my $Cur_def = "";
my %Not_def_mess = ();
my %Active = ();
my $N_errors = 0;
PARAM:
while (@ARGV && $ARGV[0] =~ /^-/) { $_ = shift;
    /^-o$/ and do { $_ = shift;  
    open(OUT, ">$_") or &Error("Could not create $_.");
$Output = \*OUT;;  next PARAM; };
/^-o(.+)/ and do { $_ = $1;
    open(OUT, ">$_") or &Error("Could not create $_.");
$Output = \*OUT;;  next PARAM; };
/^-v$/ and do {
    print STDERR "This is $Prog (version $Version)\n";
    next PARAM; };
/^-x$/ and do { $Start = shift;  next PARAM; };
/^-x(.+)/ and do { $Start = $1;  next PARAM; };
&Message("Unknown option `$_' ignored.");
}
DATA:
while (<>) { chomp;
    /^def:(.*)>>$/ and do {
    $Cur_def = $1;  $Start = $Start || $Cur_def;
    $Def{$Cur_def} = 
        exists $Def{$Cur_def} ? "$Def{$Cur_def}nl\n" : "";
    next DATA; };
    /^(code:|nl|use:)/ and do { 
    $Def{$Cur_def} .= "$_\n";  next DATA; };
}
&Error("No macros defined.") unless $Start;
&Expand($Start);
print $Output "\n";
close OUT unless $Output == \*STDOUT;
exit ($N_errors ? 1 : 0);

sub Expand {
    my $sy = shift;
    unless (exists $Def{$sy}) {
    &Warning("Macro name $Macro_start$sy>> has not been defined.")
        unless exists $Not_def_mess{$sy};
    $Not_def_mess{$sy} = "reported";  return;
}
    &Error("Definition cycle found;", "the loop involves:", 
    join(" ", map("$Macro_start$_>>",
                  sort {$Active{$a} <=> $Active{$b}} 
                      grep {$Active{$_} >= $Active{$sy}} 
                          keys %Active))) 
        if $Active{$sy};
$Active{$sy} = 1+keys %Active;
    my $line;
foreach $line (split(/\n/,$Def{$sy})) {
    if ($line =~ /^code:(.*);$/) { print $Output $1; }
    elsif ($line =~ /^nl$/) { print $Output "\n"; }
    elsif ($line =~ /^use:(.*)>>$/) { &Expand($1); }
    else { &Error("Unknown format: $line."); }
}
    delete $Active{$sy};
}
sub Warning {
    &Message(@_);  ++$N_errors;
}
sub Error {
    &Message(@_);  
    &Tidy_up if defined &Tidy_up;
    exit 1;
}
sub Message {
    print STDERR "$Prog: ", shift, "\n";
    while (@_) {
	print STDERR " "x(2+length $Prog), shift, "\n";
    }
}
