Changeset 21546 for perl5

Timestamp:

07/25/08 23:52:06 (4 months ago)

Author:

fglock

Message:

[v6.pm] emitter fixes

Location:

perl5/Pugs-Compiler-Perl6/lib/Pugs

Files:

• Emitter/Perl6/Perl5.pm (modified) (4 diffs)
• Runtime/Perl6.pm (modified) (1 diff)

perl5/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm

@@ -408 +408 @@
 }
 
+sub _emit_array_index {
+    my $n = shift;
+    if (   ref($n) eq 'HASH' 
+        && exists $n->{op1}
+        && $n->{op1} eq '*'
+        && $n->{fixity} eq 'prefix'
+        ) 
+    {
+        return _emit( $n->{exp1} );
+    }
+    return _emit( $n );
+}
+
 sub _emit_parameter_signature {
     my $n = $_[0] or return '';
@@ -653 +666 @@
         )
     {
-        if (    $n->{sub}{bareword} eq 'push'
-             && $n->{op1} eq 'call'
-             && (  _is_paren_containing($n->{param}, \&_is_empty_exp)
-                || _is_paren_containing($n->{param}, \&_is_exp_containing, \&_is_empty_braces )
-                )
-            ) 
-        {
-            return _not_implemented( "push without parameters", "call" );
+        if ( $n->{sub}{bareword} eq 'push' && $n->{op1} eq 'call' ) {
+            if ( _is_paren_containing($n->{param}, \&_is_empty_exp) ) {
+                return _not_implemented( "push without parameters", "call" );
+            }
+            if ( _is_paren_containing($n->{param}, \&_is_exp_containing, \&_is_empty_braces ) ) {
+                return " # push( [] ) ??? \n";   # See: push.t
+            }
         }
 
@@ -771 +783 @@
             }
 
-            if ($subname eq 'substr' || $subname eq 'split' || $subname eq 'die' || $subname eq 'return' || $subname eq 'push' || $subname eq 'shift' || $subname eq 'join' || $subname eq 'index' || $subname eq 'undef' || $subname eq 'rand' || $subname eq 'int' || $subname eq 'splice' || $subname eq 'keys' || $subname eq 'values' || $subname eq 'sort' || $subname eq 'chomp' || $subname eq 'lc' || $subname eq 'abs' ) {
+            if ($subname eq 'substr' || $subname eq 'split' || $subname eq 'die' || $subname eq 'return' || $subname eq 'push' || $subname eq 'pop' || $subname eq 'shift' || $subname eq 'join' || $subname eq 'index' || $subname eq 'undef' || $subname eq 'rand' || $subname eq 'int' || $subname eq 'splice' || $subname eq 'keys' || $subname eq 'values' || $subname eq 'sort' || $subname eq 'chomp' || $subname eq 'lc' || $subname eq 'abs' ) {
                 return $subname . emit_parenthesis( $n->{param} );
             }
@@ -1644 +1656 @@
                        )
                        ;
-            return $name . '[' . _emit( $n->{exp2} ) . ']';
-        }
-
-        return _emit( $n->{exp1} ) . '->[' . _emit( $n->{exp2} ) . ']';
+            return $name . '[' . _emit_array_index( $n->{exp2} ) . ']';
+        }
+
+        return _emit( $n->{exp1} ) . '->[' . _emit_array_index( $n->{exp2} ) . ']';
     }
 

perl5/Pugs-Compiler-Perl6/lib/Pugs/Runtime/Perl6.pm

@@ -246 +246 @@
     use Scalar::Util qw(looks_like_number);
     
+    sub elems {
+        return scalar @{$_[0]} if ref($_[0]) eq 'ARRAY';
+        return 1;
+    }
+    
     sub perl {
         local $Data::Dumper::Terse    = 1;