136 lines
3.1 KiB
Perl
Executable File
136 lines
3.1 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
|
|
package S2::NodeFormals;
|
|
|
|
use strict;
|
|
use S2::Node;
|
|
use vars qw($VERSION @ISA);
|
|
|
|
$VERSION = '1.0';
|
|
@ISA = qw(S2::Node);
|
|
|
|
sub new {
|
|
my ($class, $formals) = @_;
|
|
my $node = new S2::Node;
|
|
$node->{'listFormals'} = $formals || [];
|
|
bless $node, $class;
|
|
}
|
|
|
|
sub cleanForFreeze {
|
|
my $this = shift;
|
|
delete $this->{'tokenlist'};
|
|
foreach (@{$this->{'listFormals'}}) { $_->cleanForFreeze; }
|
|
}
|
|
|
|
sub parse {
|
|
my ($class, $toker, $isDecl) = @_;
|
|
my $n = new S2::NodeFormals;
|
|
my $count = 0;
|
|
|
|
$n->requireToken($toker, $S2::TokenPunct::LPAREN);
|
|
while ($toker->peek() != $S2::TokenPunct::RPAREN) {
|
|
$n->requireToken($toker, $S2::TokenPunct::COMMA) if $count;
|
|
$n->skipWhite($toker);
|
|
|
|
my $nf = parse S2::NodeNamedType $toker;
|
|
push @{$n->{'listFormals'}}, $nf;
|
|
$n->addNode($nf);
|
|
|
|
$n->skipWhite($toker);
|
|
$count++;
|
|
}
|
|
$n->requireToken($toker, $S2::TokenPunct::RPAREN);
|
|
return $n;
|
|
}
|
|
|
|
sub check {
|
|
my ($this, $l, $ck) = @_;
|
|
my %seen;
|
|
foreach my $nt (@{$this->{'listFormals'}}) {
|
|
my $name = $nt->getName();
|
|
S2::error($nt, "Duplicate argument named $name") if $seen{$name}++;
|
|
my $t = $nt->getType();
|
|
unless ($ck->isValidType($t)) {
|
|
S2::error($nt, "Unknown type " . $t->toString);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub asS2 {
|
|
my ($this, $o) = @_;
|
|
return unless @{$this->{'listFormals'}};
|
|
$o->write($this->toString());
|
|
}
|
|
|
|
sub toString {
|
|
my ($this) = @_;
|
|
return "(" . join(", ", map { $_->toString }
|
|
@{$this->{'listFormals'}}) . ")";
|
|
}
|
|
|
|
sub getFormals { shift->{'listFormals'}; }
|
|
|
|
# static
|
|
sub variations {
|
|
my ($nf, $ck) = @_; # NodeFormals, Checker
|
|
my $l = [];
|
|
if ($nf) {
|
|
$nf->getVariations($ck, $l, [], 0);
|
|
} else {
|
|
push @$l, new S2::NodeFormals;
|
|
}
|
|
return $l;
|
|
}
|
|
|
|
sub getVariations {
|
|
my ($this, $ck, $vars, $temp, $col) = @_;
|
|
my $size = @{$this->{'listFormals'}};
|
|
|
|
if ($col == $size) {
|
|
push @$vars, new S2::NodeFormals($temp);
|
|
return;
|
|
}
|
|
|
|
my $nt = $this->{'listFormals'}->[$col]; # NodeNamedType
|
|
my $t = $nt->getType();
|
|
|
|
foreach my $st (@{$t->subTypes($ck)}) {
|
|
my $newtemp = [ @$temp ]; # hacky clone (not cloning member objects)
|
|
push @$newtemp, new S2::NodeNamedType($nt->getName(), $st);
|
|
$this->getVariations($ck, $vars, $newtemp, $col+1);
|
|
}
|
|
}
|
|
|
|
sub typeList {
|
|
my $this = shift;
|
|
return join(',', map { $_->getType()->toString }
|
|
@{$this->{'listFormals'}});
|
|
|
|
# debugging implementation:
|
|
#my @list;
|
|
#foreach my $nnt (@{$this->{'listFormals'}}) { # NodeNamedType
|
|
# my $t = $nnt->getType();
|
|
# if (ref $t ne "S2::Type") {
|
|
# print STDERR "Is: $t\n";
|
|
# S2::error()
|
|
# }
|
|
# push @list, $t->toString;
|
|
#}
|
|
#return join(',', @list);
|
|
}
|
|
|
|
|
|
# adds all these variables to the stmtblock's symbol table
|
|
sub populateScope {
|
|
my ($this, $nb) = @_; # NodeStmtBlock
|
|
foreach my $nt (@{$this->{'listFormals'}}) {
|
|
$nb->addLocalVar($nt->getName(), $nt->getType());
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
|