package Regex::Generate;
# Copyright (C) 2002-2006, The Perl Foundation.
# $Id: Generate.pm 21249 2007-09-13 06:33:24Z 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:
syntax highlighted by Code2HTML, v. 0.9.1