generator

用于词法分析的词法分析器

#!/usr/local/bin/perl

# $Id: generator,v 1.1 1997/01/19 06:04:24 matt Exp $
#
# Code generator for graphviz .dot files.
#
# (c) 1997 Matt Phillips.

# extract root dir from exec path
BEGIN
{
  ($root) = ($0 =~ m<^(.*)/[^/]*$>);
  $root = $root ? "$root/../.." : '.';

  # set @INC correctly
  push (@INC, "$root/foo");
}
  
use FooParser;
use FooObject;

# subs
# ----------------------------------------------------------------------

sub error
{
  my ($message, $nodie) = @_;
  print STDERR ("generator: error: $message\n");
  exit (1) if (!$nodie);
}

sub warning
{
  print STDERR ("generator: warning: @_\n");
}

sub makePrintable
{
  my ($char) = @_;
  my $ascii = ord ($char);

  if ($ascii <= 32 || $ascii >= 127)
  {
    return sprintf ("0x%02X", $ascii);
  } else
  {
    return $char;
  }
}

sub doGenerate
{
  my ($scanner) = @_;

  my $states = $scanner->getAttrs ('states');

  # header
  print ("digraph finite_state_machine \{\n");

  # node setup
  for $state (@$states)
  {
    my $id = $state->getAttrString ('state');
    my $production = $state->getAttrString ('production');

    if ($production)
    {
      print ("node [shape = doublecircle label = \"$id:\\n$production\"]; \"$id\";\n");
    } else
    {
      print ("node [shape = circle]; \"$id\";\n");
    }
  }

  # edges
  for $state (@$states)
  {
    my $id = $state->getAttrString ('state');
    my $edges = $state->getAttrs ('edges');

    for $edge (@$edges)
    {
      my $target = $edge->getAttrString ('target');
      my $range = $edge->getAttrString ('range');
      my $lower = substr ($range, 0, 1);
      my $upper = substr ($range, 2, 1);
      $lower = makePrintable ($lower);
      $upper = makePrintable ($upper) if $upper;
      $range = $upper ? "$lower..$upper" : $lower;
      print ("$id -> $target [label = \"$range\"];\n");
    }
  }
  
  print ("\}\n");
}

# main
# ----------------------------------------------------------------------

@ARGV = ('-') if (!@ARGV);

for $file (@ARGV)
{
  open (FOOFILE, $file) || error ("could not open $file: $!");
  $parser = new FooParser (\*FOOFILE);
  close (FOOFILE);

  if ($parser->getErrors ())
  {
    error ("problems parsing $file:\n".
	   join ("\n ", @{$parser->getErrors ()})."\n");
  }

  $scanner = $parser->getRoot ();

  doGenerate ($scanner);
}