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

[svn:parrot] r33922 - in trunk/languages/perl6/src: builtins classes parser

From:
pmichaud
Date:
December 15, 2008 08:51
Subject:
[svn:parrot] r33922 - in trunk/languages/perl6/src: builtins classes parser
Message ID:
20081215165140.6D538CBA12@x12.develooper.com
Author: pmichaud
Date: Mon Dec 15 08:51:39 2008
New Revision: 33922

Modified:
   trunk/languages/perl6/src/builtins/assign.pir
   trunk/languages/perl6/src/classes/Hash.pir
   trunk/languages/perl6/src/classes/Mapping.pir
   trunk/languages/perl6/src/classes/Object.pir
   trunk/languages/perl6/src/parser/actions.pm

Log:
[rakudo]: Refactor hash construction and assignment.


Modified: trunk/languages/perl6/src/builtins/assign.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/assign.pir	(original)
+++ trunk/languages/perl6/src/builtins/assign.pir	Mon Dec 15 08:51:39 2008
@@ -64,9 +64,7 @@
     .tailcall 'infix:='(cont, source)
 
   cont_hash:
-    $P0 = source.'hash'()
-    copy cont, $P0
-    .return (cont)
+    .tailcall cont.'!STORE'(source)
 .end
 
 
@@ -126,7 +124,7 @@
     goto assign_loop
   assign_array:
   assign_hash:
-    'infix:='(cont, slist)
+    cont.'!STORE'(slist)
     slist = new 'Nil'
     goto assign_loop
   assign_done:

Modified: trunk/languages/perl6/src/classes/Hash.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Hash.pir	(original)
+++ trunk/languages/perl6/src/classes/Hash.pir	Mon Dec 15 08:51:39 2008
@@ -4,14 +4,9 @@
 
 src/classes/Hash.pir - Perl 6 Hash class and related functions
 
-=head2 Object Methods
-
-=over 4
-
 =cut
 
 .namespace []
-
 .sub 'onload' :anon :load :init
     .local pmc p6meta, hashproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
@@ -19,29 +14,30 @@
     hashproto.'!MUTABLE'()
 .end
 
-=item ACCEPTS()
+=head2 Methods
+
+=over 4
 
 =cut
 
-.sub 'hash'
-    .param pmc args            :slurpy
-    .param pmc hash            :slurpy :named
-    args.'!flatten'()
-    unless hash goto hash_done
-    unshift args, hash
-  hash_done:
-    .tailcall args.'hash'()
-.end
+=item ACCEPTS()
 
+=cut
 
 .namespace ['Perl6Hash']
-
 .sub 'ACCEPTS' :method
     .param pmc topic
     .tailcall self.'contains'(topic)
 .end
 
+.namespace ['Perl6Hash']
+.sub 'contains' :method
+    .param pmc key
+    $I0 = exists self[key]
+    .return( $I0 )
+.end
 
+.namespace ['Perl6Hash']
 .sub 'delete' :method
     .param pmc keys :slurpy
     .local pmc result
@@ -49,7 +45,6 @@
     .local pmc tmp
     result = new 'List'
     keys.'!flatten'()
-
   keys_loop:
     unless keys goto done
     key = shift keys
@@ -57,29 +52,109 @@
     push result, tmp
     delete self[key]
     goto keys_loop
-
   done:
     .return (result)
 .end
 
+.namespace ['Perl6Hash']
+.sub 'exists' :method
+    .param pmc key
+    $I0 = exists self[key]
+    .return( $I0 )
+.end
+
+.namespace ['Perl6Hash']
 .sub 'hash' :method
     .return (self)
 .end
 
-.sub 'exists' :method
-    .param pmc key
+.namespace ['Perl6Hash']
+.sub 'Hash' :method
+    .return (self)
+.end
 
-    $I0 = exists self[key]
-    .return( $I0 )
+=back
+
+=head2 Operators
+
+=over
+
+=item circumfix:<{ }>
+
+Create a Hash (hashref).
+
+=cut
+
+.namespace []
+.sub 'circumfix:{ }'
+    .param pmc values :slurpy
+    $P0 = values.'Hash'()
+    $P0 = new 'ObjectRef', $P0
+    .return ($P0)
 .end
 
-.sub 'contains' :method
-    .param pmc key
+=back
 
