develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33646 - in branches/assign: . languages/perl6/config/makefiles languages/perl6/src/builtins languages/perl6/src/classes languages/perl6/src/parser

From:
pmichaud
Date:
December 7, 2008 22:36
Subject:
[svn:parrot] r33646 - in branches/assign: . languages/perl6/config/makefiles languages/perl6/src/builtins languages/perl6/src/classes languages/perl6/src/parser
Message ID:
20081208063621.3A651CB9AF@x12.develooper.com
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') {...}



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About