语法分析器（syntax analyzer）【Perl实现】

查看正文内容

#!/usr/bin/perl

use strict;   # parse.pl - inputs lex, outputs flattened ast
use warnings; # http://www.rosettacode.org/wiki/Compiler/syntax_analyzer

my $h = qr/\G\s*\d+\s+\d+\s+/;  # header of each line

sub error {
    die "*** Expected @_ at " . (/\G(.*\n)/ ?
  $1 =~ s/^\s*(\d+)\s+(\d+)\s+/line $1 character $2 got /r : "EOF\n") }

sub want {
    /$h \Q$_[1]\E.*\n/gcx ? shift : error "'$_[1]'" }

local $_ = join '', <>;
print want stmtlist(), 'End_of_input';

sub stmtlist
  {
   
  /(?=$h (RightBrace|End_of_input))/gcx and return ";\n";
  my ($stmt, $stmtlist) = (stmt(), stmtlist());
  $stmtlist eq ";\n" ? $stmt : "Sequence\n$stmt$stmtlist";
  }

sub stmt
  {
   
  /$h Semicolon\n/gcx ? ";\n" :
    /$h Identifier \s+ (\w+) \n/gcx ? want("Assign\nIdentifier\t$1\n"