Merge remote branch 'upstream'

src/Perl6/Actions.pm

@@ -394,6 +394,9 @@ method statement_control:sym<use>($/) {
                 ),
             );
         }
+        elsif ~$<module_name> eq 'MONKEY_TYPING' {
+            $*MONKEY_TYPING := 1;
+        }
         else {
             need($<module_name>);
             import($/);
@@ -1562,6 +1565,9 @@ method dotty:sym<.>($/) { make $<dottyop>.ast; }
 
 method dotty:sym<.*>($/) {
     my $past := $<dottyop>.ast;
+    unless $past.isa(PAST::Op) && $past.pasttype() eq 'callmethod' {
+        $/.CURSOR.panic("Can not use " ~ $<sym>.Str ~ " on a non-identifier method call");
+    }
     $past.unshift($past.name);
     $past.name('!dispatch_' ~ $<sym>.Str);
     $past.pasttype('call');
@@ -1589,13 +1595,28 @@ method privop($/) {
 
 method methodop($/) {
     my $past := $<args> ?? $<args>[0].ast !! PAST::Op.new( :node($/) );
-    if $<identifier> {
-        $past.name( ~$<identifier> );
+    $past.pasttype('callmethod');
+    if $<longname> {
+        # May just be .foo, but could also be .Foo::bar
+        my @parts := Perl6::Grammar::parse_name(~$<longname>);
+        my $name := @parts.pop;
+        if +@parts {
+            $past.unshift(PAST::Var.new(
+                :name(@parts.pop),
+                :namespace(@parts),
+                :scope('package')
+            ));
+            $past.unshift($name);
+            $past.name('!dispatch_::');
+            $past.pasttype('call');
+        }
+        else {
+            $past.name( $name );
+        }
     }
     elsif $<quote> {
         $past.name( $<quote>.ast );
     }
-    $past.pasttype('callmethod');
     make $past;
 }
 

src/Perl6/Grammar.pm

@@ -85,7 +85,10 @@ method add_our_name($name) {
 method add_name($name) {
     if $*SCOPE eq 'augment' || $*SCOPE eq 'supersede' {
         unless self.is_name($name) {
-            pir::die("Can't $*SCOPE something that doesn't exist");
+            pir::die("Can't $*SCOPE $*PKGDECL that doesn't exist");
+        }
+        unless $*MONKEY_TYPING {
+            pir::die("Can't $*SCOPE $*PKGDECL $name without 'use MONKEY_TYPING'");
         }
     }
     else {
@@ -239,6 +242,7 @@ token comp_unit {
     :my %*METAOPGEN;                           # hash of generated metaops
     :my $*IN_DECL;                             # what declaration we're in
     :my $*IMPLICIT;                            # whether we allow an implicit param
+    :my $*MONKEY_TYPING := 0;                  # whether augment/supersede are allowed
     <.newpad>
     <.outerlex>
     <.finishpad>
@@ -1088,7 +1092,7 @@ token privop {
 
 token methodop {
     [
-    | <identifier>
+    | <longname>
     | <?before <[ ' " ]> >
         <quote>
         [ <?before '(' | '.(' | '\\'> || <.panic: "Quoted method name requires parenthesized arguments"> ]

src/core/Any-str.pm

@@ -1,4 +1,8 @@
 augment class Any {
+    method ACCEPTS($topic) {
+        self === $topic
+    }
+
     our Int multi method bytes() is export {
         pir::box__PI(pir::bytelength__IS(self))
     }
@@ -251,7 +255,7 @@ augment class Any {
     }
 
     multi method Str() {
-        sprintf '%s<0x%f>', self.WHAT, self.WHERE;
+        sprintf '%s<0x%x>', self.WHAT, self.WHERE;
     }
 }
 

src/core/EnumMap.pm

@@ -21,7 +21,12 @@ class EnumMap does Associative {
     }
 
     multi method ACCEPTS(Regex $topic) {
-        any(@.keys) ~~ $topic;
+        for @.keys -> $k {
+            if $topic.ACCEPTS($k) {
+                return True;
+            }
+        }
+        False
     }
 
     multi method ACCEPTS(%topic) {

src/core/Parcel.pm

@@ -8,7 +8,7 @@ augment class Parcel {
         if self.elems == 0 {
             $x.notdef || ($x.does(::Positional) && $x == 0)
         } else {
-            die "Don't know how to smart-match against a Parcel that doesn't happen to be empty";
+            self.Seq.ACCEPTS($x)
         }
     }
 }

src/core/Seq.pm

@@ -1,4 +1,49 @@
 augment class Seq {
+    multi method ACCEPTS(@topic) {
+        my $self_it = self.iterator();
+        my $topic_it = @topic.iterator();
+        loop {
+            my $cur_self_elem = $self_it.get;
+            if $cur_self_elem ~~ EMPTY { last }
+            if $cur_self_elem ~~ Whatever {
+                # If we just have * left, we're done. Otherwise, we have a
+                # "target" to look for.
+                loop {
+                    $cur_self_elem = $self_it.get;
+                    if $cur_self_elem ~~ EMPTY { return True }
+                    unless $cur_self_elem ~~ Whatever {
+                        last;
+                    }
+                }
+
+                # Need to find our target in the topic, if possible.
+                loop {
+                    my $cur_topic_elem = $topic_it.get;
+                    if $cur_topic_elem ~~ EMPTY {
+                        # Ran out before finding what we wanted.
+                        return False;
+                    }
+                    elsif $cur_topic_elem === $cur_self_elem {
+                        last;
+                    }
+                }
+            }
+            else {
+                my $cur_topic_elem = $topic_it.get;
+                if $cur_topic_elem ~~ EMPTY || $cur_topic_elem !=== $cur_self_elem {
+                    return False;
+                }
+            }
+        }
+
+        # If we've nothing left to match, we're successful.
+        $topic_it.get ~~ EMPTY
+    }
+
+    multi method ACCEPTS($topic) {
+        self.ACCEPTS(@($topic))
+    }
+
     method elems() { pir::set__IP(self!fill); }
 
     method Str() {

src/core/traits.pm

@@ -1,3 +1,7 @@
+# Need to be able to augment in the setting, and this is the first file, so we
+# put this here.
+use MONKEY_TYPING;
+
 # XXX Signature is wrong really - will fix once we can parse other things.
 our multi trait_mod:<is>(Mu $child, Mu $parent) {
     $child.^add_parent($parent);

src/glue/dispatch.pir

@@ -258,6 +258,33 @@ there are none.
 .end
 
 
+=item !dispatch_::
+
+Helper for handling calls of the form .Foo::bar.
+
+=cut
+
+.sub '!dispatch_::'
+    .param pmc invocant
+    .param string name
+    .param pmc target
+    .param pmc pos_args   :slurpy
+    .param pmc named_args :slurpy :named
+    $I0 = target.'ACCEPTS'(invocant)
+    unless $I0 goto not_allowed
+    $P0 = find_method target, name
+    .tailcall $P0(invocant, pos_args :flat, named_args :flat :named)
+  not_allowed:
+    $S0 = "Can not call method '"
+    concat $S0, name
+    concat $S0, "' on unrelated type '"
+    $S1 = target.'perl'()
+    concat $S0, $S1
+    concat $S0, "'"
+    '&die'($S0)
+.end
+
+
 =item !deferal_fail
 
 Used by P6invocation to help us get soft-failure semantics when no deferal

t/spectest.data

@@ -160,9 +160,9 @@ S03-operators/series-arity0.t
 S03-operators/series-arity2ormore.t
 S03-operators/series-simple.t
 S03-operators/series.t
-# S03-smartmatch/any-any.t
+S03-smartmatch/any-any.t
 # S03-smartmatch/any-array-slice.t
-# S03-smartmatch/any-array.t
+S03-smartmatch/any-array.t
 S03-smartmatch/any-bool.t
 S03-smartmatch/any-callable.t
 S03-smartmatch/any-complex.t
@@ -174,18 +174,18 @@ S03-smartmatch/any-pair.t
 S03-smartmatch/any-str.t
 # S03-smartmatch/any-sub.t
 S03-smartmatch/any-type.t
-# S03-smartmatch/array-array.t
+S03-smartmatch/array-array.t
 S03-smartmatch/array-hash.t
 S03-smartmatch/disorganized.t
 S03-smartmatch/hash-hash.t
-# S03-smartmatch/regex-hash.t
+S03-smartmatch/regex-hash.t
 S03-smartmatch/scalar-hash.t
 # S03-operators/series.t
 # S03-operators/short-circuit.t
 S03-operators/spaceship-and-containers.t
 # S03-operators/spaceship.t
 S03-operators/subscript-vs-lt.t
-# S03-operators/ternary.t
+S03-operators/ternary.t
 S03-operators/so.t
 S03-operators/value_equivalence.t
 # S04-blocks-and-statements/pointy-rw.t
@@ -334,7 +334,7 @@ S09-typed-arrays/hashes.t
 # S12-attributes/class.t
 S12-attributes/clone.t
 # S12-attributes/delegation.t
-# S12-attributes/inheritance.t
+S12-attributes/inheritance.t
 # S12-attributes/instance.t
 # S12-attributes/recursive.t
 S12-attributes/undeclared.t
@@ -343,7 +343,7 @@ S12-attributes/undeclared.t
 S12-class/basic.t
 S12-class/declaration-order.t
 S12-class/inheritance-class-methods.t
-# S12-class/inheritance.t
+S12-class/inheritance.t
 S12-class/instantiate.t
 # S12-class/interface-consistency.t
 # S12-class/namespaced.t