Implement postfix method calls

sorear · Jul 13, 2010 · 91d8b99 · 91d8b99
1 parent 91580e7
commit 91d8b99
Show file tree

Hide file tree

Showing 3 changed files with 86 additions and 8 deletions.
diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm
@@ -31,6 +31,7 @@ sub unv { }
 sub comment { }
 sub comment__S_Sharp { }
 sub spacey { }
+sub unspacey { }
 sub nofun { }
 sub curlycheck { }
 sub pod_comment { }
@@ -211,9 +212,19 @@ sub CHAIN { my ($cl, $M) = @_;
 }
 
 sub POSTFIX { my ($cl, $M) = @_;
-    $M->{_ast} = Op::CallSub->new(
-        invocant => Op::Lexical->new(name => '&postfix:<' . $M->{sym} . '>'),
-        positionals => [ $M->{arg}{_ast} ]);
+    my $op = $M->{_ast};
+    if ($op->{postfix}) {
+        $M->{_ast} = Op::CallSub->new(
+            invocant => Op::Lexical->new(name => "&postfix:<" . $op->{postfix} . ">"),
+            positionals => [ $M->{arg}{_ast} ]);
+    } elsif ($op->{name}) {
+        $M->{_ast} = Op::CallMethod->new(
+            receiver => $M->{arg}{_ast},
+            name => $op->{name},
+            positionals => $op->{args} // []);
+    } else {
+        $M->sorry("Unhandled postop type");
+    }
 }
 
 sub PREFIX { my ($cl, $M) = @_;
@@ -234,10 +245,48 @@ sub postfix__S_ANY { }
 
 sub postcircumfix { }
 
-sub postop { }
-sub POST { }
+sub postop { my ($cl, $M) = @_;
+    $M->{_ast} = $M->{sym};
+}
+sub POST { my ($cl, $M) = @_;
+    $M->{_ast} = $M->{dotty}{_ast} if $M->{dotty};
+    $M->{_ast} = $M->{privop}{_ast} if $M->{privop};
+    $M->{_ast} = { postfix => $M->{postop}{_ast} } if $M->{postop};
+}
+
 sub PRE { }
 
+sub methodop { my ($cl, $M) = @_;
+    my %r;
+    $r{name}  = $cl->mangle_longname($M->{longname}) if $M->{longname};
+    $r{quote} = $M->{quote}{_ast} if $M->{quote};
+    $r{ref}   = $M->{variable}{_ast}{term} if $M->{variable};
+
+    $r{args}  = $M->{args}[0]{_ast} if $M->{args}[0];
+    $r{args}  = $M->{arglist}[0]{_ast} if $M->{arglist}[0];
+
+    $M->{_ast} = \%r;
+}
+
+sub dottyop { my ($cl, $M) = @_;
+    if ($M->{colonpair}) {
+        $M->sorry("Colonpair dotties NYI");
+        return;
+    }
+
+    $M->{_ast} = $M->{methodop}{_ast} if $M->{methodop};
+    $M->{_ast} = { postfix => $M->{postop}{_ast} } if $M->{postop};
+}
+
+sub privop { my ($cl, $M) = @_;
+    $M->{_ast} = { %{ $M->{methodop}{_ast} }, private => 1 };
+}
+
+sub dotty { }
+sub dotty__S_Dot { my ($cl, $M) = @_;
+    $M->{_ast} = $M->{dottyop}{_ast};
+}
+
 sub coloncircumfix { my ($cl, $M) = @_;
     $M->{_ast} = $M->{circumfix}{_ast};
     $M->{qpvalue} = $M->{circumfix}{qpvalue};

diff --git a/Op.pm b/Op.pm
@@ -105,6 +105,36 @@ use 5.010;
     no Moose;
 }
 
+{
+    package Op::CallMethod;
+    use Moose;
+    extends 'Op';
+
+    has receiver    => (isa => 'Op', is => 'ro', required => 1);
+    has positionals => (isa => 'ArrayRef[Op]', is => 'ro',
+        default => sub { [] });
+    has name        => (isa => 'Str', is => 'ro', required => 1);
+
+    sub item_cg {
+        my ($self, $cg, $body) = @_;
+        $self->receiver->item_cg($cg, $body);
+        $cg->dup_fetch;
+        $_->item_cg($cg, $body) for @{ $self->positionals };
+        $cg->call_method(1, $self->name, scalar(@{ $self->positionals }));
+    }
+
+    sub void_cg {
+        my ($self, $cg, $body) = @_;
+        $self->receiver->item_cg($cg, $body);
+        $cg->dup_fetch;
+        $_->item_cg($cg, $body) for @{ $self->positionals };
+        $cg->call_method(0, $self->name, scalar(@{ $self->positionals }));
+    }
+
+    __PACKAGE__->meta->make_immutable;
+    no Moose;
+}
+
 {
     package Op::Yada;
     use Moose;

diff --git a/setting b/setting
@@ -244,7 +244,7 @@ my class Bool is Enum {
 }
 
 sub infix:<~>($l,$r) { Q:NIL {
-    {$l} @ unbox:String  {$r} @ unbox:String  .plaincall/2:String.Concat
+    {$l.Str} @ unbox:String  {$r.Str} @ unbox:String  .plaincall/2:String.Concat
         box:Str
 } }
 
@@ -289,8 +289,7 @@ sub infix:<< != >>($l,$r) { Q:NIL {
 } }
 
 sub say($str) { Q:NIL {
-    {$str} dup@ .method/0:Str @ unbox:String
-        .plaincall/1:Console.WriteLine null:Variable
+    {$str.Str} @ unbox:String .plaincall/1:Console.WriteLine null:Variable
 } }
 
 sub infix:<=>($l,$r) { Q:NIL { {$l} {$r} @ !  {$l} } }