Merge branch 'master' of git@github.com:rakudo/rakudo

rakudo · Aug 27, 2009 · 93cd932 · 93cd932
2 parents 9976deb + 32e9d79
commit 93cd932
Show file tree

Hide file tree

Showing 9 changed files with 175 additions and 126 deletions.
diff --git a/build/Makefile.in b/build/Makefile.in
@@ -146,6 +146,7 @@ SETTING = \
   src/setting/Bool.pm \
   src/setting/Buf.pm \
   src/setting/Code.pm \
+  src/setting/Complex.pm \
   src/setting/Hash.pm \
   src/setting/Int.pm \
   src/setting/IO.pm \

diff --git a/build/gen_junction_pir.pl b/build/gen_junction_pir.pl
@@ -8,7 +8,6 @@
 my @binary = qw(
   infix:**
   infix:* infix:/ infix:% infix:div infix:mod
-  infix:+ infix:-
   infix:~
   infix:== infix:!= infix:<  infix:>  infix:<= infix:>=
   infix:eq infix:ne infix:lt infix:gt infix:le infix:ge

diff --git a/build/gen_whatever_pir.pl b/build/gen_whatever_pir.pl
@@ -6,7 +6,7 @@
 use warnings;
 
 my @ops = qw(
-  infix:** infix:* infix:/ infix:% infix:div infix:mod infix:+ infix:-
+  infix:** infix:* infix:/ infix:% infix:div infix:mod
   infix:== infix:!= infix:<  infix:>  infix:<= infix:>= infix:<=>
   infix:.. infix:^.. infix:..^ infix:^..^
   prefix:+ prefix:- prefix:~ prefix:? prefix:! prefix:^
@@ -19,22 +19,22 @@
             .sub '$_' :multi('Whatever', _)
                 .param pmc x
                 .param pmc y
-                .tailcall '!whatever_helper'('$_', x, y)
+                .tailcall 'WhateverCodeX'('$_', x, y)
             .end
             .sub '$_' :multi(_, 'Whatever')
                 .param pmc x
                 .param pmc y
-                .tailcall '!whatever_helper'('$_', x, y)
+                .tailcall 'WhateverCodeX'('$_', x, y)
             .end
             .sub '$_' :multi('WhateverCode', _)
                 .param pmc x
                 .param pmc y
-                .tailcall '!whatever_helper'('$_', x, y)
+                .tailcall 'WhateverCodeX'('$_', x, y)
             .end
             .sub '$_' :multi(_, 'WhateverCode')
                 .param pmc x
                 .param pmc y
-                .tailcall '!whatever_helper'('$_', x, y)
+                .tailcall 'WhateverCodeX'('$_', x, y)
             .end
         };
     }
@@ -43,59 +43,14 @@
             .namespace []
             .sub '$_' :multi('Whatever')
                 .param pmc x
-                .tailcall '!whatever_helper'('$_', x)
+                .tailcall 'WhateverCodeX'('$_', x)
             .end
             .sub '$_' :multi('WhateverCode', _)
                 .param pmc x
                 .param pmc y
-                .tailcall '!whatever_helper'('$_', x, y)
+                .tailcall 'WhateverCodeX'('$_', x, y)
             .end
         };
     }
 }
 
-print q{
-    .namespace []
-    .sub '!whatever_helper' :anon
-        .param string opname
-        .param pmc left
-        .param pmc right       :optional
-        .local pmc opfunc
-        opfunc = find_name opname
-        .lex '$opfunc', opfunc
-        .lex '$left', left
-        .lex '$right', right
-        .const 'Sub' $P0 = '!whatever_closure'
-        $P1 = newclosure $P0
-        '!fixup_routine_type'($P1, 'WhateverCode')
-        .return ($P1)
-    .end
-    .sub '!whatever_closure' :anon :outer('!whatever_helper')
-        .param pmc arg
-        .local pmc opfunc, left, right
-        opfunc = find_lex '$opfunc'
-        left   = find_lex '$left'
-        right  = find_lex '$right'
-        left   = '!whatever_eval'(left, arg)
-        if null right goto unary
-        right  = '!whatever_eval'(right, arg)
-        .tailcall opfunc(left, right)
-      unary:
-        .tailcall opfunc(left)
-    .end
-    .sub '!whatever_eval' :multi(_)
-        .param pmc whatever
-        .param pmc arg
-        .return (whatever)
-    .end
-    .sub '!whatever_eval' :multi('Whatever')
-        .param pmc whatever
-        .param pmc arg
-        .return (arg)
-    .end
-    .sub '!whatever_eval' :multi('WhateverCode')
-        .param pmc whatever
-        .param pmc arg
-        .tailcall whatever(arg)
-    .end
-};
diff --git a/src/builtins/op.pir b/src/builtins/op.pir
@@ -279,37 +279,6 @@ src/builtins/op.pir - Perl 6 builtin operators
 
 
 ## additive