-    $I0 = exists self[key]
-    .return( $I0 )
+=head2 Private methods
+
+=over
+
+=item !STORE
+
+Store a value into a hash.
+
+=cut
+
+.namespace ['Perl6Hash']
+.sub '!STORE' :method
+    .param pmc source
+    ## we create a new hash here instead of emptying self in case
+    ## the source argument contains self or elements of self.
+    .local pmc hash, it
+    hash = new 'Perl6Hash'
+    source = 'list'(source)
+    it = iter source
+  iter_loop:
+    unless it goto iter_done
+    .local pmc elem, key, value
+    elem = shift it
+    $I0 = does elem, 'hash'
+    if $I0 goto iter_hash
+    $I0 = isa elem, 'Perl6Pair'
+    if $I0 goto iter_pair
+    unless it goto err_odd_list
+    key = elem
+    value = shift it
+    goto iter_kv
+  iter_pair:
+    key = elem.'key'()
+    value = elem.'value'()
+  iter_kv:
+    value = 'Scalar'(value)
+    hash[key] = value
+    goto iter_loop
+  iter_hash:
+    .local pmc hashiter
+    hashiter = iter elem
+  hashiter_loop:
+    unless hashiter goto hashiter_done
+    $S0 = shift hashiter
+    value = elem[$S0]
+    value = 'Scalar'(value)
+    value = clone value
+    hash[$S0] = value
+    goto hashiter_loop
+  hashiter_done:
+    goto iter_loop
+  iter_done:
+    copy self, hash
+    .return (self)
+
+  err_odd_list:
+    die "Odd number of elements found where hash expected"
 .end
 
+
 =back
 
 =cut

Modified: trunk/languages/perl6/src/classes/Mapping.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Mapping.pir	(original)
+++ trunk/languages/perl6/src/classes/Mapping.pir	Mon Dec 15 08:51:39 2008
@@ -24,29 +24,16 @@
 
 =item Scalar
 
-When we're going to be stored as an item, become a Hash and then return
-ourself in a ObjectRef.
+When we're going to be stored as an item, become a Hash and 
+return an ObjectRef to it.
 
 =cut
 
+.namespace ['Mapping']
 .sub 'Scalar' :method
-    # Create a hash with our values.
-    .local pmc hash, it
-    hash = get_hll_global "Hash"
-    hash = hash.'new'()
-    it = iter self
-  it_loop:
-    unless it goto it_loop_end
-    $P0 = shift it
-    $P1 = self[$P0]
-    hash[$P0] = $P1
-    goto it_loop
-  it_loop_end:
-
-    # Wrap it up in an object ref and return it.
-    .local pmc ref
-    ref = new 'ObjectRef', hash
-    .return (ref)
+    $P0 = self.'Hash'()
+    $P0 = new 'ObjectRef', $P0
+    .return ($P0)
 .end
 
 

Modified: trunk/languages/perl6/src/classes/Object.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Object.pir	(original)
+++ trunk/languages/perl6/src/classes/Object.pir	Mon Dec 15 08:51:39 2008
@@ -43,14 +43,19 @@
 
 =item hash
 
-Return invocant in hash context.  Default is to build a Hash from C<.list>.
+Return invocant in hash context.
 
 =cut
 
 .namespace ['Perl6Object']
 .sub 'hash' :method
-    $P0 = self.'list'()
-    .tailcall $P0.'hash'()
+    .tailcall self.'Hash'()
+.end
+
+.namespace []
+.sub 'hash'
+    .param pmc values :slurpy
+    .tailcall values.'Hash'()
 .end
 
 =item item
@@ -144,6 +149,17 @@
     .return ($P0)
 .end
 
+=item Hash()
+
+=cut
+
+.namespace ['Perl6Object']
+.sub 'Hash' :method
+    $P0 = new 'Perl6Hash'
+    $P0.'!STORE'(self)
+    .return ($P0)
+.end
+
 =item Iterator()
 
 =cut

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm	(original)
+++ trunk/languages/perl6/src/parser/actions.pm	Mon Dec 15 08:51:39 2008
@@ -2639,7 +2639,7 @@
             my @children := @($past[1]);
             $past := PAST::Op.new(
                 :pasttype('call'),
-                :name('hash'),
+                :name('circumfix:{ }'),
                 :node($/)
             );
             for @children {



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