The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
package Rc::Sh;  #bourne shell backend
use Carp;
use Rc qw($OutputFH);
use vars qw($level %Local $Backq);
$level = 0;
%Local = (IFS => 1);

sub HELP { die "Will an 'sh' expert please step forward?" }

sub indent(&) { local $level = $level + 1; shift->() }
sub nl() { "\n" . ' 'x($level*4) }

sub Rc::Node::sh {
    print $OutputFH shift->shp(). "\n";
}

sub Rc::Node::shp {
    my $n=shift;
    die ref($n)." not implemented yet for 'sh'";
}

sub Rc::Word::shp { shift->string }

sub Rc::Qword::shp {
    my $s = shift->string;
    # quotemeta XXX
    "'$s'"
}

sub no_brace {
    my $n=shift;
    $n->isa('Rc::Brace')? $n->kid(0) : $n
}

sub Rc::If::shp {
    my $n=shift;
    my $k = $n->kid(1);
    'if '.$n->kid(0)->shp.' ; then'.
	($k->isa('Rc::Else')? $k->shp :
	 indent { nl.no_brace($k)->shp }.nl.'fi' )
}

sub Rc::Orelse::shp {
    my $n=shift;
    join(' || ', map { $_->shp } $n->kids);
}

sub Rc::Concat::shp {
    my $n = shift;
    # maybe some sanity check? XXX
    join('', map { $_->shp } $n->kids);
}

sub Rc::Else::shp {
    my $n =shift;
    my $k = $n->kid(1);
    indent { nl.no_brace($n->kid(0))->shp }.nl.do {
	if ($k->isa('Rc::If')) {
	    'el'.$k->shp
	} else {
	    'else '.$k->shp;
	}
    };
}

sub Rc::Args::shp {
    my $n = shift;
    join(' ', map { $_->shp } $n->kids)
}

sub _words {
    my $n=shift;
    my @w;
    while ($n->isa('Rc::Lappend')) {
	push @w, $n->kid(1);
	$n = $n->kid(0);
    }
    @w, $n;
}

sub _match {
    my ($x,$y) = @_;
    if (ref $y eq 'Rc::Undef') {
	'test "x'.$x->shp.'" = x'
    } else {
	die "don't know how to match against $y";
    }
}

sub Rc::Match::shp {
    my $n=shift;
    join(' || ', map { _match($n->kid(0), $_) } _words($n->kid(1)))
}

sub as_var {
    my ($k) = @_;
    my $varname;
    if ($k->isa('Rc::WordX')) {
	$varname = $k->shp;
	if ($varname =~ /[:=-?+%\#]/) {
	    die "metacharacters found in var '$varname'";
	} elsif ($varname eq 'pid') {
	    return "\$";
	}
    } else {
	die "don't know how use $k as a variable"
    }
    "{$varname}"
}

sub Rc::Backq::shp {
    my $n=shift;
    die "nested Backq unimplemented" if $Backq;
    local $Backq=1;
    my @s;
    my $k = $n->kid(0);
    if ($k->isa('Rc::Var')) {
	my $v = $k->kid(0);
	if ($v->isa('Rc::Word') and $v->string eq 'ifs') {}
	else {
	    push @s, 'IFS='.$v->shp;
	}
    } else {
	die "backq with strange ifs"
    }
    # quotemeta XXX
    '`'.$n->kid(1)->shp.'`'
}

*Rc::Flat::shp = \&HELP;
*Rc::Count::shp = \&HELP;
sub Rc::Var::shp { "\$". as_var(shift->kid(0)) }

sub _body {
    my $n=shift;
    my @s;
    my @k = $n->kids;
    push @s, $k[0]->shp; # $k[0] always set? XXX
    if (!$k[1]->isa('Rc::Undef')) {
	if (!$k[0]->isa('Rc::Nowait')) {
	    push @s, nl;
	}
	push @s, $k[1]->shp;
    }
    join '', @s;
}

*Rc::Body::shp = \&_body;
*Rc::Cbody::shp = \&_body;

sub Rc::Brace::shp {
    my $n=shift;
    my $k1=$n->kid(1);
    '{'.indent { nl.$n->kid(0)->shp }.nl.'}'.
	(!$k1->isa("Rc::Undef")? $k1->shp:'')
}

sub Rc::Assign::shp {
    my ($n) = @_;
    my $name = $n->kid(0)->shp;
    $name.'='.$n->kid(1)->shp.($Local{$name}? '':'; export '.$name)
}

sub Rc::Pre::shp {
    my $n=shift;
    my @l;
    my @s = ("# LOCALISATION BLOCK");
    while (1) {
	my $mod = $n->kid(0);
	if ($mod->isa('Rc::Assign')) {
	    my $name = $mod->kid(0)->shp;
	    die "sh doesn't do nested localization ($name)"
		if $Local{$name};
	    $Local{$name}=1;
	    push @l, $name;
	    push @s, "$name=".$mod->kid(1)->shp;
	} elsif ($mod->isa('Rc::Redir')) {
	    die "Pre($mod) - not yet"; #move down? XXX
	} else {
	    die "Pre($mod)?";
	}
	if ($n->kid(1)->isa('Rc::Pre')) {
	    $n = $n->kid(1);
	    next;
	}
	last;
    }
    @s = join(nl,@s);
    indent {
	push @s, nl.no_brace($n->kid(1))->shp;
    };
    push @s,nl;
    for (@l) {
	delete $Local{$_};
	push @s, "unset $_".nl;
    }
    join('',@s);
}

sub Rc::Newfn::shp {
    my $n = shift;
    $n->kid(0)->shp.'() {'.indent { nl.$n->kid(1)->shp }.nl.'}'
}

1;