package Regex::Generate;

# Copyright (C) 2002-2006, The Perl Foundation.
# $Id: /mirror/trunk/languages/regex/lib/Regex/Generate.pm 21249 2007-09-13T06:33:24.019117Z paultcochrane  $

use strict;
use warnings;

############### SIMPLE OUTPUT ##############

sub output_nop {
    return "nop";
}

sub output_terminate {
    return "terminate";
}

sub output_increment {
    my $var = shift;
    return "$var++";
}

sub output_assign {
    my ( $var, $val ) = @_;
    return "$var := $val";
}

sub output_atend {
    return "atend";
}

sub output_advance {
    my $distance = shift || 1;
    return "advance $distance";
}

#  sub output_fork {
#      my ($label) = @_;
#      return "fork $label->[1]";
#  }

#  sub output_reverse_fork {
#      my ($label) = @_;
#      return "reverse_fork $label->[1]";
#  }

sub output_onfail {
    my ($label) = @_;
    return "onfail $label->[1]";
}

sub output_match {
    my ($byte) = @_;
    return "match '$byte'";
}

sub output_classmatch {
    my ($class) = @_;
    return "classmatch '$class'";
}

sub output_start {
    my ($n) = @_;
    return "start $n";
}

sub output_end {
    my ($n) = @_;
    return "end $n";
}

sub output_fail {
    return "fail";
}

sub output_if {
    my ( $a, $cond, $b, $where ) = @_;
    return "if $a $cond $b goto $where->[1]";
}

sub output_goto {
    my ($where) = @_;
    return "goto $where->[1]";
}

sub output_label {
    my ( $label, $reachable ) = @_;
    return "$label:" . ( $reachable ? "" : " (unreachable)" );
}

##################################

use vars qw(%OUTPUT);

sub gather {
    foreach ( keys %Regex::Generate:: ) {
        next unless /^output_(\w+)$/;
        $OUTPUT{$1} = $Regex::Generate::{$_};
    }
}
gather();

sub output {
    my @r;
    my $curlabel = "\t";
    for my $op (@_) {
        if ( !ref($op) ) {
            push @r, $curlabel . $op;
            $curlabel = "\t";
        }
        elsif ( $op->[0] eq 'label' ) {
            $curlabel = "$op->[1]:" . $curlabel;
        }
        elsif ( my $outfunc = $OUTPUT{ $op->[0] } ) {
            my @args = @$op;
            shift(@args);
            push @r, $curlabel . $outfunc->(@args);
            $curlabel = "\t";
        }
        else {
            die "Unable to output $op->[0]";
        }
    }
    return @r;
}

1;

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
