Implement .^can returning something that as well as being useful in b…

…oolean context can also be invoked to run the first method that would be handed back or used as an iterator to get all methods that we could call. Also re-work a few things in P6Invocation to look more like it probably should have in the first place - I'd seen this coming anyway. One bug .^can on proto-objects + iteration does not yet work.

build/Makefile.in

@@ -42,6 +42,7 @@ SOURCES = perl6.pir \
   src/parser/methods.pir \
   src/parser/quote_expression.pir \
   src/parrot/Protoobject.pir \
+  src/parrot/P6Invocation.pir \
   src/parrot/P6role.pir \
   src/parrot/misc.pir \
   src/parrot/state.pir \

src/builtins/control.pir

@@ -443,7 +443,7 @@ on error.
     # it and hand back it's return values. A tailcall does fine.
     .local pmc clist, lexpad, self, next
     get_next_candidate_info clist, $P0, lexpad
-    next = clist.'get'()
+    next = clone clist
     $P0 = deref next
     $I0 = isa $P0, 'Method'
     unless $I0 goto not_method
@@ -466,7 +466,7 @@ on error.
     # return to return it as if it was from our original call.
     .local pmc clist, lexpad, self, next, result
     get_next_candidate_info clist, $P0, lexpad
-    next = clist.'get'()
+    next = clone clist
     $P0 = deref next
     $I0 = isa $P0, 'Method'
     unless $I0 goto not_method
@@ -487,7 +487,7 @@ on error.
     # Find next candidate as well as caller and lexpad.
     .local pmc clist, routine, lexpad, next
     get_next_candidate_info clist, routine, lexpad
-    next = clist.'get'()
+    next = clone clist
 
     # Build arguments based upon what the caller was originall invoked with,
     # and tailcall the next candidate.
@@ -505,7 +505,7 @@ on error.
     # Find next candidate as well as caller and lexpad.
     .local pmc clist, routine, lexpad, next
     get_next_candidate_info clist, routine, lexpad
-    next = clist.'get'()
+    next = clone clist
 
     # Build arguments based upon what the caller was originall invoked with,
     # get the result of the next candidate and use return to retrun from

src/classes/ClassHOW.pir

@@ -50,6 +50,24 @@ This class subclasses P6metaclass to give Perl 6 specific meta-class behaviors.
 
 =over
 
+=item can(object, name)
+
+=cut
+
+.sub 'can' :method
+    .param pmc obj
+    .param string name
+    push_eh not_found
+    $P0 = find_method obj, name
+    pop_eh
+    .return ($P0)
+  not_found:
+    pop_eh
+    $P0 = new ['Nil']
+    .return ($P0)
+.end
+
+
 =item does(object, role)
 
 Tests role membership.

src/classes/Routine.pir

@@ -88,7 +88,7 @@ wrappable executable objects.
     .param pmc pos_args   :slurpy
     .param pmc named_args :slurpy :named
     $P0 = find_lex '__CANDIDATE_LIST__'
-    $P1 = $P0.'get'()
+    $P1 = clone $P0
     .tailcall $P1(pos_args :flat, named_args :flat :named)
 .end
 .sub '!wrap_clholder_helper' :anon

src/parrot/P6Invocation.pir

@@ -0,0 +1,39 @@
+## $Id$
+
+=head1 NAME
+
+src/parrot/P6Invocation - extra methods for the P6Invocation PMC
+
+=head2 Methods on P6Invocation
+
+We also add some methods to P6Invocation.
+
+=item !flatten
+
+Here so that list(...) will behave nicely. No doubt can change substantially
+when we have laziness support.
+
+=cut
+
+.namespace ["P6Invocation"]
+.sub '!flatten' :method
+    .local pmc result
+    result = new ['ResizablePMCArray']
+  it_loop:
+    unless self goto it_loop_end
+    $P0 = shift self
+    push result, $P0
+    goto it_loop
+  it_loop_end:
+    .return (result)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

src/pmc/p6invocation.pmc

@@ -22,6 +22,9 @@ gets stuck into the lex pad to represent the the candidate list.
 #include "pmc_perl6multisub.h"
 
 
+#define P6I_MODE_DISPATCH 0
+#define P6I_MODE_CHECK    1
+
 /* Declaration; definition of this is in p6opaque.pmc. */
 PMC *look_for_method(PARROT_INTERP, PMC *search_list, INTVAL *start_pos, STRING *name);
 
@@ -31,7 +34,7 @@ PMC *get_all_candidates_with_cur_args(PARROT_INTERP, PMC *self);
 
 /* This does the grunt work of working out what the next candidate is. Takes
  * account of us maybe needing to look into multi variants and all that lot. */
