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

				#!/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 = 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);				}