394 lines
12 KiB
Perl
394 lines
12 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
|
||
|
|
package S2::NodeFunction;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use S2::Node;
|
||
|
|
use S2::NodeFormals;
|
||
|
|
use S2::NodeStmtBlock;
|
||
|
|
use vars qw($VERSION @ISA);
|
||
|
|
|
||
|
|
$VERSION = '1.0';
|
||
|
|
@ISA = qw(S2::Node);
|
||
|
|
|
||
|
|
sub new {
|
||
|
|
my ($class) = @_;
|
||
|
|
my $node = new S2::Node;
|
||
|
|
bless $node, $class;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cleanForFreeze {
|
||
|
|
my $this = shift;
|
||
|
|
delete $this->{'tokenlist'};
|
||
|
|
delete $this->{'docstring'};
|
||
|
|
$this->{'formals'}->cleanForFreeze() if $this->{'formals'};
|
||
|
|
$this->{'rettype'}->cleanForFreeze() if $this->{'rettype'};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub getDocString { shift->{'docstring'}; }
|
||
|
|
|
||
|
|
sub canStart {
|
||
|
|
my ($class, $toker) = @_;
|
||
|
|
return $toker->peek() == $S2::TokenKeyword::FUNCTION;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub parse {
|
||
|
|
my ($class, $toker, $isDecl) = @_;
|
||
|
|
my $n = new S2::NodeFunction;
|
||
|
|
|
||
|
|
# get the function keyword
|
||
|
|
$n->setStart($n->requireToken($toker, $S2::TokenKeyword::FUNCTION));
|
||
|
|
|
||
|
|
# is the builtin keyword on?
|
||
|
|
# this is the old way, but still supported. the new way
|
||
|
|
# is function attributes in brackets.
|
||
|
|
if ($toker->peek() == $S2::TokenKeyword::BUILTIN) {
|
||
|
|
$n->{'attr'}->{'builtin'} = 1;
|
||
|
|
$n->eatToken($toker);
|
||
|
|
}
|
||
|
|
|
||
|
|
# the class name or function name (if no class)
|
||
|
|
$n->{'name'} = $n->getIdent($toker);
|
||
|
|
|
||
|
|
# check for a double colon
|
||
|
|
if ($toker->peek() == $S2::TokenPunct::DCOLON) {
|
||
|
|
# so last ident was the class name
|
||
|
|
$n->{'classname'} = $n->{'name'};
|
||
|
|
$n->eatToken($toker);
|
||
|
|
$n->{'name'} = $n->getIdent($toker);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Argument list is optional.
|
||
|
|
if ($toker->peek() == $S2::TokenPunct::LPAREN) {
|
||
|
|
$n->addNode($n->{'formals'} = S2::NodeFormals->parse($toker));
|
||
|
|
}
|
||
|
|
|
||
|
|
# Attribute list is optional
|
||
|
|
if ($toker->peek() == $S2::TokenPunct::LBRACK) {
|
||
|
|
$n->eatToken($toker);
|
||
|
|
while ($toker->peek() && $toker->peek() != $S2::TokenPunct::RBRACK) {
|
||
|
|
my $t = $n->eatToken($toker);
|
||
|
|
next if $t == $S2::TokenPunct::COMMA;
|
||
|
|
S2::error($t, "Expecting an identifer for an attribute")
|
||
|
|
unless $t->isa("S2::TokenIdent");
|
||
|
|
my $attr = $t->getIdent();
|
||
|
|
unless ($attr eq "builtin" || # implemented by system, not in S2
|
||
|
|
$attr eq "fixed" || # can't be overridden in derived or same layers
|
||
|
|
$attr eq "notags") { # return from untrusted layers pass through S2::notags()
|
||
|
|
S2::error($t, "Unknown function attribute '$attr'");
|
||
|
|
}
|
||
|
|
$n->{'attr'}->{$attr} = 1;
|
||
|
|
}
|
||
|
|
$n->requireToken($toker, $S2::TokenPunct::RBRACK);
|
||
|
|
}
|
||
|
|
|
||
|
|
# return type is optional too.
|
||
|
|
if ($toker->peek() == $S2::TokenPunct::COLON) {
|
||
|
|
$n->requireToken($toker, $S2::TokenPunct::COLON);
|
||
|
|
$n->addNode($n->{'rettype'} = S2::NodeType->parse($toker));
|
||
|
|
}
|
||
|
|
|
||
|
|
# docstring
|
||
|
|
if ($toker->peek()->isa('S2::TokenStringLiteral')) {
|
||
|
|
$n->{'docstring'} = $n->eatToken($toker)->getString();
|
||
|
|
}
|
||
|
|
|
||
|
|
# if inside a class declaration, only a declaration now.
|
||
|
|
if ($isDecl || $n->{'attr'}->{'builtin'}) {
|
||
|
|
$n->requireToken($toker, $S2::TokenPunct::SCOLON);
|
||
|
|
return $n;
|
||
|
|
}
|
||
|
|
|
||
|
|
# otherwise, keep parsing the function definition.
|
||
|
|
$n->{'stmts'} = parse S2::NodeStmtBlock $toker;
|
||
|
|
$n->addNode($n->{'stmts'});
|
||
|
|
|
||
|
|
return $n;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub getFormals { shift->{'formals'}; }
|
||
|
|
sub getName { shift->{'name'}->getIdent(); }
|
||
|
|
sub getReturnType {
|
||
|
|
my $this = shift;
|
||
|
|
return $this->{'rettype'} ? $this->{'rettype'}->getType() : $S2::Type::VOID;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub check {
|
||
|
|
my ($this, $l, $ck) = @_;
|
||
|
|
|
||
|
|
# keep a reference to the checker for later
|
||
|
|
$this->{'ck'} = $ck;
|
||
|
|
|
||
|
|
# reset the functionID -> local funcNum mappings
|
||
|
|
$ck->resetFunctionNums();
|
||
|
|
|
||
|
|
# tell the checker we've seen a function now so it knows
|
||
|
|
# later to complain if it then sees a new class declaration.
|
||
|
|
# (builtin functions are okay)
|
||
|
|
$ck->setHitFunction(1) unless $this->{'attr'}->{'builtin'};
|
||
|
|
|
||
|
|
my $funcName = $this->{'name'}->getIdent();
|
||
|
|
my $cname = $this->className();
|
||
|
|
my $funcID = S2::Checker::functionID($cname, $funcName, $this->{'formals'});
|
||
|
|
my $t = $this->getReturnType();
|
||
|
|
|
||
|
|
$ck->setInFunction($funcID);
|
||
|
|
|
||
|
|
if ($cname && $cname eq $funcName) {
|
||
|
|
$this->{'isCtor'} = 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($ck->isFuncBuiltin($funcID)) {
|
||
|
|
S2::error($this, "Can't override built-in functions");
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($ck->checkFuncAttr($funcID, "fixed") && $l->getType() ne "core") {
|
||
|
|
S2::error($this, "Can't override functions with the 'fixed' attribute.");
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($this->{'attr'}->{'builtin'} && $l->getType() ne "core") {
|
||
|
|
S2::error($this, "Only core layers can declare builtin functions");
|
||
|
|
}
|
||
|
|
|
||
|
|
# if this function is global, no declaration is done, but if
|
||
|
|
# this is class-scoped, we must check the class exists and
|
||
|
|
# that it declares this function.
|
||
|
|
if ($cname) {
|
||
|
|
my $nc = $ck->getClass($cname);
|
||
|
|
unless ($nc) {
|
||
|
|
S2::error($this, "Can't declare function $funcID for ".
|
||
|
|
"non-existent class '$cname'");
|
||
|
|
}
|
||
|
|
|
||
|
|
my $et = $ck->functionType($funcID);
|
||
|
|
unless ($et || ($l->getType() eq "layout" &&
|
||
|
|
$funcName =~ /^lay_/)) {
|
||
|
|
S2::error($this, "Can't define undeclared object function $funcID");
|
||
|
|
}
|
||
|
|
|
||
|
|
# find & register all the derivative names by which this function
|
||
|
|
# could be called.
|
||
|
|
my $dercs = $nc->getDerClasses();
|
||
|
|
my $fvs = S2::NodeFormals::variations($this->{'formals'}, $ck);
|
||
|
|
foreach my $dc (@$dercs) { # DerItem
|
||
|
|
my $c = $dc->{'nc'}; # NodeClass
|
||
|
|
foreach my $fv (@$fvs) {
|
||
|
|
my $derFuncID = S2::Checker::functionID($c->getName(), $this->getName(), $fv);
|
||
|
|
$ck->setFuncDistance($derFuncID, { 'nf' => $this, 'dist' => $dc->{'dist'} });
|
||
|
|
$ck->addFunction($derFuncID, $t, $this->{'attr'});
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# non-class function. register all variations of the formals.
|
||
|
|
my $fvs = S2::NodeFormals::variations($this->{'formals'}, $ck);
|
||
|
|
foreach my $fv (@$fvs) {
|
||
|
|
my $derFuncID = S2::Checker::functionID($cname,
|
||
|
|
$this->getName(),
|
||
|
|
$fv);
|
||
|
|
$ck->setFuncDistance($derFuncID, { 'nf' => $this, 'dist' => 0 });
|
||
|
|
|
||
|
|
unless ($l->isCoreOrLayout() || $ck->functionType($derFuncID)) {
|
||
|
|
# only core and layout layers can define new functions
|
||
|
|
S2::error($this, "Only core and layout layers can define new functions.");
|
||
|
|
}
|
||
|
|
|
||
|
|
$ck->addFunction($derFuncID, $t, $this->{'attr'});
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# check the formals
|
||
|
|
$this->{'formals'}->check($l, $ck) if $this->{'formals'};
|
||
|
|
|
||
|
|
|
||
|
|
# check the statement block
|
||
|
|
if ($this->{'stmts'}) {
|
||
|
|
# prepare stmts to be checked
|
||
|
|
$this->{'stmts'}->setReturnType($t);
|
||
|
|
|
||
|
|
# make sure $this is accessible in a class method
|
||
|
|
# FIXME: not in static functions, once we have static functions
|
||
|
|
if ($cname) {
|
||
|
|
$this->{'stmts'}->addLocalVar("this", new S2::Type($cname));
|
||
|
|
} else {
|
||
|
|
$this->{'stmts'}->addLocalVar("this", $S2::Type::VOID); # prevent its use
|
||
|
|
}
|
||
|
|
|
||
|
|
# make sure $this is accessible in a class method
|
||
|
|
# that has a parent.
|
||
|
|
my $pname = $ck->getParentClassName($cname); # String
|
||
|
|
if (defined $pname) {
|
||
|
|
$this->{'stmts'}->addLocalVar("super", new S2::Type($pname));
|
||
|
|
} else {
|
||
|
|
$this->{'stmts'}->addLocalVar("super", $S2::Type::VOID); # prevent its use
|
||
|
|
}
|
||
|
|
|
||
|
|
$this->{'formals'}->populateScope($this->{'stmts'}) if $this->{'formals'};
|
||
|
|
|
||
|
|
$ck->setCurrentFunctionClass($cname); # for $.member lookups
|
||
|
|
$ck->pushLocalBlock($this->{'stmts'});
|
||
|
|
$this->{'stmts'}->check($l, $ck);
|
||
|
|
$ck->popLocalBlock();
|
||
|
|
}
|
||
|
|
|
||
|
|
# remember the funcID -> local funcNum mappings for the backend
|
||
|
|
$this->{'funcNames'} = $ck->getFuncNames();
|
||
|
|
$ck->setInFunction(0);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub asS2 {
|
||
|
|
my ($this, $o) = @_;
|
||
|
|
die "not done";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub attrsJoined {
|
||
|
|
my $this = shift;
|
||
|
|
return join(',', keys %{$this->{'attr'} || {}});
|
||
|
|
}
|
||
|
|
|
||
|
|
sub asPerl {
|
||
|
|
my ($this, $bp, $o) = @_;
|
||
|
|
unless ($this->{'classname'}) {
|
||
|
|
$o->tabwrite("register_global_function(" .
|
||
|
|
$bp->getLayerIDString() . "," .
|
||
|
|
$bp->quoteString($this->{'name'}->getIdent() . ($this->{'formals'} ? $this->{'formals'}->toString() : "()")) . "," .
|
||
|
|
$bp->quoteString($this->getReturnType()->toString()));
|
||
|
|
$o->write(", " . $bp->quoteString($this->{'docstring'}));
|
||
|
|
$o->write(", " . $bp->quoteString($this->attrsJoined));
|
||
|
|
|
||
|
|
$o->writeln(");");
|
||
|
|
}
|
||
|
|
|
||
|
|
return if $this->{'attr'}->{'builtin'};
|
||
|
|
|
||
|
|
$o->tabwrite("register_function(" . $bp->getLayerIDString() .
|
||
|
|
", [");
|
||
|
|
|
||
|
|
# declare all the names by which this function would be called:
|
||
|
|
# its base name, then all derivative classes which aren't already
|
||
|
|
# used.
|
||
|
|
foreach my $funcID (@{$this->{'ck'}->getFuncIDs($this)}) {
|
||
|
|
$o->write($bp->quoteString($funcID) . ", ");
|
||
|
|
}
|
||
|
|
|
||
|
|
$o->writeln("], sub {");
|
||
|
|
$o->tabIn();
|
||
|
|
|
||
|
|
# the first time register_function is run, it'll find the
|
||
|
|
# funcNames for this session and save those in a list and then
|
||
|
|
# return the sub which is a closure and will have fast access
|
||
|
|
# to that num -> num hash. (benchmarking showed two
|
||
|
|
# hashlookups on ints was faster than one on strings)
|
||
|
|
|
||
|
|
if (scalar(@{$this->{'funcNames'}})) {
|
||
|
|
$o->tabwriteln("my \@_l2g_func = ( undef, ");
|
||
|
|
$o->tabIn();
|
||
|
|
foreach my $id (@{$this->{'funcNames'}}) {
|
||
|
|
$o->tabwriteln("get_func_num(" .
|
||
|
|
$bp->quoteString($id) . "),");
|
||
|
|
}
|
||
|
|
$o->tabOut();
|
||
|
|
$o->tabwriteln(");");
|
||
|
|
}
|
||
|
|
|
||
|
|
# now, return the closure
|
||
|
|
$o->tabwriteln("return sub {");
|
||
|
|
$o->tabIn();
|
||
|
|
|
||
|
|
# setup function argument/ locals
|
||
|
|
$o->tabwrite("my (\$_ctx");
|
||
|
|
if ($this->{'classname'} && ! $this->{'isCtor'}) {
|
||
|
|
$o->write(", \$this");
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($this->{'formals'}) {
|
||
|
|
my $nts = $this->{'formals'}->getFormals();
|
||
|
|
foreach my $nt (@$nts) {
|
||
|
|
$o->write(", \$" . $nt->getName());
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$o->writeln(") = \@_;");
|
||
|
|
# end function locals
|
||
|
|
|
||
|
|
$this->{'stmts'}->asPerl($bp, $o, 0);
|
||
|
|
$o->tabOut();
|
||
|
|
$o->tabwriteln("};");
|
||
|
|
|
||
|
|
# end the outer sub
|
||
|
|
$o->tabOut();
|
||
|
|
$o->tabwriteln("});");
|
||
|
|
}
|
||
|
|
|
||
|
|
sub toString {
|
||
|
|
my $this = shift;
|
||
|
|
return $this->className() . "...";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub isBuiltin { shift->{'builtin'}; }
|
||
|
|
|
||
|
|
# private
|
||
|
|
sub className {
|
||
|
|
my $this = shift;
|
||
|
|
return undef unless $this->{'classname'};
|
||
|
|
return $this->{'classname'}->getIdent();
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# private
|
||
|
|
sub totalName {
|
||
|
|
my $this = shift;
|
||
|
|
my $sb;
|
||
|
|
my $clas = $this->className();
|
||
|
|
$sb .= "${clas}::" if $clas;
|
||
|
|
$sb .= $this->{'name'}->getIdent();
|
||
|
|
return $sb;
|
||
|
|
}
|
||
|
|
|
||
|
|
# called by NodeClass
|
||
|
|
sub registerFunction {
|
||
|
|
my ($this, $ck, $cname) = @_;
|
||
|
|
|
||
|
|
my $fname = $this->getName();
|
||
|
|
my $funcID = S2::Checker::functionID($cname, $fname,
|
||
|
|
$this->{'formals'});
|
||
|
|
my $et = $ck->functionType($funcID);
|
||
|
|
my $rt = $this->getReturnType();
|
||
|
|
|
||
|
|
# check that function is either currently undefined or
|
||
|
|
# defined with the same type, otherwise complain
|
||
|
|
if ($et && ! $et->equals($rt)) {
|
||
|
|
S2::error($this, "Can't redefine function '$fname' with return ".
|
||
|
|
"type of '" . $rt->toString . "' masking ".
|
||
|
|
"earlier definition of type '". $et->toString ."'.");
|
||
|
|
}
|
||
|
|
|
||
|
|
$ck->addFunction($funcID, $rt, $this->{'attr'}); # Register
|
||
|
|
}
|
||
|
|
|
||
|
|
__END__
|
||
|
|
|
||
|
|
|
||
|
|
public void asS2 (Indenter o)
|
||
|
|
{
|
||
|
|
o.tabwrite("function " + totalName());
|
||
|
|
if (formals != null) {
|
||
|
|
o.write(" ");
|
||
|
|
formals.asS2(o);
|
||
|
|
}
|
||
|
|
if (rettype != null) {
|
||
|
|
o.write(" : ");
|
||
|
|
rettype.asS2(o);
|
||
|
|
}
|
||
|
|
if (stmts != null) {
|
||
|
|
o.write(" ");
|
||
|
|
stmts.asS2(o);
|
||
|
|
o.newline();
|
||
|
|
} else {
|
||
|
|
o.writeln(";");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|