Changeset 21663 for perl5

Timestamp:

08/01/08 10:38:42 (4 months ago)

Author:

fglock

Message:

[v6.pm] 0.032

Location:

perl5/Pugs-Compiler-Perl6

Files:

• ChangeLog (modified) (1 diff)
• Makefile.PL (modified) (2 diffs)
• lib/Pugs/Emitter/Perl6/Perl5.pm (modified) (7 diffs)
• lib/Pugs/Runtime/Perl6.pm (modified) (3 diffs)
• lib/Pugs/Runtime/Perl6Prelude.pm (modified) (1 diff)
• lib/v6.pm (modified) (2 diffs)

perl5/Pugs-Compiler-Perl6/ChangeLog

@@ +1 @@
+0.032  2008-08-01
+- pi, Inf, NaN
+- more operators
+- IO fixes
+
 0.031  2008-07-30
 - updated skipped tests

perl5/Pugs-Compiler-Perl6/Makefile.PL

@@ -144 +144 @@
     }
     if ( $out eq 't/spec/S04-statements/do.t' ) {
-        $text = "force_todo(1..8,10..16,20..23);\n" . $text;
+        $text = "force_todo(1..6,10,11,20..22);\n" . $text;  
         # redo works in perl5 blocks
         $text =~ s/^([^\n]*?\; *redo\;)/ok( 0, "redo works in perl5 blocks", :todo ) ; # $1/mg;
@@ -192 +192 @@
 );
 
-clean_files(map {glob File::Spec->catfile('t', ('*') x $_, '*.{t,pm}c')} 0..3);
+clean_files( 't/Test.pmc', map {glob File::Spec->catfile('t', ('*') x $_, '*.{t,pm}c')} 0..3);
 
 &WriteAll;

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

