Skip to content

Commit

Permalink
First real implementation of private methods
Browse files Browse the repository at this point in the history 
They are now stored disjointly from regular methods, and are never inherited
or overriden.  The $foo!Foo::bar syntax is available for calling private
methods from other classes; trusts is not implemented.
  • Loading branch information
@sorear
sorear committed Oct 2, 2010
1 parent 747ffe7 commit 2be14a1
Show file tree
Hide file tree
Showing 8 changed files with 90 additions and 35 deletions.
17 changes: 17 additions & 0 deletions lib/Kernel.cs
View file
Expand Up @@ -303,6 +303,11 @@ public class Frame: IP6 {
}
}

public class NieczaException: Exception {
public NieczaException(string detail) : base(detail) {}
public NieczaException() : base() {}
}

// NOT IP6; these things should only be exposed through a ClassHOW-like
// façade
public class DynMetaObject {
Expand All @@ -329,6 +334,8 @@ public List<DynMetaObject> superclasses
= new List<DynMetaObject>();
public Dictionary<string, IP6> local
= new Dictionary<string, IP6>();
public Dictionary<string, IP6> priv
= new Dictionary<string, IP6>();
public List<string> local_attr = new List<string>();

public Dictionary<string, int> slotMap = new Dictionary<string, int>();
Expand Down Expand Up @@ -456,6 +463,16 @@ public List<DynMetaObject> superclasses
Invalidate();
}

public void AddPrivateMethod(string name, IP6 code) {
priv[name] = code;
}

public IP6 GetPrivateMethod(string name) {
IP6 code = priv[name];
if (code == null) { throw new NieczaException("private method lookup failed for " + name + " in class " + this.name); }
return code;
}

