You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
92 lines
2.2 KiB
92 lines
2.2 KiB
15 years ago
|
package Ast;
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
use vars qw/ $this $pack @endCodes /;
|
||
|
|
|
||
|
|
#-----------------------------------------------------------------------------
|
||
|
|
# This package is used to create a simple Abstract Syntax tree. Each node
|
||
|
|
# in the AST is an associative array and supports two kinds of properties -
|
||
|
|
# scalars and lists of scalars.
|
||
|
|
# See SchemParser.pm for an example of usage.
|
||
|
|
# ... Sriram
|
||
|
|
#-----------------------------------------------------------------------------
|
||
|
|
|
||
|
|
# Constructor
|
||
|
|
# e.g AST::New ("personnel")
|
||
|
|
# Stores the argument in a property called astNodeName whose sole purpose
|
||
|
|
# is to support Print()
|
||
|
|
|
||
|
|
sub New {
|
||
|
|
my ($this) = {"astNodeName" => $_[0]};
|
||
|
|
bless ($this);
|
||
|
|
return $this;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Add a property to this object
|
||
|
|
# $astNode->AddProp("className", "Employee");
|
||
|
|
|
||
|
|
sub AddProp {
|
||
|
|
my ($this) = $_[0];
|
||
|
|
$this->{$_[1]} = $_[2];
|
||
|
|
}
|
||
|
|
|
||
|
|
# Equivalent to AddProp, except the property name is associated
|
||
|
|
# with a list of values
|
||
|
|
# $classAstNode->AddProp("attrList", $attrAstNode);
|
||
|
|
|
||
|
|
sub AddPropList {
|
||
|
|
my ($this) = $_[0];
|
||
|
|
if (! exists $this->{$_[1]}) {
|
||
|
|
$this->{$_[1]} = [];
|
||
|
|
}
|
||
|
|
push (@{$this->{$_[1]}}, $_[2]);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Returns a list of all the property names of this object
|
||
|
|
sub GetProps {
|
||
|
|
my ($this) = $_[0];
|
||
|
|
return keys %{$this};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub Visit {
|
||
|
|
# Converts each of this AstNode's properties into global variables.
|
||
|
|
# The global variables are introduced into package "main"
|
||
|
|
# At the same time, a piece of code is formed to undo this work above -
|
||
|
|
# $endCode essentially contains the values of these global variables
|
||
|
|
# before they are mangled. endCode gets pushed into a stack (endCodes),
|
||
|
|
# which is unwound by UnVisit().
|
||
|
|
|
||
|
|
local ($this, $pack) = @_;
|
||
|
|
|
||
|
|
|
||
|
|
my $code = "";
|
||
|
|
my $endCode = "";
|
||
|
|
|
||
|
|
|
||
|
|
foreach my $k (keys %{$this}) {
|
||
|
|
|
||
|
|
my $glob = $pack."::".$k;
|
||
|
|
|
||
|
|
if ( defined $$glob ) {
|
||
|
|
|
||
|
|
if ( ${$glob} ne "" ) {
|
||
|
|
$$glob =~ s/\'/\\\'/g;
|
||
|
|
}
|
||
|
|
|
||
|
|
$endCode .= '$'.$pack.'::'.$k. " = '".$$glob."';";
|
||
|
|
} else {
|
||
|
|
$endCode .= '$'.$pack . "::". $k . ' = "";';
|
||
|
|
}
|
||
|
|
$code .= '$'.$pack . "::" . $k . "= \$this->{\"$k\"};";
|
||
|
|
}
|
||
|
|
push (@endCodes, $endCode);
|
||
|
|
eval($code) if $code;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub UnVisit {
|
||
|
|
my $code = pop(@endCodes);
|
||
|
|
eval($code) if ($code);
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|