Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Reimplement sub "extend" functionality
  • Loading branch information
@sorear
sorear committed Oct 5, 2011
1 parent e617031 commit 11c6923
Show file tree
Hide file tree
Showing 6 changed files with 302 additions and 17 deletions.
16 changes: 15 additions & 1 deletion lib/CodeGen.cs
View file
Expand Up @@ -5098,7 +5098,7 @@ public class DowncallReceiver : CallReceiver {
r = new object[] { "hint",null,null,null };
var lcomm = li as LICommon;
if (lcomm != null)
r = new object[] { "common",null,null,null, lcomm.hkey };
r = new object[] { "common",null,null,null, lcomm.Stash(), lcomm.VarName() };

r[1] = li.file;
r[2] = li.line;
Expand Down Expand Up @@ -5446,6 +5446,20 @@ public class DowncallReceiver : CallReceiver {
if (p == Kernel.PHASER_CONTROL)
s.outer.control = s;
return null;
} else if (cmd == "sub_set_extend") {
SubInfo s = (SubInfo)Handle.Unbox(args[1]);
object[] val = new object[args.Length - 3];
Array.Copy(args, 3, val, 0, val.Length);
if (s.extend == null)
s.extend = new Dictionary<string,object[]>();
s.extend[(string)args[2]] = val;
return null;
} else if (cmd == "sub_get_extend") {
SubInfo s = (SubInfo)Handle.Unbox(args[1]);
object[] ret = null;
if (s.extend != null)
s.extend.TryGetValue((string)args[2], out ret);
return ret ?? new object[0];
} else if (cmd == "sub_finish") {
SubInfo s = (SubInfo)Handle.Unbox(args[1]);
s.nam_str = (string)args[2];
Expand Down
3 changes: 3 additions & 0 deletions lib/Kernel.cs
View file
Expand Up @@ -1108,6 +1108,8 @@ public class LICommon : LexInfo {
public LICommon(string hkey) { this.hkey = hkey; }

public override void Init(Frame f) { }
internal string Stash() { return hkey.Substring(1, (int)hkey[0]); }
internal string VarName() { return hkey.Substring(1 + (int)hkey[0]); }

public override object Get(Frame f) {
return Kernel.currentGlobals[hkey].v;
Expand Down Expand Up @@ -1305,6 +1307,7 @@ public class UsedInScopeInfo {
// For dispatch routines, 0 = parameter list
public object param0, param1;
public List<SubInfo> children = new List<SubInfo>();
public Dictionary<string,object[]> extend;

// No instance fields past this point
public const int SIG_I_RECORD = 3;
Expand Down
1 change: 1 addition & 0 deletions src/NieczaBackendDotnet.pm6
View file
Expand Up @@ -85,6 +85,7 @@ method post_save($name, :$main) {
}

class StaticSub {
method kind { "sub" }
method FALLBACK($name, *@args) { downcall("sub_$name", self, @args) }

method lex_names() { downcall("lex_names", self) }
Expand Down
19 changes: 10 additions & 9 deletions src/NieczaFrontendSTD.pm6
View file
Expand Up @@ -27,22 +27,23 @@ method cat_O($cat, $sym) {
}

method function_O($name) {
my $lex = self.lookup_lex($name);
my @lex = self.lookup_lex($name);

if $lex ~~ ::Metamodel::Lexical::Dispatch {
$lex = self.lookup_lex($name ~ ":(!proto)");
if @lex[0] eq 'dispatch' {
@lex = self.lookup_lex($name ~ ":(!proto)");
}

my $sub;

if $lex ~~ ::Metamodel::Lexical::Common {
$sub = $*unit.deref($*unit.get($*unit.deref($lex.pkg), $lex.name));
} elsif $lex ~~ ::Metamodel::Lexical::SubDef {
$sub = $lex.body;
if @lex[0] eq 'common' {
$sub = $*unit.get(@lex[4], @lex[5]);
} elsif @lex[0] eq 'sub' {
$sub = @lex[4];
}

if $sub ~~ ::Metamodel::StaticSub {
return $sub.extend<prec>;
if $sub && $sub.kind eq 'sub' {
my %ext = $sub.get_extend('prec');
return %ext || Any;
} else {
return Any;
}
Expand Down
13 changes: 6 additions & 7 deletions src/NieczaPassSimplifier.pm6
View file
Expand Up @@ -144,13 +144,12 @@ sub run_optree($body, $op, $nv) {
my @inv_lex = $body.lookup_lex($invname);
return $op unless @inv_lex && @inv_lex[0] eq 'sub';

# TODO: get extend working again
# if $inv_lex.body.extend<builtin> -> $B {
# return $op unless defined my $args = no_named_params($op);
# return $op unless $args >= $B[1] &&
# (!defined($B[2]) || $args <= $B[2]);
# return ::Op::Builtin.new(name => $B[0], args => $args);
# }
if @inv_lex[4].get_extend('builtin') -> $B {
return $op unless defined my $args = no_named_params($op);
return $op unless $args >= $B[1] &&
(!defined($B[2]) || $args <= $B[2]);
return ::Op::Builtin.new(name => $B[0], args => $args);
}

return $op unless @inv_lex[4].unit.name eq 'CORE';
return $op unless my $func = %funcs{$invname};
Expand Down
267 changes: 267 additions & 0 deletions src/niecza
View file
Expand Up @@ -20,6 +20,12 @@ use RxOp;
use Sig;
use STD;

augment class STD {
method lookup_lex($name, $lex?) {
($lex // $*CURLEX)<!sub>.lookup_lex($name, $*FILE<name>, self.lineof(self.pos));
}
}

augment class Op::ForLoop {
method statement_level() {
my $body = $*CURLEX<!sub>.lookup_lex($!sink)[4];
Expand Down Expand Up @@ -114,6 +120,267 @@ method add_attribute($/, $name, $sigil, $accessor, $type) {
$at ?? ::Op::Attribute.new(name => $name, initializer => $type) !!
::Op::StatementList.new;
}
method install_sub($/, $sub, :$multiness is copy, :$scope is copy, :$class,
:$longname, :$method_type is copy, :$contextual is copy) {

$multiness ||= 'only';
my ($pkg, $name) = self.process_name($longname, :declaring);

if !$scope {
if !defined($name) {
$scope = 'anon';
} elsif defined($pkg) {
$scope = 'our';
} elsif defined($method_type) {
$scope = 'has';
} else {
$scope = 'my';
}
}

if $class eq 'Regex' {
my $/;
$*CURLEX<!name> = $name;
$*CURLEX<!cleanname !sym> =
!defined($name) ?? (Str, Str) !!
($name ~~ /\:sym\<(.*)\>/) ?? ($name.substr(0, $/.from), ~$0) !!
($name ~~ /\:(\w+)/) ?? ($name.substr(0, $/.from), ~$0) !!
($name, Str);
$multiness = 'multi' if defined $*CURLEX<!sym>;
$*CURLEX<!multi> = $multiness;
}

if $scope ne 'my' && $scope ne 'our' && $scope ne 'anon' && $scope ne 'has' {
$/.CURSOR.sorry("Illegal scope $scope for subroutine");
$scope = 'anon';
}

if $scope eq 'has' && !defined($method_type) {
$/.CURSOR.sorry('has scope-type is only valid for methods');
$scope = 'anon';
}

if $scope ne 'anon' && !defined($name) {
$/.CURSOR.sorry("Scope $scope requires a name");
$scope = 'anon';
}

if $scope ne 'our' && defined($pkg) {
$/.CURSOR.sorry("Double-colon-qualified subs must be our");
$scope = 'our';
}

if $scope eq 'anon' && $multiness ne 'only' {
$/.CURSOR.sorry("Multi routines must have a name");
$multiness = 'only';
}

if $contextual && (defined($method_type) || $scope ne 'my') {
$/.CURSOR.sorry("Context-named routines must by purely my-scoped");
$contextual = False;
}

$method_type = Str if $scope eq 'anon';

my $method_targ = $method_type && $sub.outer.body_of;
if !$method_targ && defined($method_type) {
$/.CURSOR.sorry("Methods must be used in some kind of package");
$method_type = Str;
}

if $method_targ && !$method_targ.CAN('add_method') {
$/.CURSOR.sorry("A {$method_targ.kind} cannot have methods added");
$method_type = Str;
$method_targ = Any;
}

if $name ~~ Op && (!defined($method_type) || $scope ne 'has' ||
$method_targ.kind ne 'prole') {
$/.CURSOR.sorry("Computed names are only implemented for parametric roles");
$name = "placeholder";
}

my $bindlex = $scope eq 'my' || ($scope eq 'our' && !$pkg);

$sub.set_name(defined($method_type) ?? $method_targ.name ~ "." ~ $name !!
($name // 'ANON'));
$sub.set_class($class);

my $std = $/.CURSOR;
{
my $/;
if $sub.name ~~ /^(\w+)\:\<(.*)\>$/ {
my %new = %( $std.default_O(~$0, ~$1) );
$sub.set_extend('prec', %new.kv);
}
}

my Str $symbol;
$/.CURSOR.trymop({
if $bindlex && $class eq 'Regex' {
$symbol = '&' ~ $name;
my $proto = $symbol;
$proto ~~ s/\:.*//;
$sub.outer.add_dispatcher($proto, |mnode($/))
if $multiness ne 'only' && !$sub.outer.has_lexical($proto);
$symbol ~= ":(!proto)" if $multiness eq 'proto';
} elsif $bindlex {
$symbol = '&' ~ $name;
$/.CURSOR.check_categorical($symbol);
if $multiness ne 'only' && !$sub.outer.has_lexical($symbol) {
$sub.outer.add_dispatcher($symbol, |mnode($/))
}

given $multiness {
when 'multi' { $symbol ~= ":({ self.gensym })"; }
when 'proto' { $symbol ~= ":(!proto)"; }
default {
$/.CURSOR.check_categorical($symbol);
}
}
} else {
$symbol = self.gensym;
}

$sub.set_outervar($symbol);
$sub.set_methodof(defined($method_type) ?? $method_targ !! Any);
$sub.outer.add_my_sub($symbol, $sub, |mnode($/));

if $multiness ne 'only' || $scope eq 'our' || $method_type {
$/.CURSOR.mark_used($symbol);
}

if defined($method_type) || $scope eq 'our' {
$sub.outer.create_static_pad;
}

if defined($method_type) {
my $mode = 0;
given $method_type {
when 'sub' { $mode += 2 }
when 'normal' { $mode += 0 }
when 'private' { $mode += 1 }
default { die "Unimplemented method type $_" }
}
given $multiness {
when 'only' { $mode += 0 }
when 'proto' { $mode += 4 }
when 'multi' { $mode += 8 }
default { die "Unimplemented multiness $_" }
}
if defined $*AUGMENT_BUFFER {
push $*AUGMENT_BUFFER, $mode, $name, $symbol;
} else {
$method_targ.add_method($mode, $name, $sub, |mnode($/));
}
}

if $scope eq 'our' {
$*unit.bind(($pkg // $sub.outer.cur_pkg).who,
"&$name", $sub);
}
});
}

method process_block_traits($/, @tr) {
my $sub = $*CURLEX<!sub>;
my $pack = $sub.body_of;
for @tr -> $T {
my $tr = $T.ast;
if $pack && $tr<name> {
my $super = $tr<name>;

$T.CURSOR.sorry("superclass $super.name() declared outside of any class"),
next unless $sub.body_of;
$T.CURSOR.sorry("superclass $super.name() declared in an augment"),
next if defined $*AUGMENT_BUFFER;
$T.CURSOR.sorry("cannot declare a superclass in this kind of package"),
next if !$pack.CAN('add_super');

$T.CURSOR.trymop({
$pack.add_super($super);
});
} elsif $pack && $tr<export> {
my @exports = @( $tr<export> );
$sub.outer.add_exports($pack.name, $pack, @exports);
} elsif !$pack && $tr<export> {
my @exports = @( $tr<export> );
$sub.outer.add_exports('&'~$sub.name, $sub, @exports);
$sub.strong_used = True;
$sub.outer.create_static_pad;
$/.CURSOR.mark_used($sub.outervar)
if defined $sub.outervar;
} elsif !$pack && $tr<nobinder> {
$sub.set_signature(Any);
} elsif !$pack && grep { defined $tr{$_} }, <looser tighter equiv> {
my $rel = $tr.keys.[0];
my $to = $tr.values.[0];
$to = $to.inside if $to ~~ ::Op::Paren;
$to = $to.children[0] if $to ~~ ::Op::StatementList && $to.children == 1;

my $oprec;
if $to ~~ ::Op::Lexical {
$oprec = $T.CURSOR.function_O($to.name);
} elsif $to ~~ ::Op::StringLiteral && $sub.name ~~ /^(\w+)\:\<.*\>$/ {
$oprec = $T.CURSOR.cat_O(~$0, $to.text);
} else {
$T.CURSOR.sorry("Cannot interpret operator reference");
next;
}
unless $sub.get_extend('prec') {
$T.CURSOR.sorry("Target does not seem to be an operator");
next;
}
unless $oprec {
$T.CURSOR.sorry("No precedence available for reference target");
next;
}
if $rel eq 'equiv' {
$sub.set_extend('prec', $oprec.kv);
} else {
my %prec = $sub.get_extend('prec');
%prec<prec> = $oprec.<prec>;
%prec<prec> ~~ s/\=/<=/ if $rel eq 'looser';
%prec<prec> ~~ s/\=/>=/ if $rel eq 'tighter';
$sub.set_extend('prec', %prec.kv);
}
} elsif !$pack && $tr<assoc> {
my $arg = ~self.trivial_eval($T, $tr<assoc>);
my %prec = $sub.get_extend('prec');
unless %prec {
$T.CURSOR.sorry("Target does not seem to be an operator");
next;
}
unless $arg eq any < left right non list unary chain > {
$T.CURSOR.sorry("Invalid associativity $arg");
next;
}
%prec<assoc> = $arg;
$sub.set_extend('prec', %prec.kv);
} elsif !$pack && $tr<Niecza::absprec> {
my $arg = ~self.trivial_eval($T, $tr<Niecza::absprec>);
my %prec = $sub.get_extend('prec');
unless %prec {
$T.CURSOR.sorry("Target does not seem to be an operator");
next;
}
%prec<prec> = $arg;
%prec<dba> = "like $sub.name()";
$sub.set_extend('prec', %prec.kv);
} elsif !$pack && $tr<Niecza::builtin> {
$sub.set_extend('builtin',
self.trivial_eval($T, $tr<Niecza::builtin>));
} elsif !$pack && $tr<return_pass> {
$sub.returnable = False;
} elsif !$pack && $tr<of> {
} elsif !$pack && $tr<rw> {
} elsif !$pack && $tr<unsafe> {
$sub.unsafe = True;
} else {
$T.CURSOR.sorry("Unhandled trait $tr.keys[0] for this context");
}
}
}

method variable_declarator($/) {
if $*MULTINESS {
Expand Down

0 comments on commit 11c6923

Please sign in to comment.