@@ -250 +250 @@
 sub _emit_complex {
     my $n = shift;
-    $n =~ s/i/*i/;
+    $n =~ s/i/*Math::Complex::i/;
     "($n)";
+}
+
+sub _emit_num {
+    my $n = shift;
+    return '$Math::Complex::Inf' if $n eq 'Inf';
+    return '($Math::Complex::Inf - $Math::Complex::Inf)' if $n eq 'NaN';
+    "$n";
 }
 
@@ -296 +303 @@
         if exists $n->{int};
 
-    return $n->{num}
+    return _emit_num( $n->{num} )
         if exists $n->{num};
 
@@ -852 +859 @@
             }
 
-            if (   $subname eq 'any' || $subname eq 'all'  
-                || $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' || $subname eq 'sleep' 
+            if ($subname eq 'readline') {
+                my $param = _emit( $n->{param} );
+                return "Pugs::Runtime::Perl6::IO::readline( $param )";
+            }
+
+            if ($subname eq 'pi') {
+                return "Math::Complex::pi()";
+            }
+
+            if (   $subname eq 'any'    || $subname eq 'all'  
+                || $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'    || $subname eq 'sleep' 
+                || $subname eq 'unlink' || $subname eq 'close'  || $subname eq 'sqrt'
                 ) 
             {
@@ -933 +950 @@
              $n->{method}{dot_bareword} eq 'warn' ) {
             my $s = _emit( $n->{self} );
-            if ( $s eq Pugs::Runtime::Common::mangle_var('$*ERR') ) {
-                return " print STDERR '', " . _emit( $n->{param} );
+            if ( exists $n->{self}{scalar} && $n->{self}{scalar} eq '$*ERR' ) {
+                return " print STDERR " . ( $n->{param} ? _emit( $n->{param} ) : "''" );
+            }
+            if ( exists $n->{self}{scalar} && $n->{self}{scalar} eq '$*OUT' ) {
+                return " print STDOUT " . ( $n->{param} ? _emit( $n->{param} ) : "''" );
+            }
+            if ( exists $n->{self}{scalar} && $n->{self}{scalar} ) {
+                return "$s->print" . emit_parenthesis( $n->{param} );
             }
             return " print '', $s";
@@ -940 +963 @@
         if ( $n->{method}{dot_bareword} eq 'say' ) {
             my $s = _emit( $n->{self} );
-            if ( $s eq Pugs::Runtime::Common::mangle_var('$*ERR') ) {
-                return " print STDERR '', " . _emit( $n->{param} ) . ', "\n"';
+            if ( exists $n->{self}{scalar} && $n->{self}{scalar} eq '$*OUT' ) {
+                return " print STDOUT " . ( $n->{param} ? _emit( $n->{param} ) : "''" ) . ', "\n"';
+            }
+            if ( exists $n->{self}{scalar} && $n->{self}{scalar} eq '$*ERR' ) {
+                return " print STDERR " . ( $n->{param} ? _emit( $n->{param} ) : "''" ) . ', "\n"';
+            }
+            if ( exists $n->{self}{scalar} && $n->{self}{scalar} ) {
+                return "$s->say" . emit_parenthesis( $n->{param} );
             }
             return " print '', $s" . ', "\n"';
@@ -1122 +1151 @@
             $ret .= 'else '. emit_block( $n->{else} ) . "\n";
         }
+        else {
+            $ret .= "else { () }\n";
+        }
         return $ret;
     }
 
     if ( $n->{statement} eq 'do' ) {
-        return 'do { for($_) ' . emit_block( $n->{exp1} ) . ' }';
+        # double braces in 'do' allow for 'next/last'
+        return 'do {{ ' . emit_block( $n->{exp1} ) . ' }}';
     }
     if ( $n->{statement} eq 'given' ) {
@@ -1299 +1332 @@
                 bool->import();  # True, False
                 use Quantum::Superpositions;
-                use Math::Complex;
+                use Math::Complex ();
                 $attributes ";
 

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

@@ -183 +183 @@
         }
     }
+
+    sub readline {
+        my $tmp = $_[0]->getline;
+        chomp( $tmp );
+        $tmp;
+    }
+    
+    sub say {
+        (+shift)->print(@_, "\n");
+    }
     
     sub slurp {
         if ( wantarray ) {
             my @a;
-            if ( ref( $_[0] ) eq 'IO::File' ) {
+            if ( UNIVERSAL::isa( $_[0], 'IO::Handle' ) ) {
                 my $f = shift;
                 @a = <$f>;
@@ -199 +209 @@
         }
 
-            if ( ref( $_[0] ) eq 'IO::File' ) {
+            if ( UNIVERSAL::isa( $_[0], 'IO::Handle' ) ) {
                 return <$_[0]>;
             }
@@ -207 +217 @@
             }
     }
+
+
+package Pugs::Runtime::Perl6::IO::File;
+    use base 'IO::File';
+    use base 'Pugs::Runtime::Perl6::IO';
+
 
 package Pugs::Runtime::Perl6::Routine;

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

@@ -23 +23 @@
 # sub sleep($seconds) is export { use v5; CORE::sleep($seconds); use v6; }
 
-sub open($file, :$w? ) { use v5; my $fh = IO::File->new; $fh->open($file, ($w ? 'w' : ()) ) || warn "can't open file $file"; $fh; use v6; }
+sub open($file, :$w? ) { 
+    use v5; 
+    my $fh = Pugs::Runtime::Perl6::IO::File->new; 
+    $fh->open($file, ($w ? 'w' : ()) ) || warn "can't open file $file"; 
+    $fh; 
+    use v6; 
+}
 
 module Pugs::Internals;

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

@@ -1 +1 @@
 package v6;
-$v6::VERSION = '0.031';
+$v6::VERSION = '0.032';
 
 # Documentation in the __END__
@@ -94 +94 @@
         "use Scalar::Util;
          use Quantum::Superpositions;
-         use Math::Complex;
+         use Math::Complex ();
          use Pugs::Runtime::Perl6;
          use Pugs::Runtime::Perl6Prelude;