83 lines
1.7 KiB
Perl
Executable File
83 lines
1.7 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
|
|
package S2::NodeCondExpr;
|
|
|
|
use strict;
|
|
use S2::Node;
|
|
use S2::NodeRange;
|
|
use vars qw($VERSION @ISA);
|
|
|
|
$VERSION = '1.0';
|
|
@ISA = qw(S2::Node);
|
|
|
|
sub new {
|
|
my ($class, $n) = @_;
|
|
my $node = new S2::Node;
|
|
bless $node, $class;
|
|
}
|
|
|
|
sub canStart {
|
|
my ($class, $toker) = @_;
|
|
S2::NodeRange->canStart($toker);
|
|
}
|
|
|
|
sub parse {
|
|
my ($class, $toker) = @_;
|
|
my $n = new S2::NodeCondExpr;
|
|
|
|
$n->{'test_expr'} = parse S2::NodeRange $toker;
|
|
$n->addNode($n->{'test_expr'});
|
|
|
|
return $n->{'test_expr'} unless
|
|
$toker->peek() == $S2::TokenPunct::QMARK;
|
|
|
|
$n->eatToken($toker);
|
|
|
|
$n->{'true_expr'} = parse S2::NodeRange $toker;
|
|
$n->addNode($n->{'true_expr'});
|
|
$n->requireToken($toker, $S2::TokenPunct::COLON);
|
|
|
|
$n->{'false_expr'} = parse S2::NodeRange $toker;
|
|
$n->addNode($n->{'false_expr'});
|
|
|
|
return $n;
|
|
}
|
|
|
|
sub getType {
|
|
my ($this, $ck) = @_;
|
|
|
|
my $ctype = $this->{'test_expr'}->getType($ck);
|
|
unless ($ctype->isBoolable()) {
|
|
S2::error($this, "Conditional expression not of type boolean.");
|
|
}
|
|
|
|
my $lt = $this->{'true_expr'}->getType($ck);
|
|
my $rt = $this->{'false_expr'}->getType($ck);
|
|
unless ($lt->equals($rt)) {
|
|
S2::error($this, "Types don't match in conditional expression.");
|
|
}
|
|
return $lt;
|
|
}
|
|
|
|
sub asS2 {
|
|
my ($this, $o) = @_;
|
|
$this->{'test_expr'}->asS2($o);
|
|
$o->write(" ? ");
|
|
$this->{'true_expr'}->asS2($o);
|
|
$o->write(" : ");
|
|
$this->{'false_expr'}->asS2($o);
|
|
}
|
|
|
|
sub asPerl {
|
|
my ($this, $bp, $o) = @_;
|
|
$o->write("(");
|
|
$this->{'test_expr'}->asPerl_bool($bp, $o);
|
|
$o->write(" ? ");
|
|
$this->{'true_expr'}->asPerl($bp, $o);
|
|
$o->write(" : ");
|
|
$this->{'false_expr'}->asPerl($bp, $o);
|
|
$o->write(")");
|
|
}
|
|
|