Add a way to mark a block as having a custom arguments processor, and compile it to a :call_sig usage on Parrot.

Author: jnthn

src/QAST/Block.nqp

@@ -1,11 +1,13 @@
 class QAST::Block is QAST::Node {
     has str $!blocktype;
     has int $!lexical;
+    has int $!custom_args;
     has str $!cuid;
     has %!symbol;
 
-    method blocktype(*@value) { $!blocktype := @value[0] if @value; $!blocktype }
-    method lexical(*@value)   { $!lexical := @value[0] if @value; $!lexical }
+    method blocktype(*@value)   { $!blocktype := @value[0] if @value; $!blocktype }
+    method lexical(*@value)     { $!lexical := @value[0] if @value; $!lexical }
+    method custom_args(*@value) { $!custom_args := @value[0] if @value; $!custom_args }
 
     my $cur_cuid := 0;
     my $cuid_suffix := ~nqp::time_n();

src/QAST/Compiler.nqp

@@ -269,33 +269,38 @@ class QAST::Compiler is HLL::Compiler {
             # Generate parameter handling code.
             my $decls := self.post_new('Ops');
             my %lex_params;
-            for $block.params {
-                my @param := ['.param'];
-                
-                if $_.scope eq 'local'{
-                    nqp::push(@param, $block.local_type_long($_.name));
-                    nqp::push(@param, $_.name);
-                }
-                else {
-                    my $reg := $block.lex_reg($_.name);
-                    nqp::push(@param, $block.lexical_type_long($_.name));
-                    nqp::push(@param, $reg);
-                    %lex_params{$_.name} := $reg;
-                }
-                
-                if $_.slurpy {
-                    nqp::push(@param, ':slurpy');
-                    if $_.named {
-                        nqp::push(@param, ':named');
+            if $node.custom_args {
+                $decls.push_pirop('.param pmc CALL_SIG :call_sig');
+            }
+            else {
+                for $block.params {
+                    my @param := ['.param'];
+                    
+                    if $_.scope eq 'local'{
+                        nqp::push(@param, $block.local_type_long($_.name));
+                        nqp::push(@param, $_.name);
                     }
+                    else {
+                        my $reg := $block.lex_reg($_.name);
+                        nqp::push(@param, $block.lexical_type_long($_.name));
+                        nqp::push(@param, $reg);
+                        %lex_params{$_.name} := $reg;
+                    }
+                    
+                    if $_.slurpy {
+                        nqp::push(@param, ':slurpy');
+                        if $_.named {
+                            nqp::push(@param, ':named');
+                        }
+                    }
+                    elsif $_.named {
+                        nqp::push(@param, ':named(' ~ self.escape($_.named) ~ ')');
+                    }
+                    
+                    $decls.push_pirop(pir::join(' ', @param));
                 }
-                elsif $_.named {
-                    nqp::push(@param, ':named(' ~ self.escape($_.named) ~ ')');
-                }
-                
-                $decls.push_pirop(pir::join(' ', @param));
             }
-            
+
             # Generate declarations.
             for $block.lexicals {
                 $decls.push_pirop('.lex ' ~ self.escape($_.name) ~ ', ' ~ $block.lex_reg($_.name));