Author: pmichaud
Date: Sun Dec 7 22:36:20 2008
New Revision: 33646
Added:
branches/assign/languages/perl6/src/classes/Nil.pir (contents, props
changed)
Modified:
branches/assign/MANIFEST
branches/assign/languages/perl6/config/makefiles/root.in
branches/assign/languages/perl6/src/builtins/assign.pir
branches/assign/languages/perl6/src/classes/List.pir
branches/assign/languages/perl6/src/parser/grammar-oper.pg
Log:
[rakudo]: First cut at list assignment.
Modified: branches/assign/MANIFEST
==============================================================================
--- branches/assign/MANIFEST (original)
+++ branches/assign/MANIFEST Sun Dec 7 22:36:20 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Mon Dec 8 03:44:20 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Dec 8 06:34:03 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2144,6 +2144,7 @@
languages/perl6/src/classes/Match.pir [perl6]
languages/perl6/src/classes/Method.pir [perl6]
languages/perl6/src/classes/Module.pir [perl6]
+languages/perl6/src/classes/Nil.pir [perl6]
languages/perl6/src/classes/Num.pir [perl6]
languages/perl6/src/classes/Object.pir [perl6]
languages/perl6/src/classes/Order.pir [perl6]
Modified: branches/assign/languages/perl6/config/makefiles/root.in
==============================================================================
--- branches/assign/languages/perl6/config/makefiles/root.in (original)
+++ branches/assign/languages/perl6/config/makefiles/root.in Sun Dec 7
22:36:20 2008
@@ -72,6 +72,7 @@
src/classes/Method.pir \
src/classes/Junction.pir \
src/classes/Failure.pir \
+ src/classes/Nil.pir \
src/classes/Role.pir \
src/classes/Pair.pir \
src/classes/Whatever.pir \
@@ -133,7 +134,7 @@
$(PARROT) $(PARROT_ARGS) $(NQP) --output=src/gen_actions.pir \
--encoding=fixed_8 --target=pir src/parser/actions.pm
-src/gen_builtins.pir: build/gen_builtins_pir.pl
+src/gen_builtins.pir: build/gen_builtins_pir.pl Makefile
$(PERL) build/gen_builtins_pir.pl $(BUILTINS_PIR) > src/gen_builtins.pir
src/gen_metaop.pir: build/gen_metaop_pir.pl
Modified: branches/assign/languages/perl6/src/builtins/assign.pir
==============================================================================
--- branches/assign/languages/perl6/src/builtins/assign.pir (original)
+++ branches/assign/languages/perl6/src/builtins/assign.pir Sun Dec 7
22:36:20 2008
@@ -94,6 +94,70 @@
.end
+.sub 'infix:=' :multi(['List'], _)
+ .param pmc list
+ .param pmc source
+
+ ## get the list of containers and sources
+ source = source.'list'()
+ source.'!flatten'()
+
+ ## first, temporarily mark each container with a property
+ ## so we can clone it in source if needed
+ .local pmc it, true
+ it = iter list
+ true = box 1
+ mark_loop:
+ unless it goto mark_done
+ $P0 = shift it
+ setprop $P0, 'target', true
+ goto mark_loop
+ mark_done:
+
+ ## now build our 'real' source list, cloning any targets we encounter
+ .local pmc slist
+ slist = new 'List'
+ it = iter source
+ source_loop:
+ unless it goto source_done
+ $P0 = shift it
+ $P1 = getprop 'target', $P0
+ if null $P1 goto source_next
+ $P0 = clone $P0
+ source_next:
+ push slist, $P0
+ goto source_loop
+ source_done:
+
+ ## now perform the assignments, clearing targets as we go
+ .local pmc pmcnull
+ null pmcnull
+ it = iter list
+ assign_loop:
+ unless it goto assign_done
+ .local pmc cont
+ cont = shift it
+ setprop cont, 'target', pmcnull
+ $I0 = isa cont, 'ObjectRef'
+ if $I0 goto assign_scalar
+ $I0 = isa cont, 'Perl6Array'
+ if $I0 goto assign_array
+ $I0 = isa cont, 'Perl6Hash'
+ if $I0 goto assign_hash
+ assign_scalar:
+ $P0 = shift slist
+ 'infix:='(cont, $P0)
+ goto assign_loop
+ assign_array:
+ assign_hash:
+ 'infix:='(cont, slist)
+ slist = new 'Nil'
+ goto assign_loop
+ assign_done:
+ .return (list)
+.end
+
+
.sub '!REDUCEMETAOP'
.param string opname
.param pmc identity
Modified: branches/assign/languages/perl6/src/classes/List.pir
==============================================================================
--- branches/assign/languages/perl6/src/classes/List.pir (original)
+++ branches/assign/languages/perl6/src/classes/List.pir Sun Dec 7
22:36:20 2008
@@ -695,7 +695,7 @@
.namespace []
.sub 'list'
.param pmc values :slurpy
- .tailcall values.'!flatten'()
+ .tailcall values.'list'()
.end
=item C<infix:,(...)>
@@ -706,7 +706,7 @@
.sub 'infix:,'
.param pmc args :slurpy
- .tailcall args.'!flatten'()
+ .tailcall args.'list'()
.end
Added: branches/assign/languages/perl6/src/classes/Nil.pir
==============================================================================
--- (empty file)
+++ branches/assign/languages/perl6/src/classes/Nil.pir Sun Dec 7 22:36:20 2008
@@ -0,0 +1,69 @@
+## $Id$
+
+=head1 NAME
+
+src/classes/Nil.pir - Nil objects
+
+=head1 DESCRIPTION
+
+=cut
+
+.namespace []
+
+.sub '' :anon :load :init
+ .local pmc p6meta, nilproto
+ p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+ nilproto = p6meta.'new_class'('Nil', 'parent'=>'Failure')
+.end
+
+=head2 Context methods
+
+=over
+
+=item 'list'
+
+=cut
+
+.namespace ['Nil']
+.sub 'list' :method
+ $P0 = new 'List'
+ .return ($P0)
+.end
+
+=back
+
+=head2 Coercion methods
+
+=over
+
+=item Scalar
+
+=cut
+
+.sub 'Scalar' :method
+ $P0 = new 'Failure'
+ .return ($P0)
+.end
+
+=back
+
+=head2 Methods
+
+=item 'shift'
+
+=cut
+
+.sub 'shift' :method :vtable('shift_pmc')
+ .return (self)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Modified: branches/assign/languages/perl6/src/parser/grammar-oper.pg
==============================================================================
--- branches/assign/languages/perl6/src/parser/grammar-oper.pg (original)
+++ branches/assign/languages/perl6/src/parser/grammar-oper.pg Sun Dec 7
22:36:20 2008
@@ -167,7 +167,6 @@
# is pasttype('copy')
is pasttype('call')
is assoc('right')
- is lvalue(1)
{ ... }
proto prefix:<[,]> is precedence('e=') is subname('list') {...}
proto prefix:<[&]> is equiv(prefix:<[,]>) is subname('all') {...}