-.sub 'infix:+' :multi(_,_)
-    .param num a
-    .param num b
-    $N0 = a + b
-    .return ($N0)
-.end
-
-
-.sub 'infix:+' :multi(Integer,Integer)
-    .param num a
-    .param num b
-    $N0 = a + b
-    .tailcall '!upgrade_to_num_if_needed'($N0)
-.end
-
-
-.sub 'infix:-' :multi(_,_)
-    .param num a
-    .param num b
-    $N0 = a - b
-    .return ($N0)
-.end
-
-
-.sub 'infix:-' :multi(Integer,Integer)
-    .param num a
-    .param num b
-    $N0 = a - b
-    .tailcall '!upgrade_to_num_if_needed'($N0)
-.end
-
 
 .sub 'infix:~' :multi(_,_)
     .param string a

diff --git a/src/classes/Complex.pir b/src/classes/Complex.pir
@@ -162,57 +162,17 @@ Casts a value to a complex number.
     .return ($N0)
 .end
 
-=item infix:+
+=item prefix:+
 
 =cut
 
 .namespace []
 
-.sub 'infix:+' :multi('Complex', _)
-    .param pmc a
-    .param pmc b
-    b = b.'Complex'()
-    add $P0, a, b
-    .return ($P0)
-.end
-
-.sub 'infix:+' :multi(_, 'Complex')
-    .param pmc a
-    .param pmc b
-    a = a.'Complex'()
-    add $P0, a, b
-    .return ($P0)
-.end
-
-=item prefix:+
-
-=cut
-
 .sub 'prefix:+' :multi('Complex')
     .param pmc a
     .return (a)
 .end
 
-=item infix:-
-
-=cut
-
-.sub 'infix:-' :multi('Complex', _)
-    .param pmc a
-    .param pmc b
-    b = b.'Complex'()
-    sub $P0, a, b
-    .return ($P0)
-.end
-
-.sub 'infix:-' :multi(_, 'Complex')
-    .param pmc a
-    .param pmc b
-    a = a.'Complex'()
-    sub $P0, a, b
-    .return ($P0)
-.end
-
 =item prefix:-
 
 =cut

diff --git a/src/classes/WhateverCode.pir b/src/classes/WhateverCode.pir
@@ -6,7 +6,7 @@ WhateverCode - Blocks that delay evaluation of whatever results
 
 =head1 DESCRIPTION
 
-This file sets up the Perl 6 C<WhateverCode> class, the class for 
+This file sets up the Perl 6 C<WhateverCode> class, the class for
 C<Whatever> operations.
 
 =cut
@@ -19,6 +19,51 @@ C<Whatever> operations.
     p6meta.'new_class'('WhateverCode', 'parent'=>'Code')
 .end
 