-static PMC *get_next_candidate(PARROT_INTERP, PMC *SELF) {
+static PMC *get_next_candidate(PARROT_INTERP, PMC *SELF, int check_only) {
     PMC    *candidates, *current, *search_list;
     STRING *name;
     INTVAL  position, resume_point;
@@ -72,27 +75,31 @@ static PMC *get_next_candidate(PARROT_INTERP, PMC *SELF) {
     current = VTABLE_get_pmc_keyed_int(interp, candidates, position);
     if (VTABLE_isa(interp, current, CONST_STRING(interp, "Perl6MultiSub"))) {
         /* Multi. Ask the multi-dispatcher for all possible variants that we
-         * could call with the current argument. */
-        PMC *possibles = get_all_candidates_with_cur_args(interp, current);
-        if (VTABLE_elements(interp, possibles) == 0) {
-            /* No candidates here; increment the position, and then jump back
-             * to check if we need to find another candidate and try again or
-             * if the list is already containing more things for us to try. */
-            position++;
-            SETATTR_P6Invocation_position(interp, SELF, position);
-            goto check_and_continue_search;
-        }
+         * could call with the current argument, unless we have none in
+         * which we're just gonna have to leave the multi here in the list. */
+        if (interp->current_args) {
+            PMC *possibles = get_all_candidates_with_cur_args(interp, current);
+            if (VTABLE_elements(interp, possibles) == 0) {
+                /* No candidates here; increment the position, and then jump back
+                 * to check if we need to find another candidate and try again or
+                 * if the list is already containing more things for us to try. */
+                position++;
+                SETATTR_P6Invocation_position(interp, SELF, position);
+                goto check_and_continue_search;
+            }
 
-        /* If we get here, we have some possibles; splice them into the candidate
-         * list, then continue as normal. This means that deferal will take into
-         * account the other multi-variants. Then our current becomes the first
-         * of the multi candidates. */
-        VTABLE_splice(interp, candidates, possibles, position, 1);
-        current = VTABLE_get_pmc_keyed_int(interp, candidates, position);
+            /* If we get here, we have some possibles; splice them into the candidate
+             * list, then continue as normal. This means that deferal will take into
+             * account the other multi-variants. Then our current becomes the first
+             * of the multi candidates. */
+            VTABLE_splice(interp, candidates, possibles, position, 1);
+            current = VTABLE_get_pmc_keyed_int(interp, candidates, position);
+        }
     }
 
-    /* Increment position in candidate list, and we're done. */
-    position++;
+    /* Increment position in candidate list if we're in check mode, and we're done. */
+    if (!check_only)
+        position++;
     SETATTR_P6Invocation_position(interp, SELF, position);
     return current;
 }
@@ -162,23 +169,41 @@ pmclass P6Invocation need_ext dynpmc group perl6_group {
     }
 
     VTABLE INTVAL get_bool() {
-        PMC    *candidates;
+        PMC    *first_candidate, *candidates;
         INTVAL  position;
+
+        /* First, check if we have a first candidate. */
+        GETATTR_P6Invocation_first_candidate(interp, SELF, first_candidate);
+        if (!PMC_IS_NULL(first_candidate))
+            return 1;
 
-        /* Get candidates and position, and check if we have more candidates. */
+        /* Get candidates and position, and check if we have more candidates
+         * already known about. */
         GETATTR_P6Invocation_candidate_list(interp, SELF, candidates);
         GETATTR_P6Invocation_position(interp, SELF, position);
-        return position < VTABLE_elements(interp, candidates);
+        if (!PMC_IS_NULL(candidates) && position < VTABLE_elements(interp, candidates))
+            return 1;
+
+        /* If not, then we see if the dispatcher can potentially find more. */
+        return !PMC_IS_NULL(get_next_candidate(interp, SELF, P6I_MODE_CHECK));
+    }
+
+    VTABLE INTVAL get_integer() {
+        return VTABLE_get_bool(interp, SELF);
     }
 
     VTABLE PMC *get_pmc() {
         PMC *first_candidate;
         PMC *clone = VTABLE_clone(interp, SELF);
         GETATTR_P6Invocation_first_candidate(interp, clone, first_candidate);
         if (PMC_IS_NULL(first_candidate))
-            first_candidate = get_next_candidate(interp, clone);
+            first_candidate = get_next_candidate(interp, clone, P6I_MODE_CHECK);
         return first_candidate;
     }
+
+    VTABLE PMC *get_iter() {
+        return VTABLE_clone(interp, SELF);
+    }
 
     VTABLE opcode_t *invoke(void *next) {
         STRING   *lexname = CONST_STRING(interp, "__CANDIDATE_LIST__");
@@ -190,7 +215,7 @@ pmclass P6Invocation need_ext dynpmc group perl6_group {
          * candidate list next time we're used. */
         GETATTR_P6Invocation_first_candidate(interp, SELF, first_candidate);
         if (PMC_IS_NULL(first_candidate))
-            first_candidate = get_next_candidate(interp, SELF);
+            first_candidate = get_next_candidate(interp, SELF, P6I_MODE_DISPATCH);
         else
             SETATTR_P6Invocation_first_candidate(interp, SELF, PMCNULL);
 
@@ -202,8 +227,24 @@ pmclass P6Invocation need_ext dynpmc group perl6_group {
         return addr;
     }
 
+    VTABLE PMC *shift_pmc() {
+        /* Result is a clone of ourself. We clone ourself rather than handing
+         * back the method so invocations of it that defer will work out. */
+        PMC *result = VTABLE_clone(interp, SELF);
+
+        /* Now shuffle along one candidate. */
+        PMC *first_candidate;
+        GETATTR_P6Invocation_first_candidate(interp, SELF, first_candidate);
+        if (PMC_IS_NULL(first_candidate))
+            get_next_candidate(interp, SELF, P6I_MODE_DISPATCH);
+        else
+            SETATTR_P6Invocation_first_candidate(interp, SELF, PMCNULL);
+
+        return result;
+    }
+
     METHOD PMC *get() {
-        PMC *next = VTABLE_clone(interp, SELF);
-        RETURN(PMC *next);
+        PMC *result = VTABLE_shift_pmc(interp, SELF);
+        RETURN(PMC *result);
     }
 }