Changeset 21564

Timestamp:

07/27/08 10:41:54 (6 months ago)

Author:

fglock

Message:

[v6.pm] added all(), any(), true(), not()

Location:

perl5/Pugs-Compiler-Perl6

Files:

• ChangeLog (modified) (1 diff)
• Makefile.PL (modified) (1 diff)
• lib/Pugs/Emitter/Perl6/Perl5.pm (modified) (5 diffs)
• lib/Pugs/Grammar/Prefix.pm (modified) (2 diffs)
• lib/v6.pm (modified) (2 diffs)

perl5/Pugs-Compiler-Perl6/ChangeLog

@@ +1 @@
+- all(), any(), true(), not()
+
 0.027  2008-07-25
 - more unicode tests are skipped

perl5/Pugs-Compiler-Perl6/Makefile.PL

@@ -23 +23 @@
 requires('Module::Compile'      => '0.20');
 requires('Scalar::Util'         => '0');
+requires('Quantum::Superpositions' => '0');
 requires('Devel::Caller'        => '0.10');
 requires('Data::Bind'           => '0.28');

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

@@ -787 +787 @@
             }
 
-            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' ) {
+            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' 
+                ) 
+            {
                 return $subname . emit_parenthesis( $n->{param} );
             }
@@ -1220 +1227 @@
                 our \@EXPORT;
                 bool->import();  # True, False
+                use Quantum::Superpositions;
                 $attributes ";
 
@@ -1583 +1591 @@
     }
     
+    if ( $n->{op1} eq '|' ) {
+        return 'any(' . _emit( $n->{exp1} ) . ', ' . _emit( $n->{exp2} ) . ')';
+    }
+
     return '(' . _emit( $n->{exp1} ) . ' ' .
         $n->{op1} . ' ' . _emit( $n->{exp2} ) . ')';
@@ -1798 +1810 @@
         return ' "" . ' . _emit( $n->{exp1} );
     }
-    if ( $n->{op1} eq '!' ) {
+    if ( $n->{op1} eq '!' || $n->{op1} eq 'not' ) {
         return _emit( $n->{exp1} ) . ' ? 0 : 1 ';
     }
@@ -1817 +1829 @@
     }
 
-    if ($n->{op1} eq '?') { # bool
-        return '('._emit($n->{exp1}).' ? 1 : 0 )';
+    if ($n->{op1} eq '?' || $n->{op1} eq 'true') { # bool
+        return '(' . _emit($n->{exp1}) . ' ? 1 : 0 )';
     }
 

perl5/Pugs-Compiler-Perl6/lib/Pugs/Grammar/Prefix.pm

@@ -47 +47 @@
     );
     __PACKAGE__->add_same_precedence_ops( { assoc => 'left'}, 'prefix:<+>', qw(
-        - ? ~ | @ % $ & ! * : = \\
+        - ? ~ | @ % $ & ! * : = \\ 
     ) );
     __PACKAGE__->add_rule( 
@@ -68 +68 @@
         other => 'infix:<+>',
     );
+    __PACKAGE__->add_rule( 
+        name => 'true',
+        assoc => 'left',
+        precedence => 'looser',
+        other => 'infix:<eq>',
+    );
+    __PACKAGE__->add_rule( 
+        name => 'not',
+        assoc => 'left',
+        precedence => 'equal',
+        other => 'prefix:<true>',
+    );
 
     __PACKAGE__->recompile;

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

@@ -93 +93 @@
         ) : '').
         "use Scalar::Util;
+         use Quantum::Superpositions;
          use Pugs::Runtime::Perl6;
          use Pugs::Runtime::Perl6Prelude;
@@ -106 +107 @@
          my \%_V6_PAD;
          our \%_V6_STATE;
+         bool->import();  # True, False
         " .  
         # "Pugs::Runtime::Perl6Prelude->import();\n" .   # XXX - is import() needed?