+
+.namespace []
+.sub 'WhateverCodeX' :anon
+    .param string opname
+    .param pmc left
+    .param pmc right       :optional
+    .local pmc opfunc
+    opfunc = find_name opname
+    .lex '$opfunc', opfunc
+    .lex '$left', left
+    .lex '$right', right
+    .const 'Sub' $P0 = '!whatever_closure'
+    $P1 = newclosure $P0
+    '!fixup_routine_type'($P1, 'WhateverCode')
+    .return ($P1)
+.end
+.sub '!whatever_closure' :anon :outer('WhateverCodeX')
+    .param pmc arg
+    .local pmc opfunc, left, right
+    opfunc = find_lex '$opfunc'
+    left   = find_lex '$left'
+    right  = find_lex '$right'
+    left   = '!whatever_eval'(left, arg)
+    if null right goto unary
+    right  = '!whatever_eval'(right, arg)
+    .tailcall opfunc(left, right)
+  unary:
+    .tailcall opfunc(left)
+.end
+.sub '!whatever_eval' :multi(_)
+    .param pmc whatever
+    .param pmc arg
+    .return (whatever)
+.end
+.sub '!whatever_eval' :multi('Whatever')
+    .param pmc whatever
+    .param pmc arg
+    .return (arg)
+.end
+.sub '!whatever_eval' :multi('WhateverCode')
+    .param pmc whatever
+    .param pmc arg
+    .tailcall whatever(arg)
+.end
+
 =over 4
 
 =back

diff --git a/src/setting/Complex.pm b/src/setting/Complex.pm
@@ -0,0 +1,46 @@
+multi sub infix:<+>(Complex $a, $b) is default {
+    Q:PIR {
+        $P0 = find_lex '$a'
+        $P1 = find_lex '$b'
+        $P1 = $P1.'Complex'()
+        $P0 = deobjectref $P0
+        $P1 = deobjectref $P1
+        %r = add $P0, $P1
+    }
+}
+
+multi sub infix:<+>($a, Complex $b) {
+    Q:PIR { 
+        $P0 = find_lex '$a' 
+        $P0 = $P0.'Complex'()
+        $P1 = find_lex '$b'
+        $P0 = deobjectref $P0
+        $P1 = deobjectref $P1
+        %r = add $P0, $P1
+    }
+}
+
+multi sub infix:<->(Complex $a, $b) is default {
+    Q:PIR {
+        $P0 = find_lex '$a'
+        $P1 = find_lex '$b'
+        $P1 = $P1.'Complex'()
+        $P0 = deobjectref $P0
+        $P1 = deobjectref $P1
+        %r = sub $P0, $P1
+    }
+}
+
+multi sub infix:<->($a, Complex $b) {
+    Q:PIR { 
+        $P0 = find_lex '$a' 
+        $P0 = $P0.'Complex'()
+        $P1 = find_lex '$b'
+        $P0 = deobjectref $P0
+        $P1 = deobjectref $P1
+        %r = sub $P0, $P1
+    }
+}
+
+
+# vim: ft=perl6
diff --git a/src/setting/Operators.pm b/src/setting/Operators.pm
@@ -86,4 +86,50 @@ sub prefix:<[||]>(*@a) {
 
 sub infix:<!%>($a, $b) { ! ($a % $b) }
 
+
+multi sub infix:<+>($a, $b) {
+    Q:PIR {
+        $P0 = find_lex '$a'
+        $N0 = $P0
+        $P1 = find_lex '$b'
+        $N1 = $P1
+        $N2 = $N0 + $N1
+        %r = box $N2
+    }
+}
+
+multi sub infix:<+>(Int $a, Int $b) {
+    Q:PIR {
+        $P0 = find_lex '$a'
+        $N0 = $P0
+        $P1 = find_lex '$b'
+        $N1 = $P1
+        $N2 = $N0 + $N1
+        %r = '!upgrade_to_num_if_needed'($N2)
+    }
+}
+    
+multi sub infix:<->($a, $b) {
+    Q:PIR {
+        $P0 = find_lex '$a'
+        $N0 = $P0
+        $P1 = find_lex '$b'
+        $N1 = $P1
+        $N2 = $N0 - $N1
+        %r = box $N2
+    }
+}
+
+multi sub infix:<->(Int $a, Int $b) {
+    Q:PIR {
+        $P0 = find_lex '$a'
+        $N0 = $P0
+        $P1 = find_lex '$b'
+        $N1 = $P1
+        $N2 = $N0 - $N1
+        %r = '!upgrade_to_num_if_needed'($N2)
+    }
+}
+    
+
 # vim: ft=perl6