[svn:parrot] r35754 - trunk/languages/perl6/src/classes

Author: jonathan
Date: Mon Jan 19 06:32:30 2009
New Revision: 35754

Modified:
   trunk/languages/perl6/src/classes/Junction.pir
   trunk/languages/perl6/src/classes/Signature.pir

Log:
[rakudo] Handling of junction auto-threading for the single dispatch case with positional arguments. Note that it won't work for built-ins written in PIR; those will start working when we switch to a PIR prelude.

Modified: trunk/languages/perl6/src/classes/Junction.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Junction.pir	(original)
+++ trunk/languages/perl6/src/classes/Junction.pir	Mon Jan 19 06:32:30 2009
@@ -222,6 +222,13 @@
     .return (junc)
 .end
 
+
+=item !DISPATCH_JUNCTION
+
+Does a junctional dispatch. XXX Needs to support named args.
+
+=cut
+
 .sub '!DISPATCH_JUNCTION'
     .param pmc the_sub
     .param pmc args            :slurpy
@@ -284,6 +291,68 @@
     .tailcall '!MAKE_JUNCTION'(type, results)
 .end
 
+
+=item !DISPATCH_JUNCTION_SINGLE
+
+Wrapper for junction dispatcher in the single dispatch case, where we are
+passed the sub that is being called along with a way to build tuples of the
+parameters for the dispatcher.
+
+=cut
+
+.sub '!DISPATCH_JUNCTION_SINGLE'
+    .param pmc sub
+    .param pmc lexpad
+    .param pmc signature
+
+    # We build tuples of the args and pass them onto the main junction
+    # dispatcher.
+    .local pmc pos_args, name_args, it, param
+    pos_args = new ['ResizablePMCArray']
+    name_args = new ['Hash']
+    $P0 = signature.'params'()
+    it = iter $P0
+  param_loop:
+    unless it goto param_loop_end
+    .local pmc param
+    param = shift it
+    .local string name
+    .local pmc named, value
+    name = param['name']
+    named = param['named']
+    value = lexpad[name]
+    if null named goto pos_arg
+    name_args[named] = value
+    goto param_loop
+  pos_arg:
+    push pos_args, value
+    goto param_loop
+  param_loop_end:
+
+    .tailcall '!DISPATCH_JUNCTION'(sub, pos_args :flat, name_args :flat :named)
+.end
+
+
+=item !DISPATCH_JUNCTION_MULTI
+
+Wrapper for junction dispatcher in the multi dispatch case. Here we are handed
+back as the thingy to call in place of a candidate, and PCC doesn't give us an
+easy way to unshift another argument into the call, so we have it attached as
+a property.
+
+=cut
+
+.sub '!DISPATCH_JUNCTION_MULTI'
+    .param pmc pos_args  :slurpy
+    .param pmc name_args :slurpy :named
+    .local pmc pi, sub
+    pi = new 'ParrotInterpreter'
+    sub = pi['sub']
+    sub = getprop 'sub', sub
+    .tailcall '!DISPATCH_JUNCTION'(sub, pos_args :flat, name_args :flat)
+.end
+
+
 =head2 Functions
 
 =over 4

Modified: trunk/languages/perl6/src/classes/Signature.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Signature.pir	(original)
+++ trunk/languages/perl6/src/classes/Signature.pir	Mon Jan 19 06:32:30 2009
@@ -70,7 +70,11 @@
     constraints = 'list'()
     type = null
     cur_list = attr["type"]
-    if null cur_list goto cur_list_loop_end
+    unless null cur_list goto have_type_attr
+    $P0 = get_hll_global 'Any'
+    cur_list = 'all'($P0)
+    attr["type"] = cur_list
+  have_type_attr:
     cur_list = cur_list.'!eigenstates'()
     cur_list_iter = iter cur_list
   cur_list_loop:
@@ -255,7 +259,7 @@
     .return (s)
 .end
 
-=item !BIND_SIGNATURE
+=item !SIGNATURE_BIND
 
 Analyze the signature of the caller, (re)binding the caller's
 lexicals as needed and performing type checks.
@@ -341,6 +345,12 @@
     .return ()
 
   err_param_type:
+    # Is it a junctional parameter?
+    $I0 = isa var, 'Junction'
+    unless $I0 goto not_junctional
+    $P0 = '!DISPATCH_JUNCTION_SINGLE'(callersub, callerlex, callersig)
+    'return'($P0)
+  not_junctional:
     .local string errmsg
     errmsg = 'Parameter type check failed'
     goto err_throw