[svn:parrot] r46785 - in trunk: compilers/pct/src/PAST compilers/pct/src/POST t/compilers/pct

[bacek at svn.parrot.org]

Author: bacek
Date: Wed May 19 09:59:54 2010
New Revision: 46785
URL: https://trac.parrot.org/parrot/changeset/46785

Log:
Merge branch 'pct_multi_support' into trunk

Modified:
   trunk/compilers/pct/src/PAST/Compiler.pir
   trunk/compilers/pct/src/PAST/Node.pir
   trunk/compilers/pct/src/POST/Compiler.pir
   trunk/compilers/pct/src/POST/Node.pir
   trunk/t/compilers/pct/post.t

Modified: trunk/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Compiler.pir	Wed May 19 09:22:39 2010	(r46784)
+++ trunk/compilers/pct/src/PAST/Compiler.pir	Wed May 19 09:59:54 2010	(r46785)
@@ -791,7 +791,7 @@
     unshift blockpast, node
 
     .local string name, pirflags, blocktype
-    .local pmc nsentry, subid, ns, hll
+    .local pmc nsentry, subid, ns, hll, multi
     name = node.'name'()
     pirflags = node.'pirflags'()
     blocktype = node.'blocktype'()
@@ -799,6 +799,7 @@
     subid = node.'subid'()
     ns = node.'namespace'()
     hll = node.'hll'()
+    multi = node.'multi'()
 
     ##  handle nsentry attribute
     $I0 = defined nsentry
@@ -824,7 +825,7 @@
     ##  create a POST::Sub node for this block
     .local pmc bpost
     $P0 = get_hll_global ['POST'], 'Sub'
-    bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype, 'namespace'=>ns, 'hll'=>hll, 'subid'=>subid)
+    bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype, 'namespace'=>ns, 'hll'=>hll, 'subid'=>subid, 'multi'=>multi)
     unless pirflags goto pirflags_done
     bpost.'pirflags'(pirflags)
   pirflags_done:

Modified: trunk/compilers/pct/src/PAST/Node.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Node.pir	Wed May 19 09:22:39 2010	(r46784)
+++ trunk/compilers/pct/src/PAST/Node.pir	Wed May 19 09:59:54 2010	(r46785)
@@ -286,6 +286,18 @@
     .tailcall self.'attr'('vivibase', value, has_value)
 .end
 
+=item multitype([type])
+
+Get/set MMD type of Var when used as parameter of Block.
+
+=cut
+
+.sub 'multitype' :method
+    .param pmc value           :optional
+    .param int has_value       :opt_flag
+    .tailcall self.'attr'('multitype', value, has_value)
+.end
+
 
 =back
 
@@ -570,6 +582,19 @@
     .tailcall self.'attr'('namespace', value, has_value)
 .end
 
+=item multi([multi])
+
+Get/set the multi signature for this block.  The C<multi> argument
+can be either a string or an array of strings.
+
+=cut
+
+.sub 'multi' :method
+    .param pmc value           :optional
+    .param int has_value       :opt_flag
+    .tailcall self.'attr'('multi', value, has_value)
+.end
+
 
 =item hll([hll])
 

Modified: trunk/compilers/pct/src/POST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/POST/Compiler.pir	Wed May 19 09:22:39 2010	(r46784)
+++ trunk/compilers/pct/src/POST/Compiler.pir	Wed May 19 09:59:54 2010	(r46785)
@@ -321,6 +321,30 @@
     set_global '$?NAMESPACE', ns
     nskey = self.'key_pir'(ns)
 
+    .local pmc multi
+    multi = node.'multi'()
+    unless multi goto no_multi
+
+    .local pmc parts, m_iter
+    parts  = new ['ResizableStringArray']
+    m_iter = iter multi
+  multi_iter:
+    unless m_iter goto multi_iter_done
+    $P0 = shift m_iter
+    $S0 = $P0
+    if $S0 == "_" goto push_part
+    $S0 = self.'key_pir'($P0)
+  push_part:
+    push parts, $S0
+    goto multi_iter
+
+  multi_iter_done:
+    pirflags = concat pirflags, ' :multi('
+    $S0 = join ',', parts
+    pirflags = concat pirflags, $S0
+    pirflags = concat pirflags, ')'
+  no_multi:
+
   subpir_start:
     $P0 = node['loadinit']
     if null $P0 goto loadinit_done

Modified: trunk/compilers/pct/src/POST/Node.pir
==============================================================================
--- trunk/compilers/pct/src/POST/Node.pir	Wed May 19 09:22:39 2010	(r46784)
+++ trunk/compilers/pct/src/POST/Node.pir	Wed May 19 09:59:54 2010	(r46785)
@@ -204,6 +204,12 @@
     .tailcall self.'attr'('outer', value, has_value)
 .end
 
+.sub 'multi' :method
+    .param pmc value           :optional
+    .param int has_value       :opt_flag
+    .tailcall self.'attr'('multi', value, has_value)
+.end
+
 
 .sub 'subid' :method
     .param pmc value           :optional

Modified: trunk/t/compilers/pct/post.t
==============================================================================
--- trunk/t/compilers/pct/post.t	Wed May 19 09:22:39 2010	(r46784)
+++ trunk/t/compilers/pct/post.t	Wed May 19 09:59:54 2010	(r46785)
@@ -6,7 +6,7 @@
 use strict;
 use warnings;
 use lib qw(t . lib ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 7;
 
 foreach my $name (qw(Op Ops Sub Label)) {
     my $module = "'POST';'$name'";
@@ -83,6 +83,37 @@
 }
 OUT
 
+pir_output_is( <<'CODE', <<'OUT', 'Generate :multi' );
+.sub _main
+    load_bytecode 'PCT.pbc'
+    load_bytecode 'dumper.pbc'
+    .local pmc node
+    node = new ['POST';'Sub']
+    node.'name'('foo')
+    $P0 = new ['ResizablePMCArray']
+    push $P0, "_"
+    push $P0, "Foo"
+    $P1 = new ['ResizableStringArray']
+    push $P1, "Bar"
+    push $P1, "Baz"
+    push $P0, $P1
+    node.'multi'($P0)
+
+    .local pmc compiler
+    compiler = new ['POST';'Compiler']
+    $S0 = compiler.'to_pir'(node)
+    say $S0
+    .return ()
+.end
+CODE
+
+.namespace []
+.sub "foo"  :subid("post10") :multi(_,["Foo"],["Bar";"Baz"])
+.end
+
+
+OUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4