fooscanner.pm

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

# $Id: FooScanner.pm,v 1.6 1997/02/22 07:59:18 matt Exp $
#
# Foo scanner class.
#
# (c) June 96 Matt Phillips.

package FooScanner;

sub new
{
  my ($class, $file) = @_;
  my $self = {'file' => $file, 'errors' => undef,
	      'line' => '', 'lineNo' => 0, 'symbolLine' => 0,
	      'symbol' => '', 'text' => ''};

  bless $self, $class;
  return $self;
}

sub getNext
{
  my ($self) = @_;
  my $file = $self->{'file'};
  local ($_) = $self->{'line'};

  do
  {
    # read a non-empty line or eof
    while (/^\s*$/ && !eof ($file))
    {
      $_ = <$file>;
      $self->{'lineNo'}++;
    }
    
    # strip leading whitespace
    s/^\s+//;

    $self->{'symbolLine'} = $self->{'lineNo'};

    # read a symbol from the current line
    if ($_ eq '')
    {				# eof
      $self->{'text'} = '';
      $self->{'symbol'} = 'eof';
    } elsif (s/^\"(([^\\\"\n]|\\.)+)\"//)
    {				# string
      my $string = $1;

      # evaluate backslashed numbers
      $string =~ s/\\([0-9a-fA-F]{1,2})/chr(hex ($1))/eg;

      # remove any other backslashes
      $string =~ s/\\(.)/$1/eg;

      $self->{'text'} = $string;
      $self->{'symbol'} = 'string';
    } elsif (s/^(\w[\w\d_]*)//)
    {				# ident
      $self->{'text'} = $1;
      $self->{'symbol'} = 'ident';
    } elsif (s/^([\(\)\[\]])//)
    {				# brackets
      $self->{'text'} = $1;
      $self->{'symbol'} = $1;
    } else
    {				# error
      chomp;
      push (@{$self->{'errors'}},
	    " error: ".$self->getSymbolLine ().": invalid symbol: '$_'");
      $_ = '';
    }
  } while ($self->{'symbol'} eq '');

  $self->{'line'} = $_;
}

sub eof
{
  my $self = shift;
  return $self->{'symbol'} eq 'eof';
}

sub getText
{
  my $self = shift;
  return $self->{'text'};
}

sub getSymbol
{
  my $self = shift;
  return $self->{'symbol'};
}

sub getSymbolLine
{
  my $self = shift;
  return $self->{'lineNo'};
}

sub getErrors
{
  my $self = shift;
  return $self->{'errors'};
}

sub error
{
  my ($self, $message) = @_;
  my $errors = $self->{'errors'};

  if (!$errors)
  {
    $errors = [];
    $self->{'errors'} = $errors;
  }

  push (@$errors, "error: ".$self->{'symbolLine'}.": $message");
}

sub mustbe
{
  my ($self, $symbol) = @_;
  
  if ($self->{'symbol'} eq $symbol)
  {
    $self->getNext ();
    return 1;
  } else
  {
    $self->error ("'$symbol' expected ('".$self->{'text'}."' found)");
    return 0;
  }
}

sub have
{
  my ($self, $symbol) = @_;

  if ($self->{'symbol'} eq $symbol)
  {
    $self->getNext ();
    return 1;
  } else
  {
    return 0;
  }
}

1;