Skip to content

Commit

Permalink
Use a trait to explicitly mark functions that handle their own bindin…
Browse files Browse the repository at this point in the history 
…g, rather than brokenly overloading "no signature"
  • Loading branch information
@sorear
sorear committed Jul 29, 2010
1 parent d4465fa commit a5771c1
Show file tree
Hide file tree
Showing 2 changed files with 36 additions and 17 deletions.
24 changes: 12 additions & 12 deletions CORE.setting
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ my class ClassHOW { ... }

PRE-INIT {
# ClassHOW.new($name) --> meta class instance
sub new { Q:CgOp {
sub new is rawcall { Q:CgOp {
(withtypes $mo DynMetaObject $self DynObject
[l $mo (rawnew DynMetaObject (unbox String (@ (pos 1))))]
[l $self (rawnew DynObject (getfield klass
Expand All @@ -43,7 +43,7 @@ PRE-INIT {
} }
# $how.add-super($p)
sub add-super { Q:CgOp { (prog
sub add-super is rawcall { Q:CgOp { (prog
[rawcall
(getfield superclasses (unwrap DynMetaObject
(getattr meta-object (@ (pos 0))))) Add
Expand All @@ -52,7 +52,7 @@ PRE-INIT {
} }

# $how.add-method($name, $sub)
sub add-method { Q:CgOp {
sub add-method is rawcall { Q:CgOp {
(prog
[setindex (unbox String (@ (pos 1)))
(getfield local (unwrap DynMetaObject (getattr meta-object
Expand All @@ -63,7 +63,7 @@ PRE-INIT {
} }
# $how.add-attribute($name)
sub add-attribute { Q:CgOp {
sub add-attribute is rawcall { Q:CgOp {
(prog
[setindex (unbox String (@ (pos 1)))
(getfield local_attr (unwrap DynMetaObject (getattr meta-object
Expand All @@ -74,7 +74,7 @@ PRE-INIT {
} }

# $how.create-protoobject()
sub create-protoobject { Q:CgOp {
sub create-protoobject is rawcall { Q:CgOp {
(withtypes $p DynObject $mo DynMetaObject
[l $mo (unwrap DynMetaObject (getattr meta-object (@ (pos 0))))]
[l $p (rawnew DynObject (l $mo))]
Expand All @@ -87,7 +87,7 @@ PRE-INIT {
[newscalar (l $p)])
} }
sub compose { Q:CgOp { (null Variable) } }
sub compose is rawcall { Q:CgOp { (null Variable) } }

Q:CgOp {
(withtypes $chmo DynMetaObject $chch Variable
Expand Down Expand Up @@ -126,7 +126,7 @@ my class Scalar { ... }
my class Sub { ... }
PRE-INIT {
# (DynMetaObject $dmo, ClassHOW $super --> ClassHOW)
sub wrap-dpmo { Q:CgOp {
sub wrap-dpmo is rawcall { Q:CgOp {
(withtypes $ch Variable $dm DynMetaObject
[l $ch (methodcall (l ClassHOW) new (string_var ""))]
[l $dm (unwrap DynMetaObject (@ (pos 0)))]
Expand Down Expand Up @@ -225,7 +225,7 @@ constant False = Q:CgOp { (box Bool (bool 0)) };
# taking a slurpy is wrong for this due to flattening. I'm not sure what is
# right, maybe **@foo
sub infix:<~> { Q:CgOp {
sub infix:<~> is rawcall { Q:CgOp {
(letn buf (rawnew System.Text.StringBuilder)
i (int 0)
max (getfield Length (getfield pos (callframe)))
Expand Down Expand Up @@ -301,7 +301,7 @@ sub exit() { Q:CgOp {
)
} }
sub infix:<=> { Q:CgOp { (prog [assign (pos 0) (pos 1)] (pos 0)) } }
sub infix:<=> is rawcall { Q:CgOp { (prog [assign (pos 0) (pos 1)] (pos 0)) } }
# Buglet in STD: standard infix operators look custom inside the setting, and
# forget their precedence.
Expand Down Expand Up @@ -358,7 +358,7 @@ PRE-INIT {
Mu.HOW.add-method("notdef", anon method notdef() { ! self.defined });
Mu.HOW.add-method("so", anon method so() { self.Bool });
Mu.HOW.add-method("not", anon method not() { ! self.Bool });
Mu.HOW.add-method("RAWCREATE", anon method RAWCREATE { Q:CgOp {
Mu.HOW.add-method("RAWCREATE", anon method RAWCREATE is rawcall { Q:CgOp {
(withtypes i Int32 max Int32 obj DynObject
[l max (getfield Length (getfield pos (callframe)))]
[l i (int 1)]
Expand Down Expand Up @@ -401,14 +401,14 @@ PRE-INIT {
# boxes a List<Variable>. SCHLIEMEL WAS HERE
# we can't use sigs on push and unshift because $x loses the flat bit
my class LLArray {
method push { Q:CgOp { (prog
method push is rawcall { Q:CgOp { (prog
[rawcall (unbox List<Variable> (@ (pos 0))) Add (pos 1)] [pos 0]) } }
method shift() { Q:CgOp { (withtypes $f Variable $lv List<Variable>
[l $lv (unbox List<Variable> (@ (l self)))]
[l $f (getindex (int 0) (l $lv))]
[rawcall (l $lv) RemoveAt (int 0)]
[l $f]) } }
method unshift { Q:CgOp { (prog
method unshift is rawcall { Q:CgOp { (prog
[rawcall (unbox List<Variable> (@ (pos 0))) Insert (int 0) (pos 1)]
[pos 0]) } }
method first-flattens() { Q:CgOp {
Expand Down
29 changes: 24 additions & 5 deletions Niecza/Actions.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1412,6 +1412,8 @@ sub trait_mod__S_is { my ($cl, $M) = @_;
} elsif ($trait eq 'export') {
$M->{_ast} = { export => [ 'DEFAULT', 'ALL' ] };
$noparm = 'Export tags NYI';
} elsif ($trait eq 'rawcall') {
$M->{_ast} = { nobinder => 1 };
} else {
$M->sorry('Unhandled trait ' . $trait);
}
Expand Down Expand Up @@ -1473,6 +1475,10 @@ sub block_to_closure { my ($cl, $M, $blk, %args) = @_;
method_too => $args{method_too}, exports => ($args{exports} // []));
}

sub get_placeholder_sig { my ($cl) = @_;
return Sig->new(params => []);
}

# always a sub, though sometimes it's an implied sub after multi/proto/only
sub routine_def { my ($cl, $M) = @_;
if ($M->{sigil}[0] && $M->{sigil}[0]->Str eq '&*') {
Expand All @@ -1485,9 +1491,13 @@ sub routine_def { my ($cl, $M) = @_;
return;
}
my @export;
my $signature = $M->{multisig}[0] ? $M->{multisig}[0]{_ast} :
$cl->get_placeholder_sig($M);
for my $t (@{ $M->{trait} }) {
if ($t->{_ast}{export}) {
push @export, @{ $t->{_ast}{export} };
} elsif ($t->{_ast}{nobinder}) {
$signature = undef;
} else {
$M->sorry('Non-export sub traits NYI');
}
Expand All @@ -1508,7 +1518,7 @@ sub routine_def { my ($cl, $M) = @_;
$cl->sl_to_block('sub',
$M->{blockoid}{_ast},
subname => $m,
signature => ($M->{multisig}[0] ? $M->{multisig}[0]{_ast} : undef)),
signature => $signature),
outer_key => (($scope eq 'my') ? "&$m" : undef),
exports => \@export);
}
Expand All @@ -1519,8 +1529,8 @@ sub method_def { my ($cl, $M) = @_;
$scope = 'anon' if !$M->{longname};
my $name = $M->{longname} ? $cl->mangle_longname($M->{longname}, "method definition") : undef;

if ($M->{trait}[0] || $M->{sigil}) {
$M->sorry("Method traits NYI");
if ($M->{sigil}) {
$M->sorry("Method sgils NYI");
return;
}
if ($type eq '^') {
Expand All @@ -1543,11 +1553,20 @@ sub method_def { my ($cl, $M) = @_;
$M->sorry("Packages NYI");
return;
}
my $sig = $M->{multisig}[0] ? $M->{multisig}[0]{_ast} :
$cl->get_placeholder_sig;

for my $t (@{ $M->{trait} }) {
if ($t->{_ast}{nobinder}) {
$sig = undef;
} else {
$M->sorry("NYI method trait " . $M->Str);
}
}

my $bl = $cl->sl_to_block('sub', $M->{blockoid}{_ast},
subname => $name,
signature => ($M->{multisig}[0] ?
$M->{multisig}[0]{_ast}->for_method : undef));
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));
Expand Down

0 comments on commit a5771c1

Please sign in to comment.