Changeset 21543 for perl5

Timestamp:

07/25/08 21:28:49 (4 months ago)

Author:

fglock

Message:

[v6.pm] emitter hacks

Files:

• perl5/Pugs-Compiler-Perl6/lib/Pugs/Emitter/Perl6/Perl5.pm (modified) (3 diffs)

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

@@ -581 +581 @@
 }
 
+sub _is_empty_braces {
+    return 1 if
+           ref($_[0]) eq 'HASH'
+        && exists $_[0]{fixity}
+        && !exists $_[0]{exp1}
+        && $_[0]{fixity} eq 'circumfix'
+        && $_[0]{op1} eq '['
+        && $_[0]{op2} eq ']'
+}
+
+sub _is_empty_exp {
+    return 1 if
+           ref($_[0]) eq 'HASH'
+        && !exists $_[0]{exp1}
+}
+
+sub _is_exp_containing {
+    return 1 if
+           ref($_[0]) eq 'HASH'
+        && exists $_[0]{exp1}
+        && $_[1]->( $_[0]{exp1}, @_[2..$#_] )
+}
+
+sub _is_paren_containing {
+    return 1 if
+           ref($_[0]) eq 'HASH'
+        && exists $_[0]{fixity}
+        && $_[0]{fixity} eq 'circumfix'
+        && $_[0]{op1} eq '('
+        && $_[0]{op2} eq ')'
+        && $_[1]->($_[0], @_[2..$#_] )
+}
+
 sub _emit_closure {
     my ($signature, $block) = @_;
@@ -620 +653 @@
         )
     {
+        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 'call' ) {
             # call;
@@ -786 +829 @@
         no warnings 'uninitialized';
         #warn "method_call: ", Dumper( $n );
+        if ( $n->{method}{dot_bareword} eq 'nextwith' ) {
+            if ( exists $n->{self}{code} ) {
+                my ($sub_name) = $n->{self}{code} =~ /^&(.*)$/;
+                return 'return ' . _emit( {
+                        op1   => 'call',
+                        param => $n->{param},
+                        sub   => { bareword => $sub_name },
+                    } );
+            }
+        }
         if ( $n->{method}{dot_bareword} eq 'print' ||
              $n->{method}{dot_bareword} eq 'warn' ) {