public void AddAttribute(string name) {
local_attr.Add(name);
Invalidate();
Expand Down
22 changes: 11 additions & 11 deletions lib/SAFE.setting
View file
Expand Up @@ -341,7 +341,7 @@ my class List is Cool {
#| Takes an object and applies whatever semantics the List subclass
#| needs to apply on stuff out of the iterator stack
method !elem is rawcall { Q:CgOp { (pos 1) } }
method _elem is rawcall { Q:CgOp { (pos 1) } }
sub count-items($self) { Q:CgOp {
(box Num (cast num (vvarlist_count (getslot items vvarlist (@ {$self})))))
Expand Down Expand Up @@ -384,7 +384,7 @@ my class List is Cool {
(ternary (obj_isa (@ (l v)) (l ItMo))
(vvarlist_unshiftn (l rest) (unbox fvarlist
(@ (methodcall (l v) reify))))
(vvarlist_push (l items) (methodcall {self} !elem (l v)))))))
(vvarlist_push (l items) (methodcall {self} _elem (l v)))))))
(box Bool (>= (vvarlist_count (l items)) (l nr))))
} }
Expand Down Expand Up @@ -446,7 +446,7 @@ my class List is Cool {
# exactly like List, but flattens, and with "is copy" semantics on stuff
my class Seq is List {
method !elem($x) { my $y = $x; $y }
method _elem($x) { my $y = $x; $y }
method Seq { self }
}
Expand Down Expand Up @@ -482,9 +482,9 @@ my class Array is List {
}
method at-pos($ix) {
self!fill($ix+1)
?? self!item-at-pos($ix)
!! Any!butWHENCE(sub () is rawcall {
self!List::fill($ix+1)
?? self!List::item-at-pos($ix)
!! Any!Any::butWHENCE(sub () is rawcall {
self!extend($ix, Q:CgOp { (pos 0) });
});
}
Expand Down Expand Up @@ -514,7 +514,7 @@ my class Hash {
?? Q:CgOp {
(varhash_getindex [unbox str (@ {$key.Str})]
[unbox varhash (@ {self})])
} !! Any!butWHENCE({ self!extend($key, Q:CgOp { (pos 0) }) });
} !! Any!Any::butWHENCE({ self!extend($key, Q:CgOp { (pos 0) }) });
}
}
Expand All @@ -540,12 +540,12 @@ sub postcircumfix:<[ ]> is rawcall {
(Q:CgOp { (pos 0) }).defined
?? (Q:CgOp { (pos 0) }).at-pos($index)
!! Any!butWHENCE(sub () is rawcall {
!! Any!Any::butWHENCE(sub () is rawcall {
my $ar := Q:CgOp { (getindex (int 0) (getfield pos
(getfield outer (callframe)))) };
$ar.defined && die("Autovivification collision");
$ar = Array.new;
$ar!extend($index, Q:CgOp { (pos 0) });
$ar!Array::extend($index, Q:CgOp { (pos 0) });
});
}
Expand All @@ -554,12 +554,12 @@ sub postcircumfix:<{ }> is rawcall {
(Q:CgOp { (pos 0) }).defined
?? (Q:CgOp { (pos 0) }).at-key($key)
!! Any!butWHENCE(sub () is rawcall {
!! Any!Any::butWHENCE(sub () is rawcall {
my $ar := Q:CgOp { (getindex (int 0) (getfield pos
(getfield outer (callframe)))) };
$ar.defined && die("Autovivification collision");
$ar = Hash.new;
$ar!extend($key, Q:CgOp { (pos 0) });
$ar!Hash::extend($key, Q:CgOp { (pos 0) });
});
}
Expand Down
2 changes: 2 additions & 0 deletions src/CLRTypes.pm
View file
Expand Up @@ -28,6 +28,8 @@ my %typedata = (
AddMethod => [m => 'Void'],
AddSuperclass=> [m => 'Void'],
AddAttribute => [m => 'Void'],
AddPrivateMethod => [m => 'Void'],
GetPrivateMethod => [m => 'IP6'],
typeObject => [f => 'IP6'],
how => [f => 'IP6'],
name => [f => 'String'] },
Expand Down
9 changes: 5 additions & 4 deletions src/CSharpBackend.pm
View file
Expand Up @@ -191,7 +191,8 @@ sub pkg3 {
return unless $_->isa('Metamodel::Class');
my $p = $_->{peer}{mo};
for my $m (@{ $_->methods }) {
push @thaw, CgOp::rawcall(CgOp::rawsget($p), 'AddMethod',
push @thaw, CgOp::rawcall(CgOp::rawsget($p),
($m->private ? 'AddPrivateMethod' : 'AddMethod'),
CgOp::clr_string($m->name),
CgOp::rawsget($unit->deref($m->body)->{peer}{ps}));
}
Expand Down Expand Up @@ -330,15 +331,15 @@ sub codegen_sub {
my $ops;
# TODO: Bind a return value here to catch non-ro sub use
if ($_->gather_hack) {
$ops = CgOp::prog(@enter, CgOp::sink($_->code->cgop),
$ops = CgOp::prog(@enter, CgOp::sink($_->code->cgop($_)),
CgOp::rawsccall('Kernel.Take', CgOp::scopedlex('EMPTY')));
} elsif ($_->returnable && defined($_->signature)) {
$ops = CgOp::prog(@enter,
CgOp::return(CgOp::span("rstart", "rend",
$_->code->cgop)),
$_->code->cgop($_))),
CgOp::ehspan(4, undef, 0, "rstart", "rend", "rend"));
} else {
$ops = CgOp::prog(@enter, CgOp::return($_->code->cgop));
$ops = CgOp::prog(@enter, CgOp::return($_->code->cgop($_)));
}

local %haslet;
Expand Down
32 changes: 26 additions & 6 deletions src/Metamodel.pm
View file
Expand Up @@ -143,8 +143,9 @@ our $unit;
}

sub add_method {
my ($self, $name, $body) = @_;
push @{ $self->methods }, Metamodel::Method->new(name => $name, body => $body);
my ($self, $type, $name, $body) = @_;
push @{ $self->methods }, Metamodel::Method->new(name => $name,
body => $body, private => ($type eq '!'));
}

sub push_multi_regex {
Expand Down Expand Up @@ -188,8 +189,9 @@ our $unit;
package Metamodel::Method;
use Moose;

has name => (isa => 'Str', is => 'ro');
has body => (is => 'ro');
has name => (isa => 'Str', is => 'ro', required => 1);
has private => (isa => 'Bool', is => 'ro', required => 1);
has body => (is => 'ro', required => 1);

no Moose;
__PACKAGE__->meta->make_immutable;
Expand Down Expand Up @@ -312,6 +314,7 @@ our $unit;
has gather_hack => (isa => 'Bool', is => 'ro', default => 0);
has strong_used => (isa => 'Bool', is => 'rw', default => 0);
has body_of => (isa => 'Maybe[ArrayRef]', is => 'ro');
has in_class => (isa => 'Maybe[ArrayRef]', is => 'ro');
has cur_pkg => (isa => 'Maybe[ArrayRef[Str]]', is => 'ro');
has name => (isa => 'Str', is => 'ro', default => 'ANON');
has returnable => (isa => 'Bool', is => 'ro', default => 0);
Expand Down Expand Up @@ -649,6 +652,8 @@ sub Body::begin {
unit => $unit,
outer => $top,
body_of => $args{body_of},
in_class => $args{body_of} // (@opensubs ? $opensubs[-1]->in_class :
undef),
cur_pkg => $args{cur_pkg} // (@opensubs ? $opensubs[-1]->cur_pkg :
[ 'GLOBAL' ]), # cur_pkg does NOT propagate down from settings
augmenting => $args{augmenting},
Expand Down Expand Up @@ -754,6 +759,21 @@ sub Op::Lexical::begin {
}
}

sub Op::CallMethod::begin {
my $self = shift;

$self->Op::begin;
if ($self->private) {
if ($self->ppath) {
$self->pclass($unit->get_stash(@{ $opensubs[-1]->find_pkg($self->ppath) })->obj);
} elsif ($opensubs[-1]->in_class) {
$self->pclass($opensubs[-1]->in_class);
} else {
die "unable to resolve class of reference for method";
}
}
}

sub Op::PackageVar::begin {
my $self = shift;

Expand Down Expand Up @@ -786,7 +806,7 @@ sub Op::Attribute::begin {
$opensubs[-1]->create_static_pad; # for protosub instance
$nb->strong_used(1);
$opensubs[-1]->add_my_sub($self->name . '!a', $nb);
$ns->add_method($self->name, $unit->make_ref($nb));
$ns->add_method('', $self->name, $unit->make_ref($nb));
}
}

Expand Down Expand Up @@ -814,7 +834,7 @@ sub Op::SubDef::begin {

if (defined($self->method_too)) {
$unit->deref($opensubs[-1]->body_of)
->add_method($self->method_too, $r);
->add_method(@{ $self->method_too }, $r);
}

if (defined($self->proto_too)) {
Expand Down
19 changes: 13 additions & 6 deletions src/Niecza/Actions.pm
View file
Expand Up @@ -380,7 +380,7 @@ sub regex_def { my ($cl, $M) = @_;
$ast = Optimizer::RxSimple::run($ast);
$M->{_ast} = Op::SubDef->new(
var => $var,
method_too => ($scope eq 'has' ? $name : undef),
method_too => ($scope eq 'has' ? ['', $name] : undef),
proto_too => ($scope eq 'has' ? $unsymtext : undef),
body => Body->new(
ltm => $lad,
Expand Down Expand Up @@ -1091,10 +1091,15 @@ sub POSTFIX { my ($cl, $M) = @_;
name => $op->{metamethod},
args => $op->{args} // []);
} elsif ($op->{name}) {
if ($op->{path} && !$op->{private}) {
$M->sorry("Qualified references to non-private methods NYI");
}
$M->{_ast} = Op::CallMethod->new(node($M),
receiver => $arg,
name => ($op->{private} ? '!' . $op->{name} : $op->{name}),
args => $op->{args} // []);
private => $op->{private},
ppath => $op->{path},
name => $op->{name},
args => $op->{args} // []);
} elsif ($op->{postcall}) {
if (@{ $op->{postcall} } > 1) {
$M->sorry("Slicels NYI");
Expand Down Expand Up @@ -1190,8 +1195,10 @@ sub PRE { }

sub methodop { my ($cl, $M) = @_;
my %r;
$r{name} = $cl->unqual_longname($M->{longname},
"Qualified method calls NYI") if $M->{longname};
if ($M->{longname}) {
my $c = $cl->mangle_longname($M->{longname});
@r{"name", "path"} = @$c{"name", "path"};
}
$r{quote} = $M->{quote}{_ast} if $M->{quote};
$r{ref} = $cl->do_variable_reference($M, $M->{variable}{_ast})
if $M->{variable};
Expand Down Expand Up @@ -2379,7 +2386,7 @@ sub method_def { my ($cl, $M) = @_;
signature => $sig ? $sig->for_method : undef);

$M->{_ast} = $cl->block_to_closure($M, $bl, outer_key => $sym,
method_too => ($scope ne 'anon' ? "$type$name" : undef));
method_too => ($scope ne 'anon' ? [ $type, $name ] : undef));
}

sub block { my ($cl, $M) = @_;
Expand Down
14 changes: 11 additions & 3 deletions src/Op.pm
View file
Expand Up @@ -185,12 +185,20 @@ use CgOp;

has receiver => (isa => 'Op', is => 'ro', required => 1);
has name => (isa => 'Str', is => 'ro', required => 1);
has private => (isa => 'Bool', is => 'ro', default => 0);
has ppath => (isa => 'Maybe[ArrayRef[Str]]', is => 'ro');
has pclass => (isa => 'ArrayRef', is => 'rw');
sub zyg { $_[0]->receiver, $_[0]->SUPER::zyg }

sub code {
my ($self, $body) = @_;
CgOp::methodcall($self->receiver->cgop($body),
$self->name, $self->argblock($body));
if ($self->private) {
# XXX encapsulation break
CgOp::subcall(CgOp::rawcall(CgOp::rawsget($body->unit->deref($self->pclass)->{peer}{mo}), "GetPrivateMethod", CgOp::clr_string($self->name)), $self->receiver->cgop($body), $self->argblock($body));
} else {
CgOp::methodcall($self->receiver->cgop($body),
$self->name, $self->argblock($body));
}
}

__PACKAGE__->meta->make_immutable;
Expand Down Expand Up @@ -764,7 +772,7 @@ use CgOp;

has var => (isa => 'Str', is => 'ro', required => 1);
has body => (isa => 'Body', is => 'ro', required => 1);
has method_too => (isa => 'Maybe[Str]', is => 'ro', required => 0);
has method_too => (isa => 'Maybe[ArrayRef[Str]]', is => 'ro');
has proto_too => (isa => 'Maybe[Str]', is => 'ro', required => 0);
has exports => (isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] });
# Is candidate for beta-optimization. Not compatible with method_too,
Expand Down
10 changes: 5 additions & 5 deletions test.pl
View file
Expand Up @@ -464,11 +464,11 @@
my $d = 0;
my $e = 0;
(Any!butWHENCE({ $a = 1 }));
my $x := (Any!butWHENCE({ $b = 1 })); #OK not used
my $y ::= (Any!butWHENCE({ $c = 1 })); #OK not used
my $z = (Any!butWHENCE({ $d = 1 })); #OK not used
(Any!butWHENCE({ $e = 1 })) = 2;
(Any!Any::butWHENCE({ $a = 1 }));
my $x := (Any!Any::butWHENCE({ $b = 1 })); #OK not used
my $y ::= (Any!Any::butWHENCE({ $c = 1 })); #OK not used
my $z = (Any!Any::butWHENCE({ $d = 1 })); #OK not used
(Any!Any::butWHENCE({ $e = 1 })) = 2;
ok !$a, "no autovivification in void context";
ok $b, "autovivification after rw bind";
Expand Down

0 comments on commit 2be14a1

Please sign in to